ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
wrt_rst_mod Module Reference

Functions/Subroutines

subroutine, public wrt_rst (ng, tile)
 
subroutine, private wrt_rst_nf90 (ng, model, tile, lbi, ubi, lbj, ubj)
 
subroutine, private wrt_rst_pio (ng, model, tile, lbi, ubi, lbj, ubj)
 

Function/Subroutine Documentation

◆ wrt_rst()

subroutine, public wrt_rst_mod::wrt_rst ( integer, intent(in) ng,
integer, intent(in) tile )

Definition at line 62 of file wrt_rst.F.

63!***********************************************************************
64!
65! Imported variable declarations.
66!
67 integer, intent(in) :: ng, tile
68!
69! Local variable declarations.
70!
71 integer :: LBi, UBi, LBj, UBj
72!
73 character (len=*), parameter :: MyFile = &
74 & __FILE__
75!
76!-----------------------------------------------------------------------
77! Write out history fields according to IO type.
78!-----------------------------------------------------------------------
79!
80 lbi=bounds(ng)%LBi(tile)
81 ubi=bounds(ng)%UBi(tile)
82 lbj=bounds(ng)%LBj(tile)
83 ubj=bounds(ng)%UBj(tile)
84!
85 SELECT CASE (rst(ng)%IOtype)
86 CASE (io_nf90)
87 CALL wrt_rst_nf90 (ng, inlm, tile, &
88 & lbi, ubi, lbj, ubj)
89
90#if defined PIO_LIB && defined DISTRIBUTE
91 CASE (io_pio)
92 CALL wrt_rst_pio (ng, inlm, tile, &
93 & lbi, ubi, lbj, ubj)
94#endif
95 CASE DEFAULT
96 IF (master) WRITE (stdout,10) rst(ng)%IOtype
97 exit_flag=3
98 END SELECT
99 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
100!
101 10 FORMAT (' WRT_RST - Illegal output file type, io_type = ',i0, &
102 & /,11x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
103!
104 RETURN

References mod_param::bounds, mod_scalars::exit_flag, strings_mod::founderror(), mod_param::inlm, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_parallel::master, mod_scalars::noerror, mod_iounits::rst, mod_iounits::stdout, wrt_rst_nf90(), and wrt_rst_pio().

Referenced by output(), roms_kernel_mod::roms_finalize(), roms_kernel_mod::roms_run(), and roms_kernel_mod::roms_run().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_rst_nf90()

subroutine, private wrt_rst_mod::wrt_rst_nf90 ( integer, intent(in) ng,
integer, intent(in) model,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj )
private

Definition at line 108 of file wrt_rst.F.

110!***********************************************************************
111!
112 USE mod_netcdf
113!
114! Imported variable declarations.
115!
116 integer, intent(in) :: ng, model, tile
117 integer, intent(in) :: LBi, UBi, LBj, UBj
118!
119! Local variable declarations.
120!
121 integer :: Fcount, gfactor, gtype, i, itrc, status
122# if defined PERFECT_RESTART || defined SOLVE3D
123 integer :: ntmp(1)
124# endif
125!
126 real(dp) :: scale
127!
128 character (len=*), parameter :: MyFile = &
129 & __FILE__//", wrt_rst_nf90"
130!
131 sourcefile=myfile
132!
133!-----------------------------------------------------------------------
134! Write out restart fields.
135!-----------------------------------------------------------------------
136!
137 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
138!
139! Set grid type factor to write full (gfactor=1) fields or water
140! points (gfactor=-1) fields only.
141!
142#if !defined PERFECT_RESTART && \
143 (defined write_water && defined masking)
144 gfactor=-1
145#else
146 gfactor=1
147#endif
148!
149! Set time record index.
150!
151 rst(ng)%Rindex=rst(ng)%Rindex+1
152 fcount=rst(ng)%Fcount
153 rst(ng)%Nrec(fcount)=rst(ng)%Nrec(fcount)+1
154!
155! Report.
156!
157#ifdef SOLVE3D
158# ifdef NESTING
159 IF (master) WRITE (stdout,10) kout, nout, rst(ng)%Rindex, ng
160# else
161 IF (master) WRITE (stdout,10) kout, nout, rst(ng)%Rindex
162# endif
163#else
164# ifdef NESTING
165 IF (master) WRITE (stdout,10) kout, rst(ng)%Rindex, ng
166# else
167 IF (master) WRITE (stdout,10) kout, rst(ng)%Rindex
168# endif
169#endif
170!
171! If requested, set time index to recycle time records in restart
172! file.
173!
174 IF (lcyclerst(ng)) THEN
175 rst(ng)%Rindex=mod(rst(ng)%Rindex-1,2)+1
176 END IF
177
178#ifdef PERFECT_RESTART
179!
180! Write out time-stepping indices.
181!
182# ifdef SOLVE3D
183 ntmp(1)=1+mod((iic(ng)-1)-ntstart(ng),2)
184 CALL netcdf_put_ivar (ng, model, rst(ng)%name, 'nstp', &
185 & ntmp, (/rst(ng)%Rindex/), (/1/), &
186 & ncid = rst(ng)%ncid)
187 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
188
189 CALL netcdf_put_ivar (ng, model, rst(ng)%name, 'nrhs', &
190 & ntmp, (/rst(ng)%Rindex/), (/1/), &
191 & ncid = rst(ng)%ncid)
192 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
193
194 ntmp(1)=3-ntmp(1)
195 CALL netcdf_put_ivar (ng, model, rst(ng)%name, 'nnew', &
196 & ntmp, (/rst(ng)%Rindex/), (/1/), &
197 & ncid = rst(ng)%ncid)
198 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
199# endif
200 CALL netcdf_put_ivar (ng, model, rst(ng)%name, 'kstp', &
201 & kstp(ng:), (/rst(ng)%Rindex/), (/1/), &
202 & ncid = rst(ng)%ncid)
203 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
204
205 CALL netcdf_put_ivar (ng, model, rst(ng)%name, 'krhs', &
206 & krhs(ng:), (/rst(ng)%Rindex/), (/1/), &
207 & ncid = rst(ng)%ncid)
208 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
209
210 CALL netcdf_put_ivar (ng, model, rst(ng)%name, 'knew', &
211 & knew(ng:), (/rst(ng)%Rindex/), (/1/), &
212 & ncid = rst(ng)%ncid)
213 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
214#endif
215!
216! Write out model time (s).
217!
218 CALL netcdf_put_fvar (ng, model, rst(ng)%name, &
219 & trim(vname(1,idtime)), time(ng:), &
220 & (/rst(ng)%Rindex/), (/1/), &
221 & ncid = rst(ng)%ncid, &
222 & varid = rst(ng)%Vid(idtime))
223 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
224
225#if defined SEDIMENT && defined SED_MORPH
226!
227! Write out time-dependent bathymetry (m)
228!
229 IF (hout(idbath,ng)) THEN
230 scale=1.0_dp
231 gtype=gfactor*r2dvar
232 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idbath, &
233 & rst(ng)%Vid(idbath), &
234 & rst(ng)%Rindex, gtype, &
235 & lbi, ubi, lbj, ubj, scale, &
236# ifdef MASKING
237 & grid(ng) % rmask, &
238# endif
239 & grid(ng) % h, &
240 & setfillval = .false.)
241 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
242 IF (master) THEN
243 WRITE (stdout,20) trim(vname(1,idbath)), rst(ng)%Rindex
244 END IF
245 exit_flag=3
246 ioerror=status
247 RETURN
248 END IF
249 END IF
250#endif
251#ifdef WET_DRY
252!
253! Write out wet/dry mask at PSI-points.
254!
255 scale=1.0_dp
256 gtype=gfactor*p2dvar
257 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idpwet, &
258 & rst(ng)%Vid(idpwet), &
259 & rst(ng)%Rindex, gtype, &
260 & lbi, ubi, lbj, ubj, scale, &
261# ifdef MASKING
262 & grid(ng) % pmask, &
263# endif
264 & grid(ng) % pmask_wet, &
265 & setfillval = .false.)
266 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
267 IF (master) THEN
268 WRITE (stdout,20) trim(vname(1,idpwet)), rst(ng)%Rindex
269 END IF
270 exit_flag=3
271 ioerror=status
272 RETURN
273 END IF
274!
275! Write out wet/dry mask at RHO-points.
276!
277 scale=1.0_dp
278 gtype=gfactor*r2dvar
279 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idrwet, &
280 & rst(ng)%Vid(idrwet), &
281 & rst(ng)%Rindex, gtype, &
282 & lbi, ubi, lbj, ubj, scale, &
283# ifdef MASKING
284 & grid(ng) % rmask, &
285# endif
286 & grid(ng) % rmask_wet, &
287 & setfillval = .false.)
288 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
289 IF (master) THEN
290 WRITE (stdout,20) trim(vname(1,idrwet)), rst(ng)%Rindex
291 END IF
292 exit_flag=3
293 ioerror=status
294 RETURN
295 END IF
296!
297! Write out wet/dry mask at U-points.
298!
299 scale=1.0_dp
300 gtype=gfactor*u2dvar
301 status=nf_fwrite2d(ng, model, rst(ng)%ncid, iduwet, &
302 & rst(ng)%Vid(iduwet), &
303 & rst(ng)%Rindex, gtype, &
304 & lbi, ubi, lbj, ubj, scale, &
305# ifdef MASKING
306 & grid(ng) % umask, &
307# endif
308 & grid(ng) % umask_wet, &
309 & setfillval = .false.)
310 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
311 IF (master) THEN
312 WRITE (stdout,20) trim(vname(1,iduwet)), rst(ng)%Rindex
313 END IF
314 exit_flag=3
315 ioerror=status
316 RETURN
317 END IF
318!
319! Write out wet/dry mask at V-points.
320!
321 scale=1.0_dp
322 gtype=gfactor*v2dvar
323 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idvwet, &
324 & rst(ng)%Vid(idvwet), &
325 & rst(ng)%Rindex, gtype, &
326 & lbi, ubi, lbj, ubj, scale, &
327# ifdef MASKING
328 & grid(ng) % vmask, &
329# endif
330 & grid(ng) % vmask_wet, &
331 & setfillval = .false.)
332 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
333 IF (master) THEN
334 WRITE (stdout,20) trim(vname(1,idvwet)), rst(ng)%Rindex
335 END IF
336 exit_flag=3
337 ioerror=status
338 RETURN
339 END IF
340#endif
341!
342! Write out free-surface (m).
343!
344 scale=1.0_dp
345#ifdef PERFECT_RESTART
346 gtype=gfactor*r3dvar
347 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idfsur, &
348 & rst(ng)%Vid(idfsur), &
349 & rst(ng)%Rindex, gtype, &
350 & lbi, ubi, lbj, ubj, 1, 3, scale, &
351# ifdef MASKING
352 & grid(ng) % rmask, &
353# endif
354# ifdef WET_DRY
355 & ocean(ng) % zeta, &
356 & setfillval = .false.)
357# else
358 & ocean(ng) % zeta)
359# endif
360#else
361 gtype=gfactor*r2dvar
362 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idfsur, &
363 & rst(ng)%Vid(idfsur), &
364 & rst(ng)%Rindex, gtype, &
365 & lbi, ubi, lbj, ubj, scale, &
366# ifdef MASKING
367 & grid(ng) % rmask, &
368# endif
369# ifdef WET_DRY
370 & ocean(ng) % zeta(:,:,kout), &
371 & setfillval = .false.)
372# else
373 & ocean(ng) % zeta(:,:,kout))
374# endif
375#endif
376 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
377 IF (master) THEN
378 WRITE (stdout,20) trim(vname(1,idfsur)), rst(ng)%Rindex
379 END IF
380 exit_flag=3
381 ioerror=status
382 RETURN
383 END IF
384#ifdef PERFECT_RESTART
385!
386! Write out RHS of free-surface equation.
387!
388 scale=1.0_dp
389 gtype=gfactor*r3dvar
390 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idrzet, &
391 & rst(ng)%Vid(idrzet), &
392 & rst(ng)%Rindex, gtype, &
393 & lbi, ubi, lbj, ubj, 1, 2, scale, &
394# ifdef MASKING
395 & grid(ng) % rmask, &
396# endif
397 & ocean(ng) % rzeta)
398 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
399 IF (master) THEN
400 WRITE (stdout,20) trim(vname(1,idrzet)), rst(ng)%Rindex
401 END IF
402 exit_flag=3
403 ioerror=status
404 RETURN
405 END IF
406#endif
407!
408! Write out 2D momentum component (m/s) in the XI-direction.
409!
410 scale=1.0_dp
411#ifdef PERFECT_RESTART
412 gtype=gfactor*u3dvar
413 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idubar, &
414 & rst(ng)%Vid(idubar), &
415 & rst(ng)%Rindex, gtype, &
416 & lbi, ubi, lbj, ubj, 1, 3, scale, &
417# ifdef MASKING
418 & grid(ng) % umask, &
419# endif
420 & ocean(ng) % ubar, &
421 & setfillval = .false.)
422
423#else
424 gtype=gfactor*u2dvar
425 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idubar, &
426 & rst(ng)%Vid(idubar), &
427 & rst(ng)%Rindex, gtype, &
428 & lbi, ubi, lbj, ubj, scale, &
429# ifdef MASKING
430 & grid(ng) % umask_full, &
431# endif
432 & ocean(ng) % ubar(:,:,kout))
433#endif
434 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
435 IF (master) THEN
436 WRITE (stdout,20) trim(vname(1,idubar)), rst(ng)%Rindex
437 END IF
438 exit_flag=3
439 ioerror=status
440 RETURN
441 END IF
442#ifdef PERFECT_RESTART
443!
444! Write out RHS of 2D momentum equation in the XI-direction.
445!
446 scale=1.0_dp
447 gtype=gfactor*u3dvar
448 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idru2d, &
449 & rst(ng)%Vid(idru2d), &
450 & rst(ng)%Rindex, gtype, &
451 & lbi, ubi, lbj, ubj, 1, 2, scale, &
452# ifdef MASKING
453 & grid(ng) % umask, &
454# endif
455 & ocean(ng) % rubar, &
456 & setfillval = .false.)
457 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
458 IF (master) THEN
459 WRITE (stdout,20) trim(vname(1,idru2d)), rst(ng)%Rindex
460 END IF
461 exit_flag=3
462 ioerror=status
463 RETURN
464 END IF
465#endif
466!
467! Write out 2D momentum component (m/s) in the ETA-direction.
468!
469 scale=1.0_dp
470#ifdef PERFECT_RESTART
471 gtype=gfactor*v3dvar
472 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idvbar, &
473 & rst(ng)%Vid(idvbar), &
474 & rst(ng)%Rindex, gtype, &
475 & lbi, ubi, lbj, ubj, 1, 3, scale, &
476# ifdef MASKING
477 & grid(ng) % vmask, &
478# endif
479 & ocean(ng) % vbar, &
480 & setfillval = .false.)
481#else
482 gtype=gfactor*v2dvar
483 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idvbar, &
484 & rst(ng)%Vid(idvbar), &
485 & rst(ng)%Rindex, gtype, &
486 & lbi, ubi, lbj, ubj, scale, &
487# ifdef MASKING
488 & grid(ng) % vmask_full, &
489# endif
490 & ocean(ng) % vbar(:,:,kout))
491#endif
492 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
493 IF (master) THEN
494 WRITE (stdout,20) trim(vname(1,idvbar)), rst(ng)%Rindex
495 END IF
496 exit_flag=3
497 ioerror=status
498 RETURN
499 END IF
500
501#ifdef PERFECT_RESTART
502!
503! Write out RHS of 2D momentum equation in the ETA-direction.
504!
505 scale=1.0_dp
506 gtype=gfactor*v3dvar
507 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idrv2d, &
508 & rst(ng)%Vid(idrv2d), &
509 & rst(ng)%Rindex, gtype, &
510 & lbi, ubi, lbj, ubj, 1, 2, scale, &
511# ifdef MASKING
512 & grid(ng) % vmask, &
513# endif
514 & ocean(ng) % rvbar, &
515 & setfillval = .false.)
516 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
517 IF (master) THEN
518 WRITE (stdout,20) trim(vname(1,idrv2d)), rst(ng)%Rindex
519 END IF
520 exit_flag=3
521 ioerror=status
522 RETURN
523 END IF
524#endif
525#ifdef SOLVE3D
526!
527! Write out 3D momentum component (m/s) in the XI-direction.
528!
529 scale=1.0_dp
530 gtype=gfactor*u3dvar
531# ifdef PERFECT_RESTART
532 status=nf_fwrite4d(ng, model, rst(ng)%ncid, iduvel, &
533 & rst(ng)%Vid(iduvel), &
534 & rst(ng)%Rindex, gtype, &
535 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, scale, &
536# ifdef MASKING
537 & grid(ng) % umask, &
538# endif
539 & ocean(ng) % u, &
540 & setfillval = .false.)
541# else
542 status=nf_fwrite3d(ng, model, rst(ng)%ncid, iduvel, &
543 & rst(ng)%Vid(iduvel), &
544 & rst(ng)%Rindex, gtype, &
545 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
546# ifdef MASKING
547 & grid(ng) % umask_full, &
548# endif
549 & ocean(ng) % u(:,:,:,nout))
550# endif
551 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
552 IF (master) THEN
553 WRITE (stdout,20) trim(vname(1,iduvel)), rst(ng)%Rindex
554 END IF
555 exit_flag=3
556 ioerror=status
557 RETURN
558 END IF
559
560# ifdef PERFECT_RESTART
561!
562! Write out RHS of 3D momentum equation in the XI-direction.
563!
564 scale=1.0_dp
565 gtype=gfactor*u3dvar
566 status=nf_fwrite4d(ng, model, rst(ng)%ncid, idru3d, &
567 & rst(ng)%Vid(idru3d), &
568 & rst(ng)%Rindex, gtype, &
569 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, scale, &
570# ifdef MASKING
571 & grid(ng) % umask, &
572# endif
573 & ocean(ng) % ru, &
574 & setfillval = .false.)
575 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
576 IF (master) THEN
577 WRITE (stdout,20) trim(vname(1,idru3d)), rst(ng)%Rindex
578 END IF
579 exit_flag=3
580 ioerror=status
581 RETURN
582 END IF
583# endif
584!
585! Write out momentum component (m/s) in the ETA-direction.
586!
587 scale=1.0_dp
588 gtype=gfactor*v3dvar
589# ifdef PERFECT_RESTART
590 status=nf_fwrite4d(ng, model, rst(ng)%ncid, idvvel, &
591 & rst(ng)%Vid(idvvel), &
592 & rst(ng)%Rindex, gtype, &
593 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, scale, &
594# ifdef MASKING
595 & grid(ng) % vmask, &
596# endif
597 & ocean(ng) % v, &
598 & setfillval = .false.)
599# else
600 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idvvel, &
601 & rst(ng)%Vid(idvvel), &
602 & rst(ng)%Rindex, gtype, &
603 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
604# ifdef MASKING
605 & grid(ng) % vmask_full, &
606# endif
607 & ocean(ng) % v(:,:,:,nout))
608# endif
609 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
610 IF (master) THEN
611 WRITE (stdout,20) trim(vname(1,idvvel)), rst(ng)%Rindex
612 END IF
613 exit_flag=3
614 ioerror=status
615 RETURN
616 END IF
617
618# ifdef PERFECT_RESTART
619!
620! Write out RHS of 3D momentum equation in the ETA-direction.
621!
622 scale=1.0_dp
623 gtype=gfactor*v3dvar
624 status=nf_fwrite4d(ng, model, rst(ng)%ncid, idrv3d, &
625 & rst(ng)%Vid(idrv3d), &
626 & rst(ng)%Rindex, gtype, &
627 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, scale, &
628# ifdef MASKING
629 & grid(ng) % vmask, &
630# endif
631 & ocean(ng) % rv, &
632 & setfillval = .false.)
633 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
634 IF (master) THEN
635 WRITE (stdout,20) trim(vname(1,idrv3d)), rst(ng)%Rindex
636 END IF
637 exit_flag=3
638 ioerror=status
639 RETURN
640 END IF
641# endif
642!
643! Write out tracer type variables.
644!
645 DO itrc=1,nt(ng)
646 scale=1.0_dp
647 gtype=gfactor*r3dvar
648# ifdef PERFECT_RESTART
649 status=nf_fwrite4d(ng, model, rst(ng)%ncid, idtvar(itrc), &
650 & rst(ng)%Tid(itrc), &
651 & rst(ng)%Rindex, gtype, &
652 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, scale, &
653# ifdef MASKING
654 & grid(ng) % rmask, &
655# endif
656 & ocean(ng) % t(:,:,:,:,itrc))
657# else
658 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idtvar(itrc), &
659 & rst(ng)%Tid(itrc), &
660 & rst(ng)%Rindex, gtype, &
661 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
662# ifdef MASKING
663 & grid(ng) % rmask, &
664# endif
665 & ocean(ng) % t(:,:,:,nout,itrc))
666# endif
667 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
668 IF (master) THEN
669 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), &
670 & rst(ng)%Rindex
671 END IF
672 exit_flag=3
673 ioerror=status
674 RETURN
675 END IF
676 END DO
677!
678! Write out density anomaly.
679!
680 scale=1.0_dp
681 gtype=gfactor*r3dvar
682 status=nf_fwrite3d(ng, model, rst(ng)%ncid, iddano, &
683 & rst(ng)%Vid(iddano), &
684 & rst(ng)%Rindex, gtype, &
685 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
686# ifdef MASKING
687 & grid(ng) % rmask, &
688# endif
689 & ocean(ng) % rho)
690 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
691 IF (master) THEN
692 WRITE (stdout,20) trim(vname(1,iddano)), rst(ng)%Rindex
693 END IF
694 exit_flag=3
695 ioerror=status
696 RETURN
697 END IF
698
699# ifdef LMD_SKPP
700!
701! Write out depth of surface boundary layer.
702!
703 scale=1.0_dp
704 gtype=gfactor*r2dvar
705 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idhsbl, &
706 & rst(ng)%Vid(idhsbl), &
707 & rst(ng)%Rindex, gtype, &
708 & lbi, ubi, lbj, ubj, scale, &
709# ifdef MASKING
710 & grid(ng) % rmask, &
711# endif
712 & mixing(ng) % hsbl)
713 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
714 IF (master) THEN
715 WRITE (stdout,20) trim(vname(1,idhsbl)), rst(ng)%Rindex
716 END IF
717 exit_flag=3
718 ioerror=status
719 RETURN
720 END IF
721# endif
722# ifdef LMD_BKPP
723!
724! Write out depth of bottom boundary layer.
725!
726 scale=1.0_dp
727 gtype=gfactor*r2dvar
728 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idhbbl, &
729 & rst(ng)%Vid(idhbbl), &
730 & rst(ng)%Rindex, gtype, &
731 & lbi, ubi, lbj, ubj, scale, &
732# ifdef MASKING
733 & grid(ng) % rmask, &
734# endif
735 & mixing(ng) % hbbl)
736 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
737 IF (master) THEN
738 WRITE (stdout,20) trim(vname(1,idhbbl)), rst(ng)%Rindex
739 END IF
740 exit_flag=3
741 ioerror=status
742 RETURN
743 END IF
744# endif
745# if defined PERFECT_RESTART && defined LMD_NONLOCAL
746!
747! Write out KPP nonlocal transport.
748!
749 DO i=1,nat
750 scale=1.0_dp
751 gtype=gfactor*w3dvar
752 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idghat(i), &
753 & rst(ng)%Vid(idghat(i)), &
754 & rst(ng)%Rindex, gtype, &
755 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
756# ifdef MASKING
757 & grid(ng) % rmask, &
758# endif
759 & mixing(ng) % ghats(:,:,:,i))
760 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
761 IF (master) THEN
762 WRITE (stdout,20) trim(vname(1,idghat(i))), rst(ng)%Rindex
763 END IF
764 exit_flag=3
765 ioerror=status
766 RETURN
767 END IF
768 END DO
769# endif
770# if defined BVF_MIXING || defined GLS_MIXING || \
771 defined my25_mixing || defined lmd_mixing
772!
773! Write out vertical viscosity coefficient.
774!
775 scale=1.0_dp
776 gtype=gfactor*w3dvar
777 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idvvis, &
778 & rst(ng)%Vid(idvvis), &
779 & rst(ng)%Rindex, gtype, &
780 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
781# ifdef MASKING
782 & grid(ng) % rmask, &
783# endif
784 & mixing(ng) % Akv, &
785 & setfillval = .false.)
786 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
787 IF (master) THEN
788 WRITE (stdout,20) trim(vname(1,idvvis)), rst(ng)%Rindex
789 END IF
790 exit_flag=3
791 ioerror=status
792 RETURN
793 END IF
794!
795! Write out vertical diffusion coefficient for potential temperature.
796!
797 scale=1.0_dp
798 gtype=gfactor*w3dvar
799 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idtdif, &
800 & rst(ng)%Vid(idtdif), &
801 & rst(ng)%Rindex, gtype, &
802 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
803# ifdef MASKING
804 & grid(ng) % rmask, &
805# endif
806 & mixing(ng) % Akt(:,:,:,itemp), &
807 & setfillval = .false.)
808
809 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
810 IF (master) THEN
811 WRITE (stdout,20) trim(vname(1,idtdif)), rst(ng)%Rindex
812 END IF
813 exit_flag=3
814 ioerror=status
815 RETURN
816 END IF
817
818# ifdef SALINITY
819!
820! Write out vertical diffusion coefficient for salinity.
821!
822 scale=1.0_dp
823 gtype=gfactor*w3dvar
824 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idsdif, &
825 & rst(ng)%Vid(idsdif), &
826 & rst(ng)%Rindex, gtype, &
827 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
828# ifdef MASKING
829 & grid(ng) % rmask, &
830# endif
831 & mixing(ng) % Akt(:,:,:,isalt), &
832 & setfillval = .false.)
833 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
834 IF (master) THEN
835 WRITE (stdout,20) trim(vname(1,idsdif)), rst(ng)%Rindex
836 END IF
837 exit_flag=3
838 ioerror=status
839 RETURN
840 END IF
841# endif
842# endif
843# if defined PERFECT_RESTART && \
844 (defined gls_mixing || defined my25_mixing)
845!
846! Write out turbulent kinetic energy.
847!
848 scale=1.0_dp
849 gtype=gfactor*w3dvar
850 status=nf_fwrite4d(ng, model, rst(ng)%ncid, idmtke, &
851 & rst(ng)%Vid(idmtke), &
852 & rst(ng)%Rindex, gtype, &
853 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, scale, &
854# ifdef MASKING
855 & grid(ng) % rmask, &
856# endif
857 & mixing(ng) % tke, &
858 & setfillval = .false.)
859 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
860 IF (master) THEN
861 WRITE (stdout,20) trim(vname(1,idmtke)), rst(ng)%Rindex
862 END IF
863 exit_flag=3
864 ioerror=status
865 RETURN
866 END IF
867!
868! Define turbulent kinetic energy time length scale.
869!
870 scale=1.0_dp
871 gtype=gfactor*w3dvar
872 status=nf_fwrite4d(ng, model, rst(ng)%ncid, idmtls, &
873 & rst(ng)%Vid(idmtls), &
874 & rst(ng)%Rindex, gtype, &
875 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, scale, &
876# ifdef MASKING
877 & grid(ng) % rmask, &
878# endif
879 & mixing(ng) % gls, &
880 & setfillval = .false.)
881 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
882 IF (master) THEN
883 WRITE (stdout,20) trim(vname(1,idmtls)), rst(ng)%Rindex
884 END IF
885 exit_flag=3
886 ioerror=status
887 RETURN
888 END IF
889!
890! Define vertical mixing turbulent length scale.
891!
892 scale=1.0_dp
893 gtype=gfactor*w3dvar
894 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idvmls, &
895 & rst(ng)%Vid(idvmls), &
896 & rst(ng)%Rindex, gtype, &
897 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
898# ifdef MASKING
899 & grid(ng) % rmask, &
900# endif
901 & mixing(ng) % Lscale)
902 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
903 IF (master) THEN
904 WRITE (stdout,20) trim(vname(1,idvmls)), rst(ng)%Rindex
905 END IF
906 exit_flag=3
907 ioerror=status
908 RETURN
909 END IF
910!
911! Define turbulent kinetic energy vertical diffusion coefficient.
912!
913 scale=1.0_dp
914 gtype=gfactor*w3dvar
915 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idvmkk, &
916 & rst(ng)%Vid(idvmkk), &
917 & rst(ng)%Rindex, gtype, &
918 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
919# ifdef MASKING
920 & grid(ng) % rmask, &
921# endif
922 & mixing(ng) % Akk)
923 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
924 IF (master) THEN
925 WRITE (stdout,20) trim(vname(1,idvmkk)), rst(ng)%Rindex
926 END IF
927 exit_flag=3
928 ioerror=status
929 RETURN
930 END IF
931# ifdef GLS_MIXING
932!
933! Define turbulent length scale vertical diffusion coefficient.
934!
935 scale=1.0_dp
936 gtype=gfactor*w3dvar
937 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idvmkp, &
938 & rst(ng)%Vid(idvmkp), &
939 & rst(ng)%Rindex, gtype, &
940 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
941# ifdef MASKING
942 & grid(ng) % rmask, &
943# endif
944 & mixing(ng) % Akp)
945 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
946 IF (master) THEN
947 WRITE (stdout,20) trim(vname(1,idvmkp)), rst(ng)%Rindex
948 END IF
949 exit_flag=3
950 ioerror=status
951 RETURN
952 END IF
953# endif
954# endif
955# ifdef SEDIMENT
956# ifdef BEDLOAD
957!
958! Write out bed load transport in U-direction.
959!
960 DO i=1,nst
961 scale=1.0_dp
962 gtype=gfactor*u2dvar
963 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idubld(i), &
964 & rst(ng)%Vid(idubld(i)), &
965 & rst(ng)%Rindex, gtype, &
966 & lbi, ubi, lbj, ubj, scale, &
967# ifdef MASKING
968 & grid(ng) % umask, &
969# endif
970 & sedbed(ng) % bedldu(:,:,i))
971 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
972 IF (master) THEN
973 WRITE (stdout,20) trim(vname(1,idubld(i))), rst(ng)%Rindex
974 END IF
975 exit_flag=3
976 ioerror=status
977 RETURN
978 END IF
979 END DO
980!
981! Write out bed load transport in V-direction.
982!
983 DO i=1,nst
984 scale=1.0_dp
985 gtype=gfactor*v2dvar
986 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idvbld(i), &
987 & rst(ng)%Vid(idvbld(i)), &
988 & rst(ng)%Rindex, gtype, &
989 & lbi, ubi, lbj, ubj, scale, &
990# ifdef MASKING
991 & grid(ng) % vmask, &
992# endif
993 & sedbed(ng) % bedldv(:,:,i))
994 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
995 IF (master) THEN
996 WRITE (stdout,20) trim(vname(1,idvbld(i))), rst(ng)%Rindex
997 END IF
998 exit_flag=3
999 ioerror=status
1000 RETURN
1001 END IF
1002 END DO
1003# endif
1004!
1005! Write out sediment fraction of each size class in each bed layer.
1006!
1007 DO i=1,nst
1008 scale=1.0_dp
1009 gtype=gfactor*b3dvar
1010 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idfrac(i), &
1011 & rst(ng)%Vid(idfrac(i)), &
1012 & rst(ng)%Rindex, gtype, &
1013 & lbi, ubi, lbj, ubj, 1, nbed, scale, &
1014# ifdef MASKING
1015 & grid(ng) % rmask, &
1016# endif
1017 & sedbed(ng) % bed_frac(:,:,:,i), &
1018 & setfillval = .false.)
1019 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1020 IF (master) THEN
1021 WRITE (stdout,20) trim(vname(1,idfrac(i))), rst(ng)%Rindex
1022 END IF
1023 exit_flag=3
1024 ioerror=status
1025 RETURN
1026 END IF
1027 END DO
1028!
1029! Write out sediment mass of each size class in each bed layer.
1030!
1031 DO i=1,nst
1032 scale=1.0_dp
1033 gtype=gfactor*b3dvar
1034 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idbmas(i), &
1035 & rst(ng)%Vid(idbmas(i)), &
1036 & rst(ng)%Rindex, gtype, &
1037 & lbi, ubi, lbj, ubj, 1, nbed, scale, &
1038# ifdef MASKING
1039 & grid(ng) % rmask, &
1040# endif
1041 & sedbed(ng) % bed_mass(:,:,:,nout,i), &
1042 & setfillval = .false.)
1043 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1044 IF (master) THEN
1045 WRITE (stdout,20) trim(vname(1,idbmas(i))), rst(ng)%Rindex
1046 END IF
1047 exit_flag=3
1048 ioerror=status
1049 RETURN
1050 END IF
1051 END DO
1052!
1053! Write out sediment properties in each bed layer.
1054!
1055 DO i=1,mbedp
1056 IF (i.eq.itauc) THEN
1057 scale=rho0
1058 ELSE
1059 scale=1.0_dp
1060 END IF
1061 gtype=gfactor*b3dvar
1062 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idsbed(i), &
1063 & rst(ng)%Vid(idsbed(i)), &
1064 & rst(ng)%Rindex, gtype, &
1065 & lbi, ubi, lbj, ubj, 1, nbed, scale, &
1066# ifdef MASKING
1067 & grid(ng) % rmask, &
1068# endif
1069 & sedbed(ng) % bed(:,:,:,i), &
1070 & setfillval = .false.)
1071 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1072 IF (master) THEN
1073 WRITE (stdout,20) trim(vname(1,idsbed(i))), rst(ng)%Rindex
1074 END IF
1075 exit_flag=3
1076 ioerror=status
1077 RETURN
1078 END IF
1079 END DO
1080# endif
1081# if defined SEDIMENT || defined BBL_MODEL
1082!
1083! Write out exposed sediment layer properties. Notice that only the
1084! first four properties (mean grain diameter, mean grain density,
1085! mean settling velocity, mean critical erosion stress,
1086! ripple length and ripple height) are written.
1087!
1088 DO i=1,6
1089 scale=1.0_dp
1090 gtype=gfactor*r2dvar
1091 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idbott(i), &
1092 & rst(ng)%Vid(idbott(i)), &
1093 & rst(ng)%Rindex, gtype, &
1094 & lbi, ubi, lbj, ubj, scale, &
1095# ifdef MASKING
1096 & grid(ng) % rmask, &
1097# endif
1098 & sedbed(ng) % bottom(:,:,i))
1099 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1100 IF (master) THEN
1101 WRITE (stdout,20) trim(vname(1,idbott(i))), rst(ng)%Rindex
1102 END IF
1103 exit_flag=3
1104 ioerror=status
1105 RETURN
1106 END IF
1107 END DO
1108# endif
1109#endif
1110#ifdef WEC
1111!
1112! Write out 2D Stokes U-velocity.
1113!
1114 scale=1.0_dp
1115 gtype=gfactor*u2dvar
1116 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idu2sd, &
1117 & rst(ng)%Vid(idu2sd), &
1118 & rst(ng)%Rindex, gtype, &
1119 & lbi, ubi, lbj, ubj, scale, &
1120# ifdef MASKING
1121 & grid(ng) % umask, &
1122# endif
1123 & ocean(ng) % ubar_stokes)
1124 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1125 IF (master) WRITE (stdout,20) trim(vname(1,idu2sd)), &
1126 & rst(ng)%Rindex
1127 exit_flag=3
1128 ioerror=status
1129 RETURN
1130 END IF
1131!
1132! Write out 2D Stokes V-velocity.
1133!
1134 scale=1.0_dp
1135 gtype=gfactor*v2dvar
1136 status=nf_fwrite2d(ng, model, rst(ng)%ncid, idv2sd, &
1137 & rst(ng)%Vid(idv2sd), &
1138 & rst(ng)%Rindex, gtype, &
1139 & lbi, ubi, lbj, ubj, scale, &
1140# ifdef MASKING
1141 & grid(ng) % vmask, &
1142# endif
1143 & ocean(ng) % vbar_stokes)
1144 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1145 IF (master) WRITE (stdout,20) trim(vname(1,idv2sd)), &
1146 & rst(ng)%Rindex
1147 exit_flag=3
1148 ioerror=status
1149 RETURN
1150 END IF
1151
1152# ifdef SOLVE3D
1153!
1154! Write out 3D Stokes U-velocity.
1155!
1156 scale=1.0_dp
1157 gtype=gfactor*u3dvar
1158 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idu3sd, &
1159 & rst(ng)%Vid(idu3sd), &
1160 & rst(ng)%Rindex, gtype, &
1161 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1162# ifdef MASKING
1163 & grid(ng) % umask, &
1164# endif
1165 & ocean(ng) % u_stokes)
1166 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1167 IF(master) WRITE (stdout,20) trim(vname(1,idu3sd)), &
1168 & rst(ng)%Rindex
1169 exit_flag=3
1170 ioerror=status
1171 RETURN
1172 END IF
1173!
1174! Write out 3D Stokes V-velocity.
1175!
1176 scale=1.0_dp
1177 gtype=gfactor*v3dvar
1178 status=nf_fwrite3d(ng, model, rst(ng)%ncid, idv3sd, &
1179 & rst(ng)%Vid(idv3sd), &
1180 & rst(ng)%Rindex, gtype, &
1181 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1182# ifdef MASKING
1183 & grid(ng) % vmask, &
1184# endif
1185 & ocean(ng) % v_stokes)
1186 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1187 IF (master) WRITE (stdout,20) trim(vname(1,idv3sd)), &
1188 & rst(ng)%Rindex
1189 exit_flag=3
1190 ioerror=status
1191 RETURN
1192 END IF
1193# endif
1194#endif
1195#ifdef ICE_MODEL
1196!
1197!-----------------------------------------------------------------------
1198! Write out seaice model state variables.
1199!-----------------------------------------------------------------------
1200!
1201 CALL ice_wrt_nf90 (ng, model, tile, &
1202 & lbi, ubi, lbj, ubj, &
1203 & hout, rst)
1204 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1205#endif
1206!
1207!-----------------------------------------------------------------------
1208! Synchronize restart NetCDF file to disk.
1209!-----------------------------------------------------------------------
1210!
1211 CALL netcdf_sync (ng, model, rst(ng)%name, rst(ng)%ncid)
1212 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1213!
1214 10 FORMAT (2x,'WRT_RST_NF90 - writing re-start', t42, &
1215#ifdef SOLVE3D
1216# ifdef NESTING
1217 & 'fields (Index=',i1,',',i1,') in record = ',i0,t92,i2.2)
1218# else
1219 & 'fields (Index=',i1,',',i1,') in record = ',i0)
1220# endif
1221#else
1222# ifdef NESTING
1223 & 'fields (Index=',i1,') in record = ',i0,t92,i2.2)
1224# else
1225 & 'fields (Index=',i1,') in record = ',i0)
1226# endif
1227#endif
1228 20 FORMAT (/,' WRT_RST_NF90 - error while writing variable: ',a, &
1229 & /,16x,'into restart NetCDF file for time record: ',i0)
1230!
1231 RETURN
mod_netcdf::netcdf_put_fvar
Definition mod_netcdf.F:82
mod_netcdf::netcdf_put_ivar
Definition mod_netcdf.F:96
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::netcdf_sync
subroutine, public netcdf_sync(ng, model, ncname, ncid)
Definition mod_netcdf.F:9505

References mod_param::b3dvar, mod_scalars::exit_flag, strings_mod::founderror(), mod_grid::grid, mod_ncparam::hout, mod_ncparam::idbath, mod_sediment::idbmas, mod_sediment::idbott, mod_ncparam::iddano, mod_sediment::idfrac, mod_ncparam::idfsur, mod_ncparam::idghat, mod_ncparam::idhbbl, mod_ncparam::idhsbl, mod_ncparam::idmtke, mod_ncparam::idmtls, mod_ncparam::idpwet, mod_ncparam::idru2d, mod_ncparam::idru3d, mod_ncparam::idrv2d, mod_ncparam::idrv3d, mod_ncparam::idrwet, mod_ncparam::idrzet, mod_sediment::idsbed, mod_ncparam::idsdif, mod_ncparam::idtdif, mod_ncparam::idtime, mod_ncparam::idtvar, mod_ncparam::idu2sd, mod_ncparam::idu3sd, mod_ncparam::idubar, mod_sediment::idubld, mod_ncparam::iduvel, mod_ncparam::iduwet, mod_ncparam::idv2sd, mod_ncparam::idv3sd, mod_ncparam::idvbar, mod_sediment::idvbld, mod_ncparam::idvmkk, mod_ncparam::idvmkp, mod_ncparam::idvmls, mod_ncparam::idvvel, mod_ncparam::idvvis, mod_ncparam::idvwet, mod_scalars::iic, mod_iounits::ioerror, mod_scalars::isalt, mod_sediment::itauc, mod_scalars::itemp, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_scalars::lcyclerst, mod_parallel::master, mod_sediment::mbedp, mod_mixing::mixing, mod_param::n, mod_param::nat, mod_param::nbed, mod_netcdf::netcdf_sync(), mod_scalars::noerror, mod_param::nst, mod_param::nt, mod_scalars::ntstart, mod_ocean::ocean, mod_param::p2dvar, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::rho0, mod_iounits::rst, mod_sedbed::sedbed, mod_iounits::sourcefile, mod_iounits::stdout, mod_scalars::time, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, mod_ncparam::vname, and mod_param::w3dvar.

Referenced by wrt_rst().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_rst_pio()

subroutine, private wrt_rst_mod::wrt_rst_pio ( integer, intent(in) ng,
integer, intent(in) model,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj )
private

Definition at line 1237 of file wrt_rst.F.

1239!***********************************************************************
1240!
1241 USE mod_pio_netcdf
1242!
1243! Imported variable declarations.
1244!
1245 integer, intent(in) :: ng, model, tile
1246 integer, intent(in) :: LBi, UBi, LBj, UBj
1247!
1248! Local variable declarations.
1249!
1250 integer :: Fcount, i, itrc, status
1251# if defined PERFECT_RESTART || defined SOLVE3D
1252 integer :: ntmp(1)
1253# endif
1254!
1255 real(dp) :: scale
1256!
1257 character (len=*), parameter :: MyFile = &
1258 & __FILE__//", wrt_rst_pio"
1259!
1260 TYPE (IO_desc_t), pointer :: ioDesc
1261!
1262 sourcefile=myfile
1263!
1264!-----------------------------------------------------------------------
1265! Write out restart fields.
1266!-----------------------------------------------------------------------
1267!
1268 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1269!
1270! Set time record index.
1271!
1272 rst(ng)%Rindex=rst(ng)%Rindex+1
1273 fcount=rst(ng)%Fcount
1274 rst(ng)%Nrec(fcount)=rst(ng)%Nrec(fcount)+1
1275!
1276! Report.
1277!
1278# ifdef SOLVE3D
1279# ifdef NESTING
1280 IF (master) WRITE (stdout,10) kout, nout, rst(ng)%Rindex, ng
1281# else
1282 IF (master) WRITE (stdout,10) kout, nout, rst(ng)%Rindex
1283# endif
1284# else
1285# ifdef NESTING
1286 IF (master) WRITE (stdout,10) kout, rst(ng)%Rindex, ng
1287# else
1288 IF (master) WRITE (stdout,10) kout, rst(ng)%Rindex
1289# endif
1290# endif
1291!
1292! If requested, set time index to recycle time records in restart
1293! file.
1294!
1295 IF (lcyclerst(ng)) THEN
1296 rst(ng)%Rindex=mod(rst(ng)%Rindex-1,2)+1
1297 END IF
1298
1299# ifdef PERFECT_RESTART
1300!
1301! Write out time-stepping indices.
1302!
1303# ifdef SOLVE3D
1304 ntmp(1)=1+mod((iic(ng)-1)-ntstart(ng),2)
1305 CALL pio_netcdf_put_ivar (ng, model, rst(ng)%name, 'nstp', &
1306 & ntmp, (/rst(ng)%Rindex/), (/1/), &
1307 & piofile = rst(ng)%pioFile)
1308 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1309
1310 CALL pio_netcdf_put_ivar (ng, model, rst(ng)%name, 'nrhs', &
1311 & ntmp, (/rst(ng)%Rindex/), (/1/), &
1312 & piofile = rst(ng)%pioFile)
1313 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1314
1315 ntmp(1)=3-ntmp(1)
1316 CALL pio_netcdf_put_ivar (ng, model, rst(ng)%name, 'nnew', &
1317 & ntmp, (/rst(ng)%Rindex/), (/1/), &
1318 & piofile = rst(ng)%pioFile)
1319 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1320# endif
1321 CALL pio_netcdf_put_ivar (ng, model, rst(ng)%name, 'kstp', &
1322 & kstp(ng:), (/rst(ng)%Rindex/), (/1/), &
1323 & piofile = rst(ng)%pioFile)
1324 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1325
1326 CALL pio_netcdf_put_ivar (ng, model, rst(ng)%name, 'krhs', &
1327 & krhs(ng:), (/rst(ng)%Rindex/), (/1/), &
1328 & piofile = rst(ng)%pioFile)
1329 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1330
1331 CALL pio_netcdf_put_ivar (ng, model, rst(ng)%name, 'knew', &
1332 & knew(ng:), (/rst(ng)%Rindex/), (/1/), &
1333 & piofile = rst(ng)%pioFile)
1334 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1335# endif
1336!
1337! Write out model time (s).
1338!
1339 CALL pio_netcdf_put_fvar (ng, model, rst(ng)%name, &
1340 & trim(vname(1,idtime)), time(ng:), &
1341 & (/rst(ng)%Rindex/), (/1/), &
1342 & piofile = rst(ng)%pioFile, &
1343 & piovar = rst(ng)%pioVar(idtime)%vd)
1344 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1345
1346# if defined SEDIMENT && defined SED_MORPH
1347!
1348! Write out time-dependent bathymetry (m)
1349!
1350 IF (hout(idbath,ng)) THEN
1351 scale=1.0_dp
1352 IF (rst(ng)%pioVar(idbath)%dkind.eq.pio_double) THEN
1353 iodesc => iodesc_dp_r2dvar(ng)
1354 ELSE
1355 iodesc => iodesc_sp_r2dvar(ng)
1356 END IF
1357 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idbath, &
1358 & rst(ng)%pioVar(idbath), &
1359 & rst(ng)%Rindex, &
1360 & iodesc, &
1361 & lbi, ubi, lbj, ubj, scale, &
1362# ifdef MASKING
1363 & grid(ng) % rmask, &
1364# endif
1365 & grid(ng) % h, &
1366 & setfillval = .false.)
1367 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1368 IF (master) THEN
1369 WRITE (stdout,20) trim(vname(1,idbath)), rst(ng)%Rindex
1370 END IF
1371 exit_flag=3
1372 ioerror=status
1373 RETURN
1374 END IF
1375 END IF
1376# endif
1377# ifdef WET_DRY
1378!
1379! Write out wet/dry mask at PSI-points.
1380!
1381 scale=1.0_dp
1382 IF (rst(ng)%pioVar(idpwet)%dkind.eq.pio_double) THEN
1383 iodesc => iodesc_dp_p2dvar(ng)
1384 ELSE
1385 iodesc => iodesc_sp_p2dvar(ng)
1386 END IF
1387 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idpwet, &
1388 & rst(ng)%pioVar(idpwet), &
1389 & rst(ng)%Rindex, &
1390 & iodesc(ng), &
1391 & lbi, ubi, lbj, ubj, scale, &
1392# ifdef MASKING
1393 & grid(ng) % pmask, &
1394# endif
1395 & grid(ng) % pmask_wet, &
1396 & setfillval = .false.)
1397 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1398 IF (master) THEN
1399 WRITE (stdout,20) trim(vname(1,idpwet)), rst(ng)%Rindex
1400 END IF
1401 exit_flag=3
1402 ioerror=status
1403 RETURN
1404 END IF
1405!
1406! Write out wet/dry mask at RHO-points.
1407!
1408 scale=1.0_dp
1409 IF (rst(ng)%pioVar(idrwet)%dkind.eq.pio_double) THEN
1410 iodesc => iodesc_dp_r2dvar(ng)
1411 ELSE
1412 iodesc => iodesc_sp_r2dvar(ng)
1413 END IF
1414 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idrwet, &
1415 & rst(ng)%pioVar(idrwet), &
1416 & rst(ng)%Rindex, &
1417 & iodesc, &
1418 & lbi, ubi, lbj, ubj, scale, &
1419# ifdef MASKING
1420 & grid(ng) % rmask, &
1421# endif
1422 & grid(ng) % rmask_wet, &
1423 & setfillval = .false.)
1424 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1425 IF (master) THEN
1426 WRITE (stdout,20) trim(vname(1,idrwet)), rst(ng)%Rindex
1427 END IF
1428 exit_flag=3
1429 ioerror=status
1430 RETURN
1431 END IF
1432!
1433! Write out wet/dry mask at U-points.
1434!
1435 scale=1.0_dp
1436 IF (rst(ng)%pioVar(iduwet)%dkind.eq.pio_double) THEN
1437 iodesc => iodesc_dp_u2dvar(ng)
1438 ELSE
1439 iodesc => iodesc_sp_u2dvar(ng)
1440 END IF
1441 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, iduwet, &
1442 & rst(ng)%pioVar(iduwet), &
1443 & rst(ng)%Rindex, &
1444 & iodesc, &
1445 & lbi, ubi, lbj, ubj, scale, &
1446# ifdef MASKING
1447 & grid(ng) % umask, &
1448# endif
1449 & grid(ng) % umask_wet, &
1450 & setfillval = .false.)
1451 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1452 IF (master) THEN
1453 WRITE (stdout,20) trim(vname(1,iduwet)), rst(ng)%Rindex
1454 END IF
1455 exit_flag=3
1456 ioerror=status
1457 RETURN
1458 END IF
1459!
1460! Write out wet/dry mask at V-points.
1461!
1462 scale=1.0_dp
1463 IF (rst(ng)%pioVar(idvwet)%dkind.eq.pio_double) THEN
1464 iodesc => iodesc_dp_v2dvar(ng)
1465 ELSE
1466 iodesc => iodesc_sp_v2dvar(ng)
1467 END IF
1468 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idvwet, &
1469 & rst(ng)%pioVar(idvwet), &
1470 & rst(ng)%Rindex, &
1471 & iodesc, &
1472 & lbi, ubi, lbj, ubj, scale, &
1473# ifdef MASKING
1474 & grid(ng) % vmask, &
1475# endif
1476 & grid(ng) % vmask_wet, &
1477 & setfillval = .false.)
1478 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1479 IF (master) THEN
1480 WRITE (stdout,20) trim(vname(1,idvwet)), rst(ng)%Rindex
1481 END IF
1482 exit_flag=3
1483 ioerror=status
1484 RETURN
1485 END IF
1486# endif
1487!
1488! Write out free-surface (m).
1489!
1490 scale=1.0_dp
1491# ifdef PERFECT_RESTART
1492 IF (rst(ng)%pioVar(idfsur)%dkind.eq.pio_double) THEN
1493 iodesc => iodesc_dp_zeta(ng)
1494 ELSE
1495 iodesc => iodesc_sp_zeta(ng)
1496 END IF
1497 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idfsur, &
1498 & rst(ng)%pioVar(idfsur), &
1499 & rst(ng)%Rindex, &
1500 & iodesc, &
1501 & lbi, ubi, lbj, ubj, 1, 3, scale, &
1502# ifdef MASKING
1503 & grid(ng) % rmask, &
1504# endif
1505# ifdef WET_DRY
1506 & ocean(ng) % zeta, &
1507 & setfillval = .false.)
1508# else
1509 & ocean(ng) % zeta)
1510# endif
1511# else
1512 IF (rst(ng)%pioVar(idfsur)%dkind.eq.pio_double) THEN
1513 iodesc => iodesc_dp_r2dvar(ng)
1514 ELSE
1515 iodesc => iodesc_sp_r2dvar(ng)
1516 END IF
1517 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idfsur, &
1518 & rst(ng)%pioVar(idfsur), &
1519 & rst(ng)%Rindex, &
1520 & iodesc, &
1521 & lbi, ubi, lbj, ubj, scale, &
1522# ifdef MASKING
1523 & grid(ng) % rmask, &
1524# endif
1525# ifdef WET_DRY
1526 & ocean(ng) % zeta(:,:,kout), &
1527 & setfillval = .false.)
1528# else
1529 & ocean(ng) % zeta(:,:,kout))
1530# endif
1531# endif
1532 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1533 IF (master) THEN
1534 WRITE (stdout,20) trim(vname(1,idfsur)), rst(ng)%Rindex
1535 END IF
1536 exit_flag=3
1537 ioerror=status
1538 RETURN
1539 END IF
1540
1541# ifdef PERFECT_RESTART
1542!
1543! Write out RHS of free-surface equation.
1544!
1545 scale=1.0_dp
1546 IF (rst(ng)%pioVar(idrzet)%dkind.eq.pio_double) THEN
1547 iodesc => iodesc_dp_rzeta(ng)
1548 ELSE
1549 iodesc => iodesc_sp_rzeta(ng)
1550 END IF
1551 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idrzet, &
1552 & rst(ng)%pioVar(idrzet), &
1553 & rst(ng)%Rindex, &
1554 & iodesc, &
1555 & lbi, ubi, lbj, ubj, 1, 2, scale, &
1556# ifdef MASKING
1557 & grid(ng) % rmask, &
1558# endif
1559 & ocean(ng) % rzeta)
1560 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1561 IF (master) THEN
1562 WRITE (stdout,20) trim(vname(1,idrzet)), rst(ng)%Rindex
1563 END IF
1564 exit_flag=3
1565 ioerror=status
1566 RETURN
1567 END IF
1568# endif
1569!
1570! Write out 2D momentum component (m/s) in the XI-direction.
1571!
1572 scale=1.0_dp
1573# ifdef PERFECT_RESTART
1574 IF (rst(ng)%pioVar(idubar)%dkind.eq.pio_double) THEN
1575 iodesc => iodesc_dp_ubar(ng)
1576 ELSE
1577 iodesc => iodesc_sp_ubar(ng)
1578 END IF
1579 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idubar, &
1580 & rst(ng)%pioVar(idubar), &
1581 & rst(ng)%Rindex, &
1582 & iodesc, &
1583 & lbi, ubi, lbj, ubj, 1, 3, scale, &
1584# ifdef MASKING
1585 & grid(ng) % umask, &
1586# endif
1587 & ocean(ng) % ubar, &
1588 & setfillval = .false.)
1589
1590# else
1591 IF (rst(ng)%pioVar(idubar)%dkind.eq.pio_double) THEN
1592 iodesc => iodesc_dp_u2dvar(ng)
1593 ELSE
1594 iodesc => iodesc_sp_u2dvar(ng)
1595 END IF
1596 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idubar, &
1597 & rst(ng)%pioVar(idubar), &
1598 & rst(ng)%Rindex, &
1599 & iodesc, &
1600 & lbi, ubi, lbj, ubj, scale, &
1601# ifdef MASKING
1602 & grid(ng) % umask_full, &
1603# endif
1604 & ocean(ng) % ubar(:,:,kout))
1605# endif
1606 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1607 IF (master) THEN
1608 WRITE (stdout,20) trim(vname(1,idubar)), rst(ng)%Rindex
1609 END IF
1610 exit_flag=3
1611 ioerror=status
1612 RETURN
1613 END IF
1614
1615# ifdef PERFECT_RESTART
1616!
1617! Write out RHS of 2D momentum equation in the XI-direction.
1618!
1619 scale=1.0_dp
1620 IF (rst(ng)%pioVar(idru2d)%dkind.eq.pio_double) THEN
1621 iodesc => iodesc_dp_rubar(ng)
1622 ELSE
1623 iodesc => iodesc_sp_rubar(ng)
1624 END IF
1625 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idru2d, &
1626 & rst(ng)%pioVar(idru2d), &
1627 & rst(ng)%Rindex, &
1628 & iodesc, &
1629 & lbi, ubi, lbj, ubj, 1, 2, scale, &
1630# ifdef MASKING
1631 & grid(ng) % umask, &
1632# endif
1633 & ocean(ng) % rubar, &
1634 & setfillval = .false.)
1635 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1636 IF (master) THEN
1637 WRITE (stdout,20) trim(vname(1,idru2d)), rst(ng)%Rindex
1638 END IF
1639 exit_flag=3
1640 ioerror=status
1641 RETURN
1642 END IF
1643# endif
1644!
1645! Write out 2D momentum component (m/s) in the ETA-direction.
1646!
1647 scale=1.0_dp
1648# ifdef PERFECT_RESTART
1649 IF (rst(ng)%pioVar(idvbar)%dkind.eq.pio_double) THEN
1650 iodesc => iodesc_dp_vbar(ng)
1651 ELSE
1652 iodesc => iodesc_sp_vbar(ng)
1653 END IF
1654 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idvbar, &
1655 & rst(ng)%pioVar(idvbar), &
1656 & rst(ng)%Rindex, &
1657 & iodesc, &
1658 & lbi, ubi, lbj, ubj, 1, 3, scale, &
1659# ifdef MASKING
1660 & grid(ng) % vmask, &
1661# endif
1662 & ocean(ng) % vbar, &
1663 & setfillval = .false.)
1664# else
1665 IF (rst(ng)%pioVar(idvbar)%dkind.eq.pio_double) THEN
1666 iodesc => iodesc_dp_v2dvar(ng)
1667 ELSE
1668 iodesc => iodesc_sp_v2dvar(ng)
1669 END IF
1670 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idvbar, &
1671 & rst(ng)%pioVar(idvbar), &
1672 & rst(ng)%Rindex, &
1673 & iodesc, &
1674 & lbi, ubi, lbj, ubj, scale, &
1675# ifdef MASKING
1676 & grid(ng) % vmask_full, &
1677# endif
1678 & ocean(ng) % vbar(:,:,kout))
1679# endif
1680 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1681 IF (master) THEN
1682 WRITE (stdout,20) trim(vname(1,idvbar)), rst(ng)%Rindex
1683 END IF
1684 exit_flag=3
1685 ioerror=status
1686 RETURN
1687 END IF
1688
1689# ifdef PERFECT_RESTART
1690!
1691! Write out RHS of 2D momentum equation in the ETA-direction.
1692!
1693 scale=1.0_dp
1694 IF (rst(ng)%pioVar(idrv2d)%dkind.eq.pio_double) THEN
1695 iodesc => iodesc_dp_rvbar(ng)
1696 ELSE
1697 iodesc => iodesc_sp_rvbar(ng)
1698 END IF
1699 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idrv2d, &
1700 & rst(ng)%pioVar(idrv2d), &
1701 & rst(ng)%Rindex, &
1702 & iodesc, &
1703 & lbi, ubi, lbj, ubj, 1, 2, scale, &
1704# ifdef MASKING
1705 & grid(ng) % vmask, &
1706# endif
1707 & ocean(ng) % rvbar, &
1708 & setfillval = .false.)
1709 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1710 IF (master) THEN
1711 WRITE (stdout,20) trim(vname(1,idrv2d)), rst(ng)%Rindex
1712 END IF
1713 exit_flag=3
1714 ioerror=status
1715 RETURN
1716 END IF
1717# endif
1718# ifdef SOLVE3D
1719!
1720! Write out 3D momentum component (m/s) in the XI-direction.
1721!
1722 scale=1.0_dp
1723# ifdef PERFECT_RESTART
1724 IF (rst(ng)%pioVar(iduvel)%dkind.eq.pio_double) THEN
1725 iodesc => iodesc_dp_uvel(ng)
1726 ELSE
1727 iodesc => iodesc_sp_uvel(ng)
1728 END IF
1729 status=nf_fwrite4d(ng, model, rst(ng)%pioFile, iduvel, &
1730 & rst(ng)%pioVar(iduvel), &
1731 & rst(ng)%Rindex, &
1732 & iodesc, &
1733 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, scale, &
1734# ifdef MASKING
1735 & grid(ng) % umask, &
1736# endif
1737 & ocean(ng) % u, &
1738 & setfillval = .false.)
1739# else
1740 IF (rst(ng)%pioVar(iduvel)%dkind.eq.pio_double) THEN
1741 iodesc => iodesc_dp_u3dvar(ng)
1742 ELSE
1743 iodesc => iodesc_sp_u3dvar(ng)
1744 END IF
1745 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, iduvel, &
1746 & rst(ng)%pioVar(iduvel), &
1747 & rst(ng)%Rindex, &
1748 & iodesc, &
1749 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1750# ifdef MASKING
1751 & grid(ng) % umask_full, &
1752# endif
1753 & ocean(ng) % u(:,:,:,nout))
1754# endif
1755 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1756 IF (master) THEN
1757 WRITE (stdout,20) trim(vname(1,iduvel)), rst(ng)%Rindex
1758 END IF
1759 exit_flag=3
1760 ioerror=status
1761 RETURN
1762 END IF
1763
1764# ifdef PERFECT_RESTART
1765!
1766! Write out RHS of 3D momentum equation in the XI-direction.
1767!
1768 scale=1.0_dp
1769 IF (rst(ng)%pioVar(idru3d)%dkind.eq.pio_double) THEN
1770 iodesc => iodesc_dp_ruvel(ng)
1771 ELSE
1772 iodesc => iodesc_sp_ruvel(ng)
1773 END IF
1774 status=nf_fwrite4d(ng, model, rst(ng)%pioFile, idru3d, &
1775 & rst(ng)%pioVar(idru3d), &
1776 & rst(ng)%Rindex, &
1777 & iodesc, &
1778 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, scale, &
1779# ifdef MASKING
1780 & grid(ng) % umask, &
1781# endif
1782 & ocean(ng) % ru, &
1783 & setfillval = .false.)
1784 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1785 IF (master) THEN
1786 WRITE (stdout,20) trim(vname(1,idru3d)), rst(ng)%Rindex
1787 END IF
1788 exit_flag=3
1789 ioerror=status
1790 RETURN
1791 END IF
1792# endif
1793!
1794! Write out momentum component (m/s) in the ETA-direction.
1795!
1796 scale=1.0_dp
1797# ifdef PERFECT_RESTART
1798 IF (rst(ng)%pioVar(idvvel)%dkind.eq.pio_double) THEN
1799 iodesc => iodesc_dp_vvel(ng)
1800 ELSE
1801 iodesc => iodesc_sp_vvel(ng)
1802 END IF
1803 status=nf_fwrite4d(ng, model, rst(ng)%pioFile, idvvel, &
1804 & rst(ng)%pioVar(idvvel), &
1805 & rst(ng)%Rindex, &
1806 & iodesc, &
1807 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, scale, &
1808# ifdef MASKING
1809 & grid(ng) % vmask, &
1810# endif
1811 & ocean(ng) % v, &
1812 & setfillval = .false.)
1813# else
1814 IF (rst(ng)%pioVar(idvvel)%dkind.eq.pio_double) THEN
1815 iodesc => iodesc_dp_v3dvar(ng)
1816 ELSE
1817 iodesc => iodesc_sp_v3dvar(ng)
1818 END IF
1819 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idvvel, &
1820 & rst(ng)%pioVar(idvvel), &
1821 & rst(ng)%Rindex, &
1822 & iodesc, &
1823 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1824# ifdef MASKING
1825 & grid(ng) % vmask_full, &
1826# endif
1827 & ocean(ng) % v(:,:,:,nout))
1828# endif
1829 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1830 IF (master) THEN
1831 WRITE (stdout,20) trim(vname(1,idvvel)), rst(ng)%Rindex
1832 END IF
1833 exit_flag=3
1834 ioerror=status
1835 RETURN
1836 END IF
1837
1838# ifdef PERFECT_RESTART
1839!
1840! Write out RHS of 3D momentum equation in the ETA-direction.
1841!
1842 scale=1.0_dp
1843 IF (rst(ng)%pioVar(idrv3d)%dkind.eq.pio_double) THEN
1844 iodesc => iodesc_dp_rvvel(ng)
1845 ELSE
1846 iodesc => iodesc_sp_rvvel(ng)
1847 END IF
1848 status=nf_fwrite4d(ng, model, rst(ng)%pioFile, idrv3d, &
1849 & rst(ng)%pioVar(idrv3d), &
1850 & rst(ng)%Rindex, &
1851 & iodesc, &
1852 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, scale, &
1853# ifdef MASKING
1854 & grid(ng) % vmask, &
1855# endif
1856 & ocean(ng) % rv, &
1857 & setfillval = .false.)
1858 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1859 IF (master) THEN
1860 WRITE (stdout,20) trim(vname(1,idrv3d)), rst(ng)%Rindex
1861 END IF
1862 exit_flag=3
1863 ioerror=status
1864 RETURN
1865 END IF
1866# endif
1867!
1868! Write out tracer type variables.
1869!
1870 DO itrc=1,nt(ng)
1871 scale=1.0_dp
1872# ifdef PERFECT_RESTART
1873 IF (rst(ng)%pioTrc(itrc)%dkind.eq.pio_double) THEN
1874 iodesc => iodesc_dp_trcvar(ng)
1875 ELSE
1876 iodesc => iodesc_sp_trcvar(ng)
1877 END IF
1878 status=nf_fwrite4d(ng, model, rst(ng)%pioFile, idtvar(itrc), &
1879 & rst(ng)%pioTrc(itrc), &
1880 & rst(ng)%Rindex, &
1881 & iodesc, &
1882 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, scale, &
1883# ifdef MASKING
1884 & grid(ng) % rmask, &
1885# endif
1886 & ocean(ng) % t(:,:,:,:,itrc))
1887# else
1888 IF (rst(ng)%pioTrc(itrc)%dkind.eq.pio_double) THEN
1889 iodesc => iodesc_dp_r3dvar(ng)
1890 ELSE
1891 iodesc => iodesc_sp_r3dvar(ng)
1892 END IF
1893 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idtvar(itrc), &
1894 & rst(ng)%pioTrc(itrc), &
1895 & rst(ng)%Rindex, &
1896 & iodesc, &
1897 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1898# ifdef MASKING
1899 & grid(ng) % rmask, &
1900# endif
1901 & ocean(ng) % t(:,:,:,nout,itrc))
1902# endif
1903 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1904 IF (master) THEN
1905 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), rst(ng)%Rindex
1906 END IF
1907 exit_flag=3
1908 ioerror=status
1909 RETURN
1910 END IF
1911 END DO
1912!
1913! Write out density anomaly.
1914!
1915 scale=1.0_dp
1916 IF (rst(ng)%pioVar(iddano)%dkind.eq.pio_double) THEN
1917 iodesc => iodesc_dp_r3dvar(ng)
1918 ELSE
1919 iodesc => iodesc_sp_r3dvar(ng)
1920 END IF
1921 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, iddano, &
1922 & rst(ng)%pioVar(iddano), &
1923 & rst(ng)%Rindex, &
1924 & iodesc, &
1925 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1926# ifdef MASKING
1927 & grid(ng) % rmask, &
1928# endif
1929 & ocean(ng) % rho)
1930 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1931 IF (master) THEN
1932 WRITE (stdout,20) trim(vname(1,iddano)), rst(ng)%Rindex
1933 END IF
1934 exit_flag=3
1935 ioerror=status
1936 RETURN
1937 END IF
1938
1939# ifdef LMD_SKPP
1940!
1941! Write out depth of surface boundary layer.
1942!
1943 scale=1.0_dp
1944 IF (rst(ng)%pioVar(idhsbl)%dkind.eq.pio_double) THEN
1945 iodesc => iodesc_dp_r2dvar(ng)
1946 ELSE
1947 iodesc => iodesc_sp_r2dvar(ng)
1948 END IF
1949 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idhsbl, &
1950 & rst(ng)%pioVar(idhsbl), &
1951 & rst(ng)%Rindex, &
1952 & iodesc, &
1953 & lbi, ubi, lbj, ubj, scale, &
1954# ifdef MASKING
1955 & grid(ng) % rmask, &
1956# endif
1957 & mixing(ng) % hsbl)
1958 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1959 IF (master) THEN
1960 WRITE (stdout,20) trim(vname(1,idhsbl)), rst(ng)%Rindex
1961 END IF
1962 exit_flag=3
1963 ioerror=status
1964 RETURN
1965 END IF
1966# endif
1967# ifdef LMD_BKPP
1968!
1969! Write out depth of bottom boundary layer.
1970!
1971 scale=1.0_dp
1972 IF (rst(ng)%pioVar(idhbbl)%dkind.eq.pio_double) THEN
1973 iodesc => iodesc_dp_r2dvar(ng)
1974 ELSE
1975 iodesc => iodesc_sp_r2dvar(ng)
1976 END IF
1977 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idhbbl, &
1978 & rst(ng)%pioVar(idhbbl), &
1979 & rst(ng)%Rindex, &
1980 & iodesc, &
1981 & lbi, ubi, lbj, ubj, scale, &
1982# ifdef MASKING
1983 & grid(ng) % rmask, &
1984# endif
1985 & mixing(ng) % hbbl)
1986 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1987 IF (master) THEN
1988 WRITE (stdout,20) trim(vname(1,idhbbl)), rst(ng)%Rindex
1989 END IF
1990 exit_flag=3
1991 ioerror=status
1992 RETURN
1993 END IF
1994# endif
1995# if defined PERFECT_RESTART && defined LMD_NONLOCAL
1996!
1997! Write out KPP nonlocal transport.
1998!
1999 DO i=1,nat
2000 scale=1.0_dp
2001 IF (rst(ng)%pioVar(idghat(i))%dkind.eq.pio_double) THEN
2002 iodesc => iodesc_dp_w3dvar(ng)
2003 ELSE
2004 iodesc => iodesc_sp_w3dvar(ng)
2005 END IF
2006 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idghat(i), &
2007 & rst(ng)%pioVar(idghat(i)), &
2008 & rst(ng)%Rindex, &
2009 & iodesc, &
2010 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2011# ifdef MASKING
2012 & grid(ng) % rmask, &
2013# endif
2014 & mixing(ng) % ghats(:,:,:,i))
2015 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2016 IF (master) THEN
2017 WRITE (stdout,20) trim(vname(1,idghat(i))), rst(ng)%Rindex
2018 END IF
2019 exit_flag=3
2020 ioerror=status
2021 RETURN
2022 END IF
2023 END DO
2024# endif
2025# if defined BVF_MIXING || defined GLS_MIXING || \
2026 defined my25_mixing || defined lmd_mixing
2027!
2028! Write out vertical viscosity coefficient.
2029!
2030 scale=1.0_dp
2031 IF (rst(ng)%pioVar(idvvis)%dkind.eq.pio_double) THEN
2032 iodesc => iodesc_dp_w3dvar(ng)
2033 ELSE
2034 iodesc => iodesc_sp_w3dvar(ng)
2035 END IF
2036 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idvvis, &
2037 & rst(ng)%pioVar(idvvis), &
2038 & rst(ng)%Rindex, &
2039 & iodesc, &
2040 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2041# ifdef MASKING
2042 & grid(ng) % rmask, &
2043# endif
2044 & mixing(ng) % Akv, &
2045 & setfillval = .false.)
2046 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2047 IF (master) THEN
2048 WRITE (stdout,20) trim(vname(1,idvvis)), rst(ng)%Rindex
2049 END IF
2050 exit_flag=3
2051 ioerror=status
2052 RETURN
2053 END IF
2054!
2055! Write out vertical diffusion coefficient for potential temperature.
2056!
2057 scale=1.0_dp
2058 IF (rst(ng)%pioVar(idtdif)%dkind.eq.pio_double) THEN
2059 iodesc => iodesc_dp_w3dvar(ng)
2060 ELSE
2061 iodesc => iodesc_sp_w3dvar(ng)
2062 END IF
2063 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idtdif, &
2064 & rst(ng)%pioVar(idtdif), &
2065 & rst(ng)%Rindex, &
2066 & iodesc, &
2067 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2068# ifdef MASKING
2069 & grid(ng) % rmask, &
2070# endif
2071 & mixing(ng) % Akt(:,:,:,itemp), &
2072 & setfillval = .false.)
2073
2074 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2075 IF (master) THEN
2076 WRITE (stdout,20) trim(vname(1,idtdif)), rst(ng)%Rindex
2077 END IF
2078 exit_flag=3
2079 ioerror=status
2080 RETURN
2081 END IF
2082
2083# ifdef SALINITY
2084!
2085! Write out vertical diffusion coefficient for salinity.
2086!
2087 scale=1.0_dp
2088 IF (rst(ng)%pioVar(idsdif)%dkind.eq.pio_double) THEN
2089 iodesc => iodesc_dp_w3dvar(ng)
2090 ELSE
2091 iodesc => iodesc_sp_w3dvar(ng)
2092 END IF
2093 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idsdif, &
2094 & rst(ng)%pioVar(idsdif), &
2095 & rst(ng)%Rindex, &
2096 & iodesc, &
2097 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2098# ifdef MASKING
2099 & grid(ng) % rmask, &
2100# endif
2101 & mixing(ng) % Akt(:,:,:,isalt), &
2102 & setfillval = .false.)
2103 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2104 IF (master) THEN
2105 WRITE (stdout,20) trim(vname(1,idsdif)), rst(ng)%Rindex
2106 END IF
2107 exit_flag=3
2108 ioerror=status
2109 RETURN
2110 END IF
2111# endif
2112# endif
2113# if defined PERFECT_RESTART && \
2114 (defined gls_mixing || defined my25_mixing)
2115!
2116! Write out turbulent kinetic energy.
2117!
2118 scale=1.0_dp
2119 IF (rst(ng)%pioVar(idmtke)%dkind.eq.pio_double) THEN
2120 iodesc => iodesc_dp_tkevar(ng)
2121 ELSE
2122 iodesc => iodesc_sp_tkevar(ng)
2123 END IF
2124 status=nf_fwrite4d(ng, model, rst(ng)%pioFile, idmtke, &
2125 & rst(ng)%pioVar(idmtke), &
2126 & rst(ng)%Rindex, &
2127 & iodesc, &
2128 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, scale, &
2129# ifdef MASKING
2130 & grid(ng) % rmask, &
2131# endif
2132 & mixing(ng) % tke, &
2133 & setfillval = .false.)
2134 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2135 IF (master) THEN
2136 WRITE (stdout,20) trim(vname(1,idmtke)), rst(ng)%Rindex
2137 END IF
2138 exit_flag=3
2139 ioerror=status
2140 RETURN
2141 END IF
2142!
2143! Define turbulent kinetic energy time length scale.
2144!
2145 scale=1.0_dp
2146 IF (rst(ng)%pioVar(idmtls)%dkind.eq.pio_double) THEN
2147 iodesc => iodesc_dp_tkevar(ng)
2148 ELSE
2149 iodesc => iodesc_sp_tkevar(ng)
2150 END IF
2151 status=nf_fwrite4d(ng, model, rst(ng)%pioFile, idmtls, &
2152 & rst(ng)%pioVar(idmtls), &
2153 & rst(ng)%Rindex, &
2154 & iodesc, &
2155 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, scale, &
2156# ifdef MASKING
2157 & grid(ng) % rmask, &
2158# endif
2159 & mixing(ng) % gls, &
2160 & setfillval = .false.)
2161 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2162 IF (master) THEN
2163 WRITE (stdout,20) trim(vname(1,idmtls)), rst(ng)%Rindex
2164 END IF
2165 exit_flag=3
2166 ioerror=status
2167 RETURN
2168 END IF
2169!
2170! Define vertical mixing turbulent length scale.
2171!
2172 scale=1.0_dp
2173 IF (rst(ng)%pioVar(idvmls)%dkind.eq.pio_double) THEN
2174 iodesc => iodesc_dp_w3dvar(ng)
2175 ELSE
2176 iodesc => iodesc_sp_w3dvar(ng)
2177 END IF
2178 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idvmls, &
2179 & rst(ng)%pioVar(idvmls), &
2180 & rst(ng)%Rindex, &
2181 & iodesc, &
2182 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2183# ifdef MASKING
2184 & grid(ng) % rmask, &
2185# endif
2186 & mixing(ng) % Lscale)
2187 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2188 IF (master) THEN
2189 WRITE (stdout,20) trim(vname(1,idvmls)), rst(ng)%Rindex
2190 END IF
2191 exit_flag=3
2192 ioerror=status
2193 RETURN
2194 END IF
2195!
2196! Define turbulent kinetic energy vertical diffusion coefficient.
2197!
2198 scale=1.0_dp
2199 IF (rst(ng)%pioVar(idvmkk)%dkind.eq.pio_double) THEN
2200 iodesc => iodesc_dp_w3dvar(ng)
2201 ELSE
2202 iodesc => iodesc_sp_w3dvar(ng)
2203 END IF
2204 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idvmkk, &
2205 & rst(ng)%pioVar(idvmkk), &
2206 & rst(ng)%Rindex, &
2207 & iodesc, &
2208 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2209# ifdef MASKING
2210 & grid(ng) % rmask, &
2211# endif
2212 & mixing(ng) % Akk)
2213 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2214 IF (master) THEN
2215 WRITE (stdout,20) trim(vname(1,idvmkk)), rst(ng)%Rindex
2216 END IF
2217 exit_flag=3
2218 ioerror=status
2219 RETURN
2220 END IF
2221
2222# ifdef GLS_MIXING
2223!
2224! Define turbulent length scale vertical diffusion coefficient.
2225!
2226 scale=1.0_dp
2227 IF (rst(ng)%pioVar(idvmkp)%dkind.eq.pio_double) THEN
2228 iodesc => iodesc_dp_w3dvar(ng)
2229 ELSE
2230 iodesc => iodesc_sp_w3dvar(ng)
2231 END IF
2232 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idvmkp, &
2233 & rst(ng)%pioVar(idvmkp), &
2234 & rst(ng)%Rindex, &
2235 & iodesc, &
2236 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2237# ifdef MASKING
2238 & grid(ng) % rmask, &
2239# endif
2240 & mixing(ng) % Akp)
2241 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2242 IF (master) THEN
2243 WRITE (stdout,20) trim(vname(1,idvmkp)), rst(ng)%Rindex
2244 END IF
2245 exit_flag=3
2246 ioerror=status
2247 RETURN
2248 END IF
2249# endif
2250# endif
2251# ifdef SEDIMENT
2252# ifdef BEDLOAD
2253!
2254! Write out bed load transport in U-direction.
2255!
2256 DO i=1,nst
2257 scale=1.0_dp
2258 IF (rst(ng)%pioVar(idubld(i))%dkind.eq.pio_double) THEN
2259 iodesc => iodesc_dp_u2dvar(ng)
2260 ELSE
2261 iodesc => iodesc_sp_u2dvar(ng)
2262 END IF
2263 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idubld(i), &
2264 & rst(ng)%pioVar(idubld(i)), &
2265 & rst(ng)%Rindex, &
2266 & iodesc, &
2267 & lbi, ubi, lbj, ubj, scale, &
2268# ifdef MASKING
2269 & grid(ng) % umask, &
2270# endif
2271 & sedbed(ng) % bedldu(:,:,i))
2272 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2273 IF (master) THEN
2274 WRITE (stdout,20) trim(vname(1,idubld(i))), rst(ng)%Rindex
2275 END IF
2276 exit_flag=3
2277 ioerror=status
2278 RETURN
2279 END IF
2280 END DO
2281!
2282! Write out bed load transport in V-direction.
2283!
2284 DO i=1,nst
2285 scale=1.0_dp
2286 IF (rst(ng)%pioVar(idvbld(i))%dkind.eq.pio_double) THEN
2287 iodesc => iodesc_dp_v2dvar(ng)
2288 ELSE
2289 iodesc => iodesc_sp_v2dvar(ng)
2290 END IF
2291 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idvbld(i), &
2292 & rst(ng)%pioVar(idvbld(i)), &
2293 & rst(ng)%Rindex, &
2294 & iodesc, &
2295 & lbi, ubi, lbj, ubj, scale, &
2296# ifdef MASKING
2297 & grid(ng) % vmask, &
2298# endif
2299 & sedbed(ng) % bedldv(:,:,i))
2300 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2301 IF (master) THEN
2302 WRITE (stdout,20) trim(vname(1,idvbld(i))), rst(ng)%Rindex
2303 END IF
2304 exit_flag=3
2305 ioerror=status
2306 RETURN
2307 END IF
2308 END DO
2309# endif
2310!
2311! Write out sediment fraction of each size class in each bed layer.
2312!
2313 DO i=1,nst
2314 scale=1.0_dp
2315 IF (rst(ng)%pioVar(idfrac(i))%dkind.eq.pio_double) THEN
2316 iodesc => iodesc_dp_b3dvar(ng)
2317 ELSE
2318 iodesc => iodesc_sp_b3dvar(ng)
2319 END IF
2320 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idfrac(i), &
2321 & rst(ng)%pioVar(idfrac(i)), &
2322 & rst(ng)%Rindex, &
2323 & iodesc, &
2324 & lbi, ubi, lbj, ubj, 1, nbed, scale, &
2325# ifdef MASKING
2326 & grid(ng) % rmask, &
2327# endif
2328 & sedbed(ng) % bed_frac(:,:,:,i), &
2329 & setfillval = .false.)
2330 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2331 IF (master) THEN
2332 WRITE (stdout,20) trim(vname(1,idfrac(i))), rst(ng)%Rindex
2333 END IF
2334 exit_flag=3
2335 ioerror=status
2336 RETURN
2337 END IF
2338 END DO
2339!
2340! Write out sediment mass of each size class in each bed layer.
2341!
2342 DO i=1,nst
2343 scale=1.0_dp
2344 IF (rst(ng)%pioVar(idbmas(i))%dkind.eq.pio_double) THEN
2345 iodesc => iodesc_dp_b3dvar(ng)
2346 ELSE
2347 iodesc => iodesc_sp_b3dvar(ng)
2348 END IF
2349 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idbmas(i), &
2350 & rst(ng)%pioVar(idbmas(i)), &
2351 & rst(ng)%Rindex, &
2352 & iodesc, &
2353 & lbi, ubi, lbj, ubj, 1, nbed, scale, &
2354# ifdef MASKING
2355 & grid(ng) % rmask, &
2356# endif
2357 & sedbed(ng) % bed_mass(:,:,:,nout,i), &
2358 & setfillval = .false.)
2359 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2360 IF (master) THEN
2361 WRITE (stdout,20) trim(vname(1,idbmas(i))), rst(ng)%Rindex
2362 END IF
2363 exit_flag=3
2364 ioerror=status
2365 RETURN
2366 END IF
2367 END DO
2368!
2369! Write out sediment properties in each bed layer.
2370!
2371 DO i=1,mbedp
2372 IF (i.eq.itauc) THEN
2373 scale=rho0
2374 ELSE
2375 scale=1.0_dp
2376 END IF
2377 IF (rst(ng)%pioVar(idsbed(i))%dkind.eq.pio_double) THEN
2378 iodesc => iodesc_dp_b3dvar(ng)
2379 ELSE
2380 iodesc => iodesc_sp_b3dvar(ng)
2381 END IF
2382 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idsbed(i), &
2383 & rst(ng)%pioVar(idsbed(i)), &
2384 & rst(ng)%Rindex, &
2385 & iodesc, &
2386 & lbi, ubi, lbj, ubj, 1, nbed, scale, &
2387# ifdef MASKING
2388 & grid(ng) % rmask, &
2389# endif
2390 & sedbed(ng) % bed(:,:,:,i), &
2391 & setfillval = .false.)
2392 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2393 IF (master) THEN
2394 WRITE (stdout,20) trim(vname(1,idsbed(i))), rst(ng)%Rindex
2395 END IF
2396 exit_flag=3
2397 ioerror=status
2398 RETURN
2399 END IF
2400 END DO
2401# endif
2402# if defined SEDIMENT || defined BBL_MODEL
2403!
2404! Write out exposed sediment layer properties. Notice that only the
2405! first six properties (mean grain diameter, mean grain density,
2406! mean settling velocity, mean critical erosion stress,
2407! ripple length and ripple height) are written.
2408!
2409 DO i=1,6
2410 scale=1.0_dp
2411 IF (rst(ng)%pioVar(idbott(i))%dkind.eq.pio_double) THEN
2412 iodesc => iodesc_dp_r2dvar(ng)
2413 ELSE
2414 iodesc => iodesc_sp_r2dvar(ng)
2415 END IF
2416 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idbott(i), &
2417 & rst(ng)%pioVar(idbott(i)), &
2418 & rst(ng)%Rindex, &
2419 & iodesc, &
2420 & lbi, ubi, lbj, ubj, scale, &
2421# ifdef MASKING
2422 & grid(ng) % rmask, &
2423# endif
2424 & sedbed(ng) % bottom(:,:,i))
2425 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2426 IF (master) THEN
2427 WRITE (stdout,20) trim(vname(1,idbott(i))), rst(ng)%Rindex
2428 END IF
2429 exit_flag=3
2430 ioerror=status
2431 RETURN
2432 END IF
2433 END DO
2434# endif
2435# endif
2436# ifdef WEC
2437!
2438! Write out 2D Stokes U-velocity.
2439!
2440 scale=1.0_dp
2441 IF (rst(ng)%pioVar(idu2sd)%dkind.eq.pio_double) THEN
2442 iodesc => iodesc_dp_u2dvar(ng)
2443 ELSE
2444 iodesc => iodesc_sp_u2dvar(ng)
2445 END IF
2446 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idu2sd, &
2447 & rst(ng)%pioVar(idu2sd), &
2448 & rst(ng)%Rindex, &
2449 & iodesc, &
2450 & lbi, ubi, lbj, ubj, scale, &
2451# ifdef MASKING
2452 & grid(ng) % umask, &
2453# endif
2454 & ocean(ng) % ubar_stokes)
2455 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2456 IF (master) WRITE (stdout,20) trim(vname(1,idu2sd)), &
2457 & rst(ng)%Rindex
2458 exit_flag=3
2459 ioerror=status
2460 RETURN
2461 END IF
2462!
2463! Write out 2D Stokes V-velocity.
2464!
2465 scale=1.0_dp
2466 IF (rst(ng)%pioVar(idv2sd)%dkind.eq.pio_double) THEN
2467 iodesc => iodesc_dp_v2dvar(ng)
2468 ELSE
2469 iodesc => iodesc_sp_v2dvar(ng)
2470 END IF
2471 status=nf_fwrite2d(ng, model, rst(ng)%pioFile, idv2sd, &
2472 & rst(ng)%pioVar(idv2sd), &
2473 & rst(ng)%Rindex, &
2474 & iodesc, &
2475 & lbi, ubi, lbj, ubj, scale, &
2476# ifdef MASKING
2477 & grid(ng) % vmask, &
2478# endif
2479 & ocean(ng) % vbar_stokes)
2480 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2481 IF (master) WRITE (stdout,20) trim(vname(1,idv2sd)), &
2482 & rst(ng)%Rindex
2483 exit_flag=3
2484 ioerror=status
2485 RETURN
2486 END IF
2487
2488# ifdef SOLVE3D
2489!
2490! Write out 3D Stokes U-velocity.
2491!
2492 scale=1.0_dp
2493 IF (rst(ng)%pioVar(idu3sd)%dkind.eq.pio_double) THEN
2494 iodesc => iodesc_dp_u3dvar(ng)
2495 ELSE
2496 iodesc => iodesc_sp_u3dvar(ng)
2497 END IF
2498 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idu3sd, &
2499 & rst(ng)%pioVar(idu3sd), &
2500 & rst(ng)%Rindex, &
2501 & iodesc, &
2502 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2503# ifdef MASKING
2504 & grid(ng) % umask, &
2505# endif
2506 & ocean(ng) % u_stokes)
2507 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2508 IF(master) WRITE (stdout,20) trim(vname(1,idu3sd)), &
2509 & rst(ng)%Rindex
2510 exit_flag=3
2511 ioerror=status
2512 RETURN
2513 END IF
2514!
2515! Write out 3D Stokes V-velocity.
2516!
2517 scale=1.0_dp
2518 IF (rst(ng)%pioVar(idv3sd)%dkind.eq.pio_double) THEN
2519 iodesc => iodesc_dp_v3dvar(ng)
2520 ELSE
2521 iodesc => iodesc_sp_v3dvar(ng)
2522 END IF
2523 status=nf_fwrite3d(ng, model, rst(ng)%pioFile, idv3sd, &
2524 & rst(ng)%pioVar(idv3sd), &
2525 & rst(ng)%Rindex, &
2526 & iodesc, &
2527& & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2528# ifdef MASKING
2529 & grid(ng) % vmask, &
2530# endif
2531 & ocean(ng) % v_stokes)
2532 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2533 IF (master) WRITE (stdout,20) trim(vname(1,idv3sd)), &
2534 & rst(ng)%Rindex
2535 exit_flag=3
2536 ioerror=status
2537 RETURN
2538 END IF
2539# endif
2540# endif
2541# ifdef ICE_MODEL
2542!
2543!-----------------------------------------------------------------------
2544! Write out seaice model state variables.
2545!-----------------------------------------------------------------------
2546!
2547 CALL ice_wrt_pio (ng, model, tile, &
2548 & lbi, ubi, lbj, ubj, &
2549 & hout, rst)
2550 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2551# endif
2552!
2553!-----------------------------------------------------------------------
2554! Synchronize restart NetCDF file to disk.
2555!-----------------------------------------------------------------------
2556!
2557 CALL pio_netcdf_sync (ng, model, rst(ng)%name, rst(ng)%pioFile)
2558 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2559!
2560 10 FORMAT (2x,'WRT_RST_PIO - writing re-start', t42, &
2561# ifdef SOLVE3D
2562# ifdef NESTING
2563 & 'fields (Index=',i1,',',i1,') in record = ',i0,t92,i2.2)
2564# else
2565 & 'fields (Index=',i1,',',i1,') in record = ',i0)
2566# endif
2567# else
2568# ifdef NESTING
2569 & 'fields (Index=',i1,') in record = ',i0,t92,i2.2)
2570# else
2571 & 'fields (Index=',i1,') in record = ',i0)
2572# endif
2573# endif
2574 20 FORMAT (/,' WRT_RST_PIO - error while writing variable: ',a, &
2575 & /,16x,'into restart NetCDF file for time record: ',i0)
2576!
2577 RETURN
mod_pio_netcdf::pio_netcdf_put_fvar
Definition mod_pio_netcdf.F:94
mod_pio_netcdf::pio_netcdf_put_ivar
Definition mod_pio_netcdf.F:108
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::iodesc_sp_w3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_w3dvar
Definition mod_pio_netcdf.F:212
mod_pio_netcdf::iodesc_dp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dvar
Definition mod_pio_netcdf.F:248
mod_pio_netcdf::iodesc_sp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dvar
Definition mod_pio_netcdf.F:210
mod_pio_netcdf::iodesc_dp_tkevar
type(io_desc_t), dimension(:), pointer iodesc_dp_tkevar
Definition mod_pio_netcdf.F:388
mod_pio_netcdf::iodesc_sp_trcvar
type(io_desc_t), dimension(:), pointer iodesc_sp_trcvar
Definition mod_pio_netcdf.F:373
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_dp_b3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_b3dvar
Definition mod_pio_netcdf.F:241
mod_pio_netcdf::iodesc_sp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dvar
Definition mod_pio_netcdf.F:195
mod_pio_netcdf::iodesc_dp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dvar
Definition mod_pio_netcdf.F:249
mod_pio_netcdf::iodesc_dp_ubar
type(io_desc_t), dimension(:), pointer iodesc_dp_ubar
Definition mod_pio_netcdf.F:381
mod_pio_netcdf::iodesc_sp_tkevar
type(io_desc_t), dimension(:), pointer iodesc_sp_tkevar
Definition mod_pio_netcdf.F:371
mod_pio_netcdf::iodesc_sp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
Definition mod_pio_netcdf.F:194
mod_pio_netcdf::iodesc_dp_ruvel
type(io_desc_t), dimension(:), pointer iodesc_dp_ruvel
Definition mod_pio_netcdf.F:385
mod_pio_netcdf::iodesc_dp_rzeta
type(io_desc_t), dimension(:), pointer iodesc_dp_rzeta
Definition mod_pio_netcdf.F:380
mod_pio_netcdf::iodesc_sp_rzeta
type(io_desc_t), dimension(:), pointer iodesc_sp_rzeta
Definition mod_pio_netcdf.F:363
mod_pio_netcdf::iodesc_dp_uvel
type(io_desc_t), dimension(:), pointer iodesc_dp_uvel
Definition mod_pio_netcdf.F:391
mod_pio_netcdf::iodesc_sp_b3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_b3dvar
Definition mod_pio_netcdf.F:202
mod_pio_netcdf::iodesc_sp_rvvel
type(io_desc_t), dimension(:), pointer iodesc_sp_rvvel
Definition mod_pio_netcdf.F:369
mod_pio_netcdf::iodesc_dp_rvvel
type(io_desc_t), dimension(:), pointer iodesc_dp_rvvel
Definition mod_pio_netcdf.F:386
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_vvel
type(io_desc_t), dimension(:), pointer iodesc_dp_vvel
Definition mod_pio_netcdf.F:392
mod_pio_netcdf::iodesc_dp_rvbar
type(io_desc_t), dimension(:), pointer iodesc_dp_rvbar
Definition mod_pio_netcdf.F:379
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_sp_vbar
type(io_desc_t), dimension(:), pointer iodesc_sp_vbar
Definition mod_pio_netcdf.F:365
mod_pio_netcdf::iodesc_dp_vbar
type(io_desc_t), dimension(:), pointer iodesc_dp_vbar
Definition mod_pio_netcdf.F:382
mod_pio_netcdf::iodesc_sp_rvbar
type(io_desc_t), dimension(:), pointer iodesc_sp_rvbar
Definition mod_pio_netcdf.F:362
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_dp_zeta
type(io_desc_t), dimension(:), pointer iodesc_dp_zeta
Definition mod_pio_netcdf.F:383
mod_pio_netcdf::iodesc_sp_vvel
type(io_desc_t), dimension(:), pointer iodesc_sp_vvel
Definition mod_pio_netcdf.F:375
mod_pio_netcdf::iodesc_sp_ubar
type(io_desc_t), dimension(:), pointer iodesc_sp_ubar
Definition mod_pio_netcdf.F:364
mod_pio_netcdf::iodesc_sp_uvel
type(io_desc_t), dimension(:), pointer iodesc_sp_uvel
Definition mod_pio_netcdf.F:374
mod_pio_netcdf::iodesc_sp_zeta
type(io_desc_t), dimension(:), pointer iodesc_sp_zeta
Definition mod_pio_netcdf.F:366
mod_pio_netcdf::iodesc_sp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dvar
Definition mod_pio_netcdf.F:211
mod_pio_netcdf::iodesc_sp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dvar
Definition mod_pio_netcdf.F:209
mod_pio_netcdf::iodesc_dp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar
Definition mod_pio_netcdf.F:233
mod_pio_netcdf::iodesc_sp_ruvel
type(io_desc_t), dimension(:), pointer iodesc_sp_ruvel
Definition mod_pio_netcdf.F:368
mod_pio_netcdf::iodesc_dp_rubar
type(io_desc_t), dimension(:), pointer iodesc_dp_rubar
Definition mod_pio_netcdf.F:378
mod_pio_netcdf::iodesc_sp_rubar
type(io_desc_t), dimension(:), pointer iodesc_sp_rubar
Definition mod_pio_netcdf.F:361
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_pio_netcdf::iodesc_dp_trcvar
type(io_desc_t), dimension(:), pointer iodesc_dp_trcvar
Definition mod_pio_netcdf.F:390

References mod_scalars::exit_flag, strings_mod::founderror(), mod_grid::grid, mod_ncparam::hout, mod_ncparam::idbath, mod_sediment::idbmas, mod_sediment::idbott, mod_ncparam::iddano, mod_sediment::idfrac, mod_ncparam::idfsur, mod_ncparam::idghat, mod_ncparam::idhbbl, mod_ncparam::idhsbl, mod_ncparam::idmtke, mod_ncparam::idmtls, mod_ncparam::idpwet, mod_ncparam::idru2d, mod_ncparam::idru3d, mod_ncparam::idrv2d, mod_ncparam::idrv3d, mod_ncparam::idrwet, mod_ncparam::idrzet, mod_sediment::idsbed, mod_ncparam::idsdif, mod_ncparam::idtdif, mod_ncparam::idtime, mod_ncparam::idtvar, mod_ncparam::idu2sd, mod_ncparam::idu3sd, mod_ncparam::idubar, mod_sediment::idubld, mod_ncparam::iduvel, mod_ncparam::iduwet, mod_ncparam::idv2sd, mod_ncparam::idv3sd, mod_ncparam::idvbar, mod_sediment::idvbld, mod_ncparam::idvmkk, mod_ncparam::idvmkp, mod_ncparam::idvmls, mod_ncparam::idvvel, mod_ncparam::idvvis, mod_ncparam::idvwet, mod_scalars::iic, mod_pio_netcdf::iodesc_dp_b3dvar, mod_pio_netcdf::iodesc_dp_p2dvar, mod_pio_netcdf::iodesc_dp_r2dvar, mod_pio_netcdf::iodesc_dp_r3dvar, mod_pio_netcdf::iodesc_dp_rubar, mod_pio_netcdf::iodesc_dp_ruvel, mod_pio_netcdf::iodesc_dp_rvbar, mod_pio_netcdf::iodesc_dp_rvvel, mod_pio_netcdf::iodesc_dp_rzeta, mod_pio_netcdf::iodesc_dp_tkevar, mod_pio_netcdf::iodesc_dp_trcvar, mod_pio_netcdf::iodesc_dp_u2dvar, mod_pio_netcdf::iodesc_dp_u3dvar, mod_pio_netcdf::iodesc_dp_ubar, mod_pio_netcdf::iodesc_dp_uvel, mod_pio_netcdf::iodesc_dp_v2dvar, mod_pio_netcdf::iodesc_dp_v3dvar, mod_pio_netcdf::iodesc_dp_vbar, mod_pio_netcdf::iodesc_dp_vvel, mod_pio_netcdf::iodesc_dp_w3dvar, mod_pio_netcdf::iodesc_dp_zeta, mod_pio_netcdf::iodesc_sp_b3dvar, mod_pio_netcdf::iodesc_sp_p2dvar, mod_pio_netcdf::iodesc_sp_r2dvar, mod_pio_netcdf::iodesc_sp_r3dvar, mod_pio_netcdf::iodesc_sp_rubar, mod_pio_netcdf::iodesc_sp_ruvel, mod_pio_netcdf::iodesc_sp_rvbar, mod_pio_netcdf::iodesc_sp_rvvel, mod_pio_netcdf::iodesc_sp_rzeta, mod_pio_netcdf::iodesc_sp_tkevar, mod_pio_netcdf::iodesc_sp_trcvar, mod_pio_netcdf::iodesc_sp_u2dvar, mod_pio_netcdf::iodesc_sp_u3dvar, mod_pio_netcdf::iodesc_sp_ubar, mod_pio_netcdf::iodesc_sp_uvel, mod_pio_netcdf::iodesc_sp_v2dvar, mod_pio_netcdf::iodesc_sp_v3dvar, mod_pio_netcdf::iodesc_sp_vbar, mod_pio_netcdf::iodesc_sp_vvel, mod_pio_netcdf::iodesc_sp_w3dvar, mod_pio_netcdf::iodesc_sp_zeta, mod_iounits::ioerror, mod_scalars::isalt, mod_sediment::itauc, mod_scalars::itemp, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_scalars::lcyclerst, mod_parallel::master, mod_sediment::mbedp, mod_mixing::mixing, mod_param::n, mod_param::nat, mod_param::nbed, mod_scalars::noerror, mod_param::nst, mod_param::nt, mod_scalars::ntstart, mod_ocean::ocean, mod_pio_netcdf::pio_netcdf_sync(), mod_scalars::rho0, mod_iounits::rst, mod_sedbed::sedbed, mod_iounits::sourcefile, mod_iounits::stdout, mod_scalars::time, and mod_ncparam::vname.

Referenced by wrt_rst().

Here is the call graph for this function:
Here is the caller graph for this function: