ROMS
Loading...
Searching...
No Matches
rp_wrt_ini_mod Module Reference

Functions/Subroutines

subroutine, public rp_wrt_ini (ng, tile, tindex, outrec)
 
subroutine, private rp_wrt_ini_nf90 (ng, tile, tindex, outrec, lbij, ubij, lbi, ubi, lbj, ubj)
 
subroutine, private rp_wrt_ini_pio (ng, tile, tindex, outrec, lbij, ubij, lbi, ubi, lbj, ubj)
 

Function/Subroutine Documentation

◆ rp_wrt_ini()

subroutine, public rp_wrt_ini_mod::rp_wrt_ini ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in) outrec )

Definition at line 71 of file rp_wrt_ini.F.

72!***********************************************************************
73!
74! Imported variable declarations.
75!
76 integer, intent(in) :: ng, tile, Tindex, OutRec
77!
78! Local variable declarations.
79!
80# ifdef ADJUST_BOUNDARY
81 integer :: LBij, UBij
82# endif
83 integer :: LBi, UBi, LBj, UBj
84!
85 character (len=*), parameter :: MyFile = &
86 & __FILE__
87!
88!-----------------------------------------------------------------------
89! Write out history fields according to IO type.
90!-----------------------------------------------------------------------
91!
92# ifdef ADJUST_BOUNDARY
93 lbij=bounds(ng)%LBij
94 ubij=bounds(ng)%UBij
95# endif
96 lbi=bounds(ng)%LBi(tile)
97 ubi=bounds(ng)%UBi(tile)
98 lbj=bounds(ng)%LBj(tile)
99 ubj=bounds(ng)%UBj(tile)
100!
101 SELECT CASE (irp(ng)%IOtype)
102 CASE (io_nf90)
103 CALL rp_wrt_ini_nf90 (ng, tile, tindex, outrec, &
104# ifdef ADJUST_BOUNDARY
105 & lbij, ubij, &
106# endif
107 & lbi, ubi, lbj, ubj)
108
109# if defined PIO_LIB && defined DISTRIBUTE
110 CASE (io_pio)
111 CALL rp_wrt_ini_pio (ng, tile, tindex, outrec, &
112# ifdef ADJUST_BOUNDARY
113 & lbij, ubij, &
114# endif
115 & lbi, ubi, lbj, ubj)
116# endif
117 CASE DEFAULT
118 IF (master) WRITE (stdout,10) irp(ng)%IOtype
119 exit_flag=3
120 END SELECT
121 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
122!
123 10 FORMAT (' RP_WRT_INI - Illegal output file type, io_type = ',i0, &
124 & /,14x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
125!
126 RETURN

References mod_param::bounds, mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_iounits::irp, mod_parallel::master, mod_scalars::noerror, rp_wrt_ini_nf90(), rp_wrt_ini_pio(), and mod_iounits::stdout.

Referenced by convolve_mod::error_covariance().

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

◆ rp_wrt_ini_nf90()

subroutine, private rp_wrt_ini_mod::rp_wrt_ini_nf90 ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in) outrec,
integer, intent(in) lbij,
integer, intent(in) ubij,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj )
private

Definition at line 130 of file rp_wrt_ini.F.

135!***********************************************************************
136!
137 USE mod_netcdf
138!
139! Imported variable declarations.
140!
141 integer, intent(in) :: ng, tile, Tindex, OutRec
142# ifdef ADJUST_BOUNDARY
143 integer, intent(in) :: LBij, UBij
144# endif
145 integer, intent(in) :: LBi, UBi, LBj, UBj
146!
147! Local variable declarations.
148!
149 integer :: gfactor, gtype, i, itrc, status, varid
150!
151 real(dp) :: my_time, scale
152!
153 character (len=15) :: string
154
155 character (len=*), parameter :: MyFile = &
156 & __FILE__//", rp_wrt_ini_nf90"
157!
158 sourcefile=myfile
159!
160!-----------------------------------------------------------------------
161! Write out tangent linear initial conditions.
162!-----------------------------------------------------------------------
163!
164 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
165!
166! Report.
167!
168 IF (master) THEN
169 IF (outrec.eq.2) THEN
170 string='initial fields'
171 END IF
172# ifdef SOLVE3D
173 WRITE (stdout,10) string, outer, inner, tindex, tindex, outrec
174# else
175 WRITE (stdout,10) string, outer, inner, tindex, outrec
176# endif
177 END IF
178!
179! Set grid type factor to write full (gfactor=1) fields or water
180! points (gfactor=-1) fields only.
181!
182# if defined WRITE_WATER && defined MASKING
183 gfactor=-1
184# else
185 gfactor=1
186# endif
187!
188! Write out model time (s). Use the "tdays" variable here because of
189! the management of the "time" variable due to nesting.
190!
191 my_time=tdays(ng)*day2sec
192
193 CALL netcdf_put_fvar (ng, irpm, irp(ng)%name, &
194 & trim(vname(1,idtime)), my_time, &
195 & (/outrec/), (/1/), &
196 & ncid = irp(ng)%ncid, &
197 & varid = irp(ng)%Vid(idtime))
198 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
199!
200! Write out free-surface (m)
201!
202 scale=1.0_dp
203 gtype=gfactor*r2dvar
204 status=nf_fwrite2d(ng, irpm, irp(ng)%ncid, idfsur, &
205 & irp(ng)%Vid(idfsur), &
206 & outrec, gtype, &
207 & lbi, ubi, lbj, ubj, scale, &
208# ifdef MASKING
209 & grid(ng) % rmask, &
210# endif
211# ifdef WET_DRY
212 & ocean(ng) % tl_zeta(:,:,tindex), &
213 & setfillval = .false.)
214# else
215 & ocean(ng) % tl_zeta(:,:,tindex))
216# endif
217 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
218 IF (master) THEN
219 WRITE (stdout,20) trim(vname(1,idfsur)), outrec
220 END IF
221 exit_flag=3
222 ioerror=status
223 RETURN
224 END IF
225
226# ifdef ADJUST_BOUNDARY
227!
228! Write out free-surface open boundaries.
229!
230 IF (any(lobc(:,isfsur,ng))) THEN
231 scale=1.0_dp
232 status=nf_fwrite2d_bry(ng, irpm, irp(ng)%name, irp(ng)%ncid, &
233 & vname(1,idsbry(isfsur)), &
234 & irp(ng)%Vid(idsbry(isfsur)), &
235 & outrec, r2dvar, &
236 & lbij, ubij, nbrec(ng), scale, &
237 & boundary(ng) % tl_zeta_obc(lbij:,:,:, &
238 & tindex))
239 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
240 IF (master) THEN
241 WRITE (stdout,20) trim(vname(1,idsbry(isfsur))), outrec
242 END IF
243 exit_flag=3
244 ioerror=status
245 RETURN
246 END IF
247 END IF
248# endif
249!
250! Write out 2D U-momentum component (m/s).
251!
252 scale=1.0_dp
253 gtype=gfactor*u2dvar
254 status=nf_fwrite2d(ng, irpm, irp(ng)%ncid, idubar, &
255 & irp(ng)%Vid(idubar), &
256 & outrec, gtype, &
257 & lbi, ubi, lbj, ubj, scale, &
258# ifdef MASKING
259 & grid(ng) % umask_full, &
260# endif
261 & ocean(ng) % tl_ubar(:,:,tindex))
262 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
263 IF (master) THEN
264 WRITE (stdout,20) trim(vname(1,idubar)), outrec
265 END IF
266 exit_flag=3
267 ioerror=status
268 RETURN
269 END IF
270
271# ifdef ADJUST_BOUNDARY
272!
273! Write out 2D U-momentum component open boundaries.
274!
275 IF (any(lobc(:,isubar,ng))) THEN
276 scale=1.0_dp
277 status=nf_fwrite2d_bry(ng, irpm, irp(ng)%name, irp(ng)%ncid, &
278 & vname(1,idsbry(isubar)), &
279 & irp(ng)%Vid(idsbry(isubar)), &
280 & outrec, u2dvar, &
281 & lbij, ubij, nbrec(ng), scale, &
282 & boundary(ng) % tl_ubar_obc(lbij:,:,:, &
283 & tindex))
284 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
285 IF (master) THEN
286 WRITE (stdout,20) trim(vname(1,idsbry(isubar))), outrec
287 END IF
288 exit_flag=3
289 ioerror=status
290 RETURN
291 END IF
292 END IF
293# endif
294!
295! Write out 2D V-momentum component (m/s).
296!
297 scale=1.0_dp
298 gtype=gfactor*v2dvar
299 status=nf_fwrite2d(ng, irpm, irp(ng)%ncid, idvbar, &
300 & irp(ng)%Vid(idvbar), &
301 & outrec, gtype, &
302 & lbi, ubi, lbj, ubj, scale, &
303# ifdef MASKING
304 & grid(ng) % vmask_full, &
305# endif
306 & ocean(ng) % tl_vbar(:,:,tindex))
307 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
308 IF (master) THEN
309 WRITE (stdout,20) trim(vname(1,idvbar)), outrec
310 END IF
311 exit_flag=3
312 ioerror=status
313 RETURN
314 END IF
315
316# ifdef ADJUST_BOUNDARY
317!
318! Write out 2D V-momentum component open boundaries.
319!
320 IF (any(lobc(:,isvbar,ng))) THEN
321 scale=1.0_dp
322 status=nf_fwrite2d_bry(ng, irpm, irp(ng)%name, irp(ng)%ncid, &
323 & vname(1,idsbry(isvbar)), &
324 & irp(ng)%Vid(idsbry(isvbar)), &
325 & outrec, v2dvar, &
326 & lbij, ubij, nbrec(ng), scale, &
327 & boundary(ng) % tl_vbar_obc(lbij:,:,:, &
328 & tindex))
329 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
330 IF (master) THEN
331 WRITE (stdout,20) trim(vname(1,idsbry(isvbar))), outrec
332 END IF
333 exit_flag=3
334 ioerror=status
335 RETURN
336 END IF
337 END IF
338# endif
339
340# ifdef ADJUST_WSTRESS
341!
342! Write out surface U-momentum stress. Notice that the stress has its
343! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
344! at other times in addition to initialization time.
345!
346!! scale=rho0
347 scale=1.0_dp
348 gtype=gfactor*u3dvar
349 status=nf_fwrite3d(ng, irpm, irp(ng)%ncid, idusms, &
350 & irp(ng)%Vid(idusms), &
351 & outrec, gtype, &
352 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
353# ifdef MASKING
354 & grid(ng) % umask, &
355# endif
356 & forces(ng) % tl_ustr(:,:,:,tindex))
357 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
358 IF (master) THEN
359 WRITE (stdout,20) trim(vname(1,idusms)), outrec
360 END IF
361 exit_flag=3
362 ioerror=status
363 RETURN
364 END IF
365!
366! Write out surface V-momentum stress.
367!
368!! scale=rho0
369 scale=1.0_dp
370 gtype=gfactor*v3dvar
371 status=nf_fwrite3d(ng, irpm, irp(ng)%ncid, idvsms, &
372 & irp(ng)%Vid(idvsms), &
373 & outrec, gtype, &
374 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
375# ifdef MASKING
376 & grid(ng) % vmask, &
377# endif
378 & forces(ng) % tl_vstr(:,:,:,tindex))
379 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
380 IF (master) THEN
381 WRITE (stdout,20) trim(vname(1,idvsms)), outrec
382 END IF
383 exit_flag=3
384 ioerror=status
385 RETURN
386 END IF
387# endif
388
389# ifdef SOLVE3D
390!
391! Write out 3D U-momentum component (m/s).
392!
393 scale=1.0_dp
394 gtype=gfactor*u3dvar
395 status=nf_fwrite3d(ng, irpm, irp(ng)%ncid, iduvel, &
396 & irp(ng)%Vid(iduvel), &
397 & outrec, gtype, &
398 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
399# ifdef MASKING
400 & grid(ng) % umask_full, &
401# endif
402 & ocean(ng) % tl_u(:,:,:,tindex))
403 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
404 IF (master) THEN
405 WRITE (stdout,20) trim(vname(1,iduvel)), outrec
406 END IF
407 exit_flag=3
408 ioerror=status
409 RETURN
410 END IF
411
412# ifdef ADJUST_BOUNDARY
413!
414! Write out 3D U-momentum component open boundaries.
415!
416 IF (any(lobc(:,isuvel,ng))) THEN
417 scale=1.0_dp
418 status=nf_fwrite3d_bry(ng, irpm, irp(ng)%name, irp(ng)%ncid, &
419 & vname(1,idsbry(isuvel)), &
420 & irp(ng)%Vid(idsbry(isuvel)), &
421 & outrec, u3dvar, &
422 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
423 & boundary(ng) % tl_u_obc(lbij:,:,:,:, &
424 & tindex))
425 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
426 IF (master) THEN
427 WRITE (stdout,20) trim(vname(1,idsbry(isuvel))), outrec
428 END IF
429 exit_flag=3
430 ioerror=status
431 RETURN
432 END IF
433 END IF
434# endif
435!
436! Write out 3D V-momentum component (m/s).
437!
438 scale=1.0_dp
439 gtype=gfactor*v3dvar
440 status=nf_fwrite3d(ng, irpm, irp(ng)%ncid, idvvel, &
441 & irp(ng)%Vid(idvvel), &
442 & outrec, gtype, &
443 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
444# ifdef MASKING
445 & grid(ng) % vmask_full, &
446# endif
447 & ocean(ng) % tl_v(:,:,:,tindex))
448 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
449 IF (master) THEN
450 WRITE (stdout,20) trim(vname(1,idvvel)), outrec
451 END IF
452 exit_flag=3
453 ioerror=status
454 RETURN
455 END IF
456
457# ifdef ADJUST_BOUNDARY
458!
459! Write out 3D V-momentum component open boundaries.
460!
461 IF (any(lobc(:,isvvel,ng))) THEN
462 scale=1.0_dp
463 status=nf_fwrite3d_bry(ng, irpm, irp(ng)%name, irp(ng)%ncid, &
464 & vname(1,idsbry(isvvel)), &
465 & irp(ng)%Vid(idsbry(isvvel)), &
466 & outrec, v3dvar, &
467 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
468 & boundary(ng) % tl_v_obc(lbij:,:,:,:, &
469 & tindex))
470 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
471 IF (master) THEN
472 WRITE (stdout,20) trim(vname(1,idsbry(isvvel))), outrec
473 END IF
474 exit_flag=3
475 ioerror=status
476 RETURN
477 END IF
478 END IF
479# endif
480!
481! Write out tracer type variables.
482!
483 DO itrc=1,nt(ng)
484 scale=1.0_dp
485 gtype=gfactor*r3dvar
486 status=nf_fwrite3d(ng, irpm, irp(ng)%ncid, idtvar(itrc), &
487 & irp(ng)%Tid(itrc), &
488 & outrec, gtype, &
489 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
490# ifdef MASKING
491 & grid(ng) % rmask, &
492# endif
493 & ocean(ng) % tl_t(:,:,:,tindex,itrc))
494 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
495 IF (master) THEN
496 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), outrec
497 END IF
498 exit_flag=3
499 ioerror=status
500 RETURN
501 END IF
502 END DO
503
504# ifdef ADJUST_BOUNDARY
505!
506! Write out tracers open boundaries.
507!
508 DO itrc=1,nt(ng)
509 IF (any(lobc(:,istvar(itrc),ng))) THEN
510 scale=1.0_dp
511 status=nf_fwrite3d_bry(ng, irpm, irp(ng)%name, irp(ng)%ncid, &
512 & vname(1,idsbry(istvar(itrc))), &
513 & irp(ng)%Vid(idsbry(istvar(itrc))), &
514 & outrec, r3dvar, &
515 & lbij, ubij, 1, n(ng), nbrec(ng), &
516 & scale, &
517 & boundary(ng) % tl_t_obc(lbij:,:,:,:, &
518 & tindex,itrc))
519 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
520 IF (master) THEN
521 WRITE (stdout,20) trim(vname(1,idsbry(istvar(itrc)))), &
522 & outrec
523 END IF
524 exit_flag=3
525 ioerror=status
526 RETURN
527 END IF
528 END IF
529 END DO
530# endif
531
532# ifdef ADJUST_STFLUX
533!
534! Write out surface net tracers fluxes. Notice that fluxes have their
535! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
536! at other times in addition to initialization time.
537!
538 DO itrc=1,nt(ng)
539 IF (lstflux(itrc,ng)) THEN
540 scale=1.0_dp
541 gtype=gfactor*r3dvar
542 status=nf_fwrite3d(ng, irpm, irp(ng)%ncid, idtsur(itrc), &
543 & irp(ng)%Vid(idtsur(itrc)), &
544 & outrec, gtype, &
545 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
546# ifdef MASKING
547 & grid(ng) % rmask, &
548# endif
549 & forces(ng) % tl_tflux(:,:,:,tindex,itrc))
550 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
551 IF (master) THEN
552 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
553 & outrec
554 END IF
555 exit_flag=3
556 ioerror=status
557 RETURN
558 END IF
559 END IF
560 END DO
561# endif
562# endif
563!
564!-----------------------------------------------------------------------
565! Synchronize tangent linear initial NetCDF file to disk to allow other
566! processes to access data immediately after it is written.
567!-----------------------------------------------------------------------
568!
569 CALL netcdf_sync (ng, irpm, irp(ng)%name, irp(ng)%ncid)
570 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
571!
572 10 FORMAT (2x,'RP_WRT_INI_NF90 - writing ',a, &
573 & ' (Outer=',i2.2,', Inner=',i3.3,', Index=',i0, &
574# ifdef SOLVE3D
575 & ',',i0,', Rec=',i0,')')
576# else
577 & ', Rec=',i0,')')
578# endif
579 20 FORMAT (/,' RP_WRT_INI_NF90 - error while writing variable: ',a, &
580 & /,19x,'into representers initial file for time record:', &
581 & 1x,i4)
582!
583 RETURN
subroutine, public netcdf_sync(ng, model, ncname, ncid)

References mod_boundary::boundary, mod_scalars::day2sec, mod_scalars::exit_flag, mod_forces::forces, strings_mod::founderror(), mod_grid::grid, mod_ncparam::idfsur, mod_ncparam::idsbry, mod_ncparam::idtime, mod_ncparam::idtsur, mod_ncparam::idtvar, mod_ncparam::idubar, mod_ncparam::idusms, mod_ncparam::iduvel, mod_ncparam::idvbar, mod_ncparam::idvsms, mod_ncparam::idvvel, mod_scalars::inner, mod_iounits::ioerror, mod_iounits::irp, mod_param::irpm, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_scalars::nbrec, mod_netcdf::netcdf_sync(), mod_scalars::nfrec, mod_scalars::noerror, mod_param::nt, mod_ocean::ocean, mod_scalars::outer, mod_param::r2dvar, mod_param::r3dvar, mod_iounits::sourcefile, mod_iounits::stdout, mod_scalars::tdays, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, and mod_ncparam::vname.

Referenced by rp_wrt_ini().

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

◆ rp_wrt_ini_pio()

subroutine, private rp_wrt_ini_mod::rp_wrt_ini_pio ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in) outrec,
integer, intent(in) lbij,
integer, intent(in) ubij,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj )
private

Definition at line 589 of file rp_wrt_ini.F.

594!***********************************************************************
595!
597!
598! Imported variable declarations.
599!
600 integer, intent(in) :: ng, tile, Tindex, OutRec
601# ifdef ADJUST_BOUNDARY
602 integer, intent(in) :: LBij, UBij
603# endif
604 integer, intent(in) :: LBi, UBi, LBj, UBj
605!
606! Local variable declarations.
607!
608 integer :: i, ifield, itrc, status, varid
609!
610 real(dp) :: my_time, scale
611!
612 character (len=15) :: string
613
614 character (len=*), parameter :: MyFile = &
615 & __FILE__//", rp_wrt_ini_pio"
616!
617 TYPE (IO_desc_t), pointer :: ioDesc
618!
619 sourcefile=myfile
620!
621!-----------------------------------------------------------------------
622! Write out tangent linear initial conditions.
623!-----------------------------------------------------------------------
624!
625 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
626!
627! Report.
628!
629 IF (master) THEN
630 IF (outrec.eq.2) THEN
631 string='initial fields'
632 END IF
633# ifdef SOLVE3D
634 WRITE (stdout,10) string, outer, inner, tindex, tindex, outrec
635# else
636 WRITE (stdout,10) string, outer, inner, tindex, outrec
637# endif
638 END IF
639!
640! Write out model time (s). Use the "tdays" variable here because of
641! the management of the "time" variable due to nesting.
642!
643 my_time=tdays(ng)*day2sec
644
645 CALL pio_netcdf_put_fvar (ng, irpm, irp(ng)%name, &
646 & trim(vname(1,idtime)), my_time, &
647 & (/outrec/), (/1/), &
648 & piofile = irp(ng)%pioFile, &
649 & piovar = irp(ng)%pioVar(idtime)%vd)
650 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
651!
652! Write out free-surface (m)
653!
654 scale=1.0_dp
655 IF (irp(ng)%pioVar(idfsur)%dkind.eq.pio_double) THEN
656 iodesc => iodesc_dp_r2dvar(ng)
657 ELSE
658 iodesc => iodesc_sp_r2dvar(ng)
659 END IF
660!
661 status=nf_fwrite2d(ng, irpm, irp(ng)%pioFile, idfsur, &
662 & irp(ng)%pioVar(idfsur), &
663 & outrec, iodesc, &
664 & lbi, ubi, lbj, ubj, scale, &
665# ifdef MASKING
666 & grid(ng) % rmask, &
667# endif
668# ifdef WET_DRY
669 & ocean(ng) % tl_zeta(:,:,tindex), &
670 & setfillval = .false.)
671# else
672 & ocean(ng) % tl_zeta(:,:,tindex))
673# endif
674 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
675 IF (master) THEN
676 WRITE (stdout,20) trim(vname(1,idfsur)), outrec
677 END IF
678 exit_flag=3
679 ioerror=status
680 RETURN
681 END IF
682
683# ifdef ADJUST_BOUNDARY
684!
685! Write out free-surface open boundaries.
686!
687 IF (any(lobc(:,isfsur,ng))) THEN
688 scale=1.0_dp
689 IF (irp(ng)%pioVar(idsbry(isfsur))%dkind.eq.pio_double) THEN
690 iodesc => iodesc_dp_r2dobc(ng)
691 ELSE
692 iodesc => iodesc_sp_r2dobc(ng)
693 END IF
694!
695 status=nf_fwrite2d_bry(ng, irpm, irp(ng)%name, &
696 & irp(ng)%pioFile, &
697 & vname(1,idsbry(isfsur)), &
698 & irp(ng)%pioVar(idsbry(isfsur)), &
699 & outrec, iodesc, &
700 & lbij, ubij, nbrec(ng), scale, &
701 & boundary(ng) % tl_zeta_obc(lbij:,:,:, &
702 & tindex))
703 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
704 IF (master) THEN
705 WRITE (stdout,20) trim(vname(1,idsbry(isfsur))), outrec
706 END IF
707 exit_flag=3
708 ioerror=status
709 RETURN
710 END IF
711 END IF
712# endif
713!
714! Write out 2D U-momentum component (m/s).
715!
716 scale=1.0_dp
717 IF (irp(ng)%pioVar(idubar)%dkind.eq.pio_double) THEN
718 iodesc => iodesc_dp_u2dvar(ng)
719 ELSE
720 iodesc => iodesc_sp_u2dvar(ng)
721 END IF
722!
723 status=nf_fwrite2d(ng, irpm, irp(ng)%pioFile, idubar, &
724 & irp(ng)%pioVar(idubar), &
725 & outrec, iodesc, &
726 & lbi, ubi, lbj, ubj, scale, &
727# ifdef MASKING
728 & grid(ng) % umask_full, &
729# endif
730 & ocean(ng) % tl_ubar(:,:,tindex))
731 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
732 IF (master) THEN
733 WRITE (stdout,20) trim(vname(1,idubar)), outrec
734 END IF
735 exit_flag=3
736 ioerror=status
737 RETURN
738 END IF
739
740# ifdef ADJUST_BOUNDARY
741!
742! Write out 2D U-momentum component open boundaries.
743!
744 IF (any(lobc(:,isubar,ng))) THEN
745 scale=1.0_dp
746 IF (irp(ng)%pioVar(idsbry(isubar))%dkind.eq.pio_double) THEN
747 iodesc => iodesc_dp_u2dobc(ng)
748 ELSE
749 iodesc => iodesc_sp_u2dobc(ng)
750 END IF
751!
752 status=nf_fwrite2d_bry(ng, irpm, irp(ng)%name, &
753 & irp(ng)%pioFile, &
754 & vname(1,idsbry(isubar)), &
755 & irp(ng)%pioVar(idsbry(isubar)), &
756 & outrec, iodesc, &
757 & lbij, ubij, nbrec(ng), scale, &
758 & boundary(ng) % tl_ubar_obc(lbij:,:,:, &
759 & tindex))
760 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
761 IF (master) THEN
762 WRITE (stdout,20) trim(vname(1,idsbry(isubar))), outrec
763 END IF
764 exit_flag=3
765 ioerror=status
766 RETURN
767 END IF
768 END IF
769# endif
770!
771! Write out 2D V-momentum component (m/s).
772!
773 scale=1.0_dp
774 IF (irp(ng)%pioVar(idvbar)%dkind.eq.pio_double) THEN
775 iodesc => iodesc_dp_v2dvar(ng)
776 ELSE
777 iodesc => iodesc_sp_v2dvar(ng)
778 END IF
779!
780 status=nf_fwrite2d(ng, irpm, irp(ng)%pioFile, idvbar, &
781 & irp(ng)%pioVar(idvbar), &
782 & outrec, iodesc, &
783 & lbi, ubi, lbj, ubj, scale, &
784# ifdef MASKING
785 & grid(ng) % vmask_full, &
786# endif
787 & ocean(ng) % tl_vbar(:,:,tindex))
788 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
789 IF (master) THEN
790 WRITE (stdout,20) trim(vname(1,idvbar)), outrec
791 END IF
792 exit_flag=3
793 ioerror=status
794 RETURN
795 END IF
796
797# ifdef ADJUST_BOUNDARY
798!
799! Write out 2D V-momentum component open boundaries.
800!
801 IF (any(lobc(:,isvbar,ng))) THEN
802 scale=1.0_dp
803 IF (irp(ng)%pioVar(idsbry(isvbar))%dkind.eq.pio_double) THEN
804 iodesc => iodesc_dp_v2dobc(ng)
805 ELSE
806 iodesc => iodesc_sp_v2dobc(ng)
807 END IF
808!
809 status=nf_fwrite2d_bry(ng, irpm, irp(ng)%name, &
810 & irp(ng)%pioFile, &
811 & vname(1,idsbry(isvbar)), &
812 & irp(ng)%pioVar(idsbry(isvbar)), &
813 & outrec, iodesc, &
814 & lbij, ubij, nbrec(ng), scale, &
815 & boundary(ng) % tl_vbar_obc(lbij:,:,:, &
816 & tindex))
817 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
818 IF (master) THEN
819 WRITE (stdout,20) trim(vname(1,idsbry(isvbar))), outrec
820 END IF
821 exit_flag=3
822 ioerror=status
823 RETURN
824 END IF
825 END IF
826# endif
827
828# ifdef ADJUST_WSTRESS
829!
830! Write out surface U-momentum stress. Notice that the stress has its
831! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
832! at other times in addition to initialization time.
833!
834!! scale=rho0
835 scale=1.0_dp
836 IF (irp(ng)%pioVar(idusms)%dkind.eq.pio_double) THEN
837 iodesc => iodesc_dp_u2dfrc(ng)
838 ELSE
839 iodesc => iodesc_sp_u2dfrc(ng)
840 END IF
841!
842 status=nf_fwrite3d(ng, irpm, irp(ng)%pioFile, idusms, &
843 & irp(ng)%pioVar(idusms), &
844 & outrec, iodesc, &
845 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
846# ifdef MASKING
847 & grid(ng) % umask, &
848# endif
849 & forces(ng) % tl_ustr(:,:,:,tindex))
850 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
851 IF (master) THEN
852 WRITE (stdout,20) trim(vname(1,idusms)), outrec
853 END IF
854 exit_flag=3
855 ioerror=status
856 RETURN
857 END IF
858!
859! Write out surface V-momentum stress.
860!
861!! scale=rho0
862 scale=1.0_dp
863 IF (irp(ng)%pioVar(idvsms)%dkind.eq.pio_double) THEN
864 iodesc => iodesc_dp_v2dfrc(ng)
865 ELSE
866 iodesc => iodesc_sp_v2dfrc(ng)
867 END IF
868!
869 status=nf_fwrite3d(ng, irpm, irp(ng)%pioFile, idvsms, &
870 & irp(ng)%pioVar(idvsms), &
871 & outrec, iodesc, &
872 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
873# ifdef MASKING
874 & grid(ng) % vmask, &
875# endif
876 & forces(ng) % tl_vstr(:,:,:,tindex))
877 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
878 IF (master) THEN
879 WRITE (stdout,20) trim(vname(1,idvsms)), outrec
880 END IF
881 exit_flag=3
882 ioerror=status
883 RETURN
884 END IF
885# endif
886
887# ifdef SOLVE3D
888!
889! Write out 3D U-momentum component (m/s).
890!
891 scale=1.0_dp
892 IF (irp(ng)%pioVar(iduvel)%dkind.eq.pio_double) THEN
893 iodesc => iodesc_dp_u3dvar(ng)
894 ELSE
895 iodesc => iodesc_sp_u3dvar(ng)
896 END IF
897!
898 status=nf_fwrite3d(ng, irpm, irp(ng)%pioFile, iduvel, &
899 & irp(ng)%pioVar(iduvel), &
900 & outrec, iodesc, &
901 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
902# ifdef MASKING
903 & grid(ng) % umask_full, &
904# endif
905 & ocean(ng) % tl_u(:,:,:,tindex))
906 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
907 IF (master) THEN
908 WRITE (stdout,20) trim(vname(1,iduvel)), outrec
909 END IF
910 exit_flag=3
911 ioerror=status
912 RETURN
913 END IF
914
915# ifdef ADJUST_BOUNDARY
916!
917! Write out 3D U-momentum component open boundaries.
918!
919 IF (any(lobc(:,isuvel,ng))) THEN
920 scale=1.0_dp
921 IF (irp(ng)%pioVar(idsbry(isuvel))%dkind.eq.pio_double) THEN
922 iodesc => iodesc_dp_u3dobc(ng)
923 ELSE
924 iodesc => iodesc_sp_u3dobc(ng)
925 END IF
926!
927 status=nf_fwrite3d_bry(ng, irpm, irp(ng)%name, &
928 & irp(ng)%pioFile, &
929 & vname(1,idsbry(isuvel)), &
930 & irp(ng)%pioVar(idsbry(isuvel)), &
931 & outrec, iodesc, &
932 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
933 & boundary(ng) % tl_u_obc(lbij:,:,:,:, &
934 & tindex))
935 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
936 IF (master) THEN
937 WRITE (stdout,20) trim(vname(1,idsbry(isuvel))), outrec
938 END IF
939 exit_flag=3
940 ioerror=status
941 RETURN
942 END IF
943 END IF
944# endif
945!
946! Write out 3D V-momentum component (m/s).
947!
948 scale=1.0_dp
949 IF (irp(ng)%pioVar(idvvel)%dkind.eq.pio_double) THEN
950 iodesc => iodesc_dp_v3dvar(ng)
951 ELSE
952 iodesc => iodesc_sp_v3dvar(ng)
953 END IF
954!
955 status=nf_fwrite3d(ng, irpm, irp(ng)%pioFile, idvvel, &
956 & irp(ng)%pioVar(idvvel), &
957 & outrec, iodesc, &
958 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
959# ifdef MASKING
960 & grid(ng) % vmask_full, &
961# endif
962 & ocean(ng) % tl_v(:,:,:,tindex))
963 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
964 IF (master) THEN
965 WRITE (stdout,20) trim(vname(1,idvvel)), outrec
966 END IF
967 exit_flag=3
968 ioerror=status
969 RETURN
970 END IF
971
972# ifdef ADJUST_BOUNDARY
973!
974! Write out 3D V-momentum component open boundaries.
975!
976 IF (any(lobc(:,isvvel,ng))) THEN
977 scale=1.0_dp
978 IF (irp(ng)%pioVar(idsbry(isvvel))%dkind.eq.pio_double) THEN
979 iodesc => iodesc_dp_v3dobc(ng)
980 ELSE
981 iodesc => iodesc_sp_v3dobc(ng)
982 END IF
983!
984 status=nf_fwrite3d_bry(ng, irpm, irp(ng)%name, &
985 & irp(ng)%pioFile, &
986 & vname(1,idsbry(isvvel)), &
987 & irp(ng)%pioVar(idsbry(isvvel)), &
988 & outrec, iodesc, &
989 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
990 & boundary(ng) % tl_v_obc(lbij:,:,:,:, &
991 & tindex))
992 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
993 IF (master) THEN
994 WRITE (stdout,20) trim(vname(1,idsbry(isvvel))), outrec
995 END IF
996 exit_flag=3
997 ioerror=status
998 RETURN
999 END IF
1000 END IF
1001# endif
1002!
1003! Write out tracer type variables.
1004!
1005 DO itrc=1,nt(ng)
1006 scale=1.0_dp
1007 IF (irp(ng)%pioTrc(itrc)%dkind.eq.pio_double) THEN
1008 iodesc => iodesc_dp_r3dvar(ng)
1009 ELSE
1010 iodesc => iodesc_sp_r3dvar(ng)
1011 END IF
1012!
1013 status=nf_fwrite3d(ng, irpm, irp(ng)%pioFile, idtvar(itrc), &
1014 & irp(ng)%pioTrc(itrc), &
1015 & outrec, iodesc, &
1016 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1017# ifdef MASKING
1018 & grid(ng) % rmask, &
1019# endif
1020 & ocean(ng) % tl_t(:,:,:,tindex,itrc))
1021 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1022 IF (master) THEN
1023 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), outrec
1024 END IF
1025 exit_flag=3
1026 ioerror=status
1027 RETURN
1028 END IF
1029 END DO
1030
1031# ifdef ADJUST_BOUNDARY
1032!
1033! Write out tracers open boundaries.
1034!
1035 DO itrc=1,nt(ng)
1036 IF (any(lobc(:,istvar(itrc),ng))) THEN
1037 scale=1.0_dp
1038 ifield=idsbry(istvar(itrc))
1039 IF (irp(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
1040 iodesc => iodesc_dp_r3dobc(ng)
1041 ELSE
1042 iodesc => iodesc_sp_r3dobc(ng)
1043 END IF
1044!
1045 status=nf_fwrite3d_bry(ng, irpm, irp(ng)%name, &
1046 & irp(ng)%pioFile, &
1047 & vname(1,ifield), &
1048 & irp(ng)%pioVar(ifield), &
1049 & outrec, iodesc, &
1050 & lbij, ubij, 1, n(ng), nbrec(ng), &
1051 & scale, &
1052 & boundary(ng) % tl_t_obc(lbij:,:,:,:, &
1053 & tindex,itrc))
1054 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1055 IF (master) THEN
1056 WRITE (stdout,20) trim(vname(1,idsbry(istvar(itrc)))), &
1057 & outrec
1058 END IF
1059 exit_flag=3
1060 ioerror=status
1061 RETURN
1062 END IF
1063 END IF
1064 END DO
1065# endif
1066
1067# ifdef ADJUST_STFLUX
1068!
1069! Write out surface net tracers fluxes. Notice that fluxes have their
1070! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
1071! at other times in addition to initialization time.
1072!
1073 DO itrc=1,nt(ng)
1074 IF (lstflux(itrc,ng)) THEN
1075 scale=1.0_dp
1076 IF (irp(ng)%pioVar(idtsur(itrc))%dkind.eq.pio_double) THEN
1077 iodesc => iodesc_dp_r2dfrc(ng)
1078 ELSE
1079 iodesc => iodesc_sp_r2dfrc(ng)
1080 END IF
1081!
1082 status=nf_fwrite3d(ng, irpm, irp(ng)%pioFile, idtsur(itrc), &
1083 & irp(ng)%pioVar(idtsur(itrc)), &
1084 & outrec, iodesc, &
1085 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
1086# ifdef MASKING
1087 & grid(ng) % rmask, &
1088# endif
1089 & forces(ng) % tl_tflux(:,:,:,tindex,itrc))
1090 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1091 IF (master) THEN
1092 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
1093 & outrec
1094 END IF
1095 exit_flag=3
1096 ioerror=status
1097 RETURN
1098 END IF
1099 END IF
1100 END DO
1101# endif
1102# endif
1103!
1104!-----------------------------------------------------------------------
1105! Synchronize tangent linear initial NetCDF file to disk to allow other
1106! processes to access data immediately after it is written.
1107!-----------------------------------------------------------------------
1108!
1109 CALL pio_netcdf_sync (ng, irpm, irp(ng)%name, irp(ng)%pioFile)
1110 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1111!
1112 10 FORMAT (2x,'RP_WRT_INI_PIO - writing ',a, &
1113 & ' (Outer=',i2.2,', Inner=',i3.3,', Index=',i0, &
1114# ifdef SOLVE3D
1115 & ',',i0,', Rec=',i0,')')
1116# else
1117 & ', Rec=',i0,')')
1118# endif
1119 20 FORMAT (/,' RP_WRT_INI_PIO - error while writing variable: ',a, &
1120 & /,18x,'into representers initial file for time record:', &
1121 & 1x,i4)
1122!
1123 RETURN
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dobc
subroutine, public pio_netcdf_sync(ng, model, ncname, piofile)
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dfrc

References mod_boundary::boundary, mod_scalars::day2sec, mod_scalars::exit_flag, mod_forces::forces, strings_mod::founderror(), mod_grid::grid, mod_ncparam::idfsur, mod_ncparam::idsbry, mod_ncparam::idtime, mod_ncparam::idtsur, mod_ncparam::idtvar, mod_ncparam::idubar, mod_ncparam::idusms, mod_ncparam::iduvel, mod_ncparam::idvbar, mod_ncparam::idvsms, mod_ncparam::idvvel, mod_scalars::inner, mod_pio_netcdf::iodesc_dp_r2dfrc, mod_pio_netcdf::iodesc_dp_r2dobc, mod_pio_netcdf::iodesc_dp_r2dvar, mod_pio_netcdf::iodesc_dp_r3dobc, mod_pio_netcdf::iodesc_dp_r3dvar, mod_pio_netcdf::iodesc_dp_u2dfrc, mod_pio_netcdf::iodesc_dp_u2dobc, mod_pio_netcdf::iodesc_dp_u2dvar, mod_pio_netcdf::iodesc_dp_u3dobc, mod_pio_netcdf::iodesc_dp_u3dvar, mod_pio_netcdf::iodesc_dp_v2dfrc, mod_pio_netcdf::iodesc_dp_v2dobc, mod_pio_netcdf::iodesc_dp_v2dvar, mod_pio_netcdf::iodesc_dp_v3dobc, mod_pio_netcdf::iodesc_dp_v3dvar, mod_pio_netcdf::iodesc_sp_r2dfrc, mod_pio_netcdf::iodesc_sp_r2dobc, mod_pio_netcdf::iodesc_sp_r2dvar, mod_pio_netcdf::iodesc_sp_r3dobc, mod_pio_netcdf::iodesc_sp_r3dvar, mod_pio_netcdf::iodesc_sp_u2dfrc, mod_pio_netcdf::iodesc_sp_u2dobc, mod_pio_netcdf::iodesc_sp_u2dvar, mod_pio_netcdf::iodesc_sp_u3dobc, mod_pio_netcdf::iodesc_sp_u3dvar, mod_pio_netcdf::iodesc_sp_v2dfrc, mod_pio_netcdf::iodesc_sp_v2dobc, mod_pio_netcdf::iodesc_sp_v2dvar, mod_pio_netcdf::iodesc_sp_v3dobc, mod_pio_netcdf::iodesc_sp_v3dvar, mod_iounits::ioerror, mod_iounits::irp, mod_param::irpm, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_scalars::nbrec, mod_scalars::nfrec, mod_scalars::noerror, mod_param::nt, mod_ocean::ocean, mod_scalars::outer, mod_pio_netcdf::pio_netcdf_sync(), mod_iounits::sourcefile, mod_iounits::stdout, mod_scalars::tdays, and mod_ncparam::vname.

Referenced by rp_wrt_ini().

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