ROMS
Loading...
Searching...
No Matches
tl_wrt_ini.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE tl_wrt_ini_mod
3#if (defined TANGENT || defined TL_IOMS) && defined FOUR_DVAR
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This module writes initial conditions into tangent linear file !
13! using either the standard NetCDF library or the Parallel-IO !
14! (PIO) library. !
15! !
16! On Input: !
17! !
18! ng Nested grid number. !
19! Tindex State variables time index to write. !
20! OutRec NetCDF file unlimited dimension record to write. !
21! !
22! Notice that only momentum is affected by the full time-averaged !
23! masks. If applicable, these mask contains information about !
24! river runoff and time-dependent wetting and drying variations. !
25! !
26!=======================================================================
27!
28 USE mod_param
29 USE mod_parallel
30# ifdef ADJUST_BOUNDARY
31 USE mod_boundary
32# endif
33# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
34 USE mod_forces
35# endif
36 USE mod_fourdvar
37 USE mod_grid
38 USE mod_iounits
39 USE mod_ncparam
40 USE mod_ocean
41 USE mod_scalars
42# if defined SEDIMENT_NOT_YET || defined BBL_MODEL_NOT_YET
43 USE mod_sediment
44# endif
45 USE mod_stepping
46!
47# ifdef DISTRIBUTE
48 USE distribute_mod, ONLY : mp_bcasti
49# endif
50 USE nf_fwrite2d_mod, ONLY : nf_fwrite2d
51# ifdef ADJUST_BOUNDARY
52 USE nf_fwrite2d_bry_mod, ONLY : nf_fwrite2d_bry
53# endif
54# ifdef SOLVE3D
55 USE nf_fwrite3d_mod, ONLY : nf_fwrite3d
56# ifdef ADJUST_BOUNDARY
57 USE nf_fwrite3d_bry_mod, ONLY : nf_fwrite3d_bry
58# endif
59# endif
60 USE strings_mod, ONLY : founderror
61!
62 implicit none
63!
64 PUBLIC :: tl_wrt_ini
65 PRIVATE :: tl_wrt_ini_nf90
66# if defined PIO_LIB && defined DISTRIBUTE
67 PRIVATE :: tl_wrt_ini_pio
68# endif
69!
70 CONTAINS
71!
72!***********************************************************************
73 SUBROUTINE tl_wrt_ini (ng, tile, Tindex, OutRec)
74!***********************************************************************
75!
76! Imported variable declarations.
77!
78 integer, intent(in) :: ng, tile, tindex, outrec
79!
80! Local variable declarations.
81!
82# ifdef ADJUST_BOUNDARY
83 integer :: lbij, ubij
84# endif
85 integer :: lbi, ubi, lbj, ubj
86!
87 character (len=*), parameter :: myfile = &
88 & __FILE__
89!
90!-----------------------------------------------------------------------
91! Write out history fields according to IO type.
92!-----------------------------------------------------------------------
93!
94# ifdef ADJUST_BOUNDARY
95 lbij=bounds(ng)%LBij
96 ubij=bounds(ng)%UBij
97# endif
98 lbi=bounds(ng)%LBi(tile)
99 ubi=bounds(ng)%UBi(tile)
100 lbj=bounds(ng)%LBj(tile)
101 ubj=bounds(ng)%UBj(tile)
102!
103 SELECT CASE (itl(ng)%IOtype)
104 CASE (io_nf90)
105 CALL tl_wrt_ini_nf90 (ng, tile, tindex, outrec, &
106# ifdef ADJUST_BOUNDARY
107 & lbij, ubij, &
108# endif
109 & lbi, ubi, lbj, ubj)
110
111# if defined PIO_LIB && defined DISTRIBUTE
112 CASE (io_pio)
113 CALL tl_wrt_ini_pio (ng, tile, tindex, outrec, &
114# ifdef ADJUST_BOUNDARY
115 & lbij, ubij, &
116# endif
117 & lbi, ubi, lbj, ubj)
118# endif
119 CASE DEFAULT
120 IF (master) WRITE (stdout,10) itl(ng)%IOtype
121 exit_flag=3
122 END SELECT
123 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
124!
125 10 FORMAT (' TL_WRT_INI - Illegal output file type, io_type = ',i0, &
126 & /,14x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
127!
128 RETURN
129 END SUBROUTINE tl_wrt_ini
130!
131!***********************************************************************
132 SUBROUTINE tl_wrt_ini_nf90 (ng, tile, Tindex, OutRec, &
133# ifdef ADJUST_BOUNDARY
134 & LBij, UBij, &
135# endif
136 & LBi, UBi, LBj, UBj)
137!***********************************************************************
138!
139 USE mod_netcdf
140!
141! Imported variable declarations.
142!
143 integer, intent(in) :: ng, tile, tindex, outrec
144# ifdef ADJUST_BOUNDARY
145 integer, intent(in) :: lbij, ubij
146# endif
147 integer, intent(in) :: lbi, ubi, lbj, ubj
148!
149! Local variable declarations.
150!
151 integer :: gfactor, gtype, i, itrc, status, varid
152!
153 real(dp) :: my_time, scale
154!
155# if defined RPCG
156 character (len=35) :: string
157# elif defined SP4DVAR
158 character (len=31) :: string
159# else
160 character (len=15) :: string
161# endif
162 character (len=*), parameter :: myfile = &
163 & __FILE__//", tl_wrt_ini_nf90"
164!
165 sourcefile=myfile
166!
167!-----------------------------------------------------------------------
168! Write out tangent linear initial conditions.
169!-----------------------------------------------------------------------
170!
171 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
172!
173! Report.
174!
175 IF (master) THEN
176# if defined RPCG
177 IF (outrec.eq.1) THEN
178 string='inner-loop initial fields '
179 ELSE IF (outrec.eq.2) THEN
180 string='final outer-loop increments '
181 ELSE IF (outrec.eq.3) THEN
182 string='sum of final outer-loop increments '
183 ELSE IF (outrec.eq.4) THEN
184 string='sum of adjoint solutions '
185 ELSE IF (outrec.eq.5) THEN
186 string='augmented correction term '
187 END IF
188# elif defined SP4DVAR
189 IF (outrec.eq.1) THEN
190 string='TLM initial fields '
191 ELSE IF ((2.le.outrec).and.(outrec.le.nsaddle+1)) THEN
192 string='TLM saddle-point starting field'
193 ELSE IF ((nsaddle+2.le.outrec).and.(outrec.le.2*nsaddle+2)) THEN
194 string='ADM saddle-point starting field'
195 END IF
196# else
197 IF (outrec.eq.1) THEN
198 string='initial fields'
199 ELSE IF (outrec.eq.2) THEN
200 string='v-increments '
201 ELSE IF (outrec.eq.3) THEN
202 string='v-increments '
203 ELSE IF (outrec.eq.4) THEN
204 string='v-summations '
205 ELSE IF (outrec.eq.5) THEN
206 string='x-increments '
207 END IF
208# endif
209# ifdef SOLVE3D
210 WRITE (stdout,10) string, outer, inner, tindex, tindex, outrec
211# else
212 WRITE (stdout,10) string, outer, inner, tindex, outrec
213# endif
214 END IF
215!
216! Set grid type factor to write full (gfactor=1) fields or water
217! points (gfactor=-1) fields only.
218!
219# if defined WRITE_WATER && defined MASKING
220 gfactor=-1
221# else
222 gfactor=1
223# endif
224!
225! Write out model time (s). Use the "tdays" variable here because of
226! the management of the "time" variable due to nesting.
227!
228 my_time=tdays(ng)*day2sec
229
230 CALL netcdf_put_fvar (ng, itlm, itl(ng)%name, &
231 & trim(vname(1,idtime)), my_time, &
232 & (/outrec/), (/1/), &
233 & ncid = itl(ng)%ncid, &
234 & varid = itl(ng)%Vid(idtime))
235 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
236!
237! Write out free-surface (m)
238!
239 scale=1.0_dp
240 gtype=gfactor*r2dvar
241 status=nf_fwrite2d(ng, itlm, itl(ng)%ncid, idfsur, &
242 & itl(ng)%Vid(idfsur), &
243 & outrec, gtype, &
244 & lbi, ubi, lbj, ubj, scale, &
245# ifdef MASKING
246 & grid(ng) % rmask, &
247# endif
248# ifdef WET_DRY
249 & ocean(ng) % tl_zeta(:,:,tindex), &
250 & setfillval = .false.)
251# else
252 & ocean(ng) % tl_zeta(:,:,tindex))
253# endif
254 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
255 IF (master) THEN
256 WRITE (stdout,20) trim(vname(1,idfsur)), outrec
257 END IF
258 exit_flag=3
259 ioerror=status
260 RETURN
261 END IF
262
263# ifdef ADJUST_BOUNDARY
264!
265! Write out free-surface open boundaries.
266!
267 IF (any(lobc(:,isfsur,ng))) THEN
268 scale=1.0_dp
269 status=nf_fwrite2d_bry(ng, itlm, itl(ng)%name, itl(ng)%ncid, &
270 & vname(1,idsbry(isfsur)), &
271 & itl(ng)%Vid(idsbry(isfsur)), &
272 & outrec, r2dvar, &
273 & lbij, ubij, nbrec(ng), scale, &
274 & boundary(ng) % tl_zeta_obc(lbij:,:,:, &
275 & tindex))
276 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
277 IF (master) THEN
278 WRITE (stdout,20) trim(vname(1,idsbry(isfsur))), outrec
279 END IF
280 exit_flag=3
281 ioerror=status
282 RETURN
283 END IF
284 END IF
285# endif
286!
287! Write out 2D U-momentum component (m/s).
288!
289 scale=1.0_dp
290 gtype=gfactor*u2dvar
291 status=nf_fwrite2d(ng, itlm, itl(ng)%ncid, idubar, &
292 & itl(ng)%Vid(idubar), &
293 & outrec, gtype, &
294 & lbi, ubi, lbj, ubj, scale, &
295# ifdef MASKING
296 & grid(ng) % umask_full, &
297# endif
298 & ocean(ng) % tl_ubar(:,:,tindex))
299 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
300 IF (master) THEN
301 WRITE (stdout,20) trim(vname(1,idubar)), outrec
302 END IF
303 exit_flag=3
304 ioerror=status
305 RETURN
306 END IF
307
308# ifdef ADJUST_BOUNDARY
309!
310! Write out 2D U-momentum component open boundaries.
311!
312 IF (any(lobc(:,isubar,ng))) THEN
313 scale=1.0_dp
314 status=nf_fwrite2d_bry(ng, itlm, itl(ng)%name, itl(ng)%ncid, &
315 & vname(1,idsbry(isubar)), &
316 & itl(ng)%Vid(idsbry(isubar)), &
317 & outrec, u2dvar, &
318 & lbij, ubij, nbrec(ng), scale, &
319 & boundary(ng) % tl_ubar_obc(lbij:,:,:, &
320 & tindex))
321 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
322 IF (master) THEN
323 WRITE (stdout,20) trim(vname(1,idsbry(isubar))), outrec
324 END IF
325 exit_flag=3
326 ioerror=status
327 RETURN
328 END IF
329 END IF
330# endif
331!
332! Write out 2D momentum component (m/s) in the ETA-direction.
333!
334 scale=1.0_dp
335 gtype=gfactor*v2dvar
336 status=nf_fwrite2d(ng, itlm, itl(ng)%ncid, idvbar, &
337 & itl(ng)%Vid(idvbar), &
338 & outrec, gtype, &
339 & lbi, ubi, lbj, ubj, scale, &
340# ifdef MASKING
341 & grid(ng) % vmask_full, &
342# endif
343 & ocean(ng) % tl_vbar(:,:,tindex))
344 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
345 IF (master) THEN
346 WRITE (stdout,20) trim(vname(1,idvbar)), outrec
347 END IF
348 exit_flag=3
349 ioerror=status
350 RETURN
351 END IF
352
353# ifdef ADJUST_BOUNDARY
354!
355! Write out 2D V-momentum component open boundaries.
356!
357 IF (any(lobc(:,isvbar,ng))) THEN
358 scale=1.0_dp
359 status=nf_fwrite2d_bry(ng, itlm, itl(ng)%name, itl(ng)%ncid, &
360 & vname(1,idsbry(isvbar)), &
361 & itl(ng)%Vid(idsbry(isvbar)), &
362 & outrec, v2dvar, &
363 & lbij, ubij, nbrec(ng), scale, &
364 & boundary(ng) % tl_vbar_obc(lbij:,:,:, &
365 & tindex))
366 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
367 IF (master) THEN
368 WRITE (stdout,20) trim(vname(1,idsbry(isvbar))), outrec
369 END IF
370 exit_flag=3
371 ioerror=status
372 RETURN
373 END IF
374 END IF
375# endif
376# ifdef ADJUST_WSTRESS
377!
378! Write out surface U-momentum stress. Notice that the stress has its
379! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
380! at other times in addition to initialization time.
381!
382 scale=1.0_dp ! m2/s2
383 gtype=gfactor*u3dvar
384 status=nf_fwrite3d(ng, itlm, itl(ng)%ncid, idusms, &
385 & itl(ng)%Vid(idusms), &
386 & outrec, gtype, &
387 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
388# ifdef MASKING
389 & grid(ng) % umask, &
390# endif
391 & forces(ng) % tl_ustr(:,:,:,tindex))
392 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
393 IF (master) THEN
394 WRITE (stdout,20) trim(vname(1,idusms)), outrec
395 END IF
396 exit_flag=3
397 ioerror=status
398 RETURN
399 END IF
400!
401! Write out surface V-momentum stress.
402!
403 scale=1.0_dp ! m2/s2
404 gtype=gfactor*v3dvar
405 status=nf_fwrite3d(ng, itlm, itl(ng)%ncid, idvsms, &
406 & itl(ng)%Vid(idvsms), &
407 & outrec, gtype, &
408 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
409# ifdef MASKING
410 & grid(ng) % vmask, &
411# endif
412 & forces(ng) % tl_vstr(:,:,:,tindex))
413 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
414 IF (master) THEN
415 WRITE (stdout,20) trim(vname(1,idvsms)), outrec
416 END IF
417 exit_flag=3
418 ioerror=status
419 RETURN
420 END IF
421# endif
422# ifdef SOLVE3D
423!
424! Write out 3D U-momentum component (m/s).
425!
426 scale=1.0_dp
427 gtype=gfactor*u3dvar
428 status=nf_fwrite3d(ng, itlm, itl(ng)%ncid, iduvel, &
429 & itl(ng)%Vid(iduvel), &
430 & outrec, gtype, &
431 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
432# ifdef MASKING
433 & grid(ng) % umask_full, &
434# endif
435 & ocean(ng) % tl_u(:,:,:,tindex))
436 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
437 IF (master) THEN
438 WRITE (stdout,20) trim(vname(1,iduvel)), outrec
439 END IF
440 exit_flag=3
441 ioerror=status
442 RETURN
443 END IF
444
445# ifdef ADJUST_BOUNDARY
446!
447! Write out 3D U-momentum component open boundaries.
448!
449 IF (any(lobc(:,isuvel,ng))) THEN
450 scale=1.0_dp
451 status=nf_fwrite3d_bry(ng, itlm, itl(ng)%name, itl(ng)%ncid, &
452 & vname(1,idsbry(isuvel)), &
453 & itl(ng)%Vid(idsbry(isuvel)), &
454 & outrec, u3dvar, &
455 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
456 & boundary(ng) % tl_u_obc(lbij:,:,:,:, &
457 & tindex))
458 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
459 IF (master) THEN
460 WRITE (stdout,20) trim(vname(1,idsbry(isuvel))), outrec
461 END IF
462 exit_flag=3
463 ioerror=status
464 RETURN
465 END IF
466 END IF
467# endif
468!
469! Write out 3D V-momentum component (m/s).
470!
471 scale=1.0_dp
472 gtype=gfactor*v3dvar
473 status=nf_fwrite3d(ng, itlm, itl(ng)%ncid, idvvel, &
474 & itl(ng)%Vid(idvvel), &
475 & outrec, gtype, &
476 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
477# ifdef MASKING
478 & grid(ng) % vmask_full, &
479# endif
480 & ocean(ng) % tl_v(:,:,:,tindex))
481 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
482 IF (master) THEN
483 WRITE (stdout,20) trim(vname(1,idvvel)), outrec
484 END IF
485 exit_flag=3
486 ioerror=status
487 RETURN
488 END IF
489
490# ifdef ADJUST_BOUNDARY
491!
492! Write out 3D V-momentum component open boundaries.
493!
494 IF (any(lobc(:,isvvel,ng))) THEN
495 scale=1.0_dp
496 status=nf_fwrite3d_bry(ng, itlm, itl(ng)%name, itl(ng)%ncid, &
497 & vname(1,idsbry(isvvel)), &
498 & itl(ng)%Vid(idsbry(isvvel)), &
499 & outrec, v3dvar, &
500 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
501 & boundary(ng) % tl_v_obc(lbij:,:,:,:, &
502 & tindex))
503 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
504 IF (master) THEN
505 WRITE (stdout,20) trim(vname(1,idsbry(isvvel))), outrec
506 END IF
507 exit_flag=3
508 ioerror=status
509 RETURN
510 END IF
511 END IF
512# endif
513!
514! Write out tracer type variables.
515!
516 DO itrc=1,nt(ng)
517 scale=1.0_dp
518 gtype=gfactor*r3dvar
519 status=nf_fwrite3d(ng, itlm, itl(ng)%ncid, idtvar(itrc), &
520 & itl(ng)%Tid(itrc), &
521 & outrec, gtype, &
522 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
523# ifdef MASKING
524 & grid(ng) % rmask, &
525# endif
526 & ocean(ng) % tl_t(:,:,:,tindex,itrc))
527 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
528 IF (master) THEN
529 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), outrec
530 END IF
531 exit_flag=3
532 ioerror=status
533 RETURN
534 END IF
535 END DO
536
537# ifdef ADJUST_BOUNDARY
538!
539! Write out 3D tracers open boundaries.
540!
541 DO itrc=1,nt(ng)
542 IF (any(lobc(:,istvar(itrc),ng))) THEN
543 scale=1.0_dp
544 status=nf_fwrite3d_bry(ng, itlm, itl(ng)%name, itl(ng)%ncid, &
545 & vname(1,idsbry(istvar(itrc))), &
546 & itl(ng)%Vid(idsbry(istvar(itrc))), &
547 & outrec, r3dvar, &
548 & lbij, ubij, 1, n(ng), nbrec(ng), &
549 & scale, &
550 & boundary(ng) % tl_t_obc(lbij:,:,:,:, &
551 & tindex,itrc))
552 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
553 IF (master) THEN
554 WRITE (stdout,20) trim(vname(1,idsbry(istvar(itrc)))), &
555 & outrec
556 END IF
557 exit_flag=3
558 ioerror=status
559 RETURN
560 END IF
561 END IF
562 END DO
563# endif
564# ifdef ADJUST_STFLUX
565!
566! Write out surface net tracers fluxes. Notice that fluxes have their
567! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
568! at other times in addition to initialization time.
569!
570 DO itrc=1,nt(ng)
571 IF (lstflux(itrc,ng)) THEN
572 scale=1.0_dp ! kinematic flux units
573 gtype=gfactor*r3dvar
574 status=nf_fwrite3d(ng, itlm, itl(ng)%ncid, idtsur(itrc), &
575 & itl(ng)%Vid(idtsur(itrc)), &
576 & outrec, gtype, &
577 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
578# ifdef MASKING
579 & grid(ng) % rmask, &
580# endif
581 & forces(ng) % tl_tflux(:,:,:,tindex,itrc))
582 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
583 IF (master) THEN
584 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
585 & outrec
586 END IF
587 exit_flag=3
588 ioerror=status
589 RETURN
590 END IF
591 END IF
592 END DO
593# endif
594# endif
595
596# if defined I4DVAR || defined BACKGROUND
597!
598!-----------------------------------------------------------------------
599! If 4D-Var increment phase, write out cost functions to DAV(ng)%name
600! NetCDF file.
601!-----------------------------------------------------------------------
602
603# if defined I4DVAR
604!
605! Write out tangent linear model misfit cost function. Notice that it
606! is written into DAV(ng)%name file instead of ITL(ng)%name file.
607!
608 IF (lwrtcost(ng)) THEN
609 CALL netcdf_put_fvar (ng, itlm, dav(ng)%name, &
610 & 'TLcost_function', &
611 & fourdvar(ng)%ObsCost(0), &
612 & (/nrun/), (/1/), &
613 & ncid = dav(ng)%ncid)
614 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
615 END IF
616# endif
617
618# ifdef BACKGROUND
619!
620! Write out background misfit cost function, Jb. Notice that it is
621! written into DAV(ng)%name file instead of ITL(ng)%name file.
622!
623 IF (lwrtcost(ng)) THEN
624 CALL netcdf_put_fvar (ng, itlm, dav(ng)%name, &
625 & 'back_function', &
626 & fourdvar(ng)%BackCost(0), &
627 & (/nrun/), (/1/), &
628 & ncid = dav(ng)%ncid)
629 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
630 END IF
631# endif
632
633# if defined I4DVAR
634!
635! Write out current optimal, normalized cost function minimum. Notice
636! that it is written into DAV(ng)%name file instead of ITL(ng)%name
637! file.
638!
639 IF (lwrtcost(ng)) THEN
640 CALL netcdf_put_fvar (ng, itlm, dav(ng)%name, &
641 & 'Jmin', optimality(ng:), &
642 & (/nrun/), (/1/), &
643 & ncid = dav(ng)%ncid)
644 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
645 END IF
646# endif
647# endif
648!
649!-----------------------------------------------------------------------
650! Synchronize tangent linear initial NetCDF file to disk to allow other
651! processes to access data immediately after it is written.
652!-----------------------------------------------------------------------
653!
654 CALL netcdf_sync (ng, itlm, itl(ng)%name, itl(ng)%ncid)
655 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
656
657# if defined I4DVAR || defined BACKGROUND
658 CALL netcdf_sync (ng, itlm, dav(ng)%name, dav(ng)%ncid)
659 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
660# endif
661 !
66210 FORMAT (2x,'TL_WRT_INI_NF90 - writing ',a, &
663 & ' (Outer=',i2.2,', Inner=',i3.3,', Index=',i0, &
664# ifdef SOLVE3D
665 & ',',i0,', Rec=',i0,')')
666# else
667 & ', Rec=',i0,')')
668# endif
669 20 FORMAT (/,' TL_WRT_INI_NF90 - error while writing variable: ',a, &
670 & /,14x,'into tangent initial file for time record: ',i0)
671!
672 RETURN
673 END SUBROUTINE tl_wrt_ini_nf90
674
675# if defined PIO_LIB && defined DISTRIBUTE
676!
677!***********************************************************************
678 SUBROUTINE tl_wrt_ini_pio (ng, tile, Tindex, OutRec, &
679# ifdef ADJUST_BOUNDARY
680 & LBij, UBij, &
681# endif
682 & LBi, UBi, LBj, UBj)
683!***********************************************************************
684!
685 USE mod_pio_netcdf
686!
687! Imported variable declarations.
688!
689 integer, intent(in) :: ng, tile, tindex, outrec
690# ifdef ADJUST_BOUNDARY
691 integer, intent(in) :: lbij, ubij
692# endif
693 integer, intent(in) :: lbi, ubi, lbj, ubj
694!
695! Local variable declarations.
696!
697 integer :: i, ifield, itrc, status
698!
699 real(dp) :: my_time, scale
700!
701# if defined RPCG
702 character (len=35) :: string
703# elif defined SP4DVAR
704 character (len=31) :: string
705# else
706 character (len=15) :: string
707# endif
708 character (len=*), parameter :: myfile = &
709 & __FILE__//", tl_wrt_ini_pio"
710!
711 TYPE (io_desc_t), pointer :: iodesc
712!
713 sourcefile=myfile
714!
715!-----------------------------------------------------------------------
716! Write out tangent linear initial conditions.
717!-----------------------------------------------------------------------
718!
719 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
720!
721! Report.
722!
723 IF (master) THEN
724# if defined RPCG
725 IF (outrec.eq.1) THEN
726 string='inner-loop initial fields '
727 ELSE IF (outrec.eq.2) THEN
728 string='final outer-loop increments '
729 ELSE IF (outrec.eq.3) THEN
730 string='sum of final outer-loop increments '
731 ELSE IF (outrec.eq.4) THEN
732 string='sum of adjoint solutions '
733 ELSE IF (outrec.eq.5) THEN
734 string='augmented correction term '
735 END IF
736# elif defined SP4DVAR
737 IF (outrec.eq.1) THEN
738 string='TLM initial fields '
739 ELSE IF ((2.le.outrec).and.(outrec.le.nsaddle+1)) THEN
740 string='TLM saddle-point starting field'
741 ELSE IF ((nsaddle+2.le.outrec).and.(outrec.le.2*nsaddle+2)) THEN
742 string='ADM saddle-point starting field'
743 END IF
744# else
745 IF (outrec.eq.1) THEN
746 string='initial fields'
747 ELSE IF (outrec.eq.2) THEN
748 string='v-increments '
749 ELSE IF (outrec.eq.3) THEN
750 string='v-increments '
751 ELSE IF (outrec.eq.4) THEN
752 string='v-summations '
753 ELSE IF (outrec.eq.5) THEN
754 string='x-increments '
755 END IF
756# endif
757# ifdef SOLVE3D
758 WRITE (stdout,10) string, outer, inner, tindex, tindex, outrec
759# else
760 WRITE (stdout,10) string, outer, inner, tindex, outrec
761# endif
762 END IF
763!
764! Write out model time (s). Use the "tdays" variable here because of
765! the management of the "time" variable due to nesting.
766!
767 my_time=tdays(ng)*day2sec
768
769 CALL pio_netcdf_put_fvar (ng, itlm, itl(ng)%name, &
770 & trim(vname(1,idtime)), my_time, &
771 & (/outrec/), (/1/), &
772 & piofile = itl(ng)%pioFile, &
773 & piovar = itl(ng)%pioVar(idtime)%vd)
774 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
775!
776! Write out free-surface (m)
777!
778 scale=1.0_dp
779 IF (itl(ng)%pioVar(idfsur)%dkind.eq.pio_double) THEN
780 iodesc => iodesc_dp_r2dvar(ng)
781 ELSE
782 iodesc => iodesc_sp_r2dvar(ng)
783 END IF
784!
785 status=nf_fwrite2d(ng, itlm, itl(ng)%pioFile, idfsur, &
786 & itl(ng)%pioVar(idfsur), &
787 & outrec, iodesc, &
788 & lbi, ubi, lbj, ubj, scale, &
789# ifdef MASKING
790 & grid(ng) % rmask, &
791# endif
792# ifdef WET_DRY
793 & ocean(ng) % tl_zeta(:,:,tindex), &
794 & setfillval = .false.)
795# else
796 & ocean(ng) % tl_zeta(:,:,tindex))
797# endif
798 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
799 IF (master) THEN
800 WRITE (stdout,20) trim(vname(1,idfsur)), outrec
801 END IF
802 exit_flag=3
803 ioerror=status
804 RETURN
805 END IF
806
807# ifdef ADJUST_BOUNDARY
808!
809! Write out free-surface open boundaries.
810!
811 IF (any(lobc(:,isfsur,ng))) THEN
812 scale=1.0_dp
813 IF (itl(ng)%pioVar(idsbry(isfsur))%dkind.eq.pio_double) THEN
814 iodesc => iodesc_dp_r2dobc(ng)
815 ELSE
816 iodesc => iodesc_sp_r2dobc(ng)
817 END IF
818!
819 status=nf_fwrite2d_bry(ng, itlm, itl(ng)%name, &
820 & itl(ng)%pioFile, &
821 & vname(1,idsbry(isfsur)), &
822 & itl(ng)%pioVar(idsbry(isfsur)), &
823 & outrec, iodesc, &
824 & lbij, ubij, nbrec(ng), scale, &
825 & boundary(ng) % tl_zeta_obc(lbij:,:,:, &
826 & tindex))
827 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
828 IF (master) THEN
829 WRITE (stdout,20) trim(vname(1,idsbry(isfsur))), outrec
830 END IF
831 exit_flag=3
832 ioerror=status
833 RETURN
834 END IF
835 END IF
836# endif
837!
838! Write out 2D U-momentum component (m/s).
839!
840 scale=1.0_dp
841 IF (itl(ng)%pioVar(idubar)%dkind.eq.pio_double) THEN
842 iodesc => iodesc_dp_u2dvar(ng)
843 ELSE
844 iodesc => iodesc_sp_u2dvar(ng)
845 END IF
846!
847 status=nf_fwrite2d(ng, itlm, itl(ng)%pioFile, idubar, &
848 & itl(ng)%pioVar(idubar), &
849 & outrec, iodesc, &
850 & lbi, ubi, lbj, ubj, scale, &
851# ifdef MASKING
852 & grid(ng) % umask_full, &
853# endif
854 & ocean(ng) % tl_ubar(:,:,tindex))
855 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
856 IF (master) THEN
857 WRITE (stdout,20) trim(vname(1,idubar)), outrec
858 END IF
859 exit_flag=3
860 ioerror=status
861 RETURN
862 END IF
863
864# ifdef ADJUST_BOUNDARY
865!
866! Write out 2D U-momentum component open boundaries.
867!
868 IF (any(lobc(:,isubar,ng))) THEN
869 scale=1.0_dp
870 IF (itl(ng)%pioVar(idsbry(isubar))%dkind.eq.pio_double) THEN
871 iodesc => iodesc_dp_u2dobc(ng)
872 ELSE
873 iodesc => iodesc_sp_u2dobc(ng)
874 END IF
875!
876 status=nf_fwrite2d_bry(ng, itlm, itl(ng)%name, &
877 & itl(ng)%pioFile, &
878 & vname(1,idsbry(isubar)), &
879 & itl(ng)%pioVar(idsbry(isubar)), &
880 & outrec, iodesc, &
881 & lbij, ubij, nbrec(ng), scale, &
882 & boundary(ng) % tl_ubar_obc(lbij:,:,:, &
883 & tindex))
884 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
885 IF (master) THEN
886 WRITE (stdout,20) trim(vname(1,idsbry(isubar))), outrec
887 END IF
888 exit_flag=3
889 ioerror=status
890 RETURN
891 END IF
892 END IF
893# endif
894!
895! Write out 2D momentum component (m/s) in the ETA-direction.
896!
897 scale=1.0_dp
898 IF (itl(ng)%pioVar(idvbar)%dkind.eq.pio_double) THEN
899 iodesc => iodesc_dp_v2dvar(ng)
900 ELSE
901 iodesc => iodesc_sp_v2dvar(ng)
902 END IF
903!
904 status=nf_fwrite2d(ng, itlm, itl(ng)%pioFile, idvbar, &
905 & itl(ng)%pioVar(idvbar), &
906 & outrec, iodesc, &
907 & lbi, ubi, lbj, ubj, scale, &
908# ifdef MASKING
909 & grid(ng) % vmask_full, &
910# endif
911 & ocean(ng) % tl_vbar(:,:,tindex))
912 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
913 IF (master) THEN
914 WRITE (stdout,20) trim(vname(1,idvbar)), outrec
915 END IF
916 exit_flag=3
917 ioerror=status
918 RETURN
919 END IF
920
921# ifdef ADJUST_BOUNDARY
922!
923! Write out 2D V-momentum component open boundaries.
924!
925 IF (any(lobc(:,isvbar,ng))) THEN
926 scale=1.0_dp
927 IF (itl(ng)%pioVar(idsbry(isvbar))%dkind.eq.pio_double) THEN
928 iodesc => iodesc_dp_v2dobc(ng)
929 ELSE
930 iodesc => iodesc_sp_v2dobc(ng)
931 END IF
932!
933 status=nf_fwrite2d_bry(ng, itlm, itl(ng)%name, &
934 & itl(ng)%pioFile, &
935 & vname(1,idsbry(isvbar)), &
936 & itl(ng)%pioVar(idsbry(isvbar)), &
937 & outrec, iodesc, &
938 & lbij, ubij, nbrec(ng), scale, &
939 & boundary(ng) % tl_vbar_obc(lbij:,:,:, &
940 & tindex))
941 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
942 IF (master) THEN
943 WRITE (stdout,20) trim(vname(1,idsbry(isvbar))), outrec
944 END IF
945 exit_flag=3
946 ioerror=status
947 RETURN
948 END IF
949 END IF
950# endif
951# ifdef ADJUST_WSTRESS
952!
953! Write out surface U-momentum stress. Notice that the stress has its
954! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
955! at other times in addition to initialization time.
956!
957 scale=1.0_dp ! m2/s2
958 IF (itl(ng)%pioVar(idusms)%dkind.eq.pio_double) THEN
959 iodesc => iodesc_dp_u2dfrc(ng)
960 ELSE
961 iodesc => iodesc_sp_u2dfrc(ng)
962 END IF
963!
964 status=nf_fwrite3d(ng, itlm, itl(ng)%pioFile, idusms, &
965 & itl(ng)%pioVar(idusms), &
966 & outrec, iodesc, &
967 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
968# ifdef MASKING
969 & grid(ng) % umask, &
970# endif
971 & forces(ng) % tl_ustr(:,:,:,tindex))
972 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
973 IF (master) THEN
974 WRITE (stdout,20) trim(vname(1,idusms)), outrec
975 END IF
976 exit_flag=3
977 ioerror=status
978 RETURN
979 END IF
980!
981! Write out surface V-momentum stress.
982!
983 scale=1.0_dp ! m2/s2
984 IF (itl(ng)%pioVar(idvsms)%dkind.eq.pio_double) THEN
985 iodesc => iodesc_dp_v2dfrc(ng)
986 ELSE
987 iodesc => iodesc_sp_v2dfrc(ng)
988 END IF
989!
990 status=nf_fwrite3d(ng, itlm, itl(ng)%pioFile, idvsms, &
991 & itl(ng)%pioVar(idvsms), &
992 & outrec, iodesc, &
993 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
994# ifdef MASKING
995 & grid(ng) % vmask, &
996# endif
997 & forces(ng) % tl_vstr(:,:,:,tindex))
998 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
999 IF (master) THEN
1000 WRITE (stdout,20) trim(vname(1,idvsms)), outrec
1001 END IF
1002 exit_flag=3
1003 ioerror=status
1004 RETURN
1005 END IF
1006# endif
1007# ifdef SOLVE3D
1008!
1009! Write out 3D U-momentum component (m/s).
1010!
1011 scale=1.0_dp
1012 IF (itl(ng)%pioVar(iduvel)%dkind.eq.pio_double) THEN
1013 iodesc => iodesc_dp_u3dvar(ng)
1014 ELSE
1015 iodesc => iodesc_sp_u3dvar(ng)
1016 END IF
1017!
1018 status=nf_fwrite3d(ng, itlm, itl(ng)%pioFile, iduvel, &
1019 & itl(ng)%pioVar(iduvel), &
1020 & outrec, iodesc, &
1021 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1022# ifdef MASKING
1023 & grid(ng) % umask_full, &
1024# endif
1025 & ocean(ng) % tl_u(:,:,:,tindex))
1026 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1027 IF (master) THEN
1028 WRITE (stdout,20) trim(vname(1,iduvel)), outrec
1029 END IF
1030 exit_flag=3
1031 ioerror=status
1032 RETURN
1033 END IF
1034
1035# ifdef ADJUST_BOUNDARY
1036!
1037! Write out 3D U-momentum component open boundaries.
1038!
1039 IF (any(lobc(:,isuvel,ng))) THEN
1040 scale=1.0_dp
1041 IF (itl(ng)%pioVar(idsbry(isuvel))%dkind.eq.pio_double) THEN
1042 iodesc => iodesc_dp_u3dobc(ng)
1043 ELSE
1044 iodesc => iodesc_sp_u3dobc(ng)
1045 END IF
1046!
1047 status=nf_fwrite3d_bry(ng, itlm, itl(ng)%name, &
1048 & itl(ng)%pioFile, &
1049 & vname(1,idsbry(isuvel)), &
1050 & itl(ng)%pioVar(idsbry(isuvel)), &
1051 & outrec, iodesc, &
1052 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
1053 & boundary(ng) % tl_u_obc(lbij:,:,:,:, &
1054 & tindex))
1055 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1056 IF (master) THEN
1057 WRITE (stdout,20) trim(vname(1,idsbry(isuvel))), outrec
1058 END IF
1059 exit_flag=3
1060 ioerror=status
1061 RETURN
1062 END IF
1063 END IF
1064# endif
1065!
1066! Write out 3D V-momentum component (m/s).
1067!
1068 scale=1.0_dp
1069 IF (itl(ng)%pioVar(idvvel)%dkind.eq.pio_double) THEN
1070 iodesc => iodesc_dp_v3dvar(ng)
1071 ELSE
1072 iodesc => iodesc_sp_v3dvar(ng)
1073 END IF
1074!
1075 status=nf_fwrite3d(ng, itlm, itl(ng)%pioFile, idvvel, &
1076 & itl(ng)%pioVar(idvvel), &
1077 & outrec, iodesc, &
1078 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1079# ifdef MASKING
1080 & grid(ng) % vmask_full, &
1081# endif
1082 & ocean(ng) % tl_v(:,:,:,tindex))
1083 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1084 IF (master) THEN
1085 WRITE (stdout,20) trim(vname(1,idvvel)), outrec
1086 END IF
1087 exit_flag=3
1088 ioerror=status
1089 RETURN
1090 END IF
1091
1092# ifdef ADJUST_BOUNDARY
1093!
1094! Write out 3D V-momentum component open boundaries.
1095!
1096 IF (any(lobc(:,isvvel,ng))) THEN
1097 scale=1.0_dp
1098 IF (itl(ng)%pioVar(idsbry(isvvel))%dkind.eq.pio_double) THEN
1099 iodesc => iodesc_dp_v3dobc(ng)
1100 ELSE
1101 iodesc => iodesc_sp_v3dobc(ng)
1102 END IF
1103!
1104 status=nf_fwrite3d_bry(ng, itlm, itl(ng)%name, &
1105 & itl(ng)%pioFile, &
1106 & vname(1,idsbry(isvvel)), &
1107 & itl(ng)%pioVar(idsbry(isvvel)), &
1108 & outrec, iodesc, &
1109 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
1110 & boundary(ng) % tl_v_obc(lbij:,:,:,:, &
1111 & tindex))
1112 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1113 IF (master) THEN
1114 WRITE (stdout,20) trim(vname(1,idsbry(isvvel))), outrec
1115 END IF
1116 exit_flag=3
1117 ioerror=status
1118 RETURN
1119 END IF
1120 END IF
1121# endif
1122!
1123! Write out tracer type variables.
1124!
1125 DO itrc=1,nt(ng)
1126 scale=1.0_dp
1127 IF (itl(ng)%pioTrc(itrc)%dkind.eq.pio_double) THEN
1128 iodesc => iodesc_dp_r3dvar(ng)
1129 ELSE
1130 iodesc => iodesc_sp_r3dvar(ng)
1131 END IF
1132!
1133 status=nf_fwrite3d(ng, itlm, itl(ng)%pioFile, idtvar(itrc), &
1134 & itl(ng)%pioTrc(itrc), &
1135 & outrec, iodesc, &
1136 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1137# ifdef MASKING
1138 & grid(ng) % rmask, &
1139# endif
1140 & ocean(ng) % tl_t(:,:,:,tindex,itrc))
1141 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1142 IF (master) THEN
1143 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), outrec
1144 END IF
1145 exit_flag=3
1146 ioerror=status
1147 RETURN
1148 END IF
1149 END DO
1150
1151# ifdef ADJUST_BOUNDARY
1152!
1153! Write out 3D tracers open boundaries.
1154!
1155 DO itrc=1,nt(ng)
1156 IF (any(lobc(:,istvar(itrc),ng))) THEN
1157 scale=1.0_dp
1158 ifield=idsbry(istvar(itrc))
1159 IF (itl(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
1160 iodesc => iodesc_dp_r3dobc(ng)
1161 ELSE
1162 iodesc => iodesc_sp_r3dobc(ng)
1163 END IF
1164!
1165 status=nf_fwrite3d_bry(ng, itlm, itl(ng)%name, &
1166 & itl(ng)%pioFile, &
1167 & vname(1,ifield), &
1168 & itl(ng)%pioVar(ifield), &
1169 & outrec, iodesc, &
1170 & lbij, ubij, 1, n(ng), nbrec(ng), &
1171 & scale, &
1172 & boundary(ng) % tl_t_obc(lbij:,:,:,:, &
1173 & tindex,itrc))
1174 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1175 IF (master) THEN
1176 WRITE (stdout,20) trim(vname(1,ifield)), outrec
1177 END IF
1178 exit_flag=3
1179 ioerror=status
1180 RETURN
1181 END IF
1182 END IF
1183 END DO
1184# endif
1185# ifdef ADJUST_STFLUX
1186!
1187! Write out surface net tracers fluxes. Notice that fluxes have their
1188! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
1189! at other times in addition to initialization time.
1190!
1191 DO itrc=1,nt(ng)
1192 IF (lstflux(itrc,ng)) THEN
1193 scale=1.0_dp ! kinematic flux units
1194 IF (itl(ng)%pioVar(idtsur(itrc))%dkind.eq.pio_double) THEN
1195 iodesc => iodesc_dp_r2dfrc(ng)
1196 ELSE
1197 iodesc => iodesc_sp_r2dfrc(ng)
1198 END IF
1199!
1200 status=nf_fwrite3d(ng, itlm, itl(ng)%pioFile, idtsur(itrc), &
1201 & itl(ng)%pioVar(idtsur(itrc)), &
1202 & outrec, iodesc, &
1203 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
1204# ifdef MASKING
1205 & grid(ng) % rmask, &
1206# endif
1207 & forces(ng) % tl_tflux(:,:,:,tindex,itrc))
1208 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1209 IF (master) THEN
1210 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
1211 & outrec
1212 END IF
1213 exit_flag=3
1214 ioerror=status
1215 RETURN
1216 END IF
1217 END IF
1218 END DO
1219# endif
1220# endif
1221
1222# if defined I4DVAR || defined BACKGROUND
1223!
1224!-----------------------------------------------------------------------
1225! If 4D-Var increment phase, write out cost functions to DAV(ng)%name
1226! NetCDF file.
1227!-----------------------------------------------------------------------
1228
1229# if defined I4DVAR
1230!
1231! Write out tangent linear model misfit cost function. Notice that it
1232! is written into DAV(ng)%name file instead of ITL(ng)%name file.
1233!
1234 IF (lwrtcost(ng)) THEN
1235 CALL pio_netcdf_put_fvar (ng, itlm, dav(ng)%name, &
1236 & 'TLcost_function', &
1237 & fourdvar(ng)%ObsCost(0), &
1238 & (/nrun/), (/1/), &
1239 & piofile = dav(ng)%pioFile)
1240 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1241 END IF
1242# endif
1243
1244# ifdef BACKGROUND
1245!
1246! Write out background misfit cost function, Jb. Notice that it is
1247! written into DAV(ng)%name file instead of ITL(ng)%name file.
1248!
1249 IF (lwrtcost(ng)) THEN
1250 CALL pio_netcdf_put_fvar (ng, itlm, dav(ng)%name, &
1251 & 'back_function', &
1252 & fourdvar(ng)%BackCost(0), &
1253 & (/nrun/), (/1/), &
1254 & piofile = dav(ng)%pioFile)
1255 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1256 END IF
1257# endif
1258
1259# if defined I4DVAR
1260!
1261! Write out current optimal, normalized cost function minimum. Notice
1262! that it is written into DAV(ng)%name file instead of ITL(ng)%name
1263! file.
1264!
1265 IF (lwrtcost(ng)) THEN
1266 CALL pio_netcdf_put_fvar (ng, itlm, dav(ng)%name, &
1267 & 'Jmin', optimality(ng:), &
1268 & (/nrun/), (/1/), &
1269 & piofile = dav(ng)%pioFile)
1270 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1271 END IF
1272# endif
1273# endif
1274!
1275!-----------------------------------------------------------------------
1276! Synchronize tangent linear initial NetCDF file to disk to allow other
1277! processes to access data immediately after it is written.
1278!-----------------------------------------------------------------------
1279!
1280 CALL pio_netcdf_sync (ng, itlm, itl(ng)%name, itl(ng)%pioFile)
1281 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1282
1283# if defined I4DVAR || defined BACKGROUND
1284 CALL pio_netcdf_sync (ng, itlm, dav(ng)%name, dav(ng)%pioFile)
1285 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1286# endif
1287!
1288 10 FORMAT (2x,'TL_WRT_INI_PIO - writing ',a, &
1289 & ' (Outer=',i2.2,', Inner=',i3.3,', Index=',i0, &
1290# ifdef SOLVE3D
1291 & ',',i0,', Rec=',i0,')')
1292# else
1293 & ', Rec=',i0,')')
1294# endif
1295 20 FORMAT (/,' TL_WRT_INI_PIO - error while writing variable: ',a, &
1296 & /,14x,'into tangent initial file for time record: ',i0)
1297!
1298 RETURN
1299 END SUBROUTINE tl_wrt_ini_pio
1300# endif
1301#endif
1302 END MODULE tl_wrt_ini_mod
distribute_mod::mp_bcasti
Definition distribute.F:95
mod_netcdf::netcdf_put_fvar
Definition mod_netcdf.F:82
mod_pio_netcdf::pio_netcdf_put_fvar
Definition mod_pio_netcdf.F:94
nf_fwrite2d_bry_mod::nf_fwrite2d_bry
Definition nf_fwrite2d_bry.F:79
nf_fwrite2d_mod::nf_fwrite2d
Definition nf_fwrite2d.F:77
nf_fwrite3d_bry_mod::nf_fwrite3d_bry
Definition nf_fwrite3d_bry.F:81
nf_fwrite3d_mod::nf_fwrite3d
Definition nf_fwrite3d.F:78
distribute_mod
Definition distribute.F:3
mod_boundary
Definition mod_boundary.F:2
mod_boundary::boundary
type(t_boundary), dimension(:), allocatable boundary
Definition mod_boundary.F:746
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
mod_fourdvar
Definition mod_fourdvar.F:2
mod_fourdvar::fourdvar
type(t_fourdvar), dimension(:), allocatable fourdvar
Definition mod_fourdvar.F:211
mod_fourdvar::optimality
real(r8), dimension(:), allocatable optimality
Definition mod_fourdvar.F:478
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_iounits
Definition mod_iounits.F:2
mod_iounits::ioerror
integer ioerror
Definition mod_iounits.F:313
mod_iounits::itl
type(t_io), dimension(:), allocatable itl
Definition mod_iounits.F:227
mod_iounits::dav
type(t_io), dimension(:), allocatable dav
Definition mod_iounits.F:205
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_iounits::sourcefile
character(len=256) sourcefile
Definition mod_iounits.F:317
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::io_nf90
integer, parameter io_nf90
Definition mod_ncparam.F:95
mod_ncparam::idubar
integer idubar
Definition mod_ncparam.F:325
mod_ncparam::idvvel
integer idvvel
Definition mod_ncparam.F:381
mod_ncparam::idvsms
integer idvsms
Definition mod_ncparam.F:377
mod_ncparam::isvvel
integer isvvel
Definition mod_ncparam.F:507
mod_ncparam::idsbry
integer, dimension(:), allocatable idsbry
Definition mod_ncparam.F:523
mod_ncparam::io_pio
integer, parameter io_pio
Definition mod_ncparam.F:96
mod_ncparam::isvbar
integer isvbar
Definition mod_ncparam.F:505
mod_ncparam::idtsur
integer, dimension(:), allocatable idtsur
Definition mod_ncparam.F:453
mod_ncparam::idfsur
integer idfsur
Definition mod_ncparam.F:206
mod_ncparam::idtvar
integer, dimension(:), allocatable idtvar
Definition mod_ncparam.F:568
mod_ncparam::istvar
integer, dimension(:), allocatable istvar
Definition mod_ncparam.F:520
mod_ncparam::isuvel
integer isuvel
Definition mod_ncparam.F:506
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_ncparam::iduvel
integer iduvel
Definition mod_ncparam.F:343
mod_ncparam::vname
character(len=maxlen), dimension(6, 0:nv) vname
Definition mod_ncparam.F:591
mod_ncparam::idtime
integer idtime
Definition mod_ncparam.F:307
mod_ncparam::isubar
integer isubar
Definition mod_ncparam.F:504
mod_ncparam::idusms
integer idusms
Definition mod_ncparam.F:339
mod_ncparam::idvbar
integer idvbar
Definition mod_ncparam.F:360
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::netcdf_sync
subroutine, public netcdf_sync(ng, model, ncname, ncid)
Definition mod_netcdf.F:9505
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_param
Definition mod_param.F:2
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::bounds
type(t_bounds), dimension(:), allocatable bounds
Definition mod_param.F:232
mod_param::r3dvar
integer, parameter r3dvar
Definition mod_param.F:721
mod_param::u3dvar
integer, parameter u3dvar
Definition mod_param.F:722
mod_param::u2dvar
integer, parameter u2dvar
Definition mod_param.F:718
mod_param::itlm
integer, parameter itlm
Definition mod_param.F:663
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_param::v2dvar
integer, parameter v2dvar
Definition mod_param.F:719
mod_param::v3dvar
integer, parameter v3dvar
Definition mod_param.F:723
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::iodesc_sp_v2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dobc
Definition mod_pio_netcdf.F:217
mod_pio_netcdf::iodesc_dp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dvar
Definition mod_pio_netcdf.F:248
mod_pio_netcdf::iodesc_sp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dvar
Definition mod_pio_netcdf.F:210
mod_pio_netcdf::iodesc_dp_v2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dobc
Definition mod_pio_netcdf.F:256
mod_pio_netcdf::iodesc_sp_u2dfrc
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dfrc
Definition mod_pio_netcdf.F:228
mod_pio_netcdf::iodesc_dp_v3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dobc
Definition mod_pio_netcdf.F:260
mod_pio_netcdf::pio_netcdf_sync
subroutine, public pio_netcdf_sync(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:9275
mod_pio_netcdf::iodesc_sp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dvar
Definition mod_pio_netcdf.F:195
mod_pio_netcdf::iodesc_dp_u3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dobc
Definition mod_pio_netcdf.F:259
mod_pio_netcdf::iodesc_sp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dobc
Definition mod_pio_netcdf.F:219
mod_pio_netcdf::iodesc_dp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dvar
Definition mod_pio_netcdf.F:249
mod_pio_netcdf::iodesc_dp_u2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dobc
Definition mod_pio_netcdf.F:255
mod_pio_netcdf::iodesc_sp_r2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dobc
Definition mod_pio_netcdf.F:215
mod_pio_netcdf::iodesc_sp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
Definition mod_pio_netcdf.F:194
mod_pio_netcdf::iodesc_sp_u3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dobc
Definition mod_pio_netcdf.F:220
mod_pio_netcdf::iodesc_dp_u2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dfrc
Definition mod_pio_netcdf.F:267
mod_pio_netcdf::iodesc_dp_r2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dobc
Definition mod_pio_netcdf.F:254
mod_pio_netcdf::iodesc_sp_u2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dobc
Definition mod_pio_netcdf.F:216
mod_pio_netcdf::iodesc_dp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dvar
Definition mod_pio_netcdf.F:234
mod_pio_netcdf::iodesc_dp_v2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dfrc
Definition mod_pio_netcdf.F:268
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_v2dfrc
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dfrc
Definition mod_pio_netcdf.F:229
mod_pio_netcdf::iodesc_dp_r2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dfrc
Definition mod_pio_netcdf.F:264
mod_pio_netcdf::iodesc_dp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dvar
Definition mod_pio_netcdf.F:235
mod_pio_netcdf::iodesc_sp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dvar
Definition mod_pio_netcdf.F:211
mod_pio_netcdf::iodesc_sp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dvar
Definition mod_pio_netcdf.F:209
mod_pio_netcdf::iodesc_dp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar
Definition mod_pio_netcdf.F:233
mod_pio_netcdf::iodesc_dp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dobc
Definition mod_pio_netcdf.F:258
mod_pio_netcdf::iodesc_sp_v3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dobc
Definition mod_pio_netcdf.F:221
mod_pio_netcdf::iodesc_sp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dvar
Definition mod_pio_netcdf.F:196
mod_pio_netcdf::iodesc_sp_r2dfrc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dfrc
Definition mod_pio_netcdf.F:225
mod_scalars
Definition mod_scalars.F:2
mod_scalars::day2sec
real(dp), parameter day2sec
Definition mod_scalars.F:816
mod_scalars::nsaddle
integer nsaddle
Definition mod_scalars.F:373
mod_scalars::lobc
logical, dimension(:,:,:), allocatable lobc
Definition mod_scalars.F:1127
mod_scalars::lstflux
logical, dimension(:,:), allocatable lstflux
Definition mod_scalars.F:1156
mod_scalars::nfrec
integer, dimension(:), allocatable nfrec
Definition mod_scalars.F:1148
mod_scalars::tdays
real(dp), dimension(:), allocatable tdays
Definition mod_scalars.F:261
mod_scalars::lwrtcost
logical, dimension(:), allocatable lwrtcost
Definition mod_scalars.F:1025
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::nrun
integer nrun
Definition mod_scalars.F:355
mod_scalars::nbrec
integer, dimension(:), allocatable nbrec
Definition mod_scalars.F:1119
mod_scalars::inner
integer inner
Definition mod_scalars.F:360
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
mod_scalars::outer
integer outer
Definition mod_scalars.F:361
mod_sediment
Definition sediment_mod.h:1
mod_stepping
Definition mod_stepping.F:2
nf_fwrite2d_bry_mod
Definition nf_fwrite2d_bry.F:2
nf_fwrite2d_mod
Definition nf_fwrite2d.F:2
nf_fwrite3d_bry_mod
Definition nf_fwrite3d_bry.F:2
nf_fwrite3d_mod
Definition nf_fwrite3d.F:2
strings_mod
Definition strings.F:2
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
tl_wrt_ini_mod
Definition tl_wrt_ini.F:2
tl_wrt_ini_mod::tl_wrt_ini
subroutine, public tl_wrt_ini(ng, tile, tindex, outrec)
Definition tl_wrt_ini.F:74
tl_wrt_ini_mod::tl_wrt_ini_pio
subroutine, private tl_wrt_ini_pio(ng, tile, tindex, outrec, lbij, ubij, lbi, ubi, lbj, ubj)
Definition tl_wrt_ini.F:683
tl_wrt_ini_mod::tl_wrt_ini_nf90
subroutine, private tl_wrt_ini_nf90(ng, tile, tindex, outrec, lbij, ubij, lbi, ubi, lbj, ubj)
Definition tl_wrt_ini.F:137