ROMS
Loading...
Searching...
No Matches
wrt_his.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE wrt_his_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 module writes requested model fields into the HISTORY output !
12! file using either the standard NetCDF library or the Parallel-IO !
13! (PIO) library. !
14! !
15! Notice that only momentum is affected by the full time-averaged !
16! masks. If applicable, these mask contains information about !
17! river runoff and time-dependent wetting and drying variations. !
18! !
19!=======================================================================
20!
21 USE mod_param
22 USE mod_parallel
23#ifdef BBL_MODEL
24 USE mod_bbl
25#endif
26#ifdef ADJUST_BOUNDARY
27 USE mod_boundary
28#endif
29#ifdef SOLVE3D
30 USE mod_coupling
31#endif
32 USE mod_forces
33 USE mod_grid
34 USE mod_iounits
35 USE mod_mixing
36 USE mod_ncparam
37 USE mod_ocean
38 USE mod_scalars
39#if defined SEDIMENT || defined BBL_MODEL
40 USE mod_sedbed
41 USE mod_sediment
42#endif
43 USE mod_stepping
44!
45#if (defined BBL_MODEL || defined WAVES_OUTPUT) && defined SOLVE3D
46 USE bbl_output_mod, ONLY : bbl_wrt_nf90
47# if defined PIO_LIB && defined DISTRIBUTE
48 USE bbl_output_mod, ONLY : bbl_wrt_pio
49# endif
50#endif
51#if defined ICE_MODEL && defined SOLVE3D
52 USE ice_output_mod, ONLY : ice_wrt_nf90
53# if defined PIO_LIB && defined DISTRIBUTE
54 USE ice_output_mod, ONLY : ice_wrt_pio
55# endif
56#endif
57 USE nf_fwrite2d_mod, ONLY : nf_fwrite2d
58#ifdef ADJUST_BOUNDARY
59 USE nf_fwrite2d_bry_mod, ONLY : nf_fwrite2d_bry
60#endif
61#ifdef SOLVE3D
62 USE nf_fwrite3d_mod, ONLY : nf_fwrite3d
63# ifdef ADJUST_BOUNDARY
64 USE nf_fwrite3d_bry_mod, ONLY : nf_fwrite3d_bry
65# endif
66 USE omega_mod, ONLY : scale_omega
67#endif
68#if defined SEDIMENT && defined SOLVE3D
69 USE sediment_output_mod, ONLY : sediment_wrt_nf90
70# if defined PIO_LIB && defined DISTRIBUTE
71 USE sediment_output_mod, ONLY : sediment_wrt_pio
72# endif
73#endif
74 USE strings_mod, ONLY : founderror
75 USE uv_rotate_mod, ONLY : uv_rotate2d
76#ifdef SOLVE3D
77 USE uv_rotate_mod, ONLY : uv_rotate3d
78#endif
79#if defined WEC_VF && defined SOLVE3D
80 USE wec_output_mod, ONLY : wec_wrt_nf90
81# if defined PIO_LIB && defined DISTRIBUTE
82 USE wec_output_mod, ONLY : wec_wrt_pio
83# endif
84#endif
85!
86 implicit none
87!
88 PUBLIC :: wrt_his
89 PRIVATE :: wrt_his_nf90
90#if defined PIO_LIB && defined DISTRIBUTE
91 PRIVATE :: wrt_his_pio
92#endif
93!
94 CONTAINS
95!
96!***********************************************************************
97 SUBROUTINE wrt_his (ng, tile)
98!***********************************************************************
99!
100! Imported variable declarations.
101!
102 integer, intent(in) :: ng, tile
103!
104! Local variable declarations.
105!
106#ifdef ADJUST_BOUNDARY
107 integer :: lbij, ubij
108#endif
109 integer :: lbi, ubi, lbj, ubj
110!
111 character (len=*), parameter :: myfile = &
112 & __FILE__
113!
114!-----------------------------------------------------------------------
115! Write out history fields according to IO type.
116!-----------------------------------------------------------------------
117!
118#ifdef ADJUST_BOUNDARY
119 lbij=bounds(ng)%LBij
120 ubij=bounds(ng)%UBij
121#endif
122 lbi=bounds(ng)%LBi(tile)
123 ubi=bounds(ng)%UBi(tile)
124 lbj=bounds(ng)%LBj(tile)
125 ubj=bounds(ng)%UBj(tile)
126!
127 SELECT CASE (his(ng)%IOtype)
128 CASE (io_nf90)
129 CALL wrt_his_nf90 (ng, inlm, tile, &
130#ifdef ADJUST_BOUNDARY
131 & lbij, ubij, &
132#endif
133 & lbi, ubi, lbj, ubj)
134
135#if defined PIO_LIB && defined DISTRIBUTE
136 CASE (io_pio)
137 CALL wrt_his_pio (ng, inlm, tile, &
138# ifdef ADJUST_BOUNDARY
139 & lbij, ubij, &
140# endif
141 & lbi, ubi, lbj, ubj)
142#endif
143 CASE DEFAULT
144 IF (master) WRITE (stdout,10) his(ng)%IOtype
145 exit_flag=3
146 END SELECT
147 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
148!
149 10 FORMAT (' WRT_HIS - Illegal output file type, io_type = ',i0, &
150 & /,11x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
151!
152 RETURN
153 END SUBROUTINE wrt_his
154!
155!***********************************************************************
156 SUBROUTINE wrt_his_nf90 (ng, model, tile, &
157#ifdef ADJUST_BOUNDARY
158 & LBij, UBij, &
159#endif
160 & LBi, UBi, LBj, UBj)
161!***********************************************************************
162!
163 USE mod_netcdf
164!
165! Imported variable declarations.
166!
167 integer, intent(in) :: ng, model, tile
168#ifdef ADJUST_BOUNDARY
169 integer, intent(in) :: lbij, ubij
170#endif
171 integer, intent(in) :: lbi, ubi, lbj, ubj
172!
173! Local variable declarations.
174!
175 integer :: fcount, gfactor, gtype, ifield, status
176#ifdef SOLVE3D
177 integer :: i, itrc, j, k
178#endif
179!
180 real(dp) :: scale
181
182 real(r8), allocatable :: ur2d(:,:)
183 real(r8), allocatable :: vr2d(:,:)
184#ifdef SOLVE3D
185 real(r8), allocatable :: wr3d(:,:,:)
186#endif
187!
188 character (len=*), parameter :: myfile = &
189 & __FILE__//", wrt_his_nf90"
190
191# include "set_bounds.h"
192!
193 sourcefile=myfile
194!
195!-----------------------------------------------------------------------
196! Write out history fields.
197!-----------------------------------------------------------------------
198!
199 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
200!
201! Set grid type factor to write full (gfactor=1) fields or water
202! points (gfactor=-1) fields only.
203!
204#if defined WRITE_WATER && defined MASKING
205 gfactor=-1
206#else
207 gfactor=1
208#endif
209!
210! Set time record index.
211!
212 his(ng)%Rindex=his(ng)%Rindex+1
213 fcount=his(ng)%load
214 his(ng)%Nrec(fcount)=his(ng)%Nrec(fcount)+1
215!
216! Report.
217!
218#ifdef SOLVE3D
219# ifdef NESTING
220 IF (master) WRITE (stdout,10) kout, nout, his(ng)%Rindex, ng
221# else
222 IF (master) WRITE (stdout,10) kout, nout, his(ng)%Rindex
223# endif
224#else
225# ifdef NESTING
226 IF (master) WRITE (stdout,10) kout, his(ng)%Rindex, ng
227# else
228 IF (master) WRITE (stdout,10) kout, his(ng)%Rindex
229# endif
230#endif
231!
232! Write out model time (s).
233!
234 CALL netcdf_put_fvar (ng, model, his(ng)%name, &
235 & trim(vname(1,idtime)), time(ng:), &
236 & (/his(ng)%Rindex/), (/1/), &
237 & ncid = his(ng)%ncid, &
238 & varid = his(ng)%Vid(idtime))
239 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
240
241#ifdef WET_DRY
242!
243! Write out wet/dry mask at PSI-points.
244!
245 scale=1.0_dp
246 gtype=gfactor*p2dvar
247 status=nf_fwrite2d(ng, model, his(ng)%ncid, idpwet, &
248 & his(ng)%Vid(idpwet), &
249 & his(ng)%Rindex, gtype, &
250 & lbi, ubi, lbj, ubj, scale, &
251# ifdef MASKING
252 & grid(ng) % pmask, &
253# endif
254 & grid(ng) % pmask_wet, &
255 & setfillval = .false.)
256 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
257 IF (master) THEN
258 WRITE (stdout,20) trim(vname(1,idpwet)), his(ng)%Rindex
259 END IF
260 exit_flag=3
261 ioerror=status
262 RETURN
263 END IF
264!
265! Write out wet/dry mask at RHO-points.
266!
267 scale=1.0_dp
268 gtype=gfactor*r2dvar
269 status=nf_fwrite2d(ng, model, his(ng)%ncid, idrwet, &
270 & his(ng)%Vid(idrwet), &
271 & his(ng)%Rindex, gtype, &
272 & lbi, ubi, lbj, ubj, scale, &
273# ifdef MASKING
274 & grid(ng) % rmask, &
275# endif
276 & grid(ng) % rmask_wet, &
277 & setfillval = .false.)
278 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
279 IF (master) THEN
280 WRITE (stdout,20) trim(vname(1,idrwet)), his(ng)%Rindex
281 END IF
282 exit_flag=3
283 ioerror=status
284 RETURN
285 END IF
286!
287! Write out wet/dry mask at U-points.
288!
289 scale=1.0_dp
290 gtype=gfactor*u2dvar
291 status=nf_fwrite2d(ng, model, his(ng)%ncid, iduwet, &
292 & his(ng)%Vid(iduwet), &
293 & his(ng)%Rindex, gtype, &
294 & lbi, ubi, lbj, ubj, scale, &
295# ifdef MASKING
296 & grid(ng) % umask, &
297# endif
298 & grid(ng) % umask_wet, &
299 & setfillval = .false.)
300 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
301 IF (master) THEN
302 WRITE (stdout,20) trim(vname(1,iduwet)), his(ng)%Rindex
303 END IF
304 exit_flag=3
305 ioerror=status
306 RETURN
307 END IF
308!
309! Write out wet/dry mask at V-points.
310!
311 scale=1.0_dp
312 gtype=gfactor*v2dvar
313 status=nf_fwrite2d(ng, model, his(ng)%ncid, idvwet, &
314 & his(ng)%Vid(idvwet), &
315 & his(ng)%Rindex, gtype, &
316 & lbi, ubi, lbj, ubj, scale, &
317# ifdef MASKING
318 & grid(ng) % vmask, &
319# endif
320 & grid(ng) % vmask_wet, &
321 & setfillval = .false.)
322 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
323 IF (master) THEN
324 WRITE (stdout,20) trim(vname(1,idvwet)), his(ng)%Rindex
325 END IF
326 exit_flag=3
327 ioerror=status
328 RETURN
329 END IF
330#endif
331#ifdef SOLVE3D
332!
333! Write time-varying depths of RHO-points.
334!
335 IF (hout(idpthr,ng)) THEN
336 scale=1.0_dp
337 gtype=gfactor*r3dvar
338 status=nf_fwrite3d(ng, model, his(ng)%ncid, idpthr, &
339 & his(ng)%Vid(idpthr), &
340 & his(ng)%Rindex, gtype, &
341 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
342# ifdef MASKING
343 & grid(ng) % rmask, &
344# endif
345 & grid(ng) % z_r, &
346 & setfillval = .false.)
347 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
348 IF (master) THEN
349 WRITE (stdout,20) trim(vname(1,idpthr)), his(ng)%Rindex
350 END IF
351 exit_flag=3
352 ioerror=status
353 RETURN
354 END IF
355 END IF
356!
357! Write time-varying depths of U-points.
358!
359 IF (hout(idpthu,ng)) THEN
360 scale=1.0_dp
361 gtype=gfactor*u3dvar
362 DO k=1,n(ng)
363 DO j=jstr-1,jend+1
364 DO i=istru-1,iend+1
365 grid(ng)%z_v(i,j,k)=0.5_r8*(grid(ng)%z_r(i-1,j,k)+ &
366 & grid(ng)%z_r(i ,j,k))
367 END DO
368 END DO
369 END DO
370 status=nf_fwrite3d(ng, model, his(ng)%ncid, idpthu, &
371 & his(ng)%Vid(idpthu), &
372 & his(ng)%Rindex, gtype, &
373 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
374# ifdef MASKING
375 & grid(ng) % umask, &
376# endif
377 & grid(ng) % z_v, &
378 & setfillval = .false.)
379 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
380 IF (master) THEN
381 WRITE (stdout,20) trim(vname(1,idpthu)), his(ng)%Rindex
382 END IF
383 exit_flag=3
384 ioerror=status
385 RETURN
386 END IF
387 END IF
388!
389! Write time-varying depths of V-points.
390!
391 IF (hout(idpthv,ng)) THEN
392 scale=1.0_dp
393 gtype=gfactor*v3dvar
394 DO k=1,n(ng)
395 DO j=jstrv-1,jend+1
396 DO i=istr-1,iend+1
397 grid(ng)%z_v(i,j,k)=0.5_r8*(grid(ng)%z_r(i,j-1,k)+ &
398 & grid(ng)%z_r(i,j ,k))
399 END DO
400 END DO
401 END DO
402 status=nf_fwrite3d(ng, model, his(ng)%ncid, idpthv, &
403 & his(ng)%Vid(idpthv), &
404 & his(ng)%Rindex, gtype, &
405 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
406# ifdef MASKING
407 & grid(ng) % vmask, &
408# endif
409 & grid(ng) % z_v, &
410 & setfillval = .false.)
411 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
412 IF (master) THEN
413 WRITE (stdout,20) trim(vname(1,idpthv)), his(ng)%Rindex
414 END IF
415 exit_flag=3
416 ioerror=status
417 RETURN
418 END IF
419 END IF
420!
421! Write time-varying depths of W-points.
422!
423 IF (hout(idpthw,ng)) THEN
424 scale=1.0_dp
425 gtype=gfactor*w3dvar
426 status=nf_fwrite3d(ng, model, his(ng)%ncid, idpthw, &
427 & his(ng)%Vid(idpthw), &
428 & his(ng)%Rindex, gtype, &
429 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
430# ifdef MASKING
431 & grid(ng) % rmask, &
432# endif
433 & grid(ng) % z_w, &
434 & setfillval = .false.)
435 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
436 IF (master) THEN
437 WRITE (stdout,20) trim(vname(1,idpthw)), his(ng)%Rindex
438 END IF
439 exit_flag=3
440 ioerror=status
441 RETURN
442 END IF
443 END IF
444#endif
445!
446! Write out free-surface (m)
447!
448 IF (hout(idfsur,ng)) THEN
449 scale=1.0_dp
450 gtype=gfactor*r2dvar
451 status=nf_fwrite2d(ng, model, his(ng)%ncid, idfsur, &
452 & his(ng)%Vid(idfsur), &
453 & his(ng)%Rindex, gtype, &
454 & lbi, ubi, lbj, ubj, scale, &
455#ifdef MASKING
456 & grid(ng) % rmask, &
457#endif
458#ifdef WET_DRY
459 & ocean(ng) % zeta(:,:,kout), &
460 & setfillval = .false.)
461#else
462 & ocean(ng) % zeta(:,:,kout))
463#endif
464 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
465 IF (master) THEN
466 WRITE (stdout,20) trim(vname(1,idfsur)), his(ng)%Rindex
467 END IF
468 exit_flag=3
469 ioerror=status
470 RETURN
471 END IF
472#if defined FORWARD_WRITE && defined FORWARD_RHS
473 status=nf_fwrite2d(ng, model, his(ng)%ncid, idrzet, &
474 & his(ng)%Vid(idrzet), &
475 & his(ng)%Rindex, gtype, &
476 & lbi, ubi, lbj, ubj, scale, &
477# ifdef MASKING
478 & grid(ng) % rmask, &
479# endif
480 & ocean(ng) % rzeta(:,:,kout))
481 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
482 IF (master) THEN
483 WRITE (stdout,20) trim(vname(1,idrzet)), his(ng)%Rindex
484 END IF
485 exit_flag=3
486 ioerror=status
487 RETURN
488 END IF
489#endif
490 END IF
491#ifdef ADJUST_BOUNDARY
492!
493! Write out free-surface open boundaries.
494!
495 IF (any(lobc(:,isfsur,ng))) THEN
496 scale=1.0_dp
497 status=nf_fwrite2d_bry(ng, model, his(ng)%name, his(ng)%ncid, &
498 & vname(1,idsbry(isfsur)), &
499 & his(ng)%Vid(idsbry(isfsur)), &
500 & his(ng)%Rindex, r2dvar, &
501 & lbij, ubij, nbrec(ng), scale, &
502 & boundary(ng) % zeta_obc(lbij:,:,:, &
503 & lbout(ng)))
504 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
505 IF (master) THEN
506 WRITE (stdout,20) trim(vname(1,idsbry(isfsur))), &
507 & his(ng)%Rindex
508 END IF
509 exit_flag=3
510 ioerror=status
511 RETURN
512 END IF
513 END IF
514#endif
515!
516! Write out 2D U-momentum component (m/s).
517!
518 IF (hout(idubar,ng)) THEN
519 scale=1.0_dp
520 gtype=gfactor*u2dvar
521 status=nf_fwrite2d(ng, model, his(ng)%ncid, idubar, &
522 & his(ng)%Vid(idubar), &
523 & his(ng)%Rindex, gtype, &
524 & lbi, ubi, lbj, ubj, scale, &
525#ifdef MASKING
526 & grid(ng) % umask_full, &
527#endif
528 & ocean(ng) % ubar(:,:,kout))
529 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
530 IF (master) THEN
531 WRITE (stdout,20) trim(vname(1,idubar)), his(ng)%Rindex
532 END IF
533 exit_flag=3
534 ioerror=status
535 RETURN
536 END IF
537#ifdef FORWARD_WRITE
538# ifdef FORWARD_RHS
539 status=nf_fwrite2d(ng, model, his(ng)%ncid, idru2d, &
540 & his(ng)%Vid(idru2d), &
541 & his(ng)%Rindex, gtype, &
542 & lbi, ubi, lbj, ubj, scale, &
543# ifdef MASKING
544 & grid(ng) % umask_full, &
545# endif
546 & ocean(ng) % rubar(:,:,kout))
547 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
548 IF (master) THEN
549 WRITE (stdout,20) trim(vname(1,idru2d)), his(ng)%Rindex
550 END IF
551 exit_flag=3
552 ioerror=status
553 RETURN
554 END IF
555# endif
556# ifdef SOLVE3D
557# ifdef FORWARD_RHS
558 status=nf_fwrite2d(ng, model, his(ng)%ncid, idruct, &
559 & his(ng)%Vid(idruct), &
560 & his(ng)%Rindex, gtype, &
561 & lbi, ubi, lbj, ubj, scale, &
562# ifdef MASKING
563 & grid(ng) % umask_full, &
564# endif
565 & coupling(ng) % rufrc)
566 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
567 IF (master) THEN
568 WRITE (stdout,20) trim(vname(1,idruct)), his(ng)%Rindex
569 END IF
570 exit_flag=3
571 ioerror=status
572 RETURN
573 END IF
574# endif
575 status=nf_fwrite2d(ng, model, his(ng)%ncid, idufx1, &
576 & his(ng)%Vid(idufx1), &
577 & his(ng)%Rindex, gtype, &
578 & lbi, ubi, lbj, ubj, scale, &
579# ifdef MASKING
580 & grid(ng) % umask_full, &
581# endif
582 & coupling(ng) % DU_avg1)
583 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
584 IF (master) THEN
585 WRITE (stdout,20) trim(vname(1,idufx1)), his(ng)%Rindex
586 END IF
587 exit_flag=3
588 ioerror=status
589 RETURN
590 END IF
591 status=nf_fwrite2d(ng, model, his(ng)%ncid, idufx2, &
592 & his(ng)%Vid(idufx2), &
593 & his(ng)%Rindex, gtype, &
594 & lbi, ubi, lbj, ubj, scale, &
595# ifdef MASKING
596 & grid(ng) % umask_full, &
597# endif
598 & coupling(ng) % DU_avg2)
599 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
600 IF (master) THEN
601 WRITE (stdout,20) trim(vname(1,idufx2)), his(ng)%Rindex
602 END IF
603 exit_flag=3
604 ioerror=status
605 RETURN
606 END IF
607# endif
608#endif
609 END IF
610#ifdef ADJUST_BOUNDARY
611!
612! Write out 2D U-momentum component open boundaries.
613!
614 IF (any(lobc(:,isubar,ng))) THEN
615 scale=1.0_dp
616 status=nf_fwrite2d_bry(ng, model, his(ng)%name, his(ng)%ncid, &
617 & vname(1,idsbry(isubar)), &
618 & his(ng)%Vid(idsbry(isubar)), &
619 & his(ng)%Rindex, u2dvar, &
620 & lbij, ubij, nbrec(ng), scale, &
621 & boundary(ng) % ubar_obc(lbij:,:,:, &
622 & lbout(ng)))
623 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
624 IF (master) THEN
625 WRITE (stdout,20) trim(vname(1,idsbry(isubar))), &
626 & his(ng)%Rindex
627 END IF
628 exit_flag=3
629 ioerror=status
630 RETURN
631 END IF
632 END IF
633#endif
634!
635! Write out 2D V-momentum component (m/s).
636!
637 IF (hout(idvbar,ng)) THEN
638 scale=1.0_dp
639 gtype=gfactor*v2dvar
640 status=nf_fwrite2d(ng, model, his(ng)%ncid, idvbar, &
641 & his(ng)%Vid(idvbar), &
642 & his(ng)%Rindex, gtype, &
643 & lbi, ubi, lbj, ubj, scale, &
644#ifdef MASKING
645 & grid(ng) % vmask_full, &
646#endif
647 & ocean(ng) % vbar(:,:,kout))
648 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
649 IF (master) THEN
650 WRITE (stdout,20) trim(vname(1,idvbar)), his(ng)%Rindex
651 END IF
652 exit_flag=3
653 ioerror=status
654 RETURN
655 END IF
656#ifdef FORWARD_WRITE
657# ifdef FORWARD_RHS
658 status=nf_fwrite2d(ng, model, his(ng)%ncid, idrv2d, &
659 & his(ng)%Vid(idrv2d), &
660 & his(ng)%Rindex, gtype, &
661 & lbi, ubi, lbj, ubj, scale, &
662# ifdef MASKING
663 & grid(ng) % vmask_full, &
664# endif
665 & ocean(ng) % rvbar(:,:,kout))
666 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
667 IF (master) THEN
668 WRITE (stdout,20) trim(vname(1,idrv2d)), his(ng)%Rindex
669 END IF
670 exit_flag=3
671 ioerror=status
672 RETURN
673 END IF
674# endif
675# ifdef SOLVE3D
676# ifdef FORWARD_RHS
677 status=nf_fwrite2d(ng, model, his(ng)%ncid, idrvct, &
678 & his(ng)%Vid(idrvct), &
679 & his(ng)%Rindex, gtype, &
680 & lbi, ubi, lbj, ubj, scale, &
681# ifdef MASKING
682 & grid(ng) % vmask_full, &
683# endif
684 & coupling(ng) % rvfrc)
685 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
686 IF (master) THEN
687 WRITE (stdout,20) trim(vname(1,idrvct)), his(ng)%Rindex
688 END IF
689 exit_flag=3
690 ioerror=status
691 RETURN
692 END IF
693# endif
694 status=nf_fwrite2d(ng, model, his(ng)%ncid, idvfx1, &
695 & his(ng)%Vid(idvfx1), &
696 & his(ng)%Rindex, gtype, &
697 & lbi, ubi, lbj, ubj, scale, &
698# ifdef MASKING
699 & grid(ng) % vmask_full, &
700# endif
701 & coupling(ng) % DV_avg1)
702 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
703 IF (master) THEN
704 WRITE (stdout,20) trim(vname(1,idvfx1)), his(ng)%Rindex
705 END IF
706 exit_flag=3
707 ioerror=status
708 RETURN
709 END IF
710 status=nf_fwrite2d(ng, model, his(ng)%ncid, idvfx2, &
711 & his(ng)%Vid(idvfx2), &
712 & his(ng)%Rindex, gtype, &
713 & lbi, ubi, lbj, ubj, scale, &
714# ifdef MASKING
715 & grid(ng) % vmask_full, &
716# endif
717 & coupling(ng) % DV_avg2)
718 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
719 IF (master) THEN
720 WRITE (stdout,20) trim(vname(1,idvfx2)), his(ng)%Rindex
721 END IF
722 exit_flag=3
723 ioerror=status
724 RETURN
725 END IF
726# endif
727#endif
728 END IF
729#ifdef ADJUST_BOUNDARY
730!
731! Write out 2D V-momentum component open boundaries.
732!
733 IF (any(lobc(:,isvbar,ng))) THEN
734 scale=1.0_dp
735 status=nf_fwrite2d_bry(ng, model, his(ng)%name, his(ng)%ncid, &
736 & vname(1,idsbry(isvbar)), &
737 & his(ng)%Vid(idsbry(isvbar)), &
738 & his(ng)%Rindex, v2dvar, &
739 & lbij, ubij, nbrec(ng), scale, &
740 & boundary(ng) % vbar_obc(lbij:,:,:, &
741 & lbout(ng)))
742 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
743 IF (master) THEN
744 WRITE (stdout,20) trim(vname(1,idsbry(isvbar))), &
745 & his(ng)%Rindex
746 END IF
747 exit_flag=3
748 ioerror=status
749 RETURN
750 END IF
751 END IF
752#endif
753!
754! Write out 2D Eastward and Northward momentum components (m/s) at
755! RHO-points.
756!
757 IF (hout(idu2de,ng).and.hout(idv2dn,ng)) THEN
758 IF (.not.allocated(ur2d)) THEN
759 allocate (ur2d(lbi:ubi,lbj:ubj))
760 ur2d(lbi:ubi,lbj:ubj)=0.0_r8
761 END IF
762 IF (.not.allocated(vr2d)) THEN
763 allocate (vr2d(lbi:ubi,lbj:ubj))
764 vr2d(lbi:ubi,lbj:ubj)=0.0_r8
765 END IF
766 CALL uv_rotate2d (ng, tile, .false., .true., &
767 & lbi, ubi, lbj, ubj, &
768 & grid(ng) % CosAngler, &
769 & grid(ng) % SinAngler, &
770#ifdef MASKING
771 & grid(ng) % rmask_full, &
772#endif
773 & ocean(ng) % ubar(:,:,kout), &
774 & ocean(ng) % vbar(:,:,kout), &
775 & ur2d, vr2d)
776!
777 scale=1.0_dp
778 gtype=gfactor*r2dvar
779 status=nf_fwrite2d(ng, model, his(ng)%ncid, idu2de, &
780 & his(ng)%Vid(idu2de), &
781 & his(ng)%Rindex, gtype, &
782 & lbi, ubi, lbj, ubj, scale, &
783#ifdef MASKING
784 & grid(ng) % rmask_full, &
785#endif
786 & ur2d)
787 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
788 IF (master) THEN
789 WRITE (stdout,20) trim(vname(1,idu2de)), his(ng)%Rindex
790 END IF
791 exit_flag=3
792 ioerror=status
793 RETURN
794 END IF
795!
796 status=nf_fwrite2d(ng, model, his(ng)%ncid, idv2dn, &
797 & his(ng)%Vid(idv2dn), &
798 & his(ng)%Rindex, gtype, &
799 & lbi, ubi, lbj, ubj, scale, &
800#ifdef MASKING
801 & grid(ng) % rmask_full, &
802#endif
803 & vr2d)
804 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
805 IF (master) THEN
806 WRITE (stdout,20) trim(vname(1,idv2dn)), his(ng)%Rindex
807 END IF
808 exit_flag=3
809 ioerror=status
810 RETURN
811 END IF
812 deallocate (ur2d)
813 deallocate (vr2d)
814 END IF
815
816#ifdef SOLVE3D
817!
818! Write out 3D U-momentum component (m/s).
819!
820 IF (hout(iduvel,ng)) THEN
821 scale=1.0_dp
822 gtype=gfactor*u3dvar
823 status=nf_fwrite3d(ng, model, his(ng)%ncid, iduvel, &
824 & his(ng)%Vid(iduvel), &
825 & his(ng)%Rindex, gtype, &
826 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
827# ifdef MASKING
828 & grid(ng) % umask_full, &
829# endif
830 & ocean(ng) % u(:,:,:,nout))
831 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
832 IF (master) THEN
833 WRITE (stdout,20) trim(vname(1,iduvel)), his(ng)%Rindex
834 END IF
835 exit_flag=3
836 ioerror=status
837 RETURN
838 END IF
839# if defined FORWARD_WRITE && defined FORWARD_RHS
840 status=nf_fwrite3d(ng, model, his(ng)%ncid, idru3d, &
841 & his(ng)%Vid(idru3d), &
842 & his(ng)%Rindex, gtype, &
843 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
844# ifdef MASKING
845 & grid(ng) % umask_full, &
846# endif
847 & ocean(ng) % ru(:,:,:,nout))
848 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
849 IF (master) THEN
850 WRITE (stdout,20) trim(vname(1,idru3d)), his(ng)%Rindex
851 END IF
852 exit_flag=3
853 ioerror=status
854 RETURN
855 END IF
856# endif
857 END IF
858# ifdef ADJUST_BOUNDARY
859!
860! Write out 3D U-momentum component open boundaries.
861!
862 IF (any(lobc(:,isuvel,ng))) THEN
863 scale=1.0_dp
864 status=nf_fwrite3d_bry(ng, model, his(ng)%name, his(ng)%ncid, &
865 & vname(1,idsbry(isuvel)), &
866 & his(ng)%Vid(idsbry(isuvel)), &
867 & his(ng)%Rindex, u3dvar, &
868 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
869 & boundary(ng) % u_obc(lbij:,:,:,:, &
870 & lbout(ng)))
871 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
872 IF (master) THEN
873 WRITE (stdout,20) trim(vname(1,idsbry(isuvel))), &
874 & his(ng)%Rindex
875 END IF
876 exit_flag=3
877 ioerror=status
878 RETURN
879 END IF
880 END IF
881# endif
882!
883! Write out 3D V-momentum component (m/s).
884!
885 IF (hout(idvvel,ng)) THEN
886 scale=1.0_dp
887 gtype=gfactor*v3dvar
888 status=nf_fwrite3d(ng, model, his(ng)%ncid, idvvel, &
889 & his(ng)%Vid(idvvel), &
890 & his(ng)%Rindex, gtype, &
891 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
892# ifdef MASKING
893 & grid(ng) % vmask_full, &
894# endif
895 & ocean(ng) % v(:,:,:,nout))
896 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
897 IF (master) THEN
898 WRITE (stdout,20) trim(vname(1,idvvel)), his(ng)%Rindex
899 END IF
900 exit_flag=3
901 ioerror=status
902 RETURN
903 END IF
904# if defined FORWARD_WRITE && defined FORWARD_RHS
905 status=nf_fwrite3d(ng, model, his(ng)%ncid, idrv3d, &
906 & his(ng)%Vid(idrv3d), &
907 & his(ng)%Rindex, gtype, &
908 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
909# ifdef MASKING
910 & grid(ng) % vmask_full, &
911# endif
912 & ocean(ng) % rv(:,:,:,nout))
913 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
914 IF (master) THEN
915 WRITE (stdout,20) trim(vname(1,idrv3d)), his(ng)%Rindex
916 END IF
917 exit_flag=3
918 ioerror=status
919 RETURN
920 END IF
921# endif
922 END IF
923# ifdef ADJUST_BOUNDARY
924!
925! Write out 3D V-momentum component open boundaries.
926!
927 IF (any(lobc(:,isvvel,ng))) THEN
928 scale=1.0_dp
929 status=nf_fwrite3d_bry(ng, model, his(ng)%name, his(ng)%ncid, &
930 & vname(1,idsbry(isvvel)), &
931 & his(ng)%Vid(idsbry(isvvel)), &
932 & his(ng)%Rindex, v3dvar, &
933 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
934 & boundary(ng) % v_obc(lbij:,:,:,:, &
935 & lbout(ng)))
936 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
937 IF (master) THEN
938 WRITE (stdout,20) trim(vname(1,idsbry(isvvel))), &
939 & his(ng)%Rindex
940 END IF
941 exit_flag=3
942 ioerror=status
943 RETURN
944 END IF
945 END IF
946# endif
947!
948! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid.
949!
950 IF (hout(idu3de,ng)) THEN
951 scale=1.0_dp
952 gtype=gfactor*r3dvar
953 status=nf_fwrite3d(ng, model, his(ng)%ncid, idu3de, &
954 & his(ng)%Vid(idu3de), &
955 & his(ng)%Rindex, gtype, &
956 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
957# ifdef MASKING
958 & grid(ng) % rmask_full, &
959# endif
960 & ocean(ng) % ua)
961 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
962 IF (master) THEN
963 WRITE (stdout,20) trim(vname(1,idu3de)), his(ng)%Rindex
964 END IF
965 exit_flag=3
966 ioerror=status
967 RETURN
968 END IF
969 END IF
970!
971! Write out 3D Northward momentum (m/s) at RHO-points, A-grid.
972!
973 IF (hout(idv3dn,ng)) THEN
974 status=nf_fwrite3d(ng, model, his(ng)%ncid, idv3dn, &
975 & his(ng)%Vid(idv3dn), &
976 & his(ng)%Rindex, gtype, &
977 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
978# ifdef MASKING
979 & grid(ng) % rmask_full, &
980# endif
981 & ocean(ng) % va)
982 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
983 IF (master) THEN
984 WRITE (stdout,20) trim(vname(1,idv3dn)), his(ng)%Rindex
985 END IF
986 exit_flag=3
987 ioerror=status
988 RETURN
989 END IF
990 END IF
991!
992! Write out S-coordinate omega vertical velocity (m/s).
993!
994 IF (hout(idovel,ng)) THEN
995 IF (.not.allocated(wr3d)) THEN
996 allocate (wr3d(lbi:ubi,lbj:ubj,0:n(ng)))
997 wr3d(lbi:ubi,lbj:ubj,0:n(ng))=0.0_r8
998 END IF
999 scale=1.0_dp
1000 gtype=gfactor*w3dvar
1001 CALL scale_omega (ng, tile, lbi, ubi, lbj, ubj, 0, n(ng), &
1002 & grid(ng) % pm, &
1003 & grid(ng) % pn, &
1004 & ocean(ng) % W, &
1005 & wr3d)
1006 status=nf_fwrite3d(ng, model, his(ng)%ncid, idovel, &
1007 & his(ng)%Vid(idovel), &
1008 & his(ng)%Rindex, gtype, &
1009 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1010# ifdef MASKING
1011 & grid(ng) % rmask, &
1012# endif
1013 & wr3d)
1014 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1015 IF (master) THEN
1016 WRITE (stdout,20) trim(vname(1,idovel)), his(ng)%Rindex
1017 END IF
1018 exit_flag=3
1019 ioerror=status
1020 RETURN
1021 END IF
1022 deallocate (wr3d)
1023 END IF
1024
1025# ifdef OMEGA_IMPLICIT
1026!
1027! Write out S-coordinate implicit vertical "omega" momentum component.
1028!
1029 IF (hout(idovil,ng)) THEN
1030 IF (.not.allocated(wr3d)) THEN
1031 allocate (wr3d(lbi:ubi,lbj:ubj,0:n(ng)))
1032 wr3d(lbi:ubi,lbj:ubj,0:n(ng))=0.0_r8
1033 END IF
1034 scale=1.0_dp
1035 gtype=gfactor*w3dvar
1036 CALL scale_omega (ng, tile, lbi, ubi, lbj, ubj, 0, n(ng), &
1037 & grid(ng) % pm, &
1038 & grid(ng) % pn, &
1039 & ocean(ng) % Wi, &
1040 & wr3d)
1041 status=nf_fwrite3d(ng, model, his(ng)%ncid, idovil, &
1042 & his(ng)%Vid(idovil), &
1043 & his(ng)%Rindex, gtype, &
1044 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1045# ifdef MASKING
1046 & grid(ng) % rmask, &
1047# endif
1048 & wr3d)
1049 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1050 IF (master) THEN
1051 WRITE (stdout,20) trim(vname(1,idovil)), his(ng)%Rindex
1052 END IF
1053 exit_flag=3
1054 ioerror=status
1055 RETURN
1056 END IF
1057 deallocate (wr3d)
1058 END IF
1059# endif
1060!
1061! Write out vertical velocity (m/s).
1062!
1063 IF (hout(idwvel,ng)) THEN
1064 scale=1.0_dp
1065 gtype=gfactor*w3dvar
1066 status=nf_fwrite3d(ng, model, his(ng)%ncid, idwvel, &
1067 & his(ng)%Vid(idwvel), &
1068 & his(ng)%Rindex, gtype, &
1069 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1070# ifdef MASKING
1071 & grid(ng) % rmask, &
1072# endif
1073 & ocean(ng) % wvel)
1074 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1075 IF (master) THEN
1076 WRITE (stdout,20) trim(vname(1,idwvel)), his(ng)%Rindex
1077 END IF
1078 exit_flag=3
1079 ioerror=status
1080 RETURN
1081 END IF
1082 END IF
1083!
1084! Write out tracer type variables.
1085!
1086 DO itrc=1,nt(ng)
1087 IF (hout(idtvar(itrc),ng)) THEN
1088 scale=1.0_dp
1089 gtype=gfactor*r3dvar
1090 status=nf_fwrite3d(ng, model, his(ng)%ncid, idtvar(itrc), &
1091 & his(ng)%Tid(itrc), &
1092 & his(ng)%Rindex, gtype, &
1093 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1094# ifdef MASKING
1095 & grid(ng) % rmask, &
1096# endif
1097 & ocean(ng) % t(:,:,:,nout,itrc))
1098 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1099 IF (master) THEN
1100 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), &
1101 & his(ng)%Rindex
1102 END IF
1103 exit_flag=3
1104 ioerror=status
1105 RETURN
1106 END IF
1107 END IF
1108 END DO
1109
1110# ifdef ADJUST_BOUNDARY
1111!
1112! Write out 3D tracers open boundaries.
1113!
1114 DO itrc=1,nt(ng)
1115 IF (any(lobc(:,istvar(itrc),ng))) THEN
1116 scale=1.0_dp
1117 ifield=idsbry(istvar(itrc))
1118 status=nf_fwrite3d_bry(ng, model, his(ng)%name, his(ng)%ncid,&
1119 & vname(1,ifield), &
1120 & his(ng)%Vid(ifield), &
1121 & his(ng)%Rindex, r3dvar, &
1122 & lbij, ubij, 1, n(ng), nbrec(ng), &
1123 & scale, &
1124 & boundary(ng) % t_obc(lbij:,:,:,:, &
1125 & lbout(ng),itrc))
1126 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1127 IF (master) THEN
1128 WRITE (stdout,20) trim(vname(1,ifield)), his(ng)%Rindex
1129 END IF
1130 exit_flag=3
1131 ioerror=status
1132 RETURN
1133 END IF
1134 END IF
1135 END DO
1136# endif
1137!
1138! Write out density anomaly.
1139!
1140 IF (hout(iddano,ng)) THEN
1141 scale=1.0_dp
1142 gtype=gfactor*r3dvar
1143 status=nf_fwrite3d(ng, model, his(ng)%ncid, iddano, &
1144 & his(ng)%Vid(iddano), &
1145 & his(ng)%Rindex, gtype, &
1146 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1147# ifdef MASKING
1148 & grid(ng) % rmask, &
1149# endif
1150 & ocean(ng) % rho)
1151 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1152 IF (master) THEN
1153 WRITE (stdout,20) trim(vname(1,iddano)), his(ng)%Rindex
1154 END IF
1155 exit_flag=3
1156 ioerror=status
1157 RETURN
1158 END IF
1159 END IF
1160# ifdef LMD_SKPP
1161!
1162! Write out depth surface boundary layer.
1163!
1164 IF (hout(idhsbl,ng)) THEN
1165 scale=1.0_dp
1166 gtype=gfactor*r2dvar
1167 status=nf_fwrite2d(ng, model, his(ng)%ncid, idhsbl, &
1168 & his(ng)%Vid(idhsbl), &
1169 & his(ng)%Rindex, gtype, &
1170 & lbi, ubi, lbj, ubj, scale, &
1171# ifdef MASKING
1172 & grid(ng) % rmask, &
1173# endif
1174 & mixing(ng) % hsbl)
1175 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1176 IF (master) THEN
1177 WRITE (stdout,20) trim(vname(1,idhsbl)), his(ng)%Rindex
1178 END IF
1179 exit_flag=3
1180 ioerror=status
1181 RETURN
1182 END IF
1183 END IF
1184# endif
1185# ifdef LMD_BKPP
1186!
1187! Write out depth bottom boundary layer.
1188!
1189 IF (hout(idhbbl,ng)) THEN
1190 scale=1.0_dp
1191 gtype=gfactor*r2dvar
1192 status=nf_fwrite2d(ng, model, his(ng)%ncid, idhbbl, &
1193 & his(ng)%Vid(idhbbl), &
1194 & his(ng)%Rindex, gtype, &
1195 & lbi, ubi, lbj, ubj, scale, &
1196# ifdef MASKING
1197 & grid(ng) % rmask, &
1198# endif
1199 & mixing(ng) % hbbl)
1200 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1201 IF (master) THEN
1202 WRITE (stdout,20) trim(vname(1,idhbbl)), his(ng)%Rindex
1203 END IF
1204 exit_flag=3
1205 ioerror=status
1206 RETURN
1207 END IF
1208 END IF
1209# endif
1210# if defined FORWARD_WRITE && defined LMD_NONLOCAL
1211!
1212! Write out KPP nonlocal transport.
1213!
1214 DO i=1,nat
1215 IF (hout(idghat(i),ng)) THEN
1216 scale=1.0_dp
1217 gtype=gfactor*w3dvar
1218 status=nf_fwrite3d(ng, model, his(ng)%ncid, idghat(i), &
1219 & his(ng)%Vid(idghat(i)), &
1220 & his(ng)%Rindex, gtype, &
1221 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1222# ifdef MASKING
1223 & grid(ng) % rmask, &
1224# endif
1225 & mixing(ng) % ghats(:,:,:,i))
1226 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1227 IF (master) THEN
1228 WRITE (stdout,20) trim(vname(1,idghat(i))), his(ng)%Rindex
1229 END IF
1230 exit_flag=3
1231 ioerror=status
1232 RETURN
1233 END IF
1234 END IF
1235 END DO
1236# endif
1237!
1238! Write out vertical viscosity coefficient.
1239!
1240 IF (hout(idvvis,ng)) THEN
1241 scale=1.0_dp
1242 gtype=gfactor*w3dvar
1243 status=nf_fwrite3d(ng, model, his(ng)%ncid, idvvis, &
1244 & his(ng)%Vid(idvvis), &
1245 & his(ng)%Rindex, gtype, &
1246 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1247# ifdef MASKING
1248 & grid(ng) % rmask, &
1249# endif
1250 & mixing(ng) % Akv, &
1251 & setfillval = .false.)
1252 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1253 IF (master) THEN
1254 WRITE (stdout,20) trim(vname(1,idvvis)), his(ng)%Rindex
1255 END IF
1256 exit_flag=3
1257 ioerror=status
1258 RETURN
1259 END IF
1260 END IF
1261!
1262! Write out vertical diffusion coefficient for potential temperature.
1263!
1264 IF (hout(idtdif,ng)) THEN
1265 scale=1.0_dp
1266 gtype=gfactor*w3dvar
1267 status=nf_fwrite3d(ng, model, his(ng)%ncid, idtdif, &
1268 & his(ng)%Vid(idtdif), &
1269 & his(ng)%Rindex, gtype, &
1270 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1271# ifdef MASKING
1272 & grid(ng) % rmask, &
1273# endif
1274 & mixing(ng) % Akt(:,:,:,itemp), &
1275 & setfillval = .false.)
1276 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1277 IF (master) THEN
1278 WRITE (stdout,20) trim(vname(1,idtdif)), his(ng)%Rindex
1279 END IF
1280 exit_flag=3
1281 ioerror=status
1282 RETURN
1283 END IF
1284 END IF
1285# ifdef SALINITY
1286!
1287! Write out vertical diffusion coefficient for salinity.
1288!
1289 IF (hout(idsdif,ng)) THEN
1290 scale=1.0_dp
1291 gtype=gfactor*w3dvar
1292 status=nf_fwrite3d(ng, model, his(ng)%ncid, idsdif, &
1293 & his(ng)%Vid(idsdif), &
1294 & his(ng)%Rindex, gtype, &
1295 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1296# ifdef MASKING
1297 & grid(ng) % rmask, &
1298# endif
1299 & mixing(ng) % Akt(:,:,:,isalt), &
1300 & setfillval = .false.)
1301 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1302 IF (master) THEN
1303 WRITE (stdout,20) trim(vname(1,idsdif)), his(ng)%Rindex
1304 END IF
1305 exit_flag=3
1306 ioerror=status
1307 RETURN
1308 END IF
1309 END IF
1310# endif
1311# if defined GLS_MIXING || defined MY25_MIXING
1312!
1313! Write out turbulent kinetic energy.
1314!
1315 IF (hout(idmtke,ng)) THEN
1316 scale=1.0_dp
1317 gtype=gfactor*w3dvar
1318 status=nf_fwrite3d(ng, model, his(ng)%ncid, idmtke, &
1319 & his(ng)%Vid(idmtke), &
1320 & his(ng)%Rindex, gtype, &
1321 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1322# ifdef MASKING
1323 & grid(ng) % rmask, &
1324# endif
1325 & mixing(ng) % tke(:,:,:,nout), &
1326 & setfillval = .false.)
1327 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1328 IF (master) THEN
1329 WRITE (stdout,20) trim(vname(1,idmtke)), his(ng)%Rindex
1330 END IF
1331 exit_flag=3
1332 ioerror=status
1333 RETURN
1334 END IF
1335# ifdef FORWARD_WRITE
1336 scale=1.0_dp
1337 gtype=gfactor*w3dvar
1338 status=nf_fwrite3d(ng, model, his(ng)%ncid, idvmkk, &
1339 & his(ng)%Vid(idvmkk), &
1340 & his(ng)%Rindex, gtype, &
1341 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1342# ifdef MASKING
1343 & grid(ng) % rmask, &
1344# endif
1345 & mixing(ng) % Akk)
1346 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1347 IF (master) THEN
1348 WRITE (stdout,20) trim(vname(1,idvmkk)), his(ng)%Rindex
1349 END IF
1350 exit_flag=3
1351 ioerror=status
1352 RETURN
1353 END IF
1354# endif
1355 END IF
1356!
1357! Write out turbulent length scale field.
1358!
1359 IF (hout(idmtls,ng)) THEN
1360 scale=1.0_dp
1361 gtype=gfactor*w3dvar
1362 status=nf_fwrite3d(ng, model, his(ng)%ncid, idmtls, &
1363 & his(ng)%Vid(idmtls), &
1364 & his(ng)%Rindex, gtype, &
1365 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1366# ifdef MASKING
1367 & grid(ng) % rmask, &
1368# endif
1369 & mixing(ng) % gls(:,:,:,nout), &
1370 & setfillval = .false.)
1371 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1372 IF (master) THEN
1373 WRITE (stdout,20) trim(vname(1,idmtls)), his(ng)%Rindex
1374 END IF
1375 exit_flag=3
1376 ioerror=status
1377 RETURN
1378 END IF
1379# ifdef FORWARD_WRITE
1380 scale=1.0_dp
1381 gtype=gfactor*w3dvar
1382 status=nf_fwrite3d(ng, model, his(ng)%ncid, idvmls, &
1383 & his(ng)%Vid(idvmls), &
1384 & his(ng)%Rindex, gtype, &
1385 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1386# ifdef MASKING
1387 & grid(ng) % rmask, &
1388# endif
1389 & mixing(ng) % Lscale)
1390 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1391 IF (master) THEN
1392 WRITE (stdout,20) trim(vname(1,idvmls)), his(ng)%Rindex
1393 END IF
1394 exit_flag=3
1395 ioerror=status
1396 RETURN
1397 END IF
1398# endif
1399# if defined FORWARD_WRITE && defined GLS_MIXING
1400 scale=1.0_dp
1401 gtype=gfactor*w3dvar
1402 status=nf_fwrite3d(ng, model, his(ng)%ncid, idvmkp, &
1403 & his(ng)%Vid(idvmkp), &
1404 & his(ng)%Rindex, gtype, &
1405 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1406# ifdef MASKING
1407 & grid(ng) % rmask, &
1408# endif
1409 & mixing(ng) % Akp)
1410 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1411 IF (master) THEN
1412 WRITE (stdout,20) trim(vname(1,idvmkp)), his(ng)%Rindex
1413 END IF
1414 exit_flag=3
1415 ioerror=status
1416 RETURN
1417 END IF
1418# endif
1419 END IF
1420# endif
1421# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
1422!
1423! Write out surface air pressure.
1424!
1425 IF (hout(idpair,ng)) THEN
1426 scale=1.0_dp
1427 gtype=gfactor*r2dvar
1428 status=nf_fwrite2d(ng, model, his(ng)%ncid, idpair, &
1429 & his(ng)%Vid(idpair), &
1430 & his(ng)%Rindex, gtype, &
1431 & lbi, ubi, lbj, ubj, scale, &
1432# ifdef MASKING
1433 & grid(ng) % rmask, &
1434# endif
1435 & forces(ng) % Pair)
1436 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1437 IF (master) THEN
1438 WRITE (stdout,20) trim(vname(1,idpair)), his(ng)%Rindex
1439 END IF
1440 exit_flag=3
1441 ioerror=status
1442 RETURN
1443 END IF
1444 END IF
1445# endif
1446# if defined BULK_FLUXES
1447!
1448! Write out surface air temperature.
1449!
1450 IF (hout(idtair,ng)) THEN
1451 scale=1.0_dp
1452 gtype=gfactor*r2dvar
1453 status=nf_fwrite2d(ng, model, his(ng)%ncid, idtair, &
1454 & his(ng)%Vid(idtair), &
1455 & his(ng)%Rindex, gtype, &
1456 & lbi, ubi, lbj, ubj, scale, &
1457# ifdef MASKING
1458 & grid(ng) % rmask, &
1459# endif
1460 & forces(ng) % Tair)
1461 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1462 IF (master) THEN
1463 WRITE (stdout,20) trim(vname(1,idtair)), his(ng)%Rindex
1464 END IF
1465 exit_flag=3
1466 ioerror=status
1467 RETURN
1468 END IF
1469 END IF
1470# endif
1471# if defined BULK_FLUXES || defined ECOSIM
1472!
1473! Write out surface winds.
1474!
1475 IF (hout(iduair,ng)) THEN
1476 scale=1.0_dp
1477 gtype=gfactor*r2dvar
1478 status=nf_fwrite2d(ng, model, his(ng)%ncid, iduair, &
1479 & his(ng)%Vid(iduair), &
1480 & his(ng)%Rindex, gtype, &
1481 & lbi, ubi, lbj, ubj, scale, &
1482# ifdef MASKING
1483 & grid(ng) % rmask, &
1484# endif
1485 & forces(ng) % Uwind)
1486 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1487 IF (master) THEN
1488 WRITE (stdout,20) trim(vname(1,iduair)), his(ng)%Rindex
1489 END IF
1490 exit_flag=3
1491 ioerror=status
1492 RETURN
1493 END IF
1494 END IF
1495!
1496 IF (hout(idvair,ng)) THEN
1497 scale=1.0_dp
1498 gtype=gfactor*r2dvar
1499 status=nf_fwrite2d(ng, model, his(ng)%ncid, idvair, &
1500 & his(ng)%Vid(idvair), &
1501 & his(ng)%Rindex, gtype, &
1502 & lbi, ubi, lbj, ubj, scale, &
1503# ifdef MASKING
1504 & grid(ng) % rmask, &
1505# endif
1506 & forces(ng) % Vwind)
1507 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1508 IF (master) THEN
1509 WRITE (stdout,20) trim(vname(1,idvair)), his(ng)%Rindex
1510 END IF
1511 exit_flag=3
1512 ioerror=status
1513 RETURN
1514 END IF
1515 END IF
1516!
1517! Write out Eastward/Northward surface wind (m/s) at RHO-points.
1518!
1519 IF (hout(iduaie,ng).and.hout(idvain,ng)) THEN
1520 IF (.not.allocated(ur2d)) THEN
1521 allocate (ur2d(lbi:ubi,lbj:ubj))
1522 ur2d(lbi:ubi,lbj:ubj)=0.0_r8
1523 END IF
1524 IF (.not.allocated(vr2d)) THEN
1525 allocate (vr2d(lbi:ubi,lbj:ubj))
1526 vr2d(lbi:ubi,lbj:ubj)=0.0_r8
1527 END IF
1528 CALL uv_rotate2d (ng, tile, .false., .true., &
1529 & lbi, ubi, lbj, ubj, &
1530 & grid(ng) % CosAngler, &
1531 & grid(ng) % SinAngler, &
1532# ifdef MASKING
1533 & grid(ng) % rmask_full, &
1534# endif
1535 & forces(ng) % Uwind, &
1536 & forces(ng) % Vwind, &
1537 & ur2d, vr2d)
1538!
1539 scale=1.0_dp
1540 gtype=gfactor*r2dvar
1541 status=nf_fwrite2d(ng, model, his(ng)%ncid, iduaie, &
1542 & his(ng)%Vid(iduaie), &
1543 & his(ng)%Rindex, gtype, &
1544 & lbi, ubi, lbj, ubj, scale, &
1545# ifdef MASKING
1546 & grid(ng) % rmask, &
1547# endif
1548 & ur2d)
1549 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1550 IF (master) THEN
1551 WRITE (stdout,20) trim(vname(1,iduaie)), his(ng)%Rindex
1552 END IF
1553 exit_flag=3
1554 ioerror=status
1555 RETURN
1556 END IF
1557!
1558 scale=1.0_dp
1559 gtype=gfactor*r2dvar
1560 status=nf_fwrite2d(ng, model, his(ng)%ncid, idvain, &
1561 & his(ng)%Vid(idvain), &
1562 & his(ng)%Rindex, gtype, &
1563 & lbi, ubi, lbj, ubj, scale, &
1564# ifdef MASKING
1565 & grid(ng) % rmask, &
1566# endif
1567 & vr2d)
1568 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1569 IF (master) THEN
1570 WRITE (stdout,20) trim(vname(1,idvain)), his(ng)%Rindex
1571 END IF
1572 exit_flag=3
1573 ioerror=status
1574 RETURN
1575 END IF
1576 deallocate (ur2d)
1577 deallocate (vr2d)
1578 END IF
1579# endif
1580!
1581! Write out surface active tracers fluxes.
1582!
1583 DO itrc=1,nat
1584 IF (hout(idtsur(itrc),ng)) THEN
1585 IF (itrc.eq.itemp) THEN
1586# ifdef SO_SEMI
1587 scale=1.0_dp
1588# else
1589 scale=rho0*cp ! Celsius m/s to W/m2
1590# endif
1591 ELSE IF (itrc.eq.isalt) THEN
1592 scale=1.0_dp
1593 END IF
1594 gtype=gfactor*r2dvar
1595 status=nf_fwrite2d(ng, model, his(ng)%ncid, idtsur(itrc), &
1596 & his(ng)%Vid(idtsur(itrc)), &
1597 & his(ng)%Rindex, gtype, &
1598 & lbi, ubi, lbj, ubj, scale, &
1599# ifdef MASKING
1600 & grid(ng) % rmask, &
1601# endif
1602 & forces(ng) % stflx(:,:,itrc))
1603 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1604 IF (master) THEN
1605 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
1606 & his(ng)%Rindex
1607 END IF
1608 exit_flag=3
1609 ioerror=status
1610 RETURN
1611 END IF
1612 END IF
1613 END DO
1614
1615# if defined BULK_FLUXES || defined FRC_COUPLING
1616!
1617! Write out latent heat flux.
1618!
1619 IF (hout(idlhea,ng)) THEN
1620 scale=rho0*cp
1621 gtype=gfactor*r2dvar
1622 status=nf_fwrite2d(ng, model, his(ng)%ncid, idlhea, &
1623 & his(ng)%Vid(idlhea), &
1624 & his(ng)%Rindex, gtype, &
1625 & lbi, ubi, lbj, ubj, scale, &
1626# ifdef MASKING
1627 & grid(ng) % rmask, &
1628# endif
1629 & forces(ng) % lhflx)
1630 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1631 IF (master) THEN
1632 WRITE (stdout,20) trim(vname(1,idlhea)), his(ng)%Rindex
1633 END IF
1634 exit_flag=3
1635 ioerror=status
1636 RETURN
1637 END IF
1638 END IF
1639!
1640! Write out sensible heat flux.
1641!
1642 IF (hout(idshea,ng)) THEN
1643 scale=rho0*cp
1644 gtype=gfactor*r2dvar
1645 status=nf_fwrite2d(ng, model, his(ng)%ncid, idshea, &
1646 & his(ng)%Vid(idshea), &
1647 & his(ng)%Rindex, gtype, &
1648 & lbi, ubi, lbj, ubj, scale, &
1649# ifdef MASKING
1650 & grid(ng) % rmask, &
1651# endif
1652 & forces(ng) % shflx)
1653 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1654 IF (master) THEN
1655 WRITE (stdout,20) trim(vname(1,idshea)), his(ng)%Rindex
1656 END IF
1657 exit_flag=3
1658 ioerror=status
1659 RETURN
1660 END IF
1661 END IF
1662!
1663! Write out net longwave radiation flux.
1664!
1665 IF (hout(idlrad,ng)) THEN
1666 scale=rho0*cp
1667 gtype=gfactor*r2dvar
1668 status=nf_fwrite2d(ng, model, his(ng)%ncid, idlrad, &
1669 & his(ng)%Vid(idlrad), &
1670 & his(ng)%Rindex, gtype, &
1671 & lbi, ubi, lbj, ubj, scale, &
1672# ifdef MASKING
1673 & grid(ng) % rmask, &
1674# endif
1675 & forces(ng) % lrflx)
1676 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1677 IF (master) THEN
1678 WRITE (stdout,20) trim(vname(1,idlrad)), his(ng)%Rindex
1679 END IF
1680 exit_flag=3
1681 ioerror=status
1682 RETURN
1683 END IF
1684 END IF
1685# endif
1686
1687# ifdef BULK_FLUXES
1688# ifdef EMINUSP
1689!
1690! Write out evaporation rate (kg/m2/s).
1691!
1692 IF (hout(idevap,ng)) THEN
1693 scale=1.0_dp
1694 gtype=gfactor*r2dvar
1695 status=nf_fwrite2d(ng, model, his(ng)%ncid, idevap, &
1696 & his(ng)%Vid(idevap), &
1697 & his(ng)%Rindex, gtype, &
1698 & lbi, ubi, lbj, ubj, scale, &
1699# ifdef MASKING
1700 & grid(ng) % rmask, &
1701# endif
1702 & forces(ng) % evap)
1703 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1704 IF (master) THEN
1705 WRITE (stdout,20) trim(vname(1,idevap)), his(ng)%Rindex
1706 END IF
1707 exit_flag=3
1708 ioerror=status
1709 RETURN
1710 END IF
1711 END IF
1712!
1713! Write out precipitation rate (kg/m2/s).
1714!
1715 IF (hout(idrain,ng)) THEN
1716 scale=1.0_dp
1717 gtype=gfactor*r2dvar
1718 status=nf_fwrite2d(ng, model, his(ng)%ncid, idrain, &
1719 & his(ng)%Vid(idrain), &
1720 & his(ng)%Rindex, gtype, &
1721 & lbi, ubi, lbj, ubj, scale, &
1722# ifdef MASKING
1723 & grid(ng) % rmask, &
1724# endif
1725 & forces(ng) % rain)
1726 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1727 IF (master) THEN
1728 WRITE (stdout,20) trim(vname(1,idrain)), his(ng)%Rindex
1729 END IF
1730 exit_flag=3
1731 ioerror=status
1732 RETURN
1733 END IF
1734 END IF
1735# endif
1736# endif
1737!
1738! Write out E-P (m/s).
1739!
1740 IF (hout(idempf,ng)) THEN
1741 scale=1.0_dp
1742 gtype=gfactor*r2dvar
1743 status=nf_fwrite2d(ng, model, his(ng)%ncid, idempf, &
1744 & his(ng)%Vid(idempf), &
1745 & his(ng)%Rindex, gtype, &
1746 & lbi, ubi, lbj, ubj, scale, &
1747# ifdef MASKING
1748 & grid(ng) % rmask, &
1749# endif
1750 & forces(ng) % stflux(:,:,isalt))
1751 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1752 IF (master) THEN
1753 WRITE (stdout,20) trim(vname(1,idempf)), his(ng)%Rindex
1754 END IF
1755 exit_flag=3
1756 ioerror=status
1757 RETURN
1758 END IF
1759 END IF
1760# ifdef SHORTWAVE
1761!
1762! Write out net shortwave radiation flux.
1763!
1764 IF (hout(idsrad,ng)) THEN
1765 scale=rho0*cp
1766 gtype=gfactor*r2dvar
1767 status=nf_fwrite2d(ng, model, his(ng)%ncid, idsrad, &
1768 & his(ng)%Vid(idsrad), &
1769 & his(ng)%Rindex, gtype, &
1770 & lbi, ubi, lbj, ubj, scale, &
1771# ifdef MASKING
1772 & grid(ng) % rmask, &
1773# endif
1774 & forces(ng) % srflx)
1775 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1776 IF (master) THEN
1777 WRITE (stdout,20) trim(vname(1,idsrad)), his(ng)%Rindex
1778 END IF
1779 exit_flag=3
1780 ioerror=status
1781 RETURN
1782 END IF
1783 END IF
1784# endif
1785#endif
1786!
1787! Write out surface U-momentum stress.
1788!
1789 IF (hout(idusms,ng)) THEN
1790#ifdef SO_SEMI
1791 scale=1.0_dp
1792#else
1793 scale=rho0 ! m2/s2 to Pa
1794#endif
1795 gtype=gfactor*u2dvar
1796 status=nf_fwrite2d(ng, model, his(ng)%ncid, idusms, &
1797 & his(ng)%Vid(idusms), &
1798 & his(ng)%Rindex, gtype, &
1799 & lbi, ubi, lbj, ubj, scale, &
1800#ifdef MASKING
1801 & grid(ng) % umask, &
1802#endif
1803 & forces(ng) % sustr)
1804 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1805 IF (master) THEN
1806 WRITE (stdout,20) trim(vname(1,idusms)), his(ng)%Rindex
1807 END IF
1808 exit_flag=3
1809 ioerror=status
1810 RETURN
1811 END IF
1812 END IF
1813!
1814! Write out surface V-momentum stress.
1815!
1816 IF (hout(idvsms,ng)) THEN
1817#ifdef SO_SEMI
1818 scale=1.0_dp
1819#else
1820 scale=rho0
1821#endif
1822 gtype=gfactor*v2dvar
1823 status=nf_fwrite2d(ng, model, his(ng)%ncid, idvsms, &
1824 & his(ng)%Vid(idvsms), &
1825 & his(ng)%Rindex, gtype, &
1826 & lbi, ubi, lbj, ubj, scale, &
1827#ifdef MASKING
1828 & grid(ng) % vmask, &
1829#endif
1830 & forces(ng) % svstr)
1831 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1832 IF (master) THEN
1833 WRITE (stdout,20) trim(vname(1,idvsms)), his(ng)%Rindex
1834 END IF
1835 exit_flag=3
1836 ioerror=status
1837 RETURN
1838 END IF
1839 END IF
1840!
1841! Write out bottom U-momentum stress.
1842!
1843 IF (hout(idubms,ng)) THEN
1844 scale=-rho0
1845 gtype=gfactor*u2dvar
1846 status=nf_fwrite2d(ng, model, his(ng)%ncid, idubms, &
1847 & his(ng)%Vid(idubms), &
1848 & his(ng)%Rindex, gtype, &
1849 & lbi, ubi, lbj, ubj, scale, &
1850#ifdef MASKING
1851 & grid(ng) % umask, &
1852#endif
1853 & forces(ng) % bustr)
1854 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1855 IF (master) THEN
1856 WRITE (stdout,20) trim(vname(1,idubms)), his(ng)%Rindex
1857 END IF
1858 exit_flag=3
1859 ioerror=status
1860 RETURN
1861 END IF
1862 END IF
1863!
1864! Write out bottom V-momentum stress.
1865!
1866 IF (hout(idvbms,ng)) THEN
1867 scale=-rho0
1868 gtype=gfactor*v2dvar
1869 status=nf_fwrite2d(ng, model, his(ng)%ncid, idvbms, &
1870 & his(ng)%Vid(idvbms), &
1871 & his(ng)%Rindex, gtype, &
1872 & lbi, ubi, lbj, ubj, scale, &
1873#ifdef MASKING
1874 & grid(ng) % vmask, &
1875#endif
1876 & forces(ng) % bvstr)
1877 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1878 IF (master) THEN
1879 WRITE (stdout,20) trim(vname(1,idvbms)), his(ng)%Rindex
1880 END IF
1881 exit_flag=3
1882 ioerror=status
1883 RETURN
1884 END IF
1885 END IF
1886
1887#if (defined BBL_MODEL || defined WAVES_OUTPUT) && defined SOLVE3D
1888!
1889!-----------------------------------------------------------------------
1890! Write out the bottom boundary layer model or waves variables.
1891!-----------------------------------------------------------------------
1892!
1893 CALL bbl_wrt_nf90 (ng, model, tile, &
1894 & lbi, ubi, lbj, ubj, &
1895 & hout, his)
1896 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1897#endif
1898
1899#if defined ICE_MODEL && defined SOLVE3D
1900!
1901!-----------------------------------------------------------------------
1902! Write out the sea-ice model variables.
1903!-----------------------------------------------------------------------
1904!
1905 CALL ice_wrt_nf90 (ng, model, tile, &
1906 & lbi, ubi, lbj, ubj, &
1907 & hout, his)
1908 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1909#endif
1910
1911#if defined SEDIMENT && defined SOLVE3D
1912!
1913!-----------------------------------------------------------------------
1914! Write out the sediment model variables.
1915!-----------------------------------------------------------------------
1916!
1917 CALL sediment_wrt_nf90 (ng, model, tile, &
1918 & lbi, ubi, lbj, ubj, &
1919 & hout, his)
1920 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1921#endif
1922
1923#if defined WEC_VF && defined SOLVE3D
1924!
1925!-----------------------------------------------------------------------
1926! Write out the Waves Effect on Currents variables.
1927!-----------------------------------------------------------------------
1928!
1929 CALL wec_wrt_nf90 (ng, model, tile, &
1930 & lbi, ubi, lbj, ubj, &
1931 & hout, his)
1932 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1933#endif
1934!
1935!-----------------------------------------------------------------------
1936! Synchronize history NetCDF file to disk to allow other processes
1937! to access data immediately after it is written.
1938!-----------------------------------------------------------------------
1939!
1940 CALL netcdf_sync (ng, model, his(ng)%name, his(ng)%ncid)
1941 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1942!
1943 10 FORMAT (2x,'WRT_HIS_NF90 - writing history', t42, &
1944#ifdef SOLVE3D
1945# ifdef NESTING
1946 & 'fields (Index=',i1,',',i1,') in record = ',i0,t92,i2.2)
1947# else
1948 & 'fields (Index=',i1,',',i1,') in record = ',i0)
1949# endif
1950#else
1951# ifdef NESTING
1952 & 'fields (Index=',i1,') in record = ',i0,t92,i2.2)
1953# else
1954 & 'fields (Index=',i1,') in record = ',i0)
1955# endif
1956#endif
1957 20 FORMAT (/,' WRT_HIS_NF90 - error while writing variable: ',a, &
1958 & /,16x,'into history NetCDF file for time record: ',i0)
1959!
1960 RETURN
1961 END SUBROUTINE wrt_his_nf90
1962
1963#if defined PIO_LIB && defined DISTRIBUTE
1964!
1965!***********************************************************************
1966 SUBROUTINE wrt_his_pio (ng, model, tile, &
1967# ifdef ADJUST_BOUNDARY
1968 & LBij, UBij, &
1969# endif
1970 & LBi, UBi, LBj, UBj)
1971!***********************************************************************
1972!
1973 USE mod_pio_netcdf
1974!
1975! Imported variable declarations.
1976!
1977 integer, intent(in) :: ng, model, tile
1978# ifdef ADJUST_BOUNDARY
1979 integer, intent(in) :: lbij, ubij
1980# endif
1981 integer, intent(in) :: lbi, ubi, lbj, ubj
1982!
1983! Local variable declarations.
1984!
1985 integer :: fcount, ifield, status
1986# ifdef SOLVE3D
1987 integer :: i, itrc, j, k
1988# endif
1989!
1990 real(dp) :: scale
1991
1992 real(r8), allocatable :: ur2d(:,:)
1993 real(r8), allocatable :: vr2d(:,:)
1994# ifdef SOLVE3D
1995 real(r8), allocatable :: wr3d(:,:,:)
1996# endif
1997!
1998 character (len=*), parameter :: myfile = &
1999 & __FILE__//", wrt_his_pio"
2000!
2001 TYPE (io_desc_t), pointer :: iodesc
2002
2003# include "set_bounds.h"
2004!
2005 sourcefile=myfile
2006!
2007!-----------------------------------------------------------------------
2008! Write out history fields.
2009!-----------------------------------------------------------------------
2010!
2011 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2012!
2013! Set time record index.
2014!
2015 his(ng)%Rindex=his(ng)%Rindex+1
2016 fcount=his(ng)%load
2017 his(ng)%Nrec(fcount)=his(ng)%Nrec(fcount)+1
2018!
2019! Report.
2020!
2021# ifdef SOLVE3D
2022# ifdef NESTING
2023 IF (master) WRITE (stdout,10) kout, nout, his(ng)%Rindex, ng
2024# else
2025 IF (master) WRITE (stdout,10) kout, nout, his(ng)%Rindex
2026# endif
2027# else
2028# ifdef NESTING
2029 IF (master) WRITE (stdout,10) kout, his(ng)%Rindex, ng
2030# else
2031 IF (master) WRITE (stdout,10) kout, his(ng)%Rindex
2032# endif
2033# endif
2034!
2035! Write out model time (s).
2036!
2037 CALL pio_netcdf_put_fvar (ng, model, his(ng)%name, &
2038 & trim(vname(1,idtime)), time(ng:), &
2039 & (/his(ng)%Rindex/), (/1/), &
2040 & piofile = his(ng)%pioFile, &
2041 & piovar = his(ng)%pioVar(idtime)%vd)
2042 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2043
2044# ifdef WET_DRY
2045!
2046! Write out wet/dry mask at PSI-points.
2047!
2048 scale=1.0_dp
2049 IF (his(ng)%pioVar(idpwet)%dkind.eq.pio_double) THEN
2050 iodesc => iodesc_dp_p2dvar(ng)
2051 ELSE
2052 iodesc => iodesc_sp_p2dvar(ng)
2053 END IF
2054 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idpwet, &
2055 & his(ng)%pioVar(idpwet), &
2056 & his(ng)%Rindex, &
2057 & iodesc, &
2058 & lbi, ubi, lbj, ubj, scale, &
2059# ifdef MASKING
2060 & grid(ng) % pmask, &
2061# endif
2062 & grid(ng) % pmask_wet, &
2063 & setfillval = .false.)
2064 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2065 IF (master) THEN
2066 WRITE (stdout,20) trim(vname(1,idpwet)), his(ng)%Rindex
2067 END IF
2068 exit_flag=3
2069 ioerror=status
2070 RETURN
2071 END IF
2072!
2073! Write out wet/dry mask at RHO-points.
2074!
2075 scale=1.0_dp
2076 IF (his(ng)%pioVar(idrwet)%dkind.eq.pio_double) THEN
2077 iodesc => iodesc_dp_r2dvar(ng)
2078 ELSE
2079 iodesc => iodesc_sp_r2dvar(ng)
2080 END IF
2081 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idrwet, &
2082 & his(ng)%pioVar(idrwet), &
2083 & his(ng)%Rindex, &
2084 & iodesc, &
2085 & lbi, ubi, lbj, ubj, scale, &
2086# ifdef MASKING
2087 & grid(ng) % rmask, &
2088# endif
2089 & grid(ng) % rmask_wet, &
2090 & setfillval = .false.)
2091 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2092 IF (master) THEN
2093 WRITE (stdout,20) trim(vname(1,idrwet)), his(ng)%Rindex
2094 END IF
2095 exit_flag=3
2096 ioerror=status
2097 RETURN
2098 END IF
2099!
2100! Write out wet/dry mask at U-points.
2101!
2102 scale=1.0_dp
2103 IF (his(ng)%pioVar(iduwet)%dkind.eq.pio_double) THEN
2104 iodesc => iodesc_dp_u2dvar(ng)
2105 ELSE
2106 iodesc => iodesc_sp_u2dvar(ng)
2107 END IF
2108 status=nf_fwrite2d(ng, model, his(ng)%pioFile, iduwet, &
2109 & his(ng)%pioVar(iduwet), &
2110 & his(ng)%Rindex, &
2111 & iodesc, &
2112 & lbi, ubi, lbj, ubj, scale, &
2113# ifdef MASKING
2114 & grid(ng) % umask, &
2115# endif
2116 & grid(ng) % umask_wet, &
2117 & setfillval = .false.)
2118 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2119 IF (master) THEN
2120 WRITE (stdout,20) trim(vname(1,iduwet)), his(ng)%Rindex
2121 END IF
2122 exit_flag=3
2123 ioerror=status
2124 RETURN
2125 END IF
2126!
2127! Write out wet/dry mask at V-points.
2128!
2129 scale=1.0_dp
2130 IF (his(ng)%pioVar(idvwet)%dkind.eq.pio_double) THEN
2131 iodesc => iodesc_dp_v2dvar(ng)
2132 ELSE
2133 iodesc => iodesc_sp_v2dvar(ng)
2134 END IF
2135 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idvwet, &
2136 & his(ng)%pioVar(idvwet), &
2137 & his(ng)%Rindex, &
2138 & iodesc, &
2139 & lbi, ubi, lbj, ubj, scale, &
2140# ifdef MASKING
2141 & grid(ng) % vmask, &
2142# endif
2143 & grid(ng) % vmask_wet, &
2144 & setfillval = .false.)
2145 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2146 IF (master) THEN
2147 WRITE (stdout,20) trim(vname(1,idvwet)), his(ng)%Rindex
2148 END IF
2149 exit_flag=3
2150 ioerror=status
2151 RETURN
2152 END IF
2153# endif
2154# ifdef SOLVE3D
2155!
2156! Write time-varying depths of RHO-points.
2157!
2158 IF (hout(idpthr,ng)) THEN
2159 scale=1.0_dp
2160 IF (his(ng)%pioVar(idpthr)%dkind.eq.pio_double) THEN
2161 iodesc => iodesc_dp_r3dvar(ng)
2162 ELSE
2163 iodesc => iodesc_sp_r3dvar(ng)
2164 END IF
2165 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idpthr, &
2166 & his(ng)%pioVar(idpthr), &
2167 & his(ng)%Rindex, &
2168 & iodesc, &
2169 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2170# ifdef MASKING
2171 & grid(ng) % rmask, &
2172# endif
2173 & grid(ng) % z_r, &
2174 & setfillval = .false.)
2175 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2176 IF (master) THEN
2177 WRITE (stdout,20) trim(vname(1,idpthr)), his(ng)%Rindex
2178 END IF
2179 exit_flag=3
2180 ioerror=status
2181 RETURN
2182 END IF
2183 END IF
2184!
2185! Write time-varying depths of U-points.
2186!
2187 IF (hout(idpthu,ng)) THEN
2188 scale=1.0_dp
2189 DO k=1,n(ng)
2190 DO j=jstr-1,jend+1
2191 DO i=istru-1,iend+1
2192 grid(ng)%z_v(i,j,k)=0.5_r8*(grid(ng)%z_r(i-1,j,k)+ &
2193 & grid(ng)%z_r(i ,j,k))
2194 END DO
2195 END DO
2196 END DO
2197 IF (his(ng)%pioVar(idpthu)%dkind.eq.pio_double) THEN
2198 iodesc => iodesc_dp_u3dvar(ng)
2199 ELSE
2200 iodesc => iodesc_sp_u3dvar(ng)
2201 END IF
2202 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idpthu, &
2203 & his(ng)%pioVar(idpthu), &
2204 & his(ng)%Rindex, &
2205 & iodesc, &
2206 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2207# ifdef MASKING
2208 & grid(ng) % umask, &
2209# endif
2210 & grid(ng) % z_v, &
2211 & setfillval = .false.)
2212 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2213 IF (master) THEN
2214 WRITE (stdout,20) trim(vname(1,idpthu)), his(ng)%Rindex
2215 END IF
2216 exit_flag=3
2217 ioerror=status
2218 RETURN
2219 END IF
2220 END IF
2221!
2222! Write time-varying depths of V-points.
2223!
2224 IF (hout(idpthv,ng)) THEN
2225 scale=1.0_dp
2226 DO k=1,n(ng)
2227 DO j=jstrv-1,jend+1
2228 DO i=istr-1,iend+1
2229 grid(ng)%z_v(i,j,k)=0.5_r8*(grid(ng)%z_r(i,j-1,k)+ &
2230 & grid(ng)%z_r(i,j ,k))
2231 END DO
2232 END DO
2233 END DO
2234 IF (his(ng)%pioVar(idpthv)%dkind.eq.pio_double) THEN
2235 iodesc => iodesc_dp_v3dvar(ng)
2236 ELSE
2237 iodesc => iodesc_sp_v3dvar(ng)
2238 END IF
2239 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idpthv, &
2240 & his(ng)%pioVar(idpthv), &
2241 & his(ng)%Rindex, &
2242 & iodesc, &
2243 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2244# ifdef MASKING
2245 & grid(ng) % vmask, &
2246# endif
2247 & grid(ng) % z_v, &
2248 & setfillval = .false.)
2249 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2250 IF (master) THEN
2251 WRITE (stdout,20) trim(vname(1,idpthv)), his(ng)%Rindex
2252 END IF
2253 exit_flag=3
2254 ioerror=status
2255 RETURN
2256 END IF
2257 END IF
2258!
2259! Write time-varying depths of W-points.
2260!
2261 IF (hout(idpthw,ng)) THEN
2262 scale=1.0_dp
2263 IF (his(ng)%pioVar(idpthw)%dkind.eq.pio_double) THEN
2264 iodesc => iodesc_dp_w3dvar(ng)
2265 ELSE
2266 iodesc => iodesc_sp_w3dvar(ng)
2267 END IF
2268 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idpthw, &
2269 & his(ng)%pioVar(idpthw), &
2270 & his(ng)%Rindex, &
2271 & iodesc, &
2272 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2273# ifdef MASKING
2274 & grid(ng) % rmask, &
2275# endif
2276 & grid(ng) % z_w, &
2277 & setfillval = .false.)
2278 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2279 IF (master) THEN
2280 WRITE (stdout,20) trim(vname(1,idpthw)), his(ng)%Rindex
2281 END IF
2282 exit_flag=3
2283 ioerror=status
2284 RETURN
2285 END IF
2286 END IF
2287# endif
2288!
2289! Write out free-surface (m)
2290!
2291 IF (hout(idfsur,ng)) THEN
2292 scale=1.0_dp
2293 IF (his(ng)%pioVar(idfsur)%dkind.eq.pio_double) THEN
2294 iodesc => iodesc_dp_r2dvar(ng)
2295 ELSE
2296 iodesc => iodesc_sp_r2dvar(ng)
2297 END IF
2298 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idfsur, &
2299 & his(ng)%pioVar(idfsur), &
2300 & his(ng)%Rindex, &
2301 & iodesc, &
2302 & lbi, ubi, lbj, ubj, scale, &
2303# ifdef MASKING
2304 & grid(ng) % rmask, &
2305# endif
2306# ifdef WET_DRY
2307 & ocean(ng) % zeta(:,:,kout), &
2308 & setfillval = .false.)
2309# else
2310 & ocean(ng) % zeta(:,:,kout))
2311# endif
2312 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2313 IF (master) THEN
2314 WRITE (stdout,20) trim(vname(1,idfsur)), his(ng)%Rindex
2315 END IF
2316 exit_flag=3
2317 ioerror=status
2318 RETURN
2319 END IF
2320
2321# if defined FORWARD_WRITE && defined FORWARD_RHS
2322!
2323 IF (his(ng)%pioVar(idrzet)%dkind.eq.pio_double) THEN
2324 iodesc => iodesc_dp_r2dvar(ng)
2325 ELSE
2326 iodesc => iodesc_sp_r2dvar(ng)
2327 END IF
2328 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idrzet, &
2329 & his(ng)%pioVar(idrzet), &
2330 & his(ng)%Rindex, &
2331 & iodesc, &
2332 & lbi, ubi, lbj, ubj, scale, &
2333# ifdef MASKING
2334 & grid(ng) % rmask, &
2335# endif
2336 & ocean(ng) % rzeta(:,:,kout))
2337 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2338 IF (master) THEN
2339 WRITE (stdout,20) trim(vname(1,idrzet)), his(ng)%Rindex
2340 END IF
2341 exit_flag=3
2342 ioerror=status
2343 RETURN
2344 END IF
2345# endif
2346 END IF
2347
2348# ifdef ADJUST_BOUNDARY
2349!
2350! Write out free-surface open boundaries.
2351!
2352 IF (any(lobc(:,isfsur,ng))) THEN
2353 scale=1.0_dp
2354 IF (his(ng)%pioVar(idsbry(isfsur))%dkind.eq.pio_double) THEN
2355 iodesc => iodesc_dp_r2dobc(ng)
2356 ELSE
2357 iodesc => iodesc_sp_r2dobc(ng)
2358 END IF
2359 status=nf_fwrite2d_bry(ng, model, his(ng)%name, &
2360 & his(ng)%pioFile, &
2361 & vname(1,idsbry(isfsur)), &
2362 & his(ng)%pioVar(idsbry(isfsur)), &
2363 & his(ng)%Rindex, &
2364 & iodesc, &
2365 & lbij, ubij, nbrec(ng), scale, &
2366 & boundary(ng) % zeta_obc(lbij:,:,:, &
2367 & lbout(ng)))
2368 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2369 IF (master) THEN
2370 WRITE (stdout,20) trim(vname(1,idsbry(isfsur))), &
2371 & his(ng)%Rindex
2372 END IF
2373 exit_flag=3
2374 ioerror=status
2375 RETURN
2376 END IF
2377 END IF
2378# endif
2379!
2380! Write out 2D U-momentum component (m/s).
2381!
2382 IF (hout(idubar,ng)) THEN
2383 scale=1.0_dp
2384 IF (his(ng)%pioVar(idubar)%dkind.eq.pio_double) THEN
2385 iodesc => iodesc_dp_u2dvar(ng)
2386 ELSE
2387 iodesc => iodesc_sp_u2dvar(ng)
2388 END IF
2389 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idubar, &
2390 & his(ng)%pioVar(idubar), &
2391 & his(ng)%Rindex, &
2392 & iodesc, &
2393 & lbi, ubi, lbj, ubj, scale, &
2394# ifdef MASKING
2395 & grid(ng) % umask_full, &
2396# endif
2397 & ocean(ng) % ubar(:,:,kout))
2398 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2399 IF (master) THEN
2400 WRITE (stdout,20) trim(vname(1,idubar)), his(ng)%Rindex
2401 END IF
2402 exit_flag=3
2403 ioerror=status
2404 RETURN
2405 END IF
2406
2407# ifdef FORWARD_WRITE
2408# ifdef FORWARD_RHS
2409!
2410 IF (his(ng)%pioVar(idru2d)%dkind.eq.pio_double) THEN
2411 iodesc => iodesc_dp_u2dvar(ng)
2412 ELSE
2413 iodesc => iodesc_sp_u2dvar(ng)
2414 END IF
2415 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idru2d, &
2416 & his(ng)%pioVar(idru2d), &
2417 & his(ng)%Rindex, &
2418 & iodesc, &
2419 & lbi, ubi, lbj, ubj, scale, &
2420# ifdef MASKING
2421 & grid(ng) % umask_full, &
2422# endif
2423 & ocean(ng) % rubar(:,:,kout))
2424 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2425 IF (master) THEN
2426 WRITE (stdout,20) trim(vname(1,idru2d)), his(ng)%Rindex
2427 END IF
2428 exit_flag=3
2429 ioerror=status
2430 RETURN
2431 END IF
2432# endif
2433# ifdef SOLVE3D
2434# ifdef FORWARD_RHS
2435!
2436 IF (his(ng)%pioVar(idruct)%dkind.eq.pio_double) THEN
2437 iodesc => iodesc_dp_u2dvar(ng)
2438 ELSE
2439 iodesc => iodesc_sp_u2dvar(ng)
2440 END IF
2441 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idruct, &
2442 & his(ng)%pioVar(idruct), &
2443 & his(ng)%Rindex, &
2444 & iodesc, &
2445 & lbi, ubi, lbj, ubj, scale, &
2446# ifdef MASKING
2447 & grid(ng) % umask_full, &
2448# endif
2449 & coupling(ng) % rufrc)
2450 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2451 IF (master) THEN
2452 WRITE (stdout,20) trim(vname(1,idruct)), his(ng)%Rindex
2453 END IF
2454 exit_flag=3
2455 ioerror=status
2456 RETURN
2457 END IF
2458# endif
2459!
2460 IF (his(ng)%pioVar(idufx1)%dkind.eq.pio_double) THEN
2461 iodesc => iodesc_dp_u2dvar(ng)
2462 ELSE
2463 iodesc => iodesc_sp_u2dvar(ng)
2464 END IF
2465 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idufx1, &
2466 & his(ng)%pioVar(idufx1), &
2467 & his(ng)%Rindex, &
2468 & iodesc, &
2469 & lbi, ubi, lbj, ubj, scale, &
2470# ifdef MASKING
2471 & grid(ng) % umask_full, &
2472# endif
2473 & coupling(ng) % DU_avg1)
2474 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2475 IF (master) THEN
2476 WRITE (stdout,20) trim(vname(1,idufx1)), his(ng)%Rindex
2477 END IF
2478 exit_flag=3
2479 ioerror=status
2480 RETURN
2481 END IF
2482!
2483 IF (his(ng)%pioVar(idufx2)%dkind.eq.pio_double) THEN
2484 iodesc => iodesc_dp_u2dvar(ng)
2485 ELSE
2486 iodesc => iodesc_sp_u2dvar(ng)
2487 END IF
2488 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idufx2, &
2489 & his(ng)%pioVar(idufx2), &
2490 & his(ng)%Rindex, &
2491 & iodesc, &
2492 & lbi, ubi, lbj, ubj, scale, &
2493# ifdef MASKING
2494 & grid(ng) % umask_full, &
2495# endif
2496 & coupling(ng) % DU_avg2)
2497 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2498 IF (master) THEN
2499 WRITE (stdout,20) trim(vname(1,idufx2)), his(ng)%Rindex
2500 END IF
2501 exit_flag=3
2502 ioerror=status
2503 RETURN
2504 END IF
2505# endif
2506# endif
2507 END IF
2508
2509# ifdef ADJUST_BOUNDARY
2510!
2511! Write out 2D U-momentum component open boundaries.
2512!
2513 IF (any(lobc(:,isubar,ng))) THEN
2514 scale=1.0_dp
2515 IF (his(ng)%pioVar(idsbry(isubar))%dkind.eq.pio_double) THEN
2516 iodesc => iodesc_dp_u2dobc(ng)
2517 ELSE
2518 iodesc => iodesc_sp_u2dobc(ng)
2519 END IF
2520 status=nf_fwrite2d_bry(ng, model, his(ng)%name, &
2521 & his(ng)%pioFile, &
2522 & vname(1,idsbry(isubar)), &
2523 & his(ng)%pioVar(idsbry(isubar)), &
2524 & his(ng)%Rindex, &
2525 & iodesc, &
2526 & lbij, ubij, nbrec(ng), scale, &
2527 & boundary(ng) % ubar_obc(lbij:,:,:, &
2528 & lbout(ng)))
2529 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2530 IF (master) THEN
2531 WRITE (stdout,20) trim(vname(1,idsbry(isubar))), &
2532 & his(ng)%Rindex
2533 END IF
2534 exit_flag=3
2535 ioerror=status
2536 RETURN
2537 END IF
2538 END IF
2539# endif
2540!
2541! Write out 2D V-momentum component (m/s).
2542!
2543 IF (hout(idvbar,ng)) THEN
2544 scale=1.0_dp
2545 IF (his(ng)%pioVar(idvbar)%dkind.eq.pio_double) THEN
2546 iodesc => iodesc_dp_v2dvar(ng)
2547 ELSE
2548 iodesc => iodesc_sp_v2dvar(ng)
2549 END IF
2550 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idvbar, &
2551 & his(ng)%pioVar(idvbar), &
2552 & his(ng)%Rindex, &
2553 & iodesc, &
2554 & lbi, ubi, lbj, ubj, scale, &
2555# ifdef MASKING
2556 & grid(ng) % vmask_full, &
2557# endif
2558 & ocean(ng) % vbar(:,:,kout))
2559 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2560 IF (master) THEN
2561 WRITE (stdout,20) trim(vname(1,idvbar)), his(ng)%Rindex
2562 END IF
2563 exit_flag=3
2564 ioerror=status
2565 RETURN
2566 END IF
2567
2568# ifdef FORWARD_WRITE
2569# ifdef FORWARD_RHS
2570!
2571 IF (his(ng)%pioVar(idrv2d)%dkind.eq.pio_double) THEN
2572 iodesc => iodesc_dp_v2dvar(ng)
2573 ELSE
2574 iodesc => iodesc_sp_v2dvar(ng)
2575 END IF
2576 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idrv2d, &
2577 & his(ng)%pioVar(idrv2d), &
2578 & his(ng)%Rindex, &
2579 & iodesc, &
2580 & lbi, ubi, lbj, ubj, scale, &
2581# ifdef MASKING
2582 & grid(ng) % vmask_full, &
2583# endif
2584 & ocean(ng) % rvbar(:,:,kout))
2585 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2586 IF (master) THEN
2587 WRITE (stdout,20) trim(vname(1,idrv2d)), his(ng)%Rindex
2588 END IF
2589 exit_flag=3
2590 ioerror=status
2591 RETURN
2592 END IF
2593# endif
2594# ifdef SOLVE3D
2595# ifdef FORWARD_RHS
2596!
2597 IF (his(ng)%pioVar(idrvct)%dkind.eq.pio_double) THEN
2598 iodesc => iodesc_dp_v2dvar(ng)
2599 ELSE
2600 iodesc => iodesc_sp_v2dvar(ng)
2601 END IF
2602 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idrvct, &
2603 & his(ng)%pioVar(idrvct), &
2604 & his(ng)%Rindex, &
2605 & iodesc, &
2606 & lbi, ubi, lbj, ubj, scale, &
2607# ifdef MASKING
2608 & grid(ng) % vmask_full, &
2609# endif
2610 & coupling(ng) % rvfrc)
2611 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2612 IF (master) THEN
2613 WRITE (stdout,20) trim(vname(1,idrvct)), his(ng)%Rindex
2614 END IF
2615 exit_flag=3
2616 ioerror=status
2617 RETURN
2618 END IF
2619# endif
2620!
2621 IF (his(ng)%pioVar(idvfx1)%dkind.eq.pio_double) THEN
2622 iodesc => iodesc_dp_v2dvar(ng)
2623 ELSE
2624 iodesc => iodesc_sp_v2dvar(ng)
2625 END IF
2626 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idvfx1, &
2627 & his(ng)%pioVar(idvfx1), &
2628 & his(ng)%Rindex, &
2629 & iodesc, &
2630 & lbi, ubi, lbj, ubj, scale, &
2631# ifdef MASKING
2632 & grid(ng) % vmask_full, &
2633# endif
2634 & coupling(ng) % DV_avg1)
2635 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2636 IF (master) THEN
2637 WRITE (stdout,20) trim(vname(1,idvfx1)), his(ng)%Rindex
2638 END IF
2639 exit_flag=3
2640 ioerror=status
2641 RETURN
2642 END IF
2643!
2644 IF (his(ng)%pioVar(idvfx2)%dkind.eq.pio_double) THEN
2645 iodesc => iodesc_dp_v2dvar(ng)
2646 ELSE
2647 iodesc => iodesc_sp_v2dvar(ng)
2648 END IF
2649 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idvfx2, &
2650 & his(ng)%pioVar(idvfx2), &
2651 & his(ng)%Rindex, &
2652 & iodesc, &
2653 & lbi, ubi, lbj, ubj, scale, &
2654# ifdef MASKING
2655 & grid(ng) % vmask_full, &
2656# endif
2657 & coupling(ng) % DV_avg2)
2658 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2659 IF (master) THEN
2660 WRITE (stdout,20) trim(vname(1,idvfx2)), his(ng)%Rindex
2661 END IF
2662 exit_flag=3
2663 ioerror=status
2664 RETURN
2665 END IF
2666# endif
2667# endif
2668 END IF
2669
2670# ifdef ADJUST_BOUNDARY
2671!
2672! Write out 2D V-momentum component open boundaries.
2673!
2674 IF (any(lobc(:,isvbar,ng))) THEN
2675 scale=1.0_dp
2676 IF (his(ng)%pioVar(idsbry(isvbar))%dkind.eq.pio_double) THEN
2677 iodesc => iodesc_dp_v2dobc(ng)
2678 ELSE
2679 iodesc => iodesc_sp_v2dobc(ng)
2680 END IF
2681 status=nf_fwrite2d_bry(ng, model, his(ng)%name, &
2682 & his(ng)%pioFile, &
2683 & vname(1,idsbry(isvbar)), &
2684 & his(ng)%pioVar(idsbry(isvbar)), &
2685 & his(ng)%Rindex, &
2686 & iodesc, &
2687 & lbij, ubij, nbrec(ng), scale, &
2688 & boundary(ng) % vbar_obc(lbij:,:,:, &
2689 & lbout(ng)))
2690 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2691 IF (master) THEN
2692 WRITE (stdout,20) trim(vname(1,idsbry(isvbar))), &
2693 & his(ng)%Rindex
2694 END IF
2695 exit_flag=3
2696 ioerror=status
2697 RETURN
2698 END IF
2699 END IF
2700# endif
2701!
2702! Write out 2D Eastward and Northward momentum components (m/s) at
2703! RHO-points.
2704!
2705 IF (hout(idu2de,ng).and.hout(idv2dn,ng)) THEN
2706 IF (.not.allocated(ur2d)) THEN
2707 allocate (ur2d(lbi:ubi,lbj:ubj))
2708 ur2d(lbi:ubi,lbj:ubj)=0.0_r8
2709 END IF
2710 IF (.not.allocated(vr2d)) THEN
2711 allocate (vr2d(lbi:ubi,lbj:ubj))
2712 vr2d(lbi:ubi,lbj:ubj)=0.0_r8
2713 END IF
2714 CALL uv_rotate2d (ng, tile, .false., .true., &
2715 & lbi, ubi, lbj, ubj, &
2716 & grid(ng) % CosAngler, &
2717 & grid(ng) % SinAngler, &
2718# ifdef MASKING
2719 & grid(ng) % rmask_full, &
2720# endif
2721 & ocean(ng) % ubar(:,:,kout), &
2722 & ocean(ng) % vbar(:,:,kout), &
2723 & ur2d, vr2d)
2724!
2725 scale=1.0_dp
2726 IF (his(ng)%pioVar(idu2de)%dkind.eq.pio_double) THEN
2727 iodesc => iodesc_dp_r2dvar(ng)
2728 ELSE
2729 iodesc => iodesc_sp_r2dvar(ng)
2730 END IF
2731 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idu2de, &
2732 & his(ng)%pioVar(idu2de), &
2733 & his(ng)%Rindex, &
2734 & iodesc, &
2735 & lbi, ubi, lbj, ubj, scale, &
2736# ifdef MASKING
2737 & grid(ng) % rmask_full, &
2738# endif
2739 & ur2d)
2740 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2741 IF (master) THEN
2742 WRITE (stdout,20) trim(vname(1,idu2de)), his(ng)%Rindex
2743 END IF
2744 exit_flag=3
2745 ioerror=status
2746 RETURN
2747 END IF
2748!
2749 IF (his(ng)%pioVar(idv2dn)%dkind.eq.pio_double) THEN
2750 iodesc => iodesc_dp_r2dvar(ng)
2751 ELSE
2752 iodesc => iodesc_sp_r2dvar(ng)
2753 END IF
2754 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idv2dn, &
2755 & his(ng)%pioVar(idv2dn), &
2756 & his(ng)%Rindex, &
2757 & iodesc, &
2758 & lbi, ubi, lbj, ubj, scale, &
2759# ifdef MASKING
2760 & grid(ng) % rmask_full, &
2761# endif
2762 & vr2d)
2763 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2764 IF (master) THEN
2765 WRITE (stdout,20) trim(vname(1,idv2dn)), his(ng)%Rindex
2766 END IF
2767 exit_flag=3
2768 ioerror=status
2769 RETURN
2770 END IF
2771 deallocate (ur2d)
2772 deallocate (vr2d)
2773 END IF
2774
2775# ifdef SOLVE3D
2776!
2777! Write out 3D U-momentum component (m/s).
2778!
2779 IF (hout(iduvel,ng)) THEN
2780 scale=1.0_dp
2781 IF (his(ng)%pioVar(iduvel)%dkind.eq.pio_double) THEN
2782 iodesc => iodesc_dp_u3dvar(ng)
2783 ELSE
2784 iodesc => iodesc_sp_u3dvar(ng)
2785 END IF
2786 status=nf_fwrite3d(ng, model, his(ng)%pioFile, iduvel, &
2787 & his(ng)%pioVar(iduvel), &
2788 & his(ng)%Rindex, &
2789 & iodesc, &
2790 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2791# ifdef MASKING
2792 & grid(ng) % umask_full, &
2793# endif
2794 & ocean(ng) % u(:,:,:,nout))
2795 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2796 IF (master) THEN
2797 WRITE (stdout,20) trim(vname(1,iduvel)), his(ng)%Rindex
2798 END IF
2799 exit_flag=3
2800 ioerror=status
2801 RETURN
2802 END IF
2803
2804# if defined FORWARD_WRITE && defined FORWARD_RHS
2805!
2806 IF (his(ng)%pioVar(idru3d)%dkind.eq.pio_double) THEN
2807 iodesc => iodesc_dp_u3dvar(ng)
2808 ELSE
2809 iodesc => iodesc_sp_u3dvar(ng)
2810 END IF
2811 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idru3d, &
2812 & his(ng)%pioVar(idru3d), &
2813 & his(ng)%Rindex, &
2814 & iodesc, &
2815 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2816# ifdef MASKING
2817 & grid(ng) % umask_full, &
2818# endif
2819 & ocean(ng) % ru(:,:,:,nout))
2820 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2821 IF (master) THEN
2822 WRITE (stdout,20) trim(vname(1,idru3d)), his(ng)%Rindex
2823 END IF
2824 exit_flag=3
2825 ioerror=status
2826 RETURN
2827 END IF
2828# endif
2829 END IF
2830
2831# ifdef ADJUST_BOUNDARY
2832!
2833! Write out 3D U-momentum component open boundaries.
2834!
2835 IF (any(lobc(:,isuvel,ng))) THEN
2836 scale=1.0_dp
2837 IF (his(ng)%pioVar(idsbry(isuvel))%dkind.eq.pio_double) THEN
2838 iodesc => iodesc_dp_u3dobc(ng)
2839 ELSE
2840 iodesc => iodesc_sp_u3dobc(ng)
2841 END IF
2842 status=nf_fwrite3d_bry(ng, model, his(ng)%name, &
2843 & his(ng)%pioFile, &
2844 & vname(1,idsbry(isuvel)), &
2845 & his(ng)%pioVar(idsbry(isuvel)), &
2846 & his(ng)%Rindex, &
2847 & iodesc, &
2848 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
2849 & boundary(ng) % u_obc(lbij:,:,:,:, &
2850 & lbout(ng)))
2851 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2852 IF (master) THEN
2853 WRITE (stdout,20) trim(vname(1,idsbry(isuvel))), &
2854 & his(ng)%Rindex
2855 END IF
2856 exit_flag=3
2857 ioerror=status
2858 RETURN
2859 END IF
2860 END IF
2861# endif
2862!
2863! Write out 3D V-momentum component (m/s).
2864!
2865 IF (hout(idvvel,ng)) THEN
2866 scale=1.0_dp
2867 IF (his(ng)%pioVar(idvvel)%dkind.eq.pio_double) THEN
2868 iodesc => iodesc_dp_v3dvar(ng)
2869 ELSE
2870 iodesc => iodesc_sp_v3dvar(ng)
2871 END IF
2872 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idvvel, &
2873 & his(ng)%pioVar(idvvel), &
2874 & his(ng)%Rindex, &
2875 & iodesc, &
2876 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2877# ifdef MASKING
2878 & grid(ng) % vmask_full, &
2879# endif
2880 & ocean(ng) % v(:,:,:,nout))
2881 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2882 IF (master) THEN
2883 WRITE (stdout,20) trim(vname(1,idvvel)), his(ng)%Rindex
2884 END IF
2885 exit_flag=3
2886 ioerror=status
2887 RETURN
2888 END IF
2889
2890# if defined FORWARD_WRITE && defined FORWARD_RHS
2891!
2892 IF (his(ng)%pioVar(idrv3d)%dkind.eq.pio_double) THEN
2893 iodesc => iodesc_dp_v3dvar(ng)
2894 ELSE
2895 iodesc => iodesc_sp_v3dvar(ng)
2896 END IF
2897 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idrv3d, &
2898 & his(ng)%pioVar(idrv3d), &
2899 & his(ng)%Rindex, &
2900 & iodesc, &
2901 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2902# ifdef MASKING
2903 & grid(ng) % vmask_full, &
2904# endif
2905 & ocean(ng) % rv(:,:,:,nout))
2906 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2907 IF (master) THEN
2908 WRITE (stdout,20) trim(vname(1,idrv3d)), his(ng)%Rindex
2909 END IF
2910 exit_flag=3
2911 ioerror=status
2912 RETURN
2913 END IF
2914# endif
2915 END IF
2916
2917# ifdef ADJUST_BOUNDARY
2918!
2919! Write out 3D V-momentum component open boundaries.
2920!
2921 IF (any(lobc(:,isvvel,ng))) THEN
2922 scale=1.0_dp
2923 IF (his(ng)%pioVar(idsbry(isvvel))%dkind.eq.pio_double) THEN
2924 iodesc => iodesc_dp_v3dobc(ng)
2925 ELSE
2926 iodesc => iodesc_sp_v3dobc(ng)
2927 END IF
2928 status=nf_fwrite3d_bry(ng, model, his(ng)%name, &
2929 & his(ng)%pioFile, &
2930 & vname(1,idsbry(isvvel)), &
2931 & his(ng)%pioVar(idsbry(isvvel)), &
2932 & his(ng)%Rindex, &
2933 & iodesc, &
2934 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
2935 & boundary(ng) % v_obc(lbij:,:,:,:, &
2936 & lbout(ng)))
2937 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2938 IF (master) THEN
2939 WRITE (stdout,20) trim(vname(1,idsbry(isvvel))), &
2940 & his(ng)%Rindex
2941 END IF
2942 exit_flag=3
2943 ioerror=status
2944 RETURN
2945 END IF
2946 END IF
2947# endif
2948!
2949! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid
2950!
2951 IF (hout(idu3de,ng)) THEN
2952 scale=1.0_dp
2953 IF (his(ng)%pioVar(idu3de)%dkind.eq.pio_double) THEN
2954 iodesc => iodesc_dp_r3dvar(ng)
2955 ELSE
2956 iodesc => iodesc_sp_r3dvar(ng)
2957 END IF
2958 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idu3de, &
2959 & his(ng)%pioVar(idu3de), &
2960 & his(ng)%Rindex, &
2961 & iodesc, &
2962 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2963# ifdef MASKING
2964 & grid(ng) % rmask_full, &
2965# endif
2966 & ocean(ng) % ua)
2967 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2968 IF (master) THEN
2969 WRITE (stdout,20) trim(vname(1,idu3de)), his(ng)%Rindex
2970 END IF
2971 exit_flag=3
2972 ioerror=status
2973 RETURN
2974 END IF
2975 END IF
2976!
2977! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid
2978!
2979 IF (hout(idv3dn,ng)) THEN
2980 IF (his(ng)%pioVar(idv3dn)%dkind.eq.pio_double) THEN
2981 iodesc => iodesc_dp_r3dvar(ng)
2982 ELSE
2983 iodesc => iodesc_sp_r3dvar(ng)
2984 END IF
2985 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idv3dn, &
2986 & his(ng)%pioVar(idv3dn), &
2987 & his(ng)%Rindex, &
2988 & iodesc, &
2989 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2990# ifdef MASKING
2991 & grid(ng) % rmask_full, &
2992# endif
2993 & ocean(ng) % va)
2994 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2995 IF (master) THEN
2996 WRITE (stdout,20) trim(vname(1,idv3dn)), his(ng)%Rindex
2997 END IF
2998 exit_flag=3
2999 ioerror=status
3000 RETURN
3001 END IF
3002 END IF
3003!
3004! Write out S-coordinate omega vertical velocity (m/s).
3005!
3006 IF (hout(idovel,ng)) THEN
3007 IF (.not.allocated(wr3d)) THEN
3008 allocate (wr3d(lbi:ubi,lbj:ubj,0:n(ng)))
3009 wr3d(lbi:ubi,lbj:ubj,0:n(ng))=0.0_r8
3010 END IF
3011 scale=1.0_dp
3012 CALL scale_omega (ng, tile, lbi, ubi, lbj, ubj, 0, n(ng), &
3013 & grid(ng) % pm, &
3014 & grid(ng) % pn, &
3015 & ocean(ng) % W, &
3016 & wr3d)
3017!
3018 IF (his(ng)%pioVar(idovel)%dkind.eq.pio_double) THEN
3019 iodesc => iodesc_dp_w3dvar(ng)
3020 ELSE
3021 iodesc => iodesc_sp_w3dvar(ng)
3022 END IF
3023 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idovel, &
3024 & his(ng)%pioVar(idovel), &
3025 & his(ng)%Rindex, &
3026 & iodesc, &
3027 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3028# ifdef MASKING
3029 & grid(ng) % rmask, &
3030# endif
3031 & wr3d)
3032 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3033 IF (master) THEN
3034 WRITE (stdout,20) trim(vname(1,idovel)), his(ng)%Rindex
3035 END IF
3036 exit_flag=3
3037 ioerror=status
3038 RETURN
3039 END IF
3040 deallocate (wr3d)
3041 END IF
3042
3043# ifdef OMEGA_IMPLICIT
3044!
3045! Write out S-coordinate implicit omega vertical velocity (m/s).
3046!
3047 IF (hout(idovil,ng)) THEN
3048 IF (.not.allocated(wr3d)) THEN
3049 allocate (wr3d(lbi:ubi,lbj:ubj,0:n(ng)))
3050 wr3d(lbi:ubi,lbj:ubj,0:n(ng))=0.0_r8
3051 END IF
3052 scale=1.0_dp
3053 CALL scale_omega (ng, tile, lbi, ubi, lbj, ubj, 0, n(ng), &
3054 & grid(ng) % pm, &
3055 & grid(ng) % pn, &
3056 & ocean(ng) % Wi, &
3057 & wr3d)
3058!
3059 IF (his(ng)%pioVar(idovil)%dkind.eq.pio_double) THEN
3060 iodesc => iodesc_dp_w3dvar(ng)
3061 ELSE
3062 iodesc => iodesc_sp_w3dvar(ng)
3063 END IF
3064 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idovil, &
3065 & his(ng)%pioVar(idovil), &
3066 & his(ng)%Rindex, &
3067 & iodesc, &
3068 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3069# ifdef MASKING
3070 & grid(ng) % rmask, &
3071# endif
3072 & wr3d)
3073 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3074 IF (master) THEN
3075 WRITE (stdout,20) trim(vname(1,idovil)), his(ng)%Rindex
3076 END IF
3077 exit_flag=3
3078 ioerror=status
3079 RETURN
3080 END IF
3081 deallocate (wr3d)
3082 END IF
3083# endif
3084!
3085! Write out vertical velocity (m/s).
3086!
3087 IF (hout(idwvel,ng)) THEN
3088 scale=1.0_dp
3089 IF (his(ng)%pioVar(idwvel)%dkind.eq.pio_double) THEN
3090 iodesc => iodesc_dp_w3dvar(ng)
3091 ELSE
3092 iodesc => iodesc_sp_w3dvar(ng)
3093 END IF
3094 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idwvel, &
3095 & his(ng)%pioVar(idwvel), &
3096 & his(ng)%Rindex, &
3097 & iodesc, &
3098 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3099# ifdef MASKING
3100 & grid(ng) % rmask, &
3101# endif
3102 & ocean(ng) % wvel)
3103 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3104 IF (master) THEN
3105 WRITE (stdout,20) trim(vname(1,idwvel)), his(ng)%Rindex
3106 END IF
3107 exit_flag=3
3108 ioerror=status
3109 RETURN
3110 END IF
3111 END IF
3112!
3113! Write out tracer type variables.
3114!
3115 DO itrc=1,nt(ng)
3116 IF (hout(idtvar(itrc),ng)) THEN
3117 scale=1.0_dp
3118 IF (his(ng)%pioTrc(itrc)%dkind.eq.pio_double) THEN
3119 iodesc => iodesc_dp_r3dvar(ng)
3120 ELSE
3121 iodesc => iodesc_sp_r3dvar(ng)
3122 END IF
3123 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idtvar(itrc), &
3124 & his(ng)%pioTrc(itrc), &
3125 & his(ng)%Rindex, &
3126 & iodesc, &
3127 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
3128# ifdef MASKING
3129 & grid(ng) % rmask, &
3130# endif
3131 & ocean(ng) % t(:,:,:,nout,itrc))
3132 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3133 IF (master) THEN
3134 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), &
3135 & his(ng)%Rindex
3136 END IF
3137 exit_flag=3
3138 ioerror=status
3139 RETURN
3140 END IF
3141 END IF
3142 END DO
3143
3144# ifdef ADJUST_BOUNDARY
3145!
3146! Write out 3D tracers open boundaries.
3147!
3148 DO itrc=1,nt(ng)
3149 IF (any(lobc(:,istvar(itrc),ng))) THEN
3150 scale=1.0_dp
3151 ifield=idsbry(istvar(itrc))
3152 IF (his(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
3153 iodesc => iodesc_dp_r3dobc(ng)
3154 ELSE
3155 iodesc => iodesc_sp_r3dobc(ng)
3156 END IF
3157 status=nf_fwrite3d_bry(ng, model, his(ng)%name, &
3158 & his(ng)%pioFile, &
3159 & vname(1,ifield), &
3160 & his(ng)%pioVar(ifield), &
3161 & his(ng)%Rindex, &
3162 & iodesc, &
3163 & lbij, ubij, 1, n(ng), nbrec(ng), &
3164 & scale, &
3165 & boundary(ng) % t_obc(lbij:,:,:,:, &
3166 & lbout(ng),itrc))
3167 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3168 IF (master) THEN
3169 WRITE (stdout,20) trim(vname(1,ifield)), his(ng)%Rindex
3170 END IF
3171 exit_flag=3
3172 ioerror=status
3173 RETURN
3174 END IF
3175 END IF
3176 END DO
3177# endif
3178!
3179! Write out density anomaly.
3180!
3181 IF (hout(iddano,ng)) THEN
3182 scale=1.0_dp
3183 IF (his(ng)%pioVar(iddano)%dkind.eq.pio_double) THEN
3184 iodesc => iodesc_dp_r3dvar(ng)
3185 ELSE
3186 iodesc => iodesc_sp_r3dvar(ng)
3187 END IF
3188 status=nf_fwrite3d(ng, model, his(ng)%pioFile, iddano, &
3189 & his(ng)%pioVar(iddano), &
3190 & his(ng)%Rindex, &
3191 & iodesc, &
3192 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
3193# ifdef MASKING
3194 & grid(ng) % rmask, &
3195# endif
3196 & ocean(ng) % rho)
3197 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3198 IF (master) THEN
3199 WRITE (stdout,20) trim(vname(1,iddano)), his(ng)%Rindex
3200 END IF
3201 exit_flag=3
3202 ioerror=status
3203 RETURN
3204 END IF
3205 END IF
3206
3207# ifdef LMD_SKPP
3208!
3209! Write out depth surface boundary layer.
3210!
3211 IF (hout(idhsbl,ng)) THEN
3212 scale=1.0_dp
3213 IF (his(ng)%pioVar(idhsbl)%dkind.eq.pio_double) THEN
3214 iodesc => iodesc_dp_r2dvar(ng)
3215 ELSE
3216 iodesc => iodesc_sp_r2dvar(ng)
3217 END IF
3218 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idhsbl, &
3219 & his(ng)%pioVar(idhsbl), &
3220 & his(ng)%Rindex, &
3221 & iodesc, &
3222 & lbi, ubi, lbj, ubj, scale, &
3223# ifdef MASKING
3224 & grid(ng) % rmask, &
3225# endif
3226 & mixing(ng) % hsbl)
3227 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3228 IF (master) THEN
3229 WRITE (stdout,20) trim(vname(1,idhsbl)), his(ng)%Rindex
3230 END IF
3231 exit_flag=3
3232 ioerror=status
3233 RETURN
3234 END IF
3235 END IF
3236# endif
3237# ifdef LMD_BKPP
3238!
3239! Write out depth bottom boundary layer.
3240!
3241 IF (hout(idhbbl,ng)) THEN
3242 scale=1.0_dp
3243 IF (his(ng)%pioVar(idhbbl)%dkind.eq.pio_double) THEN
3244 iodesc => iodesc_dp_r2dvar(ng)
3245 ELSE
3246 iodesc => iodesc_sp_r2dvar(ng)
3247 END IF
3248 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idhbbl, &
3249 & his(ng)%pioVar(idhbbl), &
3250 & his(ng)%Rindex, &
3251 & iodesc, &
3252 & lbi, ubi, lbj, ubj, scale, &
3253# ifdef MASKING
3254 & grid(ng) % rmask, &
3255# endif
3256 & mixing(ng) % hbbl)
3257 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3258 IF (master) THEN
3259 WRITE (stdout,20) trim(vname(1,idhbbl)), his(ng)%Rindex
3260 END IF
3261 exit_flag=3
3262 ioerror=status
3263 RETURN
3264 END IF
3265 END IF
3266# endif
3267# if defined FORWARD_WRITE && defined LMD_NONLOCAL
3268!
3269! Write out KPP nonlocal transport.
3270!
3271 DO i=1,nat
3272 IF (hout(idghat(i),ng)) THEN
3273 scale=1.0_dp
3274 IF (his(ng)%pioVar(idghat(i))%dkind.eq.pio_double) THEN
3275 iodesc => iodesc_dp_w3dvar(ng)
3276 ELSE
3277 iodesc => iodesc_sp_w3dvar(ng)
3278 END IF
3279 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idghat(i), &
3280 & his(ng)%pioVar(idghat(i)), &
3281 & his(ng)%Rindex, &
3282 & iodesc, &
3283 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3284# ifdef MASKING
3285 & grid(ng) % rmask, &
3286# endif
3287 & mixing(ng) % ghats(:,:,:,i))
3288 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3289 IF (master) THEN
3290 WRITE (stdout,20) trim(vname(1,idghat(i))), his(ng)%Rindex
3291 END IF
3292 exit_flag=3
3293 ioerror=status
3294 RETURN
3295 END IF
3296 END IF
3297 END DO
3298# endif
3299!
3300! Write out vertical viscosity coefficient.
3301!
3302 IF (hout(idvvis,ng)) THEN
3303 scale=1.0_dp
3304 IF (his(ng)%pioVar(idvvis)%dkind.eq.pio_double) THEN
3305 iodesc => iodesc_dp_w3dvar(ng)
3306 ELSE
3307 iodesc => iodesc_sp_w3dvar(ng)
3308 END IF
3309 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idvvis, &
3310 & his(ng)%pioVar(idvvis), &
3311 & his(ng)%Rindex, &
3312 & iodesc, &
3313 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3314# ifdef MASKING
3315 & grid(ng) % rmask, &
3316# endif
3317 & mixing(ng) % Akv, &
3318 & setfillval = .false.)
3319 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3320 IF (master) THEN
3321 WRITE (stdout,20) trim(vname(1,idvvis)), his(ng)%Rindex
3322 END IF
3323 exit_flag=3
3324 ioerror=status
3325 RETURN
3326 END IF
3327 END IF
3328!
3329! Write out vertical diffusion coefficient for potential temperature.
3330!
3331 IF (hout(idtdif,ng)) THEN
3332 scale=1.0_dp
3333 IF (his(ng)%pioVar(idtdif)%dkind.eq.pio_double) THEN
3334 iodesc => iodesc_dp_w3dvar(ng)
3335 ELSE
3336 iodesc => iodesc_sp_w3dvar(ng)
3337 END IF
3338 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idtdif, &
3339 & his(ng)%pioVar(idtdif), &
3340 & his(ng)%Rindex, &
3341 & iodesc, &
3342 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3343# ifdef MASKING
3344 & grid(ng) % rmask, &
3345# endif
3346 & mixing(ng) % Akt(:,:,:,itemp), &
3347 & setfillval = .false.)
3348 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3349 IF (master) THEN
3350 WRITE (stdout,20) trim(vname(1,idtdif)), his(ng)%Rindex
3351 END IF
3352 exit_flag=3
3353 ioerror=status
3354 RETURN
3355 END IF
3356 END IF
3357
3358# ifdef SALINITY
3359!
3360! Write out vertical diffusion coefficient for salinity.
3361!
3362 IF (hout(idsdif,ng)) THEN
3363 scale=1.0_dp
3364 IF (his(ng)%pioVar(idsdif)%dkind.eq.pio_double) THEN
3365 iodesc => iodesc_dp_w3dvar(ng)
3366 ELSE
3367 iodesc => iodesc_sp_w3dvar(ng)
3368 END IF
3369 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idsdif, &
3370 & his(ng)%pioVar(idsdif), &
3371 & his(ng)%Rindex, &
3372 & iodesc, &
3373 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3374# ifdef MASKING
3375 & grid(ng) % rmask, &
3376# endif
3377 & mixing(ng) % Akt(:,:,:,isalt), &
3378 & setfillval = .false.)
3379 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3380 IF (master) THEN
3381 WRITE (stdout,20) trim(vname(1,idsdif)), his(ng)%Rindex
3382 END IF
3383 exit_flag=3
3384 ioerror=status
3385 RETURN
3386 END IF
3387 END IF
3388# endif
3389# if defined GLS_MIXING || defined MY25_MIXING
3390!
3391! Write out turbulent kinetic energy.
3392!
3393 IF (hout(idmtke,ng)) THEN
3394 scale=1.0_dp
3395 IF (his(ng)%pioVar(idmtke)%dkind.eq.pio_double) THEN
3396 iodesc => iodesc_dp_w3dvar(ng)
3397 ELSE
3398 iodesc => iodesc_sp_w3dvar(ng)
3399 END IF
3400 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idmtke, &
3401 & his(ng)%pioVar(idmtke), &
3402 & his(ng)%Rindex, &
3403 & iodesc, &
3404 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3405# ifdef MASKING
3406 & grid(ng) % rmask, &
3407# endif
3408 & mixing(ng) % tke(:,:,:,nout), &
3409 & setfillval = .false.)
3410 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3411 IF (master) THEN
3412 WRITE (stdout,20) trim(vname(1,idmtke)), his(ng)%Rindex
3413 END IF
3414 exit_flag=3
3415 ioerror=status
3416 RETURN
3417 END IF
3418
3419# ifdef FORWARD_WRITE
3420!
3421 scale=1.0_dp
3422 IF (his(ng)%pioVar(idvmkk)%dkind.eq.pio_double) THEN
3423 iodesc => iodesc_dp_w3dvar(ng)
3424 ELSE
3425 iodesc => iodesc_sp_w3dvar(ng)
3426 END IF
3427 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idvmkk, &
3428 & his(ng)%pioVar(idvmkk), &
3429 & his(ng)%Rindex, &
3430 & iodesc, &
3431 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3432# ifdef MASKING
3433 & grid(ng) % rmask, &
3434# endif
3435 & mixing(ng) % Akk)
3436 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3437 IF (master) THEN
3438 WRITE (stdout,20) trim(vname(1,idvmkk)), his(ng)%Rindex
3439 END IF
3440 exit_flag=3
3441 ioerror=status
3442 RETURN
3443 END IF
3444# endif
3445 END IF
3446!
3447! Write out turbulent length scale field.
3448!
3449 IF (hout(idmtls,ng)) THEN
3450 scale=1.0_dp
3451 IF (his(ng)%pioVar(idmtls)%dkind.eq.pio_double) THEN
3452 iodesc => iodesc_dp_w3dvar(ng)
3453 ELSE
3454 iodesc => iodesc_sp_w3dvar(ng)
3455 END IF
3456 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idmtls, &
3457 & his(ng)%pioVar(idmtls), &
3458 & his(ng)%Rindex, &
3459 & iodesc, &
3460 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3461# ifdef MASKING
3462 & grid(ng) % rmask, &
3463# endif
3464 & mixing(ng) % gls(:,:,:,nout), &
3465 & setfillval = .false.)
3466 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3467 IF (master) THEN
3468 WRITE (stdout,20) trim(vname(1,idmtls)), his(ng)%Rindex
3469 END IF
3470 exit_flag=3
3471 ioerror=status
3472 RETURN
3473 END IF
3474
3475# ifdef FORWARD_WRITE
3476!
3477 IF (his(ng)%pioVar(idvmls)%dkind.eq.pio_double) THEN
3478 iodesc => iodesc_dp_w3dvar(ng)
3479 ELSE
3480 iodesc => iodesc_sp_w3dvar(ng)
3481 END IF
3482 scale=1.0_dp
3483 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idvmls, &
3484 & his(ng)%pioVar(idvmls), &
3485 & his(ng)%Rindex, &
3486 & iodesc, &
3487 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3488# ifdef MASKING
3489 & grid(ng) % rmask, &
3490# endif
3491 & mixing(ng) % Lscale)
3492 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3493 IF (master) THEN
3494 WRITE (stdout,20) trim(vname(1,idvmls)), his(ng)%Rindex
3495 END IF
3496 exit_flag=3
3497 ioerror=status
3498 RETURN
3499 END IF
3500# endif
3501# if defined FORWARD_WRITE && defined GLS_MIXING
3502!
3503 scale=1.0_dp
3504 IF (his(ng)%pioVar(idvmkp)%dkind.eq.pio_double) THEN
3505 iodesc => iodesc_dp_w3dvar(ng)
3506 ELSE
3507 iodesc => iodesc_sp_w3dvar(ng)
3508 END IF
3509 status=nf_fwrite3d(ng, model, his(ng)%pioFile, idvmkp, &
3510 & his(ng)%pioVar(idvmkp), &
3511 & his(ng)%Rindex, &
3512 & iodesc, &
3513 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
3514# ifdef MASKING
3515 & grid(ng) % rmask, &
3516# endif
3517 & mixing(ng) % Akp)
3518 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3519 IF (master) THEN
3520 WRITE (stdout,20) trim(vname(1,idvmkp)), his(ng)%Rindex
3521 END IF
3522 exit_flag=3
3523 ioerror=status
3524 RETURN
3525 END IF
3526# endif
3527 END IF
3528# endif
3529# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
3530!
3531! Write out surface air pressure.
3532!
3533 IF (hout(idpair,ng)) THEN
3534 scale=1.0_dp
3535 IF (his(ng)%pioVar(idpair)%dkind.eq.pio_double) THEN
3536 iodesc => iodesc_dp_r2dvar(ng)
3537 ELSE
3538 iodesc => iodesc_sp_r2dvar(ng)
3539 END IF
3540 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idpair, &
3541 & his(ng)%pioVar(idpair), &
3542 & his(ng)%Rindex, &
3543 & iodesc, &
3544 & lbi, ubi, lbj, ubj, scale, &
3545# ifdef MASKING
3546 & grid(ng) % rmask, &
3547# endif
3548 & forces(ng) % Pair)
3549 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3550 IF (master) THEN
3551 WRITE (stdout,20) trim(vname(1,idpair)), his(ng)%Rindex
3552 END IF
3553 exit_flag=3
3554 ioerror=status
3555 RETURN
3556 END IF
3557 END IF
3558# endif
3559# if defined BULK_FLUXES
3560!
3561! Write out surface air temperature.
3562!
3563 IF (hout(idtair,ng)) THEN
3564 scale=1.0_dp
3565 IF (his(ng)%pioVar(idtair)%dkind.eq.pio_double) THEN
3566 iodesc => iodesc_dp_r2dvar(ng)
3567 ELSE
3568 iodesc => iodesc_sp_r2dvar(ng)
3569 END IF
3570 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idtair, &
3571 & his(ng)%pioVar(idtair), &
3572 & his(ng)%Rindex, &
3573 & iodesc, &
3574 & lbi, ubi, lbj, ubj, scale, &
3575# ifdef MASKING
3576 & grid(ng) % rmask, &
3577# endif
3578 & forces(ng) % Tair)
3579 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3580 IF (master) THEN
3581 WRITE (stdout,20) trim(vname(1,idtair)), his(ng)%Rindex
3582 END IF
3583 exit_flag=3
3584 ioerror=status
3585 RETURN
3586 END IF
3587 END IF
3588# endif
3589# if defined BULK_FLUXES || defined ECOSIM
3590!
3591! Write out surface winds.
3592!
3593 IF (hout(iduair,ng)) THEN
3594 scale=1.0_dp
3595 IF (his(ng)%pioVar(iduair)%dkind.eq.pio_double) THEN
3596 iodesc => iodesc_dp_r2dvar(ng)
3597 ELSE
3598 iodesc => iodesc_sp_r2dvar(ng)
3599 END IF
3600 status=nf_fwrite2d(ng, model, his(ng)%pioFile, iduair, &
3601 & his(ng)%pioVar(iduair), &
3602 & his(ng)%Rindex, &
3603 & iodesc, &
3604 & lbi, ubi, lbj, ubj, scale, &
3605# ifdef MASKING
3606 & grid(ng) % rmask, &
3607# endif
3608 & forces(ng) % Uwind)
3609 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3610 IF (master) THEN
3611 WRITE (stdout,20) trim(vname(1,iduair)), his(ng)%Rindex
3612 END IF
3613 exit_flag=3
3614 ioerror=status
3615 RETURN
3616 END IF
3617 END IF
3618!
3619 IF (hout(idvair,ng)) THEN
3620 scale=1.0_dp
3621 IF (his(ng)%pioVar(idvair)%dkind.eq.pio_double) THEN
3622 iodesc => iodesc_dp_r2dvar(ng)
3623 ELSE
3624 iodesc => iodesc_sp_r2dvar(ng)
3625 END IF
3626 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idvair, &
3627 & his(ng)%pioVar(idvair), &
3628 & his(ng)%Rindex, &
3629 & iodesc, &
3630 & lbi, ubi, lbj, ubj, scale, &
3631# ifdef MASKING
3632 & grid(ng) % rmask, &
3633# endif
3634 & forces(ng) % Vwind)
3635 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3636 IF (master) THEN
3637 WRITE (stdout,20) trim(vname(1,idvair)), his(ng)%Rindex
3638 END IF
3639 exit_flag=3
3640 ioerror=status
3641 RETURN
3642 END IF
3643 END IF
3644!
3645! Write out Eastward/Northward surface wind (m/s) at RHO-points.
3646!
3647 IF (hout(iduaie,ng).and.hout(idvain,ng)) THEN
3648 IF (.not.allocated(ur2d)) THEN
3649 allocate (ur2d(lbi:ubi,lbj:ubj))
3650 ur2d(lbi:ubi,lbj:ubj)=0.0_r8
3651 END IF
3652 IF (.not.allocated(vr2d)) THEN
3653 allocate (vr2d(lbi:ubi,lbj:ubj))
3654 vr2d(lbi:ubi,lbj:ubj)=0.0_r8
3655 END IF
3656 CALL uv_rotate2d (ng, tile, .false., .true., &
3657 & lbi, ubi, lbj, ubj, &
3658 & grid(ng) % CosAngler, &
3659 & grid(ng) % SinAngler, &
3660# ifdef MASKING
3661 & grid(ng) % rmask_full, &
3662# endif
3663 & forces(ng) % Uwind, &
3664 & forces(ng) % Vwind, &
3665 & ur2d, vr2d)
3666!
3667 scale=1.0_dp
3668 IF (his(ng)%pioVar(iduaie)%dkind.eq.pio_double) THEN
3669 iodesc => iodesc_dp_r2dvar(ng)
3670 ELSE
3671 iodesc => iodesc_sp_r2dvar(ng)
3672 END IF
3673 status=nf_fwrite2d(ng, model, his(ng)%pioFile, iduaie, &
3674 & his(ng)%pioVar(iduaie), &
3675 & his(ng)%Rindex, &
3676 & iodesc, &
3677 & lbi, ubi, lbj, ubj, scale, &
3678# ifdef MASKING
3679 & grid(ng) % rmask, &
3680# endif
3681 & ur2d)
3682 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3683 IF (master) THEN
3684 WRITE (stdout,20) trim(vname(1,iduaie)), his(ng)%Rindex
3685 END IF
3686 exit_flag=3
3687 ioerror=status
3688 RETURN
3689 END IF
3690!
3691 scale=1.0_dp
3692 IF (his(ng)%pioVar(idvain)%dkind.eq.pio_double) THEN
3693 iodesc => iodesc_dp_r2dvar(ng)
3694 ELSE
3695 iodesc => iodesc_sp_r2dvar(ng)
3696 END IF
3697 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idvain, &
3698 & his(ng)%pioVar(idvain), &
3699 & his(ng)%Rindex, &
3700 & iodesc, &
3701 & lbi, ubi, lbj, ubj, scale, &
3702# ifdef MASKING
3703 & grid(ng) % rmask, &
3704# endif
3705 & vr2d)
3706 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3707 IF (master) THEN
3708 WRITE (stdout,20) trim(vname(1,idvain)), his(ng)%Rindex
3709 END IF
3710 exit_flag=3
3711 ioerror=status
3712 RETURN
3713 END IF
3714 deallocate (ur2d)
3715 deallocate (vr2d)
3716 END IF
3717# endif
3718!
3719! Write out surface active tracers fluxes.
3720!
3721 DO itrc=1,nat
3722 IF (hout(idtsur(itrc),ng)) THEN
3723 IF (itrc.eq.itemp) THEN
3724# ifdef SO_SEMI
3725 scale=1.0_dp
3726# else
3727 scale=rho0*cp ! Celsius m/s to W/m2
3728# endif
3729 ELSE IF (itrc.eq.isalt) THEN
3730 scale=1.0_dp
3731 END IF
3732 IF (his(ng)%pioVar(idtsur(itrc))%dkind.eq.pio_double) THEN
3733 iodesc => iodesc_dp_r2dvar(ng)
3734 ELSE
3735 iodesc => iodesc_sp_r2dvar(ng)
3736 END IF
3737 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idtsur(itrc), &
3738 & his(ng)%pioVar(idtsur(itrc)), &
3739 & his(ng)%Rindex, &
3740 & iodesc, &
3741 & lbi, ubi, lbj, ubj, scale, &
3742# ifdef MASKING
3743 & grid(ng) % rmask, &
3744# endif
3745 & forces(ng) % stflx(:,:,itrc))
3746 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3747 IF (master) THEN
3748 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
3749 & his(ng)%Rindex
3750 END IF
3751 exit_flag=3
3752 ioerror=status
3753 RETURN
3754 END IF
3755 END IF
3756 END DO
3757
3758# if defined BULK_FLUXES || defined FRC_COUPLING
3759!
3760! Write out latent heat flux.
3761!
3762 IF (hout(idlhea,ng)) THEN
3763 scale=rho0*cp
3764 IF (his(ng)%pioVar(idlhea)%dkind.eq.pio_double) THEN
3765 iodesc => iodesc_dp_r2dvar(ng)
3766 ELSE
3767 iodesc => iodesc_sp_r2dvar(ng)
3768 END IF
3769 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idlhea, &
3770 & his(ng)%pioVar(idlhea), &
3771 & his(ng)%Rindex, &
3772 & iodesc, &
3773 & lbi, ubi, lbj, ubj, scale, &
3774# ifdef MASKING
3775 & grid(ng) % rmask, &
3776# endif
3777 & forces(ng) % lhflx)
3778 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3779 IF (master) THEN
3780 WRITE (stdout,20) trim(vname(1,idlhea)), his(ng)%Rindex
3781 END IF
3782 exit_flag=3
3783 ioerror=status
3784 RETURN
3785 END IF
3786 END IF
3787!
3788! Write out sensible heat flux.
3789!
3790 IF (hout(idshea,ng)) THEN
3791 scale=rho0*cp
3792 IF (his(ng)%pioVar(idshea)%dkind.eq.pio_double) THEN
3793 iodesc => iodesc_dp_r2dvar(ng)
3794 ELSE
3795 iodesc => iodesc_sp_r2dvar(ng)
3796 END IF
3797 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idshea, &
3798 & his(ng)%pioVar(idshea), &
3799 & his(ng)%Rindex, &
3800 & iodesc, &
3801 & lbi, ubi, lbj, ubj, scale, &
3802# ifdef MASKING
3803 & grid(ng) % rmask, &
3804# endif
3805 & forces(ng) % shflx)
3806 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3807 IF (master) THEN
3808 WRITE (stdout,20) trim(vname(1,idshea)), his(ng)%Rindex
3809 END IF
3810 exit_flag=3
3811 ioerror=status
3812 RETURN
3813 END IF
3814 END IF
3815!
3816! Write out net longwave radiation flux.
3817!
3818 IF (hout(idlrad,ng)) THEN
3819 scale=rho0*cp
3820 IF (his(ng)%pioVar(idlrad)%dkind.eq.pio_double) THEN
3821 iodesc => iodesc_dp_r2dvar(ng)
3822 ELSE
3823 iodesc => iodesc_sp_r2dvar(ng)
3824 END IF
3825 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idlrad, &
3826 & his(ng)%pioVar(idlrad), &
3827 & his(ng)%Rindex, &
3828 & iodesc, &
3829 & lbi, ubi, lbj, ubj, scale, &
3830# ifdef MASKING
3831 & grid(ng) % rmask, &
3832# endif
3833 & forces(ng) % lrflx)
3834 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3835 IF (master) THEN
3836 WRITE (stdout,20) trim(vname(1,idlrad)), his(ng)%Rindex
3837 END IF
3838 exit_flag=3
3839 ioerror=status
3840 RETURN
3841 END IF
3842 END IF
3843# endif
3844
3845# ifdef BULK_FLUXES
3846# ifdef EMINUSP
3847!
3848! Write out evaporation rate (kg/m2/s).
3849!
3850 IF (hout(idevap,ng)) THEN
3851 scale=1.0_dp
3852 IF (his(ng)%pioVar(idevap)%dkind.eq.pio_double) THEN
3853 iodesc => iodesc_dp_r2dvar(ng)
3854 ELSE
3855 iodesc => iodesc_sp_r2dvar(ng)
3856 END IF
3857 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idevap, &
3858 & his(ng)%pioVar(idevap), &
3859 & his(ng)%Rindex, &
3860 & iodesc, &
3861 & lbi, ubi, lbj, ubj, scale, &
3862# ifdef MASKING
3863 & grid(ng) % rmask, &
3864# endif
3865 & forces(ng) % evap)
3866 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3867 IF (master) THEN
3868 WRITE (stdout,20) trim(vname(1,idevap)), his(ng)%Rindex
3869 END IF
3870 exit_flag=3
3871 ioerror=status
3872 RETURN
3873 END IF
3874 END IF
3875!
3876! Write out precipitation rate (kg/m2/s).
3877!
3878 IF (hout(idrain,ng)) THEN
3879 scale=1.0_dp
3880 IF (his(ng)%pioVar(idrain)%dkind.eq.pio_double) THEN
3881 iodesc => iodesc_dp_r2dvar(ng)
3882 ELSE
3883 iodesc => iodesc_sp_r2dvar(ng)
3884 END IF
3885 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idrain, &
3886 & his(ng)%pioVar(idrain), &
3887 & his(ng)%Rindex, &
3888 & iodesc, &
3889 & lbi, ubi, lbj, ubj, scale, &
3890# ifdef MASKING
3891 & grid(ng) % rmask, &
3892# endif
3893 & forces(ng) % rain)
3894 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3895 IF (master) THEN
3896 WRITE (stdout,20) trim(vname(1,idrain)), his(ng)%Rindex
3897 END IF
3898 exit_flag=3
3899 ioerror=status
3900 RETURN
3901 END IF
3902 END IF
3903# endif
3904# endif
3905!
3906! Write out E-P (m/s).
3907!
3908 IF (hout(idempf,ng)) THEN
3909 scale=1.0_dp
3910 IF (his(ng)%pioVar(idempf)%dkind.eq.pio_double) THEN
3911 iodesc => iodesc_dp_r2dvar(ng)
3912 ELSE
3913 iodesc => iodesc_sp_r2dvar(ng)
3914 END IF
3915 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idempf, &
3916 & his(ng)%pioVar(idempf), &
3917 & his(ng)%Rindex, &
3918 & iodesc, &
3919 & lbi, ubi, lbj, ubj, scale, &
3920# ifdef MASKING
3921 & grid(ng) % rmask, &
3922# endif
3923 & forces(ng) % stflux(:,:,isalt))
3924 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3925 IF (master) THEN
3926 WRITE (stdout,20) trim(vname(1,idempf)), his(ng)%Rindex
3927 END IF
3928 exit_flag=3
3929 ioerror=status
3930 RETURN
3931 END IF
3932 END IF
3933
3934# ifdef SHORTWAVE
3935!
3936! Write out net shortwave radiation flux.
3937!
3938 IF (hout(idsrad,ng)) THEN
3939 scale=rho0*cp
3940 IF (his(ng)%pioVar(idsrad)%dkind.eq.pio_double) THEN
3941 iodesc => iodesc_dp_r2dvar(ng)
3942 ELSE
3943 iodesc => iodesc_sp_r2dvar(ng)
3944 END IF
3945 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idsrad, &
3946 & his(ng)%pioVar(idsrad), &
3947 & his(ng)%Rindex, &
3948 & iodesc, &
3949 & lbi, ubi, lbj, ubj, scale, &
3950# ifdef MASKING
3951 & grid(ng) % rmask, &
3952# endif
3953 & forces(ng) % srflx)
3954 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3955 IF (master) THEN
3956 WRITE (stdout,20) trim(vname(1,idsrad)), his(ng)%Rindex
3957 END IF
3958 exit_flag=3
3959 ioerror=status
3960 RETURN
3961 END IF
3962 END IF
3963# endif
3964# endif
3965!
3966! Write out surface U-momentum stress.
3967!
3968 IF (hout(idusms,ng)) THEN
3969# ifdef SO_SEMI
3970 scale=1.0_dp
3971# else
3972 scale=rho0 ! m2/s2 to Pa
3973# endif
3974 IF (his(ng)%pioVar(idusms)%dkind.eq.pio_double) THEN
3975 iodesc => iodesc_dp_u2dvar(ng)
3976 ELSE
3977 iodesc => iodesc_sp_u2dvar(ng)
3978 END IF
3979 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idusms, &
3980 & his(ng)%pioVar(idusms), &
3981 & his(ng)%Rindex, &
3982 & iodesc, &
3983 & lbi, ubi, lbj, ubj, scale, &
3984# ifdef MASKING
3985 & grid(ng) % umask, &
3986# endif
3987 & forces(ng) % sustr)
3988 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3989 IF (master) THEN
3990 WRITE (stdout,20) trim(vname(1,idusms)), his(ng)%Rindex
3991 END IF
3992 exit_flag=3
3993 ioerror=status
3994 RETURN
3995 END IF
3996 END IF
3997!
3998! Write out surface V-momentum stress.
3999!
4000 IF (hout(idvsms,ng)) THEN
4001# ifdef SO_SEMI
4002 scale=1.0_dp
4003# else
4004 scale=rho0
4005# endif
4006 IF (his(ng)%pioVar(idvsms)%dkind.eq.pio_double) THEN
4007 iodesc => iodesc_dp_v2dvar(ng)
4008 ELSE
4009 iodesc => iodesc_sp_v2dvar(ng)
4010 END IF
4011 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idvsms, &
4012 & his(ng)%pioVar(idvsms), &
4013 & his(ng)%Rindex, &
4014 & iodesc, &
4015 & lbi, ubi, lbj, ubj, scale, &
4016# ifdef MASKING
4017 & grid(ng) % vmask, &
4018# endif
4019 & forces(ng) % svstr)
4020 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4021 IF (master) THEN
4022 WRITE (stdout,20) trim(vname(1,idvsms)), his(ng)%Rindex
4023 END IF
4024 exit_flag=3
4025 ioerror=status
4026 RETURN
4027 END IF
4028 END IF
4029!
4030! Write out bottom U-momentum stress.
4031!
4032 IF (hout(idubms,ng)) THEN
4033 scale=-rho0
4034 IF (his(ng)%pioVar(idubms)%dkind.eq.pio_double) THEN
4035 iodesc => iodesc_dp_u2dvar(ng)
4036 ELSE
4037 iodesc => iodesc_sp_u2dvar(ng)
4038 END IF
4039 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idubms, &
4040 & his(ng)%pioVar(idubms), &
4041 & his(ng)%Rindex, &
4042 & iodesc, &
4043 & lbi, ubi, lbj, ubj, scale, &
4044# ifdef MASKING
4045 & grid(ng) % umask, &
4046# endif
4047 & forces(ng) % bustr)
4048 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4049 IF (master) THEN
4050 WRITE (stdout,20) trim(vname(1,idubms)), his(ng)%Rindex
4051 END IF
4052 exit_flag=3
4053 ioerror=status
4054 RETURN
4055 END IF
4056 END IF
4057!
4058! Write out bottom V-momentum stress.
4059!
4060 IF (hout(idvbms,ng)) THEN
4061 scale=-rho0
4062 IF (his(ng)%pioVar(idvbms)%dkind.eq.pio_double) THEN
4063 iodesc => iodesc_dp_v2dvar(ng)
4064 ELSE
4065 iodesc => iodesc_sp_v2dvar(ng)
4066 END IF
4067 status=nf_fwrite2d(ng, model, his(ng)%pioFile, idvbms, &
4068 & his(ng)%pioVar(idvbms), &
4069 & his(ng)%Rindex, &
4070 & iodesc, &
4071 & lbi, ubi, lbj, ubj, scale, &
4072# ifdef MASKING
4073 & grid(ng) % vmask, &
4074# endif
4075 & forces(ng) % bvstr)
4076 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4077 IF (master) THEN
4078 WRITE (stdout,20) trim(vname(1,idvbms)), his(ng)%Rindex
4079 END IF
4080 exit_flag=3
4081 ioerror=status
4082 RETURN
4083 END IF
4084 END IF
4085
4086# if (defined BBL_MODEL || defined WAVES_OUTPUT) && defined SOLVE3D
4087!
4088!-----------------------------------------------------------------------
4089! Write out the bottom boundary layer model or waves variables.
4090!-----------------------------------------------------------------------
4091!
4092 CALL bbl_wrt_pio (ng, model, tile, &
4093 & lbi, ubi, lbj, ubj, &
4094 & hout, his)
4095 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4096# endif
4097
4098# if defined ICE_MODEL && defined SOLVE3D
4099!
4100!-----------------------------------------------------------------------
4101! Write out the sea-ice model variables.
4102!-----------------------------------------------------------------------
4103!
4104 CALL ice_wrt_pio (ng, model, tile, &
4105 & lbi, ubi, lbj, ubj, &
4106 & hout, his)
4107 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4108# endif
4109
4110# if defined SEDIMENT && defined SOLVE3D
4111!
4112!-----------------------------------------------------------------------
4113! Write out the sediment model variables.
4114!-----------------------------------------------------------------------
4115!
4116 CALL sediment_wrt_pio (ng, model, tile, &
4117 & lbi, ubi, lbj, ubj, &
4118 & hout, his)
4119 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4120# endif
4121
4122# if defined WEC_VF && defined SOLVE3D
4123!
4124!-----------------------------------------------------------------------
4125! Write out the Waves Effect on Currents variables.
4126!-----------------------------------------------------------------------
4127!
4128 CALL wec_wrt_pio (ng, model, tile, &
4129 & lbi, ubi, lbj, ubj, &
4130 & hout, his)
4131 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4132# endif
4133!
4134!-----------------------------------------------------------------------
4135! Synchronize history NetCDF file to disk to allow other processes
4136! to access data immediately after it is written.
4137!-----------------------------------------------------------------------
4138!
4139 CALL pio_netcdf_sync (ng, model, his(ng)%name, his(ng)%pioFile)
4140 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4141!
4142 10 FORMAT (2x,'WRT_HIS_PIO - writing history', t42, &
4143# ifdef SOLVE3D
4144# ifdef NESTING
4145 & 'fields (Index=',i1,',',i1,') in record = ',i0,t92,i2.2)
4146# else
4147 & 'fields (Index=',i1,',',i1,') in record = ',i0)
4148# endif
4149# else
4150# ifdef NESTING
4151 & 'fields (Index=',i1,') in record = ',i0,t92,i2.2)
4152# else
4153 & 'fields (Index=',i1,') in record = ',i0)
4154# endif
4155# endif
4156 20 FORMAT (/,' WRT_HIS_PIO - error while writing variable: ',a, &
4157 & /,15x,'into history NetCDF file for time record: ',i0)
4158!
4159 RETURN
4160 END SUBROUTINE wrt_his_pio
4161#endif
4162!
4163 END MODULE wrt_his_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_bry_mod::nf_fwrite2d_bry
Definition nf_fwrite2d_bry.F:79
nf_fwrite2d_mod::nf_fwrite2d
Definition nf_fwrite2d.F:77
nf_fwrite3d_bry_mod::nf_fwrite3d_bry
Definition nf_fwrite3d_bry.F:81
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_boundary
Definition mod_boundary.F:2
mod_boundary::boundary
type(t_boundary), dimension(:), allocatable boundary
Definition mod_boundary.F:746
mod_coupling
Definition mod_coupling.F:2
mod_coupling::coupling
type(t_coupling), dimension(:), allocatable coupling
Definition mod_coupling.F:102
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::his
type(t_io), dimension(:), allocatable his
Definition mod_iounits.F:222
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::idvmls
integer idvmls
Definition mod_ncparam.F:374
mod_ncparam::hout
logical, dimension(:,:), allocatable hout
Definition mod_ncparam.F:168
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::idrv3d
integer idrv3d
Definition mod_ncparam.F:282
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::idvsms
integer idvsms
Definition mod_ncparam.F:377
mod_ncparam::idpthw
integer idpthw
Definition mod_ncparam.F:271
mod_ncparam::isvvel
integer isvvel
Definition mod_ncparam.F:507
mod_ncparam::idsbry
integer, dimension(:), allocatable idsbry
Definition mod_ncparam.F:523
mod_ncparam::io_pio
integer, parameter io_pio
Definition mod_ncparam.F:96
mod_ncparam::isvbar
integer isvbar
Definition mod_ncparam.F:505
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::idvfx2
integer idvfx2
Definition mod_ncparam.F:373
mod_ncparam::idtsur
integer, dimension(:), allocatable idtsur
Definition mod_ncparam.F:453
mod_ncparam::idru2d
integer idru2d
Definition mod_ncparam.F:278
mod_ncparam::idvmkp
integer idvmkp
Definition mod_ncparam.F:376
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::istvar
integer, dimension(:), allocatable istvar
Definition mod_ncparam.F:520
mod_ncparam::idhbbl
integer idhbbl
Definition mod_ncparam.F:212
mod_ncparam::idvfx1
integer idvfx1
Definition mod_ncparam.F:372
mod_ncparam::isuvel
integer isuvel
Definition mod_ncparam.F:506
mod_ncparam::idufx2
integer idufx2
Definition mod_ncparam.F:338
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
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::idghat
integer, dimension(2) idghat
Definition mod_ncparam.F:209
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::isubar
integer isubar
Definition mod_ncparam.F:504
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::idru3d
integer idru3d
Definition mod_ncparam.F:279
mod_ncparam::idpthu
integer idpthu
Definition mod_ncparam.F:269
mod_ncparam::idusms
integer idusms
Definition mod_ncparam.F:339
mod_ncparam::idvmkk
integer idvmkk
Definition mod_ncparam.F:375
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::idrzet
integer idrzet
Definition mod_ncparam.F:286
mod_ncparam::idrvct
integer idrvct
Definition mod_ncparam.F:280
mod_ncparam::idufx1
integer idufx1
Definition mod_ncparam.F:337
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::idovil
integer idovil
Definition mod_ncparam.F:262
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::idruct
integer idruct
Definition mod_ncparam.F:277
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::idrv2d
integer idrv2d
Definition mod_ncparam.F:281
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_sp_v2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dobc
Definition mod_pio_netcdf.F:217
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::iodesc_dp_v2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dobc
Definition mod_pio_netcdf.F:256
mod_pio_netcdf::iodesc_dp_v3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dobc
Definition mod_pio_netcdf.F:260
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_u3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dobc
Definition mod_pio_netcdf.F:259
mod_pio_netcdf::iodesc_sp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dobc
Definition mod_pio_netcdf.F:219
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_dp_u2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dobc
Definition mod_pio_netcdf.F:255
mod_pio_netcdf::iodesc_sp_r2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dobc
Definition mod_pio_netcdf.F:215
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_sp_u3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dobc
Definition mod_pio_netcdf.F:220
mod_pio_netcdf::iodesc_dp_r2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dobc
Definition mod_pio_netcdf.F:254
mod_pio_netcdf::iodesc_sp_u2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dobc
Definition mod_pio_netcdf.F:216
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_dp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dobc
Definition mod_pio_netcdf.F:258
mod_pio_netcdf::iodesc_sp_v3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dobc
Definition mod_pio_netcdf.F:221
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::lobc
logical, dimension(:,:,:), allocatable lobc
Definition mod_scalars.F:1127
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::nbrec
integer, dimension(:), allocatable nbrec
Definition mod_scalars.F:1119
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
mod_stepping::lbout
integer, dimension(:), allocatable lbout
Definition mod_stepping.F:97
nf_fwrite2d_bry_mod
Definition nf_fwrite2d_bry.F:2
nf_fwrite2d_mod
Definition nf_fwrite2d.F:2
nf_fwrite3d_bry_mod
Definition nf_fwrite3d_bry.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_his_mod
Definition wrt_his.F:2
wrt_his_mod::wrt_his_nf90
subroutine, private wrt_his_nf90(ng, model, tile, lbij, ubij, lbi, ubi, lbj, ubj)
Definition wrt_his.F:161
wrt_his_mod::wrt_his
subroutine, public wrt_his(ng, tile)
Definition wrt_his.F:98
wrt_his_mod::wrt_his_pio
subroutine, private wrt_his_pio(ng, model, tile, lbij, ubij, lbi, ubi, lbj, ubj)
Definition wrt_his.F:1971