161
162
164
165
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
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
197
198
199 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
200
201
202
203
204#if defined WRITE_WATER && defined MASKING
205 gfactor=-1
206#else
207 gfactor=1
208#endif
209
210
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
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
233
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
755
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
1788
1789 IF (hout(idusms,ng)) THEN
1790#ifdef SO_SEMI
1791 scale=1.0_dp
1792#else
1793 scale=rho0
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
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
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
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
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
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
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
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
1937
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
subroutine, public netcdf_sync(ng, model, ncname, ncid)