137
138
140
141
142
143 integer, intent(in) :: ng, model, tile
144 integer, intent(in) :: LBi, UBi, LBj, UBj
145
146
147
148 integer :: Fcount, gfactor, gtype, status
149#ifdef SOLVE3D
150 integer :: i, itrc, j, k
151#endif
152
153 real(dp) :: scale
154
155 real(r8), allocatable :: Ur2d(:,:)
156 real(r8), allocatable :: Vr2d(:,:)
157#ifdef SOLVE3D
158 real(r8), allocatable :: Wr3d(:,:,:)
159#endif
160
161 character (len=*), parameter :: MyFile = &
162 & __FILE__//", wrt_quick_nf90"
163
164# include "set_bounds.h"
165
166 sourcefile=myfile
167
168
169
170
171
172 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
173
174
175
176
177#if defined WRITE_WATER && defined MASKING
178 gfactor=-1
179#else
180 gfactor=1
181#endif
182
183
184
185 qck(ng)%Rindex=qck(ng)%Rindex+1
186 fcount=qck(ng)%load
187 qck(ng)%Nrec(fcount)=qck(ng)%Nrec(fcount)+1
188
189
190
191#ifdef SOLVE3D
192# ifdef NESTING
193 IF (master) WRITE (stdout,10) kout, nout, qck(ng)%Rindex, ng
194# else
195 IF (master) WRITE (stdout,10) kout, nout, qck(ng)%Rindex
196# endif
197#else
198# ifdef NESTING
199 IF (master) WRITE (stdout,10) kout, qck(ng)%Rindex, ng
200# else
201 IF (master) WRITE (stdout,10) kout, qck(ng)%Rindex
202# endif
203#endif
204
205
206
208 & trim(vname(1,idtime)), time(ng:), &
209 & (/qck(ng)%Rindex/), (/1/), &
210 & ncid = qck(ng)%ncid, &
211 & varid = qck(ng)%Vid(idtime))
212 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
213
214#ifdef WET_DRY
215
216
217
218 scale=1.0_dp
219 gtype=gfactor*p2dvar
220 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idpwet, &
221 & qck(ng)%Vid(idpwet), &
222 & qck(ng)%Rindex, gtype, &
223 & lbi, ubi, lbj, ubj, scale, &
224# ifdef MASKING
225 & grid(ng) % pmask, &
226# endif
227 & grid(ng) % pmask_wet, &
228 & setfillval = .false.)
229 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
230 IF (master) THEN
231 WRITE (stdout,20) trim(vname(1,idpwet)), qck(ng)%Rindex
232 END IF
233 exit_flag=3
234 ioerror=status
235 RETURN
236 END IF
237
238
239
240 scale=1.0_dp
241 gtype=gfactor*r2dvar
242 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idrwet, &
243 & qck(ng)%Vid(idrwet), &
244 & qck(ng)%Rindex, gtype, &
245 & lbi, ubi, lbj, ubj, scale, &
246# ifdef MASKING
247 & grid(ng) % rmask, &
248# endif
249 & grid(ng) % rmask_wet, &
250 & setfillval = .false.)
251 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
252 IF (master) THEN
253 WRITE (stdout,20) trim(vname(1,idrwet)), qck(ng)%Rindex
254 END IF
255 exit_flag=3
256 ioerror=status
257 RETURN
258 END IF
259
260
261
262 scale=1.0_dp
263 gtype=gfactor*u2dvar
264 status=nf_fwrite2d(ng, model, qck(ng)%ncid, iduwet, &
265 & qck(ng)%Vid(iduwet), &
266 & qck(ng)%Rindex, gtype, &
267 & lbi, ubi, lbj, ubj, scale, &
268# ifdef MASKING
269 & grid(ng) % umask, &
270# endif
271 & grid(ng) % umask_wet, &
272 & setfillval = .false.)
273 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
274 IF (master) THEN
275 WRITE (stdout,20) trim(vname(1,iduwet)), qck(ng)%Rindex
276 END IF
277 exit_flag=3
278 ioerror=status
279 RETURN
280 END IF
281
282
283
284 scale=1.0_dp
285 gtype=gfactor*v2dvar
286 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvwet, &
287 & qck(ng)%Vid(idvwet), &
288 & qck(ng)%Rindex, gtype, &
289 & lbi, ubi, lbj, ubj, scale, &
290# ifdef MASKING
291 & grid(ng) % vmask, &
292# endif
293 & grid(ng) % vmask_wet, &
294 & setfillval = .false.)
295 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
296 IF (master) THEN
297 WRITE (stdout,20) trim(vname(1,idvwet)), qck(ng)%Rindex
298 END IF
299 exit_flag=3
300 ioerror=status
301 RETURN
302 END IF
303#endif
304#ifdef SOLVE3D
305
306
307
308 IF (qout(idpthr,ng)) THEN
309 scale=1.0_dp
310 gtype=gfactor*r3dvar
311 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idpthr, &
312 & qck(ng)%Vid(idpthr), &
313 & qck(ng)%Rindex, gtype, &
314 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
315# ifdef MASKING
316 & grid(ng) % rmask, &
317# endif
318 & grid(ng) % z_r, &
319 & setfillval = .false.)
320 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
321 IF (master) THEN
322 WRITE (stdout,20) trim(vname(1,idpthr)), qck(ng)%Rindex
323 END IF
324 exit_flag=3
325 ioerror=status
326 RETURN
327 END IF
328 END IF
329
330
331
332 IF (qout(idpthu,ng)) THEN
333 scale=1.0_dp
334 gtype=gfactor*u3dvar
335 DO k=1,n(ng)
336 DO j=jstr-1,jend+1
337 DO i=istru-1,iend+1
338 grid(ng)%z_v(i,j,k)=0.5_r8*(grid(ng)%z_r(i-1,j,k)+ &
339 & grid(ng)%z_r(i ,j,k))
340 END DO
341 END DO
342 END DO
343 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idpthu, &
344 & qck(ng)%Vid(idpthu), &
345 & qck(ng)%Rindex, gtype, &
346 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
347# ifdef MASKING
348 & grid(ng) % umask, &
349# endif
350 & grid(ng) % z_v, &
351 & setfillval = .false.)
352 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
353 IF (master) THEN
354 WRITE (stdout,20) trim(vname(1,idpthu)), qck(ng)%Rindex
355 END IF
356 exit_flag=3
357 ioerror=status
358 RETURN
359 END IF
360 END IF
361
362
363
364 IF (qout(idpthv,ng)) THEN
365 scale=1.0_dp
366 gtype=gfactor*v3dvar
367 DO k=1,n(ng)
368 DO j=jstrv-1,jend+1
369 DO i=istr-1,iend+1
370 grid(ng)%z_v(i,j,k)=0.5_r8*(grid(ng)%z_r(i,j-1,k)+ &
371 & grid(ng)%z_r(i,j ,k))
372 END DO
373 END DO
374 END DO
375 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idpthv, &
376 & qck(ng)%Vid(idpthv), &
377 & qck(ng)%Rindex, gtype, &
378 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
379# ifdef MASKING
380 & grid(ng) % vmask, &
381# endif
382 & grid(ng) % z_v, &
383 & setfillval = .false.)
384 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
385 IF (master) THEN
386 WRITE (stdout,20) trim(vname(1,idpthv)), qck(ng)%Rindex
387 END IF
388 exit_flag=3
389 ioerror=status
390 RETURN
391 END IF
392 END IF
393
394
395
396 IF (qout(idpthw,ng)) THEN
397 scale=1.0_dp
398 gtype=gfactor*w3dvar
399 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idpthw, &
400 & qck(ng)%Vid(idpthw), &
401 & qck(ng)%Rindex, gtype, &
402 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
403# ifdef MASKING
404 & grid(ng) % rmask, &
405# endif
406 & grid(ng) % z_w, &
407 & setfillval = .false.)
408 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
409 IF (master) THEN
410 WRITE (stdout,20) trim(vname(1,idpthw)), qck(ng)%Rindex
411 END IF
412 exit_flag=3
413 ioerror=status
414 RETURN
415 END IF
416 END IF
417#endif
418
419
420
421 IF (qout(idfsur,ng)) THEN
422 scale=1.0_dp
423 gtype=gfactor*r2dvar
424 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idfsur, &
425 & qck(ng)%Vid(idfsur), &
426 & qck(ng)%Rindex, gtype, &
427 & lbi, ubi, lbj, ubj, scale, &
428#ifdef MASKING
429 & grid(ng) % rmask, &
430#endif
431#ifdef WET_DRY
432 & ocean(ng) % zeta(:,:,kout), &
433 & setfillval = .false.)
434#else
435 & ocean(ng) % zeta(:,:,kout))
436#endif
437 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
438 IF (master) THEN
439 WRITE (stdout,20) trim(vname(1,idfsur)), qck(ng)%Rindex
440 END IF
441 exit_flag=3
442 ioerror=status
443 RETURN
444 END IF
445 END IF
446
447
448
449 IF (qout(idubar,ng)) THEN
450 scale=1.0_dp
451 gtype=gfactor*u2dvar
452 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idubar, &
453 & qck(ng)%Vid(idubar), &
454 & qck(ng)%Rindex, gtype, &
455 & lbi, ubi, lbj, ubj, scale, &
456#ifdef MASKING
457 & grid(ng) % umask_full, &
458#endif
459 & ocean(ng) % ubar(:,:,kout))
460 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
461 IF (master) THEN
462 WRITE (stdout,20) trim(vname(1,idubar)), qck(ng)%Rindex
463 END IF
464 exit_flag=3
465 ioerror=status
466 RETURN
467 END IF
468 END IF
469
470
471
472 IF (qout(idvbar,ng)) THEN
473 scale=1.0_dp
474 gtype=gfactor*v2dvar
475 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvbar, &
476 & qck(ng)%Vid(idvbar), &
477 & qck(ng)%Rindex, gtype, &
478 & lbi, ubi, lbj, ubj, scale, &
479#ifdef MASKING
480 & grid(ng) % vmask_full, &
481#endif
482 & ocean(ng) % vbar(:,:,kout))
483 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
484 IF (master) THEN
485 WRITE (stdout,20) trim(vname(1,idvbar)), qck(ng)%Rindex
486 END IF
487 exit_flag=3
488 ioerror=status
489 RETURN
490 END IF
491 END IF
492
493
494
495
496 IF (qout(idu2de,ng).and.qout(idv2dn,ng)) THEN
497 IF (.not.allocated(ur2d)) THEN
498 allocate (ur2d(lbi:ubi,lbj:ubj))
499 ur2d(lbi:ubi,lbj:ubj)=0.0_r8
500 END IF
501 IF (.not.allocated(vr2d)) THEN
502 allocate (vr2d(lbi:ubi,lbj:ubj))
503 vr2d(lbi:ubi,lbj:ubj)=0.0_r8
504 END IF
505 CALL uv_rotate2d (ng, tile, .false., .true., &
506 & lbi, ubi, lbj, ubj, &
507 & grid(ng) % CosAngler, &
508 & grid(ng) % SinAngler, &
509#ifdef MASKING
510 & grid(ng) % rmask_full, &
511#endif
512 & ocean(ng) % ubar(:,:,kout), &
513 & ocean(ng) % vbar(:,:,kout), &
514 & ur2d, vr2d)
515
516 scale=1.0_dp
517 gtype=gfactor*r2dvar
518 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idu2de, &
519 & qck(ng)%Vid(idu2de), &
520 & qck(ng)%Rindex, gtype, &
521 & lbi, ubi, lbj, ubj, scale, &
522#ifdef MASKING
523 & grid(ng) % rmask_full, &
524#endif
525 & ur2d)
526 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
527 IF (master) THEN
528 WRITE (stdout,20) trim(vname(1,idu2de)), qck(ng)%Rindex
529 END IF
530 exit_flag=3
531 ioerror=status
532 RETURN
533 END IF
534
535 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idv2dn, &
536 & qck(ng)%Vid(idv2dn), &
537 & qck(ng)%Rindex, gtype, &
538 & lbi, ubi, lbj, ubj, scale, &
539#ifdef MASKING
540 & grid(ng) % rmask_full, &
541#endif
542 & vr2d)
543 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
544 IF (master) THEN
545 WRITE (stdout,20) trim(vname(1,idv2dn)), qck(ng)%Rindex
546 END IF
547 exit_flag=3
548 ioerror=status
549 RETURN
550 END IF
551 deallocate (ur2d)
552 deallocate (vr2d)
553 END IF
554
555#ifdef SOLVE3D
556
557
558
559 IF (qout(iduvel,ng)) THEN
560 scale=1.0_dp
561 gtype=gfactor*u3dvar
562 status=nf_fwrite3d(ng, model, qck(ng)%ncid, iduvel, &
563 & qck(ng)%Vid(iduvel), &
564 & qck(ng)%Rindex, gtype, &
565 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
566# ifdef MASKING
567 & grid(ng) % umask_full, &
568# endif
569 & ocean(ng) % u(:,:,:,nout))
570 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
571 IF (master) THEN
572 WRITE (stdout,20) trim(vname(1,iduvel)), qck(ng)%Rindex
573 END IF
574 exit_flag=3
575 ioerror=status
576 RETURN
577 END IF
578 END IF
579
580
581
582 IF (qout(idvvel,ng)) THEN
583 scale=1.0_dp
584 gtype=gfactor*v3dvar
585 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idvvel, &
586 & qck(ng)%Vid(idvvel), &
587 & qck(ng)%Rindex, gtype, &
588 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
589# ifdef MASKING
590 & grid(ng) % vmask_full, &
591# endif
592 & ocean(ng) % v(:,:,:,nout))
593 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
594 IF (master) THEN
595 WRITE (stdout,20) trim(vname(1,idvvel)), qck(ng)%Rindex
596 END IF
597 exit_flag=3
598 ioerror=status
599 RETURN
600 END IF
601 END IF
602
603
604
605 IF (qout(idusur,ng)) THEN
606 scale=1.0_dp
607 gtype=gfactor*u2dvar
608 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idusur, &
609 & qck(ng)%Vid(idusur), &
610 & qck(ng)%Rindex, gtype, &
611 & lbi, ubi, lbj, ubj, scale, &
612# ifdef MASKING
613 & grid(ng) % umask_full, &
614# endif
615 & ocean(ng) % u(:,:,n(ng),nout))
616 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
617 IF (master) THEN
618 WRITE (stdout,20) trim(vname(1,idusur)), qck(ng)%Rindex
619 END IF
620 exit_flag=3
621 ioerror=status
622 RETURN
623 END IF
624 END IF
625
626
627
628 IF (qout(idvsur,ng)) THEN
629 scale=1.0_dp
630 gtype=gfactor*v2dvar
631 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvsur, &
632 & qck(ng)%Vid(idvsur), &
633 & qck(ng)%Rindex, gtype, &
634 & lbi, ubi, lbj, ubj, scale, &
635# ifdef MASKING
636 & grid(ng) % vmask_full, &
637# endif
638 & ocean(ng) % v(:,:,n(ng),nout))
639 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
640 IF (master) THEN
641 WRITE (stdout,20) trim(vname(1,idvsur)), qck(ng)%Rindex
642 END IF
643 exit_flag=3
644 ioerror=status
645 RETURN
646 END IF
647 END IF
648
649
650
651 IF (qout(idu3de,ng)) THEN
652 scale=1.0_dp
653 gtype=gfactor*r3dvar
654 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idu3de, &
655 & qck(ng)%Vid(idu3de), &
656 & qck(ng)%Rindex, gtype, &
657 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
658# ifdef MASKING
659 & grid(ng) % rmask_full, &
660# endif
661 & ocean(ng) % ua)
662 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
663 IF (master) THEN
664 WRITE (stdout,20) trim(vname(1,idu3de)), qck(ng)%Rindex
665 END IF
666 exit_flag=3
667 ioerror=status
668 RETURN
669 END IF
670 END IF
671
672
673
674 IF (qout(idv3dn,ng)) THEN
675 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idv3dn, &
676 & qck(ng)%Vid(idv3dn), &
677 & qck(ng)%Rindex, gtype, &
678 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
679# ifdef MASKING
680 & grid(ng) % rmask_full, &
681# endif
682 & ocean(ng) % va)
683 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
684 IF (master) THEN
685 WRITE (stdout,20) trim(vname(1,idv3dn)), qck(ng)%Rindex
686 END IF
687 exit_flag=3
688 ioerror=status
689 RETURN
690 END IF
691 END IF
692
693
694
695 IF (qout(idusue,ng)) THEN
696 scale=1.0_dp
697 gtype=gfactor*r2dvar
698 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idusue, &
699 & qck(ng)%Vid(idusue), &
700 & qck(ng)%Rindex, gtype, &
701 & lbi, ubi, lbj, ubj, scale, &
702# ifdef MASKING
703 & grid(ng) % rmask_full, &
704# endif
705 & ocean(ng) % ua(:,:,n(ng)))
706 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
707 IF (master) THEN
708 WRITE (stdout,20) trim(vname(1,idusue)), qck(ng)%Rindex
709 END IF
710 exit_flag=3
711 ioerror=status
712 RETURN
713 END IF
714 END IF
715
716
717
718 IF (qout(idvsun,ng)) THEN
719 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvsun, &
720 & qck(ng)%Vid(idvsun), &
721 & qck(ng)%Rindex, gtype, &
722 & lbi, ubi, lbj, ubj, scale, &
723# ifdef MASKING
724 & grid(ng) % rmask_full, &
725# endif
726 & ocean(ng) % va(:,:,n(ng)))
727 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
728 IF (master) THEN
729 WRITE (stdout,20) trim(vname(1,idvsun)), qck(ng)%Rindex
730 END IF
731 exit_flag=3
732 ioerror=status
733 RETURN
734 END IF
735 END IF
736
737
738
739 IF (qout(idovel,ng)) THEN
740 IF (.not.allocated(wr3d)) THEN
741 allocate (wr3d(lbi:ubi,lbj:ubj,0:n(ng)))
742 wr3d(lbi:ubi,lbj:ubj,0:n(ng))=0.0_r8
743 END IF
744 scale=1.0_dp
745 gtype=gfactor*w3dvar
746 CALL scale_omega (ng, tile, lbi, ubi, lbj, ubj, 0, n(ng), &
747 & grid(ng) % pm, &
748 & grid(ng) % pn, &
749 & ocean(ng) % W, &
750 & wr3d)
751 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idovel, &
752 & qck(ng)%Vid(idovel), &
753 & qck(ng)%Rindex, gtype, &
754 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
755# ifdef MASKING
756 & grid(ng) % rmask, &
757# endif
758 & wr3d)
759 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
760 IF (master) THEN
761 WRITE (stdout,20) trim(vname(1,idovel)), qck(ng)%Rindex
762 END IF
763 exit_flag=3
764 ioerror=status
765 RETURN
766 END IF
767 deallocate (wr3d)
768 END IF
769
770
771
772 IF (qout(idwvel,ng)) THEN
773 scale=1.0_dp
774 gtype=gfactor*w3dvar
775 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idwvel, &
776 & qck(ng)%Vid(idwvel), &
777 & qck(ng)%Rindex, gtype, &
778 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
779# ifdef MASKING
780 & grid(ng) % rmask, &
781# endif
782 & ocean(ng) % wvel)
783 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
784 IF (master) THEN
785 WRITE (stdout,20) trim(vname(1,idwvel)), qck(ng)%Rindex
786 END IF
787 exit_flag=3
788 ioerror=status
789 RETURN
790 END IF
791 END IF
792
793
794
795 DO itrc=1,nt(ng)
796 IF (qout(idtvar(itrc),ng)) THEN
797 scale=1.0_dp
798 gtype=gfactor*r3dvar
799 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idtvar(itrc), &
800 & qck(ng)%Tid(itrc), &
801 & qck(ng)%Rindex, gtype, &
802 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
803# ifdef MASKING
804 & grid(ng) % rmask, &
805# endif
806 & ocean(ng) % t(:,:,:,nout,itrc))
807 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
808 IF (master) THEN
809 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), &
810 & qck(ng)%Rindex
811 END IF
812 exit_flag=3
813 ioerror=status
814 RETURN
815 END IF
816 END IF
817 END DO
818
819
820
821 DO itrc=1,nt(ng)
822 IF (qout(idsurt(itrc),ng)) THEN
823 scale=1.0_dp
824 gtype=gfactor*r2dvar
825 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idsurt(itrc), &
826 & qck(ng)%Vid(idsurt(itrc)), &
827 & qck(ng)%Rindex, gtype, &
828 & lbi, ubi, lbj, ubj, scale, &
829# ifdef MASKING
830 & grid(ng) % rmask, &
831# endif
832 & ocean(ng) % t(:,:,n(ng),nout,itrc))
833 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
834 IF (master) THEN
835 WRITE (stdout,20) trim(vname(1,idsurt(itrc))), &
836 & qck(ng)%Rindex
837 END IF
838 exit_flag=3
839 ioerror=status
840 RETURN
841 END IF
842 END IF
843 END DO
844
845
846
847 IF (qout(iddano,ng)) THEN
848 scale=1.0_dp
849 gtype=gfactor*r3dvar
850 status=nf_fwrite3d(ng, model, qck(ng)%ncid, iddano, &
851 & qck(ng)%Vid(iddano), &
852 & qck(ng)%Rindex, gtype, &
853 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
854# ifdef MASKING
855 & grid(ng) % rmask, &
856# endif
857 & ocean(ng) % rho)
858 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
859 IF (master) THEN
860 WRITE (stdout,20) trim(vname(1,iddano)), qck(ng)%Rindex
861 END IF
862 exit_flag=3
863 ioerror=status
864 RETURN
865 END IF
866 END IF
867# ifdef LMD_SKPP
868
869
870
871 IF (qout(idhsbl,ng)) THEN
872 scale=1.0_dp
873 gtype=gfactor*r2dvar
874 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idhsbl, &
875 & qck(ng)%Vid(idhsbl), &
876 & qck(ng)%Rindex, gtype, &
877 & lbi, ubi, lbj, ubj, scale, &
878# ifdef MASKING
879 & grid(ng) % rmask, &
880# endif
881 & mixing(ng) % hsbl)
882 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
883 IF (master) THEN
884 WRITE (stdout,20) trim(vname(1,idhsbl)), qck(ng)%Rindex
885 END IF
886 exit_flag=3
887 ioerror=status
888 RETURN
889 END IF
890 END IF
891# endif
892# ifdef LMD_BKPP
893
894
895
896 IF (qout(idhbbl,ng)) THEN
897 scale=1.0_dp
898 gtype=gfactor*r2dvar
899 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idhbbl, &
900 & qck(ng)%Vid(idhbbl), &
901 & qck(ng)%Rindex, gtype, &
902 & lbi, ubi, lbj, ubj, scale, &
903# ifdef MASKING
904 & grid(ng) % rmask, &
905# endif
906 & mixing(ng) % hbbl)
907 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
908 IF (master) THEN
909 WRITE (stdout,20) trim(vname(1,idhbbl)), qck(ng)%Rindex
910 END IF
911 exit_flag=3
912 ioerror=status
913 RETURN
914 END IF
915 END IF
916# endif
917
918
919
920 IF (qout(idvvis,ng)) THEN
921 scale=1.0_dp
922 gtype=gfactor*w3dvar
923 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idvvis, &
924 & qck(ng)%Vid(idvvis), &
925 & qck(ng)%Rindex, gtype, &
926 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
927# ifdef MASKING
928 & grid(ng) % rmask, &
929# endif
930 & mixing(ng) % Akv, &
931 & setfillval = .false.)
932 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
933 IF (master) THEN
934 WRITE (stdout,20) trim(vname(1,idvvis)), qck(ng)%Rindex
935 END IF
936 exit_flag=3
937 ioerror=status
938 RETURN
939 END IF
940 END IF
941
942
943
944 IF (qout(idtdif,ng)) THEN
945 scale=1.0_dp
946 gtype=gfactor*w3dvar
947 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idtdif, &
948 & qck(ng)%Vid(idtdif), &
949 & qck(ng)%Rindex, gtype, &
950 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
951# ifdef MASKING
952 & grid(ng) % rmask, &
953# endif
954 & mixing(ng) % Akt(:,:,:,itemp), &
955 & setfillval = .false.)
956 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
957 IF (master) THEN
958 WRITE (stdout,20) trim(vname(1,idtdif)), qck(ng)%Rindex
959 END IF
960 exit_flag=3
961 ioerror=status
962 RETURN
963 END IF
964 END IF
965# ifdef SALINITY
966
967
968
969 IF (qout(idsdif,ng)) THEN
970 scale=1.0_dp
971 gtype=gfactor*w3dvar
972 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idsdif, &
973 & qck(ng)%Vid(idsdif), &
974 & qck(ng)%Rindex, gtype, &
975 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
976# ifdef MASKING
977 & grid(ng) % rmask, &
978# endif
979 & mixing(ng) % Akt(:,:,:,isalt), &
980 & setfillval = .false.)
981 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
982 IF (master) THEN
983 WRITE (stdout,20) trim(vname(1,idsdif)), qck(ng)%Rindex
984 END IF
985 exit_flag=3
986 ioerror=status
987 RETURN
988 END IF
989 END IF
990# endif
991# if defined GLS_MIXING || defined MY25_MIXING
992
993
994
995 IF (qout(idmtke,ng)) THEN
996 scale=1.0_dp
997 gtype=gfactor*w3dvar
998 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idmtke, &
999 & qck(ng)%Vid(idmtke), &
1000 & qck(ng)%Rindex, gtype, &
1001 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1002# ifdef MASKING
1003 & grid(ng) % rmask, &
1004# endif
1005 & mixing(ng) % tke(:,:,:,nout), &
1006 & setfillval = .false.)
1007 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1008 IF (master) THEN
1009 WRITE (stdout,20) trim(vname(1,idmtke)), qck(ng)%Rindex
1010 END IF
1011 exit_flag=3
1012 ioerror=status
1013 RETURN
1014 END IF
1015 END IF
1016
1017
1018
1019 IF (qout(idmtls,ng)) THEN
1020 scale=1.0_dp
1021 gtype=gfactor*w3dvar
1022 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idmtls, &
1023 & qck(ng)%Vid(idmtls), &
1024 & qck(ng)%Rindex, gtype, &
1025 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1026# ifdef MASKING
1027 & grid(ng) % rmask, &
1028# endif
1029 & mixing(ng) % gls(:,:,:,nout), &
1030 & setfillval = .false.)
1031
1032 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1033 IF (master) THEN
1034 WRITE (stdout,20) trim(vname(1,idmtls)), qck(ng)%Rindex
1035 END IF
1036 exit_flag=3
1037 ioerror=status
1038 RETURN
1039 END IF
1040 END IF
1041# endif
1042# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
1043
1044
1045
1046 IF (qout(idpair,ng)) THEN
1047 scale=1.0_dp
1048 gtype=gfactor*r2dvar
1049 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idpair, &
1050 & qck(ng)%Vid(idpair), &
1051 & qck(ng)%Rindex, gtype, &
1052 & lbi, ubi, lbj, ubj, scale, &
1053# ifdef MASKING
1054 & grid(ng) % rmask, &
1055# endif
1056 & forces(ng) % Pair)
1057 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1058 IF (master) THEN
1059 WRITE (stdout,20) trim(vname(1,idpair)), qck(ng)%Rindex
1060 END IF
1061 exit_flag=3
1062 ioerror=status
1063 RETURN
1064 END IF
1065 END IF
1066# endif
1067# if defined BULK_FLUXES
1068
1069
1070
1071 IF (qout(idtair,ng)) THEN
1072 scale=1.0_dp
1073 gtype=gfactor*r2dvar
1074 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idtair, &
1075 & qck(ng)%Vid(idtair), &
1076 & qck(ng)%Rindex, gtype, &
1077 & lbi, ubi, lbj, ubj, scale, &
1078# ifdef MASKING
1079 & grid(ng) % rmask, &
1080# endif
1081 & forces(ng) % Tair)
1082 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1083 IF (master) THEN
1084 WRITE (stdout,20) trim(vname(1,idtair)), qck(ng)%Rindex
1085 END IF
1086 exit_flag=3
1087 ioerror=status
1088 RETURN
1089 END IF
1090 END IF
1091# endif
1092# if defined BULK_FLUXES || defined ECOSIM
1093
1094
1095
1096 IF (qout(iduair,ng)) THEN
1097 scale=1.0_dp
1098 gtype=gfactor*r2dvar
1099 status=nf_fwrite2d(ng, model, qck(ng)%ncid, iduair, &
1100 & qck(ng)%Vid(iduair), &
1101 & qck(ng)%Rindex, gtype, &
1102 & lbi, ubi, lbj, ubj, scale, &
1103# ifdef MASKING
1104 & grid(ng) % rmask, &
1105# endif
1106 & forces(ng) % Uwind)
1107 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1108 IF (master) THEN
1109 WRITE (stdout,20) trim(vname(1,iduair)), qck(ng)%Rindex
1110 END IF
1111 exit_flag=3
1112 ioerror=status
1113 RETURN
1114 END IF
1115 END IF
1116
1117 IF (qout(idvair,ng)) THEN
1118 scale=1.0_dp
1119 gtype=gfactor*r2dvar
1120 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvair, &
1121 & qck(ng)%Vid(idvair), &
1122 & qck(ng)%Rindex, gtype, &
1123 & lbi, ubi, lbj, ubj, scale, &
1124# ifdef MASKING
1125 & grid(ng) % rmask, &
1126# endif
1127 & forces(ng) % Vwind)
1128 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1129 IF (master) THEN
1130 WRITE (stdout,20) trim(vname(1,idvair)), qck(ng)%Rindex
1131 END IF
1132 exit_flag=3
1133 ioerror=status
1134 RETURN
1135 END IF
1136 END IF
1137
1138
1139
1140 IF (qout(iduaie,ng).and.qout(idvain,ng)) THEN
1141 IF (.not.allocated(ur2d)) THEN
1142 allocate (ur2d(lbi:ubi,lbj:ubj))
1143 ur2d(lbi:ubi,lbj:ubj)=0.0_r8
1144 END IF
1145 IF (.not.allocated(vr2d)) THEN
1146 allocate (vr2d(lbi:ubi,lbj:ubj))
1147 vr2d(lbi:ubi,lbj:ubj)=0.0_r8
1148 END IF
1149 CALL uv_rotate2d (ng, tile, .false., .true., &
1150 & lbi, ubi, lbj, ubj, &
1151 & grid(ng) % CosAngler, &
1152 & grid(ng) % SinAngler, &
1153# ifdef MASKING
1154 & grid(ng) % rmask_full, &
1155# endif
1156 & forces(ng) % Uwind, &
1157 & forces(ng) % Vwind, &
1158 & ur2d, vr2d)
1159
1160 scale=1.0_dp
1161 gtype=gfactor*r2dvar
1162 status=nf_fwrite2d(ng, model, qck(ng)%ncid, iduaie, &
1163 & qck(ng)%Vid(iduaie), &
1164 & qck(ng)%Rindex, gtype, &
1165 & lbi, ubi, lbj, ubj, scale, &
1166# ifdef MASKING
1167 & grid(ng) % rmask, &
1168# endif
1169 & ur2d)
1170 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1171 IF (master) THEN
1172 WRITE (stdout,20) trim(vname(1,iduaie)), qck(ng)%Rindex
1173 END IF
1174 exit_flag=3
1175 ioerror=status
1176 RETURN
1177 END IF
1178
1179 scale=1.0_dp
1180 gtype=gfactor*r2dvar
1181 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvain, &
1182 & qck(ng)%Vid(idvain), &
1183 & qck(ng)%Rindex, gtype, &
1184 & lbi, ubi, lbj, ubj, scale, &
1185# ifdef MASKING
1186 & grid(ng) % rmask, &
1187# endif
1188 & vr2d)
1189 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1190 IF (master) THEN
1191 WRITE (stdout,20) trim(vname(1,idvain)), qck(ng)%Rindex
1192 END IF
1193 exit_flag=3
1194 ioerror=status
1195 RETURN
1196 END IF
1197 deallocate (ur2d)
1198 deallocate (vr2d)
1199 END IF
1200# endif
1201
1202
1203
1204 DO itrc=1,nat
1205 IF (qout(idtsur(itrc),ng)) THEN
1206 IF (itrc.eq.itemp) THEN
1207# ifdef SO_SEMI
1208 scale=1.0_dp
1209# else
1210 scale=rho0*cp
1211# endif
1212 ELSE IF (itrc.eq.isalt) THEN
1213 scale=1.0_dp
1214 END IF
1215 gtype=gfactor*r2dvar
1216 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idtsur(itrc), &
1217 & qck(ng)%Vid(idtsur(itrc)), &
1218 & qck(ng)%Rindex, gtype, &
1219 & lbi, ubi, lbj, ubj, scale, &
1220# ifdef MASKING
1221 & grid(ng) % rmask, &
1222# endif
1223 & forces(ng) % stflx(:,:,itrc))
1224 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1225 IF (master) THEN
1226 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
1227 & qck(ng)%Rindex
1228 END IF
1229 exit_flag=3
1230 ioerror=status
1231 RETURN
1232 END IF
1233 END IF
1234 END DO
1235
1236# if defined BULK_FLUXES || defined FRC_COUPLING
1237
1238
1239
1240 IF (qout(idlhea,ng)) THEN
1241 scale=rho0*cp
1242 gtype=gfactor*r2dvar
1243 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idlhea, &
1244 & qck(ng)%Vid(idlhea), &
1245 & qck(ng)%Rindex, gtype, &
1246 & lbi, ubi, lbj, ubj, scale, &
1247# ifdef MASKING
1248 & grid(ng) % rmask, &
1249# endif
1250 & forces(ng) % lhflx)
1251 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1252 IF (master) THEN
1253 WRITE (stdout,20) trim(vname(1,idlhea)), qck(ng)%Rindex
1254 END IF
1255 exit_flag=3
1256 ioerror=status
1257 RETURN
1258 END IF
1259 END IF
1260
1261
1262
1263 IF (qout(idshea,ng)) THEN
1264 scale=rho0*cp
1265 gtype=gfactor*r2dvar
1266 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idshea, &
1267 & qck(ng)%Vid(idshea), &
1268 & qck(ng)%Rindex, gtype, &
1269 & lbi, ubi, lbj, ubj, scale, &
1270# ifdef MASKING
1271 & grid(ng) % rmask, &
1272# endif
1273 & forces(ng) % shflx)
1274 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1275 IF (master) THEN
1276 WRITE (stdout,20) trim(vname(1,idshea)), qck(ng)%Rindex
1277 END IF
1278 exit_flag=3
1279 ioerror=status
1280 RETURN
1281 END IF
1282 END IF
1283
1284
1285
1286 IF (qout(idlrad,ng)) THEN
1287 scale=rho0*cp
1288 gtype=gfactor*r2dvar
1289 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idlrad, &
1290 & qck(ng)%Vid(idlrad), &
1291 & qck(ng)%Rindex, gtype, &
1292 & lbi, ubi, lbj, ubj, scale, &
1293# ifdef MASKING
1294 & grid(ng) % rmask, &
1295# endif
1296 & forces(ng) % lrflx)
1297 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1298 IF (master) THEN
1299 WRITE (stdout,20) trim(vname(1,idlrad)), qck(ng)%Rindex
1300 END IF
1301 exit_flag=3
1302 ioerror=status
1303 RETURN
1304 END IF
1305 END IF
1306# endif
1307
1308# ifdef BULK_FLUXES
1309# ifdef EMINUSP
1310
1311
1312
1313 IF (qout(idevap,ng)) THEN
1314 scale=1.0_dp
1315 gtype=gfactor*r2dvar
1316 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idevap, &
1317 & qck(ng)%Vid(idevap), &
1318 & qck(ng)%Rindex, gtype, &
1319 & lbi, ubi, lbj, ubj, scale, &
1320# ifdef MASKING
1321 & grid(ng) % rmask, &
1322# endif
1323 & forces(ng) % evap)
1324 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1325 IF (master) THEN
1326 WRITE (stdout,20) trim(vname(1,idevap)), qck(ng)%Rindex
1327 END IF
1328 exit_flag=3
1329 ioerror=status
1330 RETURN
1331 END IF
1332 END IF
1333
1334
1335
1336 IF (qout(idrain,ng)) THEN
1337 scale=1.0_dp
1338 gtype=gfactor*r2dvar
1339 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idrain, &
1340 & qck(ng)%Vid(idrain), &
1341 & qck(ng)%Rindex, gtype, &
1342 & lbi, ubi, lbj, ubj, scale, &
1343# ifdef MASKING
1344 & grid(ng) % rmask, &
1345# endif
1346 & forces(ng) % rain)
1347 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1348 IF (master) THEN
1349 WRITE (stdout,20) trim(vname(1,idrain)), qck(ng)%Rindex
1350 END IF
1351 exit_flag=3
1352 ioerror=status
1353 RETURN
1354 END IF
1355 END IF
1356# endif
1357# endif
1358
1359
1360
1361 IF (qout(idempf,ng)) THEN
1362 scale=1.0_dp
1363 gtype=gfactor*r2dvar
1364 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idempf, &
1365 & qck(ng)%Vid(idempf), &
1366 & qck(ng)%Rindex, gtype, &
1367 & lbi, ubi, lbj, ubj, scale, &
1368# ifdef MASKING
1369 & grid(ng) % rmask, &
1370# endif
1371 & forces(ng) % stflux(:,:,isalt))
1372 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1373 IF (master) THEN
1374 WRITE (stdout,20) trim(vname(1,idempf)), qck(ng)%Rindex
1375 END IF
1376 exit_flag=3
1377 ioerror=status
1378 RETURN
1379 END IF
1380 END IF
1381# ifdef SHORTWAVE
1382
1383
1384
1385 IF (qout(idsrad,ng)) THEN
1386 scale=rho0*cp
1387 gtype=gfactor*r2dvar
1388 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idsrad, &
1389 & qck(ng)%Vid(idsrad), &
1390 & qck(ng)%Rindex, gtype, &
1391 & lbi, ubi, lbj, ubj, scale, &
1392# ifdef MASKING
1393 & grid(ng) % rmask, &
1394# endif
1395 & forces(ng) % srflx)
1396 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1397 IF (master) THEN
1398 WRITE (stdout,20) trim(vname(1,idsrad)), qck(ng)%Rindex
1399 END IF
1400 exit_flag=3
1401 ioerror=status
1402 RETURN
1403 END IF
1404 END IF
1405# endif
1406#endif
1407
1408
1409
1410 IF (qout(idusms,ng)) THEN
1411 scale=rho0
1412 gtype=gfactor*u2dvar
1413 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idusms, &
1414 & qck(ng)%Vid(idusms), &
1415 & qck(ng)%Rindex, gtype, &
1416 & lbi, ubi, lbj, ubj, scale, &
1417#ifdef MASKING
1418 & grid(ng) % umask, &
1419#endif
1420 & forces(ng) % sustr)
1421 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1422 IF (master) THEN
1423 WRITE (stdout,20) trim(vname(1,idusms)), qck(ng)%Rindex
1424 END IF
1425 exit_flag=3
1426 ioerror=status
1427 RETURN
1428 END IF
1429 END IF
1430
1431
1432
1433 IF (qout(idvsms,ng)) THEN
1434 scale=rho0
1435 gtype=gfactor*v2dvar
1436 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvsms, &
1437 & qck(ng)%Vid(idvsms), &
1438 & qck(ng)%Rindex, gtype, &
1439 & lbi, ubi, lbj, ubj, scale, &
1440#ifdef MASKING
1441 & grid(ng) % vmask, &
1442#endif
1443 & forces(ng) % svstr)
1444 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1445 IF (master) THEN
1446 WRITE (stdout,20) trim(vname(1,idvsms)), qck(ng)%Rindex
1447 END IF
1448 exit_flag=3
1449 ioerror=status
1450 RETURN
1451 END IF
1452 END IF
1453
1454
1455
1456 IF (qout(idubms,ng)) THEN
1457 scale=-rho0
1458 gtype=gfactor*u2dvar
1459 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idubms, &
1460 & qck(ng)%Vid(idubms), &
1461 & qck(ng)%Rindex, gtype, &
1462 & lbi, ubi, lbj, ubj, scale, &
1463#ifdef MASKING
1464 & grid(ng) % umask, &
1465#endif
1466 & forces(ng) % bustr)
1467 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1468 IF (master) THEN
1469 WRITE (stdout,20) trim(vname(1,idubms)), qck(ng)%Rindex
1470 END IF
1471 exit_flag=3
1472 ioerror=status
1473 RETURN
1474 END IF
1475 END IF
1476
1477
1478
1479 IF (qout(idvbms,ng)) THEN
1480 scale=-rho0
1481 gtype=gfactor*v2dvar
1482 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvbms, &
1483 & qck(ng)%Vid(idvbms), &
1484 & qck(ng)%Rindex, gtype, &
1485 & lbi, ubi, lbj, ubj, scale, &
1486#ifdef MASKING
1487 & grid(ng) % vmask, &
1488#endif
1489 & forces(ng) % bvstr)
1490 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1491 IF (master) THEN
1492 WRITE (stdout,20) trim(vname(1,idvbms)), qck(ng)%Rindex
1493 END IF
1494 exit_flag=3
1495 ioerror=status
1496 RETURN
1497 END IF
1498 END IF
1499
1500#if (defined BBL_MODEL || defined WAVES_OUTPUT) && defined SOLVE3D
1501
1502
1503
1504
1505
1506 CALL bbl_wrt_nf90 (ng, model, tile, &
1507 & lbi, ubi, lbj, ubj, &
1508 & qout, qck)
1509 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1510#endif
1511
1512#if defined ICE_MODEL && defined SOLVE3D
1513
1514
1515
1516
1517
1518 CALL ice_wrt_nf90 (ng, model, tile, &
1519 & lbi, ubi, lbj, ubj, &
1520 & qout, qck)
1521 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1522#endif
1523
1524#if defined SEDIMENT && defined SOLVE3D
1525
1526
1527
1528
1529
1530 CALL sediment_wrt_nf90 (ng, model, tile, &
1531 & lbi, ubi, lbj, ubj, &
1532 & qout, qck)
1533 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1534#endif
1535
1536#if defined WEC_VF && defined SOLVE3D
1537
1538
1539
1540
1541
1542 CALL wec_wrt_nf90 (ng, model, tile, &
1543 & lbi, ubi, lbj, ubj, &
1544 & qout, qck)
1545 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1546#endif
1547
1548
1549
1550
1551
1552
1553 CALL netcdf_sync (ng, model, qck(ng)%name, qck(ng)%ncid)
1554 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1555
1556 10 FORMAT (2x,'WRT_QUICK_NF90 - writing quicksave', t42, &
1557#ifdef SOLVE3D
1558# ifdef NESTING
1559 & 'fields (Index=',i1,',',i1,') in record = ',i0,t92,i2.2)
1560# else
1561 & 'fields (Index=',i1,',',i1,') in record = ',i0)
1562# endif
1563#else
1564# ifdef NESTING
1565 & 'fields (Index=',i1,') in record = ',i0,t92,i2.2)
1566# else
1567 & 'fields (Index=',i1,') in record = ',i0)
1568# endif
1569#endif
1570 20 FORMAT (/,' WRT_QUICK_NF90 - error while writing variable: ',a, &
1571 & /,18x,'into quicksave NetCDF file for time record: ',i0)
1572
1573 RETURN
subroutine, public netcdf_sync(ng, model, ncname, ncid)