ROMS
Loading...
Searching...
No Matches
def_error.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE def_error_mod
3#if defined WEAK_CONSTRAINT && \
4 (defined posterior_error_f || defined posterior_error_i)
5!
6!git $Id$
7!================================================== Hernan G. Arango ===
8! Copyright (c) 2002-2025 The ROMS Group !
9! Licensed under a MIT/X style license !
10! See License_ROMS.md !
11!=======================================================================
12! !
13! This module creates full posterior error covariance (diagonal) !
14! matrix for weak constraint 4DVar data assimilation using either !
15! the standard NetCDF library or the Parallel-IO (PIO) library. It !
16! defines its dimensions, attributes, and variables. !
17! !
18!=======================================================================
19!
20 USE mod_param
21 USE mod_parallel
22# ifdef BIOLOGY
23 USE mod_biology
24# endif
25 USE mod_fourdvar
26 USE mod_iounits
27 USE mod_ncparam
28 USE mod_scalars
29# ifdef SEDIMENT
30 USE mod_sediment
31# endif
32!
33 USE def_dim_mod, ONLY : def_dim
34 USE def_info_mod, ONLY : def_info
35 USE def_var_mod, ONLY : def_var
36 USE strings_mod, ONLY : founderror
37 USE wrt_info_mod, ONLY : wrt_info
38!
39 implicit none
40!
41 PUBLIC :: def_error
42 PRIVATE :: def_error_nf90
43# if defined PIO_LIB && defined DISTRIBUTE
44 PRIVATE :: def_error_pio
45# endif
46!
47 CONTAINS
48!
49!***********************************************************************
50 SUBROUTINE def_error (ng)
51!***********************************************************************
52!
53! Imported variable declarations.
54!
55 integer, intent(in) :: ng
56!
57! Local variable declarations.
58!
59 character (len=*), parameter :: myfile = &
60 & __FILE__
61!
62!-----------------------------------------------------------------------
63! Create a new history file according to IO type.
64!-----------------------------------------------------------------------
65!
66 SELECT CASE (err(ng)%IOtype)
67 CASE (io_nf90)
68 CALL def_error_nf90 (ng)
69
70# if defined PIO_LIB && defined DISTRIBUTE
71 CASE (io_pio)
72 CALL def_error_pio (ng)
73# endif
74 CASE DEFAULT
75 IF (master) WRITE (stdout,10) err(ng)%IOtype
76 exit_flag=3
77 END SELECT
78 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
79!
80 10 FORMAT (' DEF_ERROR - Illegal output file type, io_type = ',i0, &
81 & /,13x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
82!
83 RETURN
84 END SUBROUTINE def_error
85!
86!***********************************************************************
87 SUBROUTINE def_error_nf90 (ng)
88!***********************************************************************
89!
90 USE mod_netcdf
91!
92! Imported variable declarations.
93!
94 integer, intent(in) :: ng
95!
96! Local variable declarations.
97!
98 logical :: got_var(nv)
99!
100 integer, parameter :: natt = 25
101
102 integer :: i, j, ifield, itrc, nrec, nvd, nvd3, nvd4
103 integer :: recdim, status, varid
104 integer :: ninnerdim
105# ifdef ADJUST_BOUNDARY
106 integer :: iorjdim, brecdim
107# endif
108# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
109 integer :: frecdim
110# endif
111 integer :: dimids(ndimid)
112 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
113# ifdef ADJUST_BOUNDARY
114 integer :: t2dobc(4)
115# endif
116
117# ifdef SOLVE3D
118 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
119# ifdef ADJUST_BOUNDARY
120 integer :: t3dobc(5)
121# endif
122# ifdef ADJUST_STFLUX
123 integer :: t3dfrc(4)
124# endif
125# endif
126# ifdef ADJUST_WSTRESS
127 integer :: u3dfrc(4), v3dfrc(4)
128# endif
129!
130 real(r8) :: aval(6)
131!
132 character (len=256) :: ncname
133 character (len=MaxLen) :: vinfo(natt)
134
135 character (len=*), parameter :: myfile = &
136 & __FILE__//", def_error_nf90"
137!
138 sourcefile=myfile
139!
140!-----------------------------------------------------------------------
141! Set and report file name.
142!-----------------------------------------------------------------------
143!
144 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
145 ncname=err(ng)%name
146!
147 IF (master) THEN
148 IF (ldeferr(ng)) THEN
149 WRITE (stdout,10) ng, trim(ncname)
150 ELSE
151 WRITE (stdout,20) ng, trim(ncname)
152 END IF
153 END IF
154!
155!=======================================================================
156! Create a new posterior error covariance matrix file.
157!=======================================================================
158!
159 define : IF (ldeferr(ng)) THEN
160 CALL netcdf_create (ng, itlm, trim(ncname), err(ng)%ncid)
161 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
162 IF (master) WRITE (stdout,30) trim(ncname)
163 RETURN
164 END IF
165!
166!-----------------------------------------------------------------------
167! Define file dimensions.
168!-----------------------------------------------------------------------
169!
170 dimids=0
171!
172 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xi_rho', &
173 & iobounds(ng)%xi_rho, dimids( 1))
174 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
175
176 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xi_u', &
177 & iobounds(ng)%xi_u, dimids( 2))
178 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
179
180 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xi_v', &
181 & iobounds(ng)%xi_v, dimids( 3))
182 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
183
184 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xi_psi', &
185 & iobounds(ng)%xi_psi, dimids( 4))
186 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
187
188 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'eta_rho', &
189 & iobounds(ng)%eta_rho, dimids( 5))
190 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
191
192 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'eta_u', &
193 & iobounds(ng)%eta_u, dimids( 6))
194 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
195
196 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'eta_v', &
197 & iobounds(ng)%eta_v, dimids( 7))
198 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
199
200 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'eta_psi', &
201 & iobounds(ng)%eta_psi, dimids( 8))
202 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
203
204# ifdef ADJUST_BOUNDARY
205 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'IorJ', &
206 & iobounds(ng)%IorJ, iorjdim)
207 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
208# endif
209
210# if defined WRITE_WATER && defined MASKING
211 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xy_rho', &
212 & iobounds(ng)%xy_rho, dimids(17))
213 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
214
215 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xy_u', &
216 & iobounds(ng)%xy_u, dimids(18))
217 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
218
219 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xy_v', &
220 & iobounds(ng)%xy_v, dimids(19))
221 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
222# endif
223
224# ifdef SOLVE3D
225# if defined WRITE_WATER && defined MASKING
226 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xyz_rho', &
227 & iobounds(ng)%xy_rho*n(ng), dimids(20))
228 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
229
230 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xyz_u', &
231 & iobounds(ng)%xy_u*n(ng), dimids(21))
232 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
233
234 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xyz_v', &
235 & iobounds(ng)%xy_v*n(ng), dimids(22))
236 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
237
238 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xyz_w', &
239 & iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
240 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
241# endif
242
243 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'N', &
244 & n(ng), dimids( 9))
245 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
246
247 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 's_rho', &
248 & n(ng), dimids( 9))
249 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
250
251 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 's_w', &
252 & n(ng)+1, dimids(10))
253 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
254
255 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'tracer', &
256 & nt(ng), dimids(11))
257 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
258
259# ifdef SEDIMENT
260 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'NST', &
261 & nst, dimids(32))
262 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
263
264 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'Nbed', &
265 & nbed, dimids(16))
266 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
267
268# if defined WRITE_WATER && defined MASKING
269 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'xybed', &
270 & iobounds(ng)%xy_rho*nbed, dimids(24))
271 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
272# endif
273# endif
274
275# ifdef ECOSIM
276 status=def_dim(ng, inlm, err(ng)%ncid, ncname, 'Nbands', &
277 & nbands, dimids(33))
278 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
279
280 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'Nphy', &
281 & nphy, dimids(25))
282 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
283
284 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'Nbac', &
285 & nbac, dimids(26))
286 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
287
288 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'Ndom', &
289 & ndom, dimids(27))
290 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
291
292 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'Nfec', &
293 & nfec, dimids(28))
294 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
295# endif
296# endif
297
298 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'boundary', &
299 & 4, dimids(14))
300 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
301
302# ifdef FOUR_DVAR
303 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'Nstate', &
304 & nstatevar(ng), dimids(29))
305 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
306# endif
307
308 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'Ninner', &
309 & ninner, ninnerdim)
310 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
311
312# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
313 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'frc_adjust', &
314 & nfrec(ng), dimids(30))
315 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
316# endif
317
318# ifdef ADJUST_BOUNDARY
319 status=def_dim(ng, itlm, err(ng)%ncid, ncname, 'obc_adjust', &
320 & nbrec(ng), dimids(31))
321 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
322# endif
323
324 status=def_dim(ng, itlm, err(ng)%ncid, ncname, &
325 & trim(adjustl(vname(5,idtime))), &
326 & nf90_unlimited, dimids(12))
327 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
328
329 recdim=dimids(12)
330# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
331 frecdim=dimids(30)
332# endif
333# ifdef ADJUST_BOUNDARY
334 brecdim=dimids(31)
335# endif
336!
337! Set number of dimensions for output variables.
338!
339# if defined WRITE_WATER && defined MASKING
340 nvd3=2
341 nvd4=2
342# else
343 nvd3=3
344 nvd4=4
345# endif
346!
347! Define dimension vectors for staggered tracer type variables.
348!
349# if defined WRITE_WATER && defined MASKING
350 t2dgrd(1)=dimids(17)
351 t2dgrd(2)=dimids(12)
352# ifdef SOLVE3D
353 t3dgrd(1)=dimids(20)
354 t3dgrd(2)=dimids(12)
355# endif
356# else
357 t2dgrd(1)=dimids( 1)
358 t2dgrd(2)=dimids( 5)
359 t2dgrd(3)=dimids(12)
360# ifdef SOLVE3D
361 t3dgrd(1)=dimids( 1)
362 t3dgrd(2)=dimids( 5)
363 t3dgrd(3)=dimids( 9)
364 t3dgrd(4)=dimids(12)
365# endif
366# ifdef ADJUST_STFLUX
367 t3dfrc(1)=dimids( 1)
368 t3dfrc(2)=dimids( 5)
369 t3dfrc(3)=frecdim
370 t3dfrc(4)=dimids(12)
371# endif
372# endif
373# ifdef ADJUST_BOUNDARY
374 t2dobc(1)=iorjdim
375 t2dobc(2)=dimids(14)
376 t2dobc(3)=brecdim
377 t2dobc(4)=dimids(12)
378# ifdef SOLVE3D
379 t3dobc(1)=iorjdim
380 t3dobc(2)=dimids( 9)
381 t3dobc(3)=dimids(14)
382 t3dobc(4)=brecdim
383 t3dobc(5)=dimids(12)
384# endif
385# endif
386!
387! Define dimension vectors for staggered u-momentum type variables.
388!
389# if defined WRITE_WATER && defined MASKING
390 u2dgrd(1)=dimids(18)
391 u2dgrd(2)=dimids(12)
392# ifdef SOLVE3D
393 u3dgrd(1)=dimids(21)
394 u3dgrd(2)=dimids(12)
395# endif
396# else
397 u2dgrd(1)=dimids( 2)
398 u2dgrd(2)=dimids( 6)
399 u2dgrd(3)=dimids(12)
400# ifdef SOLVE3D
401 u3dgrd(1)=dimids( 2)
402 u3dgrd(2)=dimids( 6)
403 u3dgrd(3)=dimids( 9)
404 u3dgrd(4)=dimids(12)
405# endif
406# ifdef ADJUST_WSTRESS
407 u3dfrc(1)=dimids( 2)
408 u3dfrc(2)=dimids( 6)
409 u3dfrc(3)=frecdim
410 u3dfrc(4)=dimids(12)
411# endif
412# endif
413!
414! Define dimension vectors for staggered v-momentum type variables.
415!
416# if defined WRITE_WATER && defined MASKING
417 v2dgrd(1)=dimids(19)
418 v2dgrd(2)=dimids(12)
419# ifdef SOLVE3D
420 v3dgrd(1)=dimids(22)
421 v3dgrd(2)=dimids(12)
422# endif
423# else
424 v2dgrd(1)=dimids( 3)
425 v2dgrd(2)=dimids( 7)
426 v2dgrd(3)=dimids(12)
427# ifdef SOLVE3D
428 v3dgrd(1)=dimids( 3)
429 v3dgrd(2)=dimids( 7)
430 v3dgrd(3)=dimids( 9)
431 v3dgrd(4)=dimids(12)
432# endif
433# ifdef ADJUST_WSTRESS
434 v3dfrc(1)=dimids( 3)
435 v3dfrc(2)=dimids( 7)
436 v3dfrc(3)=frecdim
437 v3dfrc(4)=dimids(12)
438# endif
439# endif
440# ifdef SOLVE3D
441!
442! Define dimension vector for staggered w-momentum type variables.
443!
444# if defined WRITE_WATER && defined MASKING
445 w3dgrd(1)=dimids(23)
446 w3dgrd(2)=dimids(12)
447# else
448 w3dgrd(1)=dimids( 1)
449 w3dgrd(2)=dimids( 5)
450 w3dgrd(3)=dimids(10)
451 w3dgrd(4)=dimids(12)
452# endif
453# endif
454!
455! Initialize unlimited time record dimension.
456!
457 err(ng)%Rindex=0
458!
459! Initialize local information variable arrays.
460!
461 DO i=1,natt
462 DO j=1,len(vinfo(1))
463 vinfo(i)(j:j)=' '
464 END DO
465 END DO
466 DO i=1,6
467 aval(i)=0.0_r8
468 END DO
469!
470!-----------------------------------------------------------------------
471! Define time-recordless information variables.
472!-----------------------------------------------------------------------
473!
474 CALL def_info (ng, itlm, err(ng)%ncid, ncname, dimids)
475 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
476!
477!-----------------------------------------------------------------------
478! Define time-varying variables.
479!-----------------------------------------------------------------------
480!
481! Define inner-loop Lanczos vectors tridiagonal matrix.
482!
483 vinfo( 1)='zLanczos_coef'
484 vinfo( 2)='inner-loop Lanczos vector tridiagonal matrix'
485 status=def_var(ng, itlm, err(ng)%ncid, varid, nf_type, &
486 & 2, (/ninnerdim,ninnerdim/), aval, vinfo, ncname, &
487 & setparaccess = .false.)
488 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
489!
490! Define inverse of inner-loop Lanczos vectors tridiagonal matrix.
491!
492 vinfo( 1)='zLanczos_inv'
493 vinfo( 2)='inverse inner-loop Lanczos vector tridiagonal matrix'
494 status=def_var(ng, itlm, err(ng)%ncid, varid, nf_type, &
495 & 2, (/ninnerdim,ninnerdim/), aval, vinfo, ncname, &
496 & setparaccess = .false.)
497 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
498!
499! Define inner-loop Lanczos vectors tridiagonal matrix inversion error.
500! We need to get an identity matrix withing roundoff.
501!
502 vinfo( 1)='zLanczos_err'
503 vinfo( 2)= &
504 'inner-loop Lanczos vector tridiagonal matrix inversion error'
505 status=def_var(ng, itlm, err(ng)%ncid, varid, nf_type, &
506 & 2, (/ninnerdim,ninnerdim/), aval, vinfo, ncname, &
507 & setparaccess = .false.)
508 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
509!
510! Define model time.
511!
512 vinfo( 1)=vname(1,idtime)
513 vinfo( 2)=vname(2,idtime)
514 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
515 vinfo( 4)=trim(rclock%calendar)
516 vinfo(14)=vname(4,idtime)
517 vinfo(21)=vname(6,idtime)
518 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(idtime), &
519 & nf_tout, 1, (/recdim/), aval, vinfo, ncname, &
520 & setparaccess = .true.)
521 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
522!
523! Define free-surface error variance.
524!
525 vinfo( 1)=vname(1,idfsur)
526 WRITE (vinfo( 2),40) trim(vname(2,idfsur))
527 vinfo( 3)='meter2'
528 vinfo(14)=vname(4,idfsur)
529 vinfo(16)=vname(1,idtime)
530# if defined WRITE_WATER && defined MASKING
531 vinfo(20)='mask_rho'
532# endif
533 vinfo(21)=vname(6,idfsur)
534 vinfo(22)='coordinates'
535 aval(5)=real(iinfo(1,idfsur,ng),r8)
536 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(idfsur), &
537 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
538 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
539
540# ifdef ADJUST_BOUNDARY
541!
542! Define free-surface open boundaries error variance.
543!
544 IF (any(lobc(:,isfsur,ng))) THEN
545 ifield=idsbry(isfsur)
546 vinfo( 1)=vname(1,ifield)
547 WRITE (vinfo( 2),40) trim(vname(2,ifield))
548 vinfo( 3)='meter2'
549 vinfo(14)=vname(4,ifield)
550 vinfo(16)=vname(1,idtime)
551 vinfo(21)=vname(6,ifield)
552 aval(5)=real(iinfo(1,ifield,ng),r8)
553 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(ifield), &
554 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
555 & setfillval = .false.)
556 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
557 END IF
558# endif
559!
560! Define 2D U-momentum component error variance.
561!
562 vinfo( 1)=vname(1,idubar)
563 WRITE (vinfo( 2),40) trim(vname(2,idubar))
564 vinfo( 3)='meter2 second-2'
565 vinfo(14)=vname(4,idubar)
566 vinfo(16)=vname(1,idtime)
567# if defined WRITE_WATER && defined MASKING
568 vinfo(20)='mask_u'
569# endif
570 vinfo(21)=vname(6,idubar)
571 vinfo(22)='coordinates'
572 aval(5)=real(iinfo(1,idubar,ng),r8)
573 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(idubar), &
574 & nf_fout, nvd3, u2dgrd, aval, vinfo, ncname)
575 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
576
577# ifdef ADJUST_BOUNDARY
578!
579! Define 2D U-momentum component open boundaries error variance.
580!
581 IF (any(lobc(:,isubar,ng))) THEN
582 ifield=idsbry(isubar)
583 vinfo( 1)=vname(1,ifield)
584 WRITE (vinfo( 2),40) trim(vname(2,ifield))
585 vinfo( 3)='meter2 second-2'
586 vinfo(14)=vname(4,ifield)
587 vinfo(16)=vname(1,idtime)
588 vinfo(21)=vname(6,ifield)
589 aval(5)=real(iinfo(1,ifield,ng),r8)
590 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(ifield), &
591 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
592 & setfillval = .false.)
593 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
594 END IF
595# endif
596!
597! Define 2D V-momentum component error variance.
598!
599 vinfo( 1)=vname(1,idvbar)
600 WRITE (vinfo( 2),40) trim(vname(2,idvbar))
601 vinfo( 3)='meter2 second-2'
602 vinfo(14)=vname(4,idvbar)
603 vinfo(16)=vname(1,idtime)
604# if defined WRITE_WATER && defined MASKING
605 vinfo(20)='mask_v'
606# endif
607 vinfo(21)=vname(6,idvbar)
608 vinfo(22)='coordinates'
609 aval(5)=real(iinfo(1,idvbar,ng),r8)
610 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(idvbar), &
611 & nf_fout, nvd3, v2dgrd, aval, vinfo, ncname)
612 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
613
614# ifdef ADJUST_BOUNDARY
615!
616! Define 2D V-momentum component open boundaries error variance.
617!
618 IF (any(lobc(:,isvbar,ng))) THEN
619 ifield=idsbry(isvbar)
620 vinfo( 1)=vname(1,ifield)
621 WRITE (vinfo( 2),40) trim(vname(2,ifield))
622 vinfo( 3)='meter2 second-2'
623 vinfo(14)=vname(4,ifield)
624 vinfo(16)=vname(1,idtime)
625 vinfo(21)=vname(6,ifield)
626 aval(5)=real(iinfo(1,ifield,ng),r8)
627 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(ifield), &
628 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
629 & setfillval = .false.)
630 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
631 END IF
632# endif
633# ifdef SOLVE3D
634!
635! Define 3D U-momentum component error variance.
636!
637 vinfo( 1)=vname(1,iduvel)
638 WRITE (vinfo( 2),40) trim(vname(2,iduvel))
639 vinfo( 3)='meter2 second-2'
640 vinfo(14)=vname(4,iduvel)
641 vinfo(16)=vname(1,idtime)
642# if defined WRITE_WATER && defined MASKING
643 vinfo(20)='mask_u'
644# endif
645 vinfo(21)=vname(6,iduvel)
646 vinfo(22)='coordinates'
647 aval(5)=real(iinfo(1,iduvel,ng),r8)
648 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(iduvel), &
649 & nf_fout, nvd4, u3dgrd, aval, vinfo, ncname)
650 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
651
652# ifdef ADJUST_BOUNDARY
653!
654! Define 3D U-momentum component open boundaries error variance.
655!
656 IF (any(lobc(:,isuvel,ng))) THEN
657 ifield=idsbry(isuvel)
658 vinfo( 1)=vname(1,ifield)
659 WRITE (vinfo( 2),40) trim(vname(2,ifield))
660 vinfo( 3)='meter2 second-2'
661 vinfo(14)=vname(4,ifield)
662 vinfo(16)=vname(1,idtime)
663 vinfo(21)=vname(6,ifield)
664 aval(5)=real(iinfo(1,ifield,ng),r8)
665 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(ifield), &
666 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
667 & setfillval = .false.)
668 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
669 END IF
670# endif
671!
672! Define 3D V-momentum component error variance.
673!
674 vinfo( 1)=vname(1,idvvel)
675 WRITE (vinfo( 2),40) trim(vname(2,idvvel))
676 vinfo( 3)='meter2 second-2'
677 vinfo(14)=vname(4,idvvel)
678 vinfo(16)=vname(1,idtime)
679# if defined WRITE_WATER && defined MASKING
680 vinfo(20)='mask_v'
681# endif
682 vinfo(21)=vname(6,idvvel)
683 vinfo(22)='coordinates'
684 aval(5)=real(iinfo(1,idvvel,ng),r8)
685 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(idvvel), &
686 & nf_fout, nvd4, v3dgrd, aval, vinfo, ncname)
687 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
688
689# ifdef ADJUST_BOUNDARY
690!
691! Define 3D V-momentum component open boundaries error variance.
692!
693 IF (any(lobc(:,isvvel,ng))) THEN
694 ifield=idsbry(isvvel)
695 vinfo( 1)=vname(1,ifield)
696 WRITE (vinfo( 2),40) trim(vname(2,ifield))
697 vinfo( 3)='meter2 second-2'
698 vinfo(14)=vname(4,ifield)
699 vinfo(16)=vname(1,idtime)
700 vinfo(21)=vname(6,ifield)
701 aval(5)=real(iinfo(1,ifield,ng),r8)
702 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(ifield), &
703 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
704 & setfillval = .false.)
705 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
706 END IF
707# endif
708!
709! Define tracer type variables error variance.
710!
711 DO itrc=1,nt(ng)
712 vinfo( 1)=vname(1,idtvar(itrc))
713 WRITE (vinfo( 2),40) trim(vname(2,idtvar(itrc)))
714 IF (itrc.eq.itemp) THEN
715 vinfo( 3)='Celsius2'
716 ELSE IF (itrc.eq.isalt) THEN
717 vinfo( 3)='nondimensional'
718 ELSE
719 WRITE (vinfo( 3),50) trim(vname(3,idtvar(itrc)))
720 END IF
721 vinfo(14)=vname(4,idtvar(itrc))
722 vinfo(16)=vname(1,idtime)
723# ifdef SEDIMENT
724 DO i=1,nst
725 IF (itrc.eq.idsed(i)) THEN
726 WRITE (vinfo(19),60) 1000.0_r8*sd50(i,ng)
727 END IF
728 END DO
729# endif
730# if defined WRITE_WATER && defined MASKING
731 vinfo(20)='mask_rho'
732# endif
733 vinfo(21)=vname(6,idtvar(itrc))
734 vinfo(22)='coordinates'
735 aval(5)=real(r3dvar,r8)
736 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Tid(itrc), &
737 & nf_fout, nvd4, t3dgrd, aval, vinfo, ncname)
738 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
739 END DO
740
741# ifdef ADJUST_BOUNDARY
742!
743! Define tracer type variables open boundaries error variance.
744!
745 DO itrc=1,nt(ng)
746 IF (any(lobc(:,istvar(itrc),ng))) THEN
747 ifield=idsbry(istvar(itrc))
748 vinfo( 1)=vname(1,ifield)
749 WRITE (vinfo( 2),40) trim(vname(2,ifield))
750 IF (itrc.eq.itemp) THEN
751 vinfo( 3)='Celsius2'
752 ELSE IF (itrc.eq.isalt) THEN
753 vinfo( 3)='nondimensional'
754 ELSE
755 WRITE (vinfo( 3),50) trim(vname(3,idtvar(itrc)))
756 END IF
757 vinfo(14)=vname(4,ifield)
758 vinfo(16)=vname(1,idtime)
759# ifdef SEDIMENT
760 DO i=1,nst
761 IF (itrc.eq.idsed(i)) THEN
762 WRITE (vinfo(19),60) 1000.0_r8*sd50(i,ng)
763 END IF
764 END DO
765# endif
766 vinfo(21)=vname(6,ifield)
767 aval(5)=real(iinfo(1,ifield,ng),r8)
768 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(ifield), &
769 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
770 & setfillval = .false.)
771 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
772 END IF
773 END DO
774# endif
775# ifdef ADJUST_STFLUX
776!
777! Define surface tracer fluxes error variance.
778!
779 DO itrc=1,nt(ng)
780 IF (lstflux(itrc,ng)) THEN
781 vinfo( 1)=vname(1,idtsur(itrc))
782 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
783 WRITE (vinfo( 3),50) trim(vname(3,idtsur(itrc)))
784 IF (itrc.eq.itemp) THEN
785 vinfo(11)='upward flux, cooling'
786 vinfo(12)='downward flux, heating'
787 ELSE IF (itrc.eq.isalt) THEN
788 vinfo(11)='upward flux, freshening (net precipitation)'
789 vinfo(12)='downward flux, salting (net evaporation)'
790 END IF
791 vinfo(14)=vname(4,idtsur(itrc))
792 vinfo(16)=vname(1,idtime)
793# if defined WRITE_WATER && defined MASKING
794 vinfo(20)='mask_rho'
795# endif
796 vinfo(21)=vname(6,idtsur(itrc))
797 vinfo(22)='coordinates'
798 aval(5)=real(r2dvar,r8)
799 status=def_var(ng, itlm, err(ng)%ncid, &
800 & err(ng)%Vid(idtsur(itrc)), &
801 & nf_fout, nvd4, t3dfrc, aval, vinfo, ncname)
802 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
803 END IF
804 END DO
805# endif
806# endif
807# ifdef ADJUST_WSTRESS
808!
809! Define surface U-momentum stress error variance.
810!
811 vinfo( 1)=vname(1,idusms)
812 WRITE (vinfo( 2),40) trim(vname(2,idusms))
813 vinfo( 3)='meter4 second-4'
814 vinfo(14)=vname(4,idusms)
815 vinfo(16)=vname(1,idtime)
816# if defined WRITE_WATER && defined MASKING
817 vinfo(20)='mask_u'
818# endif
819 vinfo(21)=vname(6,idusms)
820 vinfo(22)='coordinates'
821 aval(5)=real(u2dvar,r8)
822 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(idusms), &
823 & nf_fout, nvd4, u3dfrc, aval, vinfo, ncname)
824 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
825!
826! Define surface V-momentum stress error variance.
827!
828 vinfo( 1)=vname(1,idvsms)
829 WRITE (vinfo( 2),40) trim(vname(2,idvsms))
830 vinfo( 2)=vname(2,idvsms)
831 vinfo( 3)='meter4 second4'
832 vinfo(14)=vname(4,idvsms)
833 vinfo(16)=vname(1,idtime)
834# if defined WRITE_WATER && defined MASKING
835 vinfo(20)='mask_v'
836# endif
837 vinfo(21)=vname(6,idvsms)
838 vinfo(22)='coordinates'
839 aval(5)=real(v2dvar,r8)
840 status=def_var(ng, itlm, err(ng)%ncid, err(ng)%Vid(idvsms), &
841 & nf_fout, nvd4, v3dfrc, aval, vinfo, ncname)
842 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
843# endif
844!
845!-----------------------------------------------------------------------
846! Leave definition mode.
847!-----------------------------------------------------------------------
848!
849 CALL netcdf_enddef (ng, itlm, ncname, err(ng)%ncid)
850 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
851!
852!-----------------------------------------------------------------------
853! Write out time-recordless, information variables.
854!-----------------------------------------------------------------------
855!
856 CALL wrt_info (ng, itlm, err(ng)%ncid, ncname)
857 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
858 END IF define
859!
860!=======================================================================
861! Open an existing posterior error covariance matrix, check its
862! contents, and prepare for appending data.
863!=======================================================================
864!
865 query: IF (.not.ldeferr(ng)) THEN
866 ncname=err(ng)%name
867!
868! Open posterior error covariance file for read/write.
869!
870 CALL netcdf_open (ng, itlm, ncname, 1, err(ng)%ncid)
871 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
872 WRITE (stdout,70) trim(ncname)
873 RETURN
874 END IF
875!
876! Inquire about the dimensions and check for consistency.
877!
878 CALL netcdf_check_dim (ng, itlm, ncname, &
879 & ncid = err(ng)%ncid)
880 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
881!
882! Inquire about the variables.
883!
884 CALL netcdf_inq_var (ng, itlm, ncname, &
885 & ncid = err(ng)%ncid)
886 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
887!
888! Initialize logical switches.
889!
890 DO i=1,nv
891 got_var(i)=.false.
892 END DO
893!
894! Scan variable list from input NetCDF and activate switches for
895! posterior error covariance matrix variables. Get variable IDs.
896!
897 DO i=1,n_var
898 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
899 got_var(idtime)=.true.
900 err(ng)%Vid(idtime)=var_id(i)
901 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
902 got_var(idfsur)=.true.
903 err(ng)%Vid(idfsur)=var_id(i)
904 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
905 got_var(idubar)=.true.
906 err(ng)%Vid(idubar)=var_id(i)
907 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
908 got_var(idvbar)=.true.
909 err(ng)%Vid(idvbar)=var_id(i)
910# ifdef ADJUST_BOUNDARY
911 ELSE IF (trim(var_name(i)).eq. &
912 & trim(vname(1,idsbry(isfsur)))) THEN
913 got_var(idsbry(isfsur))=.true.
914 err(ng)%Vid(idsbry(isfsur))=var_id(i)
915 ELSE IF (trim(var_name(i)).eq. &
916 & trim(vname(1,idsbry(isubar)))) THEN
917 got_var(idsbry(isubar))=.true.
918 err(ng)%Vid(idsbry(isubar))=var_id(i)
919 ELSE IF (trim(var_name(i)).eq. &
920 & trim(vname(1,idsbry(isvbar)))) THEN
921 got_var(idsbry(isvbar))=.true.
922 err(ng)%Vid(idsbry(isvbar))=var_id(i)
923# endif
924# ifdef ADJUST_WSTRESS
925 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
926 got_var(idusms)=.true.
927 err(ng)%Vid(idusms)=var_id(i)
928 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
929 got_var(idvsms)=.true.
930 err(ng)%Vid(idvsms)=var_id(i)
931# endif
932# ifdef SOLVE3D
933 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
934 got_var(iduvel)=.true.
935 err(ng)%Vid(iduvel)=var_id(i)
936 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
937 got_var(idvvel)=.true.
938 err(ng)%Vid(idvvel)=var_id(i)
939# ifdef ADJUST_BOUNDARY
940 ELSE IF (trim(var_name(i)).eq. &
941 & trim(vname(1,idsbry(isuvel)))) THEN
942 got_var(idsbry(isuvel))=.true.
943 err(ng)%Vid(idsbry(isuvel))=var_id(i)
944 ELSE IF (trim(var_name(i)).eq. &
945 & trim(vname(1,idsbry(isvvel)))) THEN
946 got_var(idsbry(isvvel))=.true.
947 err(ng)%Vid(idsbry(isvvel))=var_id(i)
948# endif
949# endif
950 END IF
951# ifdef SOLVE3D
952 DO itrc=1,nt(ng)
953 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
954 got_var(idtvar(itrc))=.true.
955 err(ng)%Tid(itrc)=var_id(i)
956# ifdef ADJUST_BOUNDARY
957 ELSE IF (trim(var_name(i)).eq. &
958 & trim(vname(1,idsbry(istvar(itrc))))) THEN
959 got_var(idsbry(istvar(itrc)))=.true.
960 err(ng)%Vid(idsbry(istvar(itrc)))=var_id(i)
961# endif
962# ifdef ADJUST_STFLUX
963 ELSE IF (trim(var_name(i)).eq. &
964 & trim(vname(1,idtsur(itrc)))) THEN
965 got_var(idtsur(itrc))=.true.
966 err(ng)%Vid(idtsur(itrc))=var_id(i)
967# endif
968 END IF
969 END DO
970# endif
971 END DO
972!
973! Check if posterior error covariance matrix variables are available
974! in input NetCDF file.
975!
976 IF (.not.got_var(idtime)) THEN
977 IF (master) WRITE (stdout,80) trim(vname(1,idtime)), &
978 & trim(ncname)
979 exit_flag=3
980 RETURN
981 END IF
982 IF (.not.got_var(idfsur)) THEN
983 IF (master) WRITE (stdout,80) trim(vname(1,idfsur)), &
984 & trim(ncname)
985 exit_flag=3
986 RETURN
987 END IF
988 IF (.not.got_var(idubar)) THEN
989 IF (master) WRITE (stdout,80) trim(vname(1,idubar)), &
990 & trim(ncname)
991 exit_flag=3
992 RETURN
993 END IF
994 IF (.not.got_var(idvbar)) THEN
995 IF (master) WRITE (stdout,80) trim(vname(1,idvbar)), &
996 & trim(ncname)
997 exit_flag=3
998 RETURN
999 END IF
1000# ifdef ADJUST_BOUNDARY
1001 IF (.not.got_var(idsbry(isfsur))) THEN
1002 IF (master) WRITE (stdout,80) trim(vname(1,idsbry(isfsur))), &
1003 & trim(ncname)
1004 exit_flag=3
1005 RETURN
1006 END IF
1007 IF (.not.got_var(idsbry(isubar))) THEN
1008 IF (master) WRITE (stdout,80) trim(vname(1,idsbry(isubar))), &
1009 & trim(ncname)
1010 exit_flag=3
1011 RETURN
1012 END IF
1013 IF (.not.got_var(idsbry(isvbar))) THEN
1014 IF (master) WRITE (stdout,80) trim(vname(1,idsbry(isvbar))), &
1015 & trim(ncname)
1016 exit_flag=3
1017 RETURN
1018 END IF
1019# endif
1020# ifdef ADJUST_WSTRESS
1021 IF (.not.got_var(idusms)) THEN
1022 IF (master) WRITE (stdout,80) trim(vname(1,idusms)), &
1023 & trim(ncname)
1024 exit_flag=3
1025 RETURN
1026 END IF
1027 IF (.not.got_var(idvsms)) THEN
1028 IF (master) WRITE (stdout,80) trim(vname(1,idvsms)), &
1029 & trim(ncname)
1030 exit_flag=3
1031 RETURN
1032 END IF
1033# endif
1034# ifdef SOLVE3D
1035 IF (.not.got_var(iduvel)) THEN
1036 IF (master) WRITE (stdout,80) trim(vname(1,iduvel)), &
1037 & trim(ncname)
1038 exit_flag=3
1039 RETURN
1040 END IF
1041 IF (.not.got_var(idvvel)) THEN
1042 IF (master) WRITE (stdout,80) trim(vname(1,idvvel)), &
1043 & trim(ncname)
1044 exit_flag=3
1045 RETURN
1046 END IF
1047# ifdef ADJUST_BOUNDARY
1048 IF (.not.got_var(idsbry(isuvel))) THEN
1049 IF (master) WRITE (stdout,80) trim(vname(1,idsbry(isuvel))), &
1050 & trim(ncname)
1051 exit_flag=3
1052 RETURN
1053 END IF
1054 IF (.not.got_var(idsbry(isvvel))) THEN
1055 IF (master) WRITE (stdout,80) trim(vname(1,idsbry(isvvel))), &
1056 & trim(ncname)
1057 exit_flag=3
1058 RETURN
1059 END IF
1060# endif
1061# endif
1062# ifdef SOLVE3D
1063 DO itrc=1,nt(ng)
1064 IF (.not.got_var(idtvar(itrc))) THEN
1065 IF (master) WRITE (stdout,80) trim(vname(1,idtvar(itrc))), &
1066 & trim(ncname)
1067 exit_flag=3
1068 RETURN
1069 END IF
1070# ifdef ADJUST_BOUNDARY
1071 IF (.not.got_var(idsbry(istvar(itrc)))) THEN
1072 IF (master) WRITE (stdout,80) &
1073 & trim(vname(1,idsbry(istvar(itrc)))), &
1074 & trim(ncname)
1075 exit_flag=3
1076 RETURN
1077 END IF
1078# endif
1079# ifdef ADJUST_STFLUX
1080 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
1081 IF (master) WRITE (stdout,80) trim(vname(1,idtsur(itrc))), &
1082 & trim(ncname)
1083 exit_flag=3
1084 RETURN
1085 END IF
1086# endif
1087 END DO
1088# endif
1089!
1090! Set unlimited time record dimension to the appropriate value.
1091!
1092 err(ng)%Rindex=rec_size
1093 END IF query
1094!
1095 10 FORMAT (2x,'DEF_ERROR_NF90 - creating error file,',t56, &
1096 & 'Grid ',i2.2,': ',a)
1097 20 FORMAT (2x,'DEF_ERROR_NF90 - inquiring error file,',t56, &
1098 & 'Grid ',i2.2,': ',a)
1099 30 FORMAT (/,' DEF_ERROR_NF90 - unable to create 4DVar error NetCDF' &
1100 & ' file:',1x,a)
1101# if defined POSTERIOR_ERROR_I
1102 40 FORMAT (a,', initial posterior error variance')
1103# elif defined POSTERIOR_ERROR_F
1104 40 FORMAT (a,', final posterior error variance')
1105# endif
1106 50 FORMAT ('(',a,')^2')
1107 60 FORMAT (1pe11.4,1x,'millimeter')
1108 70 FORMAT (/,' DEF_ERROR_NF90 - unable to open error NetCDF', &
1109 & ' file: ',a)
1110 80 FORMAT (/,' DEF_ERROR_NF90 - unable to find variable: ',a,2x, &
1111 & ' in 4DVar error NetCDF file: ',a)
1112!
1113 RETURN
1114 END SUBROUTINE def_error_nf90
1115
1116# if defined PIO_LIB && defined DISTRIBUTE
1117!
1118!***********************************************************************
1119 SUBROUTINE def_error_pio (ng)
1120!***********************************************************************
1121!
1122 USE mod_pio_netcdf
1123!
1124! Imported variable declarations.
1125!
1126 integer, intent(in) :: ng
1127!
1128! Local variable declarations.
1129!
1130 logical :: got_var(nv)
1131!
1132 integer, parameter :: natt = 25
1133
1134 integer :: i, j, ifield, itrc, nrec, nvd, nvd3, nvd4
1135 integer :: recdim, status
1136 integer :: ninnerdim
1137# ifdef ADJUST_BOUNDARY
1138 integer :: iorjdim, brecdim
1139# endif
1140# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1141 integer :: frecdim
1142# endif
1143 integer :: dimids(ndimid)
1144 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
1145# ifdef ADJUST_BOUNDARY
1146 integer :: t2dobc(4)
1147# endif
1148# ifdef SOLVE3D
1149 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
1150# ifdef ADJUST_BOUNDARY
1151 integer :: t3dobc(5)
1152# endif
1153# ifdef ADJUST_STFLUX
1154 integer :: t3dfrc(4)
1155# endif
1156# endif
1157# ifdef ADJUST_WSTRESS
1158 integer :: u3dfrc(4), v3dfrc(4)
1159# endif
1160!
1161 real(r8) :: aval(6)
1162!
1163 character (len=256) :: ncname
1164 character (len=MaxLen) :: vinfo(natt)
1165
1166 character (len=*), parameter :: myfile = &
1167 & __FILE__//", def_error_pio"
1168!
1169 TYPE (var_desc_t) :: vardesc
1170!
1171 sourcefile=myfile
1172!
1173!-----------------------------------------------------------------------
1174! Set and report file name.
1175!-----------------------------------------------------------------------
1176!
1177 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1178 ncname=err(ng)%name
1179!
1180 IF (master) THEN
1181 IF (ldeferr(ng)) THEN
1182 WRITE (stdout,10) ng, trim(ncname)
1183 ELSE
1184 WRITE (stdout,20) ng, trim(ncname)
1185 END IF
1186 END IF
1187!
1188!=======================================================================
1189! Create a new posterior error covariance matrix file.
1190!=======================================================================
1191!
1192 define : IF (ldeferr(ng)) THEN
1193 CALL pio_netcdf_create (ng, itlm, trim(ncname), err(ng)%pioFile)
1194 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1195 IF (master) WRITE (stdout,30) trim(ncname)
1196 RETURN
1197 END IF
1198!
1199!-----------------------------------------------------------------------
1200! Define file dimensions.
1201!-----------------------------------------------------------------------
1202!
1203 dimids=0
1204!
1205 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xi_rho', &
1206 & iobounds(ng)%xi_rho, dimids( 1))
1207 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1208
1209 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xi_u', &
1210 & iobounds(ng)%xi_u, dimids( 2))
1211 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1212
1213 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xi_v', &
1214 & iobounds(ng)%xi_v, dimids( 3))
1215 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1216
1217 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xi_psi', &
1218 & iobounds(ng)%xi_psi, dimids( 4))
1219 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1220
1221 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'eta_rho', &
1222 & iobounds(ng)%eta_rho, dimids( 5))
1223 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1224
1225 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'eta_u', &
1226 & iobounds(ng)%eta_u, dimids( 6))
1227 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1228
1229 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'eta_v', &
1230 & iobounds(ng)%eta_v, dimids( 7))
1231 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1232
1233 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'eta_psi', &
1234 & iobounds(ng)%eta_psi, dimids( 8))
1235 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1236
1237# ifdef ADJUST_BOUNDARY
1238 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'IorJ', &
1239 & iobounds(ng)%IorJ, iorjdim)
1240 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1241# endif
1242
1243# if defined WRITE_WATER && defined MASKING
1244 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xy_rho', &
1245 & iobounds(ng)%xy_rho, dimids(17))
1246 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1247
1248 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xy_u', &
1249 & iobounds(ng)%xy_u, dimids(18))
1250 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1251
1252 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xy_v', &
1253 & iobounds(ng)%xy_v, dimids(19))
1254 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1255# endif
1256
1257# ifdef SOLVE3D
1258# if defined WRITE_WATER && defined MASKING
1259 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xyz_rho', &
1260 & iobounds(ng)%xy_rho*n(ng), dimids(20))
1261 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1262
1263 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xyz_u', &
1264 & iobounds(ng)%xy_u*n(ng), dimids(21))
1265 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1266
1267 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xyz_v', &
1268 & iobounds(ng)%xy_v*n(ng), dimids(22))
1269 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1270
1271 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xyz_w', &
1272 & iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
1273 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1274# endif
1275
1276 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'N', &
1277 & n(ng), dimids( 9))
1278 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1279
1280 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 's_rho', &
1281 & n(ng), dimids( 9))
1282 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1283
1284 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 's_w', &
1285 & n(ng)+1, dimids(10))
1286 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1287
1288 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'tracer', &
1289 & nt(ng), dimids(11))
1290 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1291
1292# ifdef SEDIMENT
1293 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'NST', &
1294 & nst, dimids(32))
1295 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1296
1297 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'Nbed', &
1298 & nbed, dimids(16))
1299 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1300
1301# if defined WRITE_WATER && defined MASKING
1302 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'xybed', &
1303 & iobounds(ng)%xy_rho*nbed, dimids(24))
1304 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1305# endif
1306# endif
1307
1308# ifdef ECOSIM
1309 status=def_dim(ng, inlm, err(ng)%pioFile, ncname, 'Nbands', &
1310 & nbands, dimids(33))
1311 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1312
1313 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'Nphy', &
1314 & nphy, dimids(25))
1315 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1316
1317 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'Nbac', &
1318 & nbac, dimids(26))
1319 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1320
1321 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'Ndom', &
1322 & ndom, dimids(27))
1323 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1324
1325 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'Nfec', &
1326 & nfec, dimids(28))
1327 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1328# endif
1329# endif
1330
1331 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'boundary', &
1332 & 4, dimids(14))
1333 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1334
1335# ifdef FOUR_DVAR
1336 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'Nstate', &
1337 & nstatevar(ng), dimids(29))
1338 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1339# endif
1340
1341 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'Ninner', &
1342 & ninner, ninnerdim)
1343 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1344
1345# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1346 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'frc_adjust', &
1347 & nfrec(ng), dimids(30))
1348 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1349# endif
1350
1351# ifdef ADJUST_BOUNDARY
1352 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, 'obc_adjust', &
1353 & nbrec(ng), dimids(31))
1354 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1355# endif
1356
1357 status=def_dim(ng, itlm, err(ng)%pioFile, ncname, &
1358 & trim(adjustl(vname(5,idtime))), &
1359 & pio_unlimited, dimids(12))
1360 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1361
1362 recdim=dimids(12)
1363# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1364 frecdim=dimids(30)
1365# endif
1366# ifdef ADJUST_BOUNDARY
1367 brecdim=dimids(31)
1368# endif
1369!
1370! Set number of dimensions for output variables.
1371!
1372# if defined WRITE_WATER && defined MASKING
1373 nvd3=2
1374 nvd4=2
1375# else
1376 nvd3=3
1377 nvd4=4
1378# endif
1379!
1380! Define dimension vectors for staggered tracer type variables.
1381!
1382# if defined WRITE_WATER && defined MASKING
1383 t2dgrd(1)=dimids(17)
1384 t2dgrd(2)=dimids(12)
1385# ifdef SOLVE3D
1386 t3dgrd(1)=dimids(20)
1387 t3dgrd(2)=dimids(12)
1388# endif
1389# else
1390 t2dgrd(1)=dimids( 1)
1391 t2dgrd(2)=dimids( 5)
1392 t2dgrd(3)=dimids(12)
1393# ifdef SOLVE3D
1394 t3dgrd(1)=dimids( 1)
1395 t3dgrd(2)=dimids( 5)
1396 t3dgrd(3)=dimids( 9)
1397 t3dgrd(4)=dimids(12)
1398# endif
1399# ifdef ADJUST_STFLUX
1400 t3dfrc(1)=dimids( 1)
1401 t3dfrc(2)=dimids( 5)
1402 t3dfrc(3)=frecdim
1403 t3dfrc(4)=dimids(12)
1404# endif
1405# endif
1406# ifdef ADJUST_BOUNDARY
1407 t2dobc(1)=iorjdim
1408 t2dobc(2)=dimids(14)
1409 t2dobc(3)=brecdim
1410 t2dobc(4)=dimids(12)
1411# ifdef SOLVE3D
1412 t3dobc(1)=iorjdim
1413 t3dobc(2)=dimids( 9)
1414 t3dobc(3)=dimids(14)
1415 t3dobc(4)=brecdim
1416 t3dobc(5)=dimids(12)
1417# endif
1418# endif
1419!
1420! Define dimension vectors for staggered u-momentum type variables.
1421!
1422# if defined WRITE_WATER && defined MASKING
1423 u2dgrd(1)=dimids(18)
1424 u2dgrd(2)=dimids(12)
1425# ifdef SOLVE3D
1426 u3dgrd(1)=dimids(21)
1427 u3dgrd(2)=dimids(12)
1428# endif
1429# else
1430 u2dgrd(1)=dimids( 2)
1431 u2dgrd(2)=dimids( 6)
1432 u2dgrd(3)=dimids(12)
1433# ifdef SOLVE3D
1434 u3dgrd(1)=dimids( 2)
1435 u3dgrd(2)=dimids( 6)
1436 u3dgrd(3)=dimids( 9)
1437 u3dgrd(4)=dimids(12)
1438# endif
1439# ifdef ADJUST_WSTRESS
1440 u3dfrc(1)=dimids( 2)
1441 u3dfrc(2)=dimids( 6)
1442 u3dfrc(3)=frecdim
1443 u3dfrc(4)=dimids(12)
1444# endif
1445# endif
1446!
1447! Define dimension vectors for staggered v-momentum type variables.
1448!
1449# if defined WRITE_WATER && defined MASKING
1450 v2dgrd(1)=dimids(19)
1451 v2dgrd(2)=dimids(12)
1452# ifdef SOLVE3D
1453 v3dgrd(1)=dimids(22)
1454 v3dgrd(2)=dimids(12)
1455# endif
1456# else
1457 v2dgrd(1)=dimids( 3)
1458 v2dgrd(2)=dimids( 7)
1459 v2dgrd(3)=dimids(12)
1460# ifdef SOLVE3D
1461 v3dgrd(1)=dimids( 3)
1462 v3dgrd(2)=dimids( 7)
1463 v3dgrd(3)=dimids( 9)
1464 v3dgrd(4)=dimids(12)
1465# endif
1466# ifdef ADJUST_WSTRESS
1467 v3dfrc(1)=dimids( 3)
1468 v3dfrc(2)=dimids( 7)
1469 v3dfrc(3)=frecdim
1470 v3dfrc(4)=dimids(12)
1471# endif
1472# endif
1473# ifdef SOLVE3D
1474!
1475! Define dimension vector for staggered w-momentum type variables.
1476!
1477# if defined WRITE_WATER && defined MASKING
1478 w3dgrd(1)=dimids(23)
1479 w3dgrd(2)=dimids(12)
1480# else
1481 w3dgrd(1)=dimids( 1)
1482 w3dgrd(2)=dimids( 5)
1483 w3dgrd(3)=dimids(10)
1484 w3dgrd(4)=dimids(12)
1485# endif
1486# endif
1487!
1488! Initialize unlimited time record dimension.
1489!
1490 err(ng)%Rindex=0
1491!
1492! Initialize local information variable arrays.
1493!
1494 DO i=1,natt
1495 DO j=1,len(vinfo(1))
1496 vinfo(i)(j:j)=' '
1497 END DO
1498 END DO
1499 DO i=1,6
1500 aval(i)=0.0_r8
1501 END DO
1502!
1503!-----------------------------------------------------------------------
1504! Define time-recordless information variables.
1505!-----------------------------------------------------------------------
1506!
1507 CALL def_info (ng, itlm, err(ng)%pioFile, ncname, dimids)
1508 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1509!
1510!-----------------------------------------------------------------------
1511! Define time-varying variables.
1512!-----------------------------------------------------------------------
1513!
1514! Define inner-loop Lanczos vectors tridiagonal matrix.
1515!
1516 vinfo( 1)='zLanczos_coef'
1517 vinfo( 2)='inner-loop Lanczos vector tridiagonal matrix'
1518 status=def_var(ng, itlm, err(ng)%pioFile, vardesc, pio_type, &
1519 & 2, (/ninnerdim,ninnerdim/), aval, vinfo, ncname, &
1520 & setparaccess = .false.)
1521 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1522!
1523! Define inverse of inner-loop Lanczos vectors tridiagonal matrix.
1524!
1525 vinfo( 1)='zLanczos_inv'
1526 vinfo( 2)='inverse inner-loop Lanczos vector tridiagonal matrix'
1527 status=def_var(ng, itlm, err(ng)%pioFile, vardesc, pio_type, &
1528 & 2, (/ninnerdim,ninnerdim/), aval, vinfo, ncname, &
1529 & setparaccess = .false.)
1530 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1531!
1532! Define inner-loop Lanczos vectors tridiagonal matrix inversion error.
1533! We need to get an identity matrix withing roundoff.
1534!
1535 vinfo( 1)='zLanczos_err'
1536 vinfo( 2)='inner-loop Lanczos vector tridiagonal matrix '// &
1537 & 'inversion error'
1538 status=def_var(ng, itlm, err(ng)%pioFile, vardesc, pio_type, &
1539 & 2, (/ninnerdim,ninnerdim/), aval, vinfo, ncname, &
1540 & setparaccess = .false.)
1541 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1542!
1543! Define model time.
1544!
1545 vinfo( 1)=vname(1,idtime)
1546 vinfo( 2)=vname(2,idtime)
1547 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
1548 vinfo( 4)=trim(rclock%calendar)
1549 vinfo(14)=vname(4,idtime)
1550 vinfo(21)=vname(6,idtime)
1551 err(ng)%pioVar(idtime)%dkind=pio_tout
1552 err(ng)%pioVar(idtime)%gtype=0
1553!
1554 status=def_var(ng, itlm, err(ng)%pioFile, &
1555 & err(ng)%pioVar(idtime)%vd, &
1556 & pio_tout, 1, (/recdim/), aval, vinfo, ncname, &
1557 & setparaccess = .true.)
1558 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1559!
1560! Define free-surface error variance.
1561!
1562 vinfo( 1)=vname(1,idfsur)
1563 WRITE (vinfo( 2),40) trim(vname(2,idfsur))
1564 vinfo( 3)='meter2'
1565 vinfo(14)=vname(4,idfsur)
1566 vinfo(16)=vname(1,idtime)
1567# if defined WRITE_WATER && defined MASKING
1568 vinfo(20)='mask_rho'
1569# endif
1570 vinfo(21)=vname(6,idfsur)
1571 vinfo(22)='coordinates'
1572 aval(5)=real(iinfo(1,idfsur,ng),r8)
1573 err(ng)%pioVar(idfsur)%dkind=pio_fout
1574 err(ng)%pioVar(idfsur)%gtype=r2dvar
1575!
1576 status=def_var(ng, itlm, err(ng)%pioFile, &
1577 & err(ng)%pioVar(idfsur)%vd, &
1578 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
1579 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1580
1581# ifdef ADJUST_BOUNDARY
1582!
1583! Define free-surface open boundaries error variance.
1584!
1585 IF (any(lobc(:,isfsur,ng))) THEN
1586 ifield=idsbry(isfsur)
1587 vinfo( 1)=vname(1,ifield)
1588 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1589 vinfo( 3)='meter2'
1590 vinfo(14)=vname(4,ifield)
1591 vinfo(16)=vname(1,idtime)
1592 vinfo(21)=vname(6,ifield)
1593 aval(5)=real(iinfo(1,ifield,ng),r8)
1594 err(ng)%pioVar(ifield)%dkind=pio_fout
1595 err(ng)%pioVar(ifield)%gtype=r2dobc
1596!
1597 status=def_var(ng, itlm, err(ng)%pioFile, &
1598 & err(ng)%pioVar(ifield)%vd, &
1599 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1600 & setfillval = .false.)
1601 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1602 END IF
1603# endif
1604!
1605! Define 2D U-momentum component error variance.
1606!
1607 vinfo( 1)=vname(1,idubar)
1608 WRITE (vinfo( 2),40) trim(vname(2,idubar))
1609 vinfo( 3)='meter2 second-2'
1610 vinfo(14)=vname(4,idubar)
1611 vinfo(16)=vname(1,idtime)
1612# if defined WRITE_WATER && defined MASKING
1613 vinfo(20)='mask_u'
1614# endif
1615 vinfo(21)=vname(6,idubar)
1616 vinfo(22)='coordinates'
1617 aval(5)=real(iinfo(1,idubar,ng),r8)
1618 err(ng)%pioVar(idubar)%dkind=pio_fout
1619 err(ng)%pioVar(idubar)%gtype=u2dvar
1620!
1621 status=def_var(ng, itlm, err(ng)%pioFile, &
1622 & err(ng)%pioVar(idubar)%vd, &
1623 & pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
1624 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1625
1626# ifdef ADJUST_BOUNDARY
1627!
1628! Define 2D U-momentum component open boundaries error variance.
1629!
1630 IF (any(lobc(:,isubar,ng))) THEN
1631 ifield=idsbry(isubar)
1632 vinfo( 1)=vname(1,ifield)
1633 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1634 vinfo( 3)='meter2 second-2'
1635 vinfo(14)=vname(4,ifield)
1636 vinfo(16)=vname(1,idtime)
1637 vinfo(21)=vname(6,ifield)
1638 aval(5)=real(iinfo(1,ifield,ng),r8)
1639 err(ng)%pioVar(ifield)%dkind=pio_fout
1640 err(ng)%pioVar(ifield)%gtype=u2dobc
1641!
1642 status=def_var(ng, itlm, err(ng)%pioFile, &
1643 & err(ng)%pioVar(ifield)%vd, &
1644 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1645 & setfillval = .false.)
1646 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1647 END IF
1648# endif
1649!
1650! Define 2D V-momentum component error variance.
1651!
1652 vinfo( 1)=vname(1,idvbar)
1653 WRITE (vinfo( 2),40) trim(vname(2,idvbar))
1654 vinfo( 3)='meter2 second-2'
1655 vinfo(14)=vname(4,idvbar)
1656 vinfo(16)=vname(1,idtime)
1657# if defined WRITE_WATER && defined MASKING
1658 vinfo(20)='mask_v'
1659# endif
1660 vinfo(21)=vname(6,idvbar)
1661 vinfo(22)='coordinates'
1662 aval(5)=real(iinfo(1,idvbar,ng),r8)
1663 err(ng)%pioVar(idvbar)%dkind=pio_fout
1664 err(ng)%pioVar(idvbar)%gtype=v2dvar
1665!
1666 status=def_var(ng, itlm, err(ng)%pioFile, &
1667 & err(ng)%pioVar(idvbar)%vd, &
1668 & pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
1669 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1670
1671# ifdef ADJUST_BOUNDARY
1672!
1673! Define 2D V-momentum component open boundaries error variance.
1674!
1675 IF (any(lobc(:,isvbar,ng))) THEN
1676 ifield=idsbry(isvbar)
1677 vinfo( 1)=vname(1,ifield)
1678 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1679 vinfo( 3)='meter2 second-2'
1680 vinfo(14)=vname(4,ifield)
1681 vinfo(16)=vname(1,idtime)
1682 vinfo(21)=vname(6,ifield)
1683 aval(5)=real(iinfo(1,ifield,ng),r8)
1684 err(ng)%pioVar(ifield)%dkind=pio_fout
1685 err(ng)%pioVar(ifield)%gtype=v2dobc
1686!
1687 status=def_var(ng, itlm, err(ng)%pioFile, &
1688 & err(ng)%pioVar(ifield)%vd, &
1689 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1690 & setfillval = .false.)
1691 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1692 END IF
1693# endif
1694# ifdef SOLVE3D
1695!
1696! Define 3D U-momentum component error variance.
1697!
1698 vinfo( 1)=vname(1,iduvel)
1699 WRITE (vinfo( 2),40) trim(vname(2,iduvel))
1700 vinfo( 3)='meter2 second-2'
1701 vinfo(14)=vname(4,iduvel)
1702 vinfo(16)=vname(1,idtime)
1703# if defined WRITE_WATER && defined MASKING
1704 vinfo(20)='mask_u'
1705# endif
1706 vinfo(21)=vname(6,iduvel)
1707 vinfo(22)='coordinates'
1708 aval(5)=real(iinfo(1,iduvel,ng),r8)
1709 err(ng)%pioVar(iduvel)%dkind=pio_fout
1710 err(ng)%pioVar(iduvel)%gtype=u3dvar
1711!
1712 status=def_var(ng, itlm, err(ng)%pioFile, &
1713 & err(ng)%pioVar(iduvel)%vd, &
1714 & pio_fout, nvd4, u3dgrd, aval, vinfo, ncname)
1715 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1716
1717# ifdef ADJUST_BOUNDARY
1718!
1719! Define 3D U-momentum component open boundaries error variance.
1720!
1721 IF (any(lobc(:,isuvel,ng))) THEN
1722 ifield=idsbry(isuvel)
1723 vinfo( 1)=vname(1,ifield)
1724 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1725 vinfo( 3)='meter2 second-2'
1726 vinfo(14)=vname(4,ifield)
1727 vinfo(16)=vname(1,idtime)
1728 vinfo(21)=vname(6,ifield)
1729 aval(5)=real(iinfo(1,ifield,ng),r8)
1730 err(ng)%pioVar(ifield)%dkind=pio_fout
1731 err(ng)%pioVar(ifield)%gtype=u3dobc
1732!
1733 status=def_var(ng, itlm, err(ng)%pioFile, &
1734 & err(ng)%pioVar(ifield)%vd, &
1735 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1736 & setfillval = .false.)
1737 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1738 END IF
1739# endif
1740!
1741! Define 3D V-momentum component error variance.
1742!
1743 vinfo( 1)=vname(1,idvvel)
1744 WRITE (vinfo( 2),40) trim(vname(2,idvvel))
1745 vinfo( 3)='meter2 second-2'
1746 vinfo(14)=vname(4,idvvel)
1747 vinfo(16)=vname(1,idtime)
1748# if defined WRITE_WATER && defined MASKING
1749 vinfo(20)='mask_v'
1750# endif
1751 vinfo(21)=vname(6,idvvel)
1752 vinfo(22)='coordinates'
1753 aval(5)=real(iinfo(1,idvvel,ng),r8)
1754 err(ng)%pioVar(idvvel)%dkind=pio_fout
1755 err(ng)%pioVar(idvvel)%gtype=v3dvar
1756!
1757 status=def_var(ng, itlm, err(ng)%pioFile, &
1758 & err(ng)%pioVar(idvvel)%vd, &
1759 & pio_fout, nvd4, v3dgrd, aval, vinfo, ncname)
1760 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1761
1762# ifdef ADJUST_BOUNDARY
1763!
1764! Define 3D V-momentum component open boundaries error variance.
1765!
1766 IF (any(lobc(:,isvvel,ng))) THEN
1767 ifield=idsbry(isvvel)
1768 vinfo( 1)=vname(1,ifield)
1769 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1770 vinfo( 3)='meter2 second-2'
1771 vinfo(14)=vname(4,ifield)
1772 vinfo(16)=vname(1,idtime)
1773 vinfo(21)=vname(6,ifield)
1774 aval(5)=real(iinfo(1,ifield,ng),r8)
1775 err(ng)%pioVar(ifield)%dkind=pio_fout
1776 err(ng)%pioVar(ifield)%gtype=v3dobc
1777!
1778 status=def_var(ng, itlm, err(ng)%pioFile, &
1779 & err(ng)%pioVar(ifield)%vd, &
1780 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1781 & setfillval = .false.)
1782 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1783 END IF
1784# endif
1785!
1786! Define tracer type variables error variance.
1787!
1788 DO itrc=1,nt(ng)
1789 vinfo( 1)=vname(1,idtvar(itrc))
1790 WRITE (vinfo( 2),40) trim(vname(2,idtvar(itrc)))
1791 IF (itrc.eq.itemp) THEN
1792 vinfo( 3)='Celsius2'
1793 ELSE IF (itrc.eq.isalt) THEN
1794 vinfo( 3)='nondimensional'
1795 ELSE
1796 WRITE (vinfo( 3),50) trim(vname(3,idtvar(itrc)))
1797 END IF
1798 vinfo(14)=vname(4,idtvar(itrc))
1799 vinfo(16)=vname(1,idtime)
1800# ifdef SEDIMENT
1801 DO i=1,nst
1802 IF (itrc.eq.idsed(i)) THEN
1803 WRITE (vinfo(19),60) 1000.0_r8*sd50(i,ng)
1804 END IF
1805 END DO
1806# endif
1807# if defined WRITE_WATER && defined MASKING
1808 vinfo(20)='mask_rho'
1809# endif
1810 vinfo(21)=vname(6,idtvar(itrc))
1811 vinfo(22)='coordinates'
1812 aval(5)=real(r3dvar,r8)
1813 err(ng)%pioTrc(itrc)%dkind=pio_fout
1814 err(ng)%pioTrc(itrc)%gtype=r3dvar
1815!
1816 status=def_var(ng, itlm, err(ng)%pioFile, &
1817 & err(ng)%pioTrc(itrc)%vd, &
1818 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
1819 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1820 END DO
1821
1822# ifdef ADJUST_BOUNDARY
1823!
1824! Define tracer type variables open boundaries error variance.
1825!
1826 DO itrc=1,nt(ng)
1827 IF (any(lobc(:,istvar(itrc),ng))) THEN
1828 ifield=idsbry(istvar(itrc))
1829 vinfo( 1)=vname(1,ifield)
1830 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1831 IF (itrc.eq.itemp) THEN
1832 vinfo( 3)='Celsius2'
1833 ELSE IF (itrc.eq.isalt) THEN
1834 vinfo( 3)='nondimensional'
1835 ELSE
1836 WRITE (vinfo( 3),50) trim(vname(3,idtvar(itrc)))
1837 END IF
1838 vinfo(14)=vname(4,ifield)
1839 vinfo(16)=vname(1,idtime)
1840# ifdef SEDIMENT
1841 DO i=1,nst
1842 IF (itrc.eq.idsed(i)) THEN
1843 WRITE (vinfo(19),60) 1000.0_r8*sd50(i,ng)
1844 END IF
1845 END DO
1846# endif
1847 vinfo(21)=vname(6,ifield)
1848 aval(5)=real(iinfo(1,ifield,ng),r8)
1849 err(ng)%pioVar(ifield)%dkind=pio_fout
1850 err(ng)%pioVar(ifield)%gtype=r3dobc
1851!
1852 status=def_var(ng, itlm, err(ng)%pioFile, &
1853 & err(ng)%pioVar(ifield)%vd, &
1854 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1855 & setfillval = .false.)
1856 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1857 END IF
1858 END DO
1859# endif
1860# ifdef ADJUST_STFLUX
1861!
1862! Define surface tracer fluxes error variance.
1863!
1864 DO itrc=1,nt(ng)
1865 IF (lstflux(itrc,ng)) THEN
1866 vinfo( 1)=vname(1,idtsur(itrc))
1867 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
1868 WRITE (vinfo( 3),50) trim(vname(3,idtsur(itrc)))
1869 IF (itrc.eq.itemp) THEN
1870 vinfo(11)='upward flux, cooling'
1871 vinfo(12)='downward flux, heating'
1872 ELSE IF (itrc.eq.isalt) THEN
1873 vinfo(11)='upward flux, freshening (net precipitation)'
1874 vinfo(12)='downward flux, salting (net evaporation)'
1875 END IF
1876 vinfo(14)=vname(4,idtsur(itrc))
1877 vinfo(16)=vname(1,idtime)
1878# if defined WRITE_WATER && defined MASKING
1879 vinfo(20)='mask_rho'
1880# endif
1881 vinfo(21)=vname(6,idtsur(itrc))
1882 vinfo(22)='coordinates'
1883 aval(5)=real(r2dvar,r8)
1884 err(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
1885 err(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1886!
1887 status=def_var(ng, itlm, err(ng)%pioFile, &
1888 & err(ng)%pioVar(idtsur(itrc))%vd, &
1889 & pio_fout, nvd4, t3dfrc, aval, vinfo, ncname)
1890 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1891 END IF
1892 END DO
1893# endif
1894# endif
1895# ifdef ADJUST_WSTRESS
1896!
1897! Define surface U-momentum stress error variance.
1898!
1899 vinfo( 1)=vname(1,idusms)
1900 WRITE (vinfo( 2),40) trim(vname(2,idusms))
1901 vinfo( 3)='meter4 second-4'
1902 vinfo(14)=vname(4,idusms)
1903 vinfo(16)=vname(1,idtime)
1904# if defined WRITE_WATER && defined MASKING
1905 vinfo(20)='mask_u'
1906# endif
1907 vinfo(21)=vname(6,idusms)
1908 vinfo(22)='coordinates'
1909 aval(5)=real(u2dvar,r8)
1910 err(ng)%pioVar(idusms)%dkind=pio_fout
1911 err(ng)%pioVar(idusms)%gtype=u2dvar
1912!
1913 status=def_var(ng, itlm, err(ng)%pioFile, &
1914 & err(ng)%pioVar(idusms)%vd, &
1915 & pio_fout, nvd4, u3dfrc, aval, vinfo, ncname)
1916 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1917!
1918! Define surface V-momentum stress error variance.
1919!
1920 vinfo( 1)=vname(1,idvsms)
1921 WRITE (vinfo( 2),40) trim(vname(2,idvsms))
1922 vinfo( 2)=vname(2,idvsms)
1923 vinfo( 3)='meter4 second4'
1924 vinfo(14)=vname(4,idvsms)
1925 vinfo(16)=vname(1,idtime)
1926# if defined WRITE_WATER && defined MASKING
1927 vinfo(20)='mask_v'
1928# endif
1929 vinfo(21)=vname(6,idvsms)
1930 vinfo(22)='coordinates'
1931 aval(5)=real(v2dvar,r8)
1932 err(ng)%pioVar(idvsms)%dkind=pio_fout
1933 err(ng)%pioVar(idvsms)%gtype=v2dvar
1934!
1935 status=def_var(ng, itlm, err(ng)%pioFile, &
1936 & err(ng)%pioVar(idvsms)%vd, &
1937 & pio_fout, nvd4, v3dfrc, aval, vinfo, ncname)
1938 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1939# endif
1940!
1941!-----------------------------------------------------------------------
1942! Leave definition mode.
1943!-----------------------------------------------------------------------
1944!
1945 CALL pio_netcdf_enddef (ng, itlm, ncname, err(ng)%pioFile)
1946 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1947!
1948!-----------------------------------------------------------------------
1949! Write out time-recordless, information variables.
1950!-----------------------------------------------------------------------
1951!
1952 CALL wrt_info (ng, itlm, err(ng)%pioFile, ncname)
1953 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1954 END IF define
1955!
1956!=======================================================================
1957! Open an existing posterior error covariance matrix, check its
1958! contents, and prepare for appending data.
1959!=======================================================================
1960!
1961 query: IF (.not.ldeferr(ng)) THEN
1962 ncname=err(ng)%name
1963!
1964! Open posterior error covariance file for read/write.
1965!
1966 CALL pio_netcdf_open (ng, itlm, ncname, 1, err(ng)%pioFile)
1967 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1968 WRITE (stdout,70) trim(ncname)
1969 RETURN
1970 END IF
1971!
1972! Inquire about the dimensions and check for consistency.
1973!
1974 CALL pio_netcdf_check_dim (ng, itlm, ncname, &
1975 & piofile = err(ng)%pioFile)
1976 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1977!
1978! Inquire about the variables.
1979!
1980 CALL pio_netcdf_inq_var (ng, itlm, ncname, &
1981 & piofile = err(ng)%pioFile)
1982 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1983!
1984! Initialize logical switches.
1985!
1986 DO i=1,nv
1987 got_var(i)=.false.
1988 END DO
1989!
1990! Scan variable list from input NetCDF and activate switches for
1991! posterior error covariance matrix variables. Get variable IDs.
1992!
1993 DO i=1,n_var
1994 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
1995 got_var(idtime)=.true.
1996 err(ng)%pioVar(idtime)%vd=var_desc(i)
1997 err(ng)%pioVar(idtime)%dkind=pio_tout
1998 err(ng)%pioVar(idtime)%gtype=0
1999 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
2000 got_var(idfsur)=.true.
2001 err(ng)%pioVar(idfsur)%vd=var_desc(i)
2002 err(ng)%pioVar(idfsur)%dkind=pio_fout
2003 err(ng)%pioVar(idfsur)%gtype=r2dvar
2004 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
2005 got_var(idubar)=.true.
2006 err(ng)%pioVar(idubar)%vd=var_desc(i)
2007 err(ng)%pioVar(idubar)%dkind=pio_fout
2008 err(ng)%pioVar(idubar)%gtype=u2dvar
2009 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
2010 got_var(idvbar)=.true.
2011 err(ng)%pioVar(idvbar)%vd=var_desc(i)
2012 err(ng)%pioVar(idvbar)%dkind=pio_fout
2013 err(ng)%pioVar(idvbar)%gtype=v2dvar
2014# ifdef ADJUST_BOUNDARY
2015 ELSE IF (trim(var_name(i)).eq. &
2016 & trim(vname(1,idsbry(isfsur)))) THEN
2017 got_var(idsbry(isfsur))=.true.
2018 err(ng)%pioVar(idsbry(isfsur))%vd=var_desc(i)
2019 err(ng)%pioVar(idsbry(isfsur))%dkind=pio_fout
2020 err(ng)%pioVar(idsbry(isfsur))%gtype=r2dobc
2021 ELSE IF (trim(var_name(i)).eq. &
2022 & trim(vname(1,idsbry(isubar)))) THEN
2023 got_var(idsbry(isubar))=.true.
2024 err(ng)%pioVar(idsbry(isubar))%vd=var_desc(i)
2025 err(ng)%pioVar(idsbry(isubar))%dkind=pio_fout
2026 err(ng)%pioVar(idsbry(isubar))%gtype=u2dobc
2027 ELSE IF (trim(var_name(i)).eq. &
2028 & trim(vname(1,idsbry(isvbar)))) THEN
2029 got_var(idsbry(isvbar))=.true.
2030 err(ng)%pioVar(idsbry(isvbar))%vd=var_desc(i)
2031 err(ng)%pioVar(idsbry(isvbar))%dkind=pio_fout
2032 err(ng)%pioVar(idsbry(isvbar))%gtype=v2dobc
2033# endif
2034# ifdef ADJUST_WSTRESS
2035 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
2036 got_var(idusms)=.true.
2037 err(ng)%pioVar(idusms)%vd=var_desc(i)
2038 err(ng)%pioVar(idusms)%dkind=pio_fout
2039 err(ng)%pioVar(idusms)%gtype=u2dvar
2040 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
2041 got_var(idvsms)=.true.
2042 err(ng)%pioVar(idvsms)%vd=var_desc(i)
2043 err(ng)%pioVar(idvsms)%dkind=pio_fout
2044 err(ng)%pioVar(idvsms)%gtype=v2dvar
2045# endif
2046# ifdef SOLVE3D
2047 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
2048 got_var(iduvel)=.true.
2049 err(ng)%pioVar(iduvel)%vd=var_desc(i)
2050 err(ng)%pioVar(iduvel)%dkind=pio_fout
2051 err(ng)%pioVar(iduvel)%gtype=u3dvar
2052 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
2053 got_var(idvvel)=.true.
2054 err(ng)%pioVar(idvvel)%vd=var_desc(i)
2055 err(ng)%pioVar(idvvel)%dkind=pio_fout
2056 err(ng)%pioVar(idvvel)%gtype=v3dvar
2057# ifdef ADJUST_BOUNDARY
2058 ELSE IF (trim(var_name(i)).eq. &
2059 & trim(vname(1,idsbry(isuvel)))) THEN
2060 got_var(idsbry(isuvel))=.true.
2061 err(ng)%pioVar(idsbry(isuvel))%vd=var_desc(i)
2062 err(ng)%pioVar(idsbry(isuvel))%dkind=pio_fout
2063 err(ng)%pioVar(idsbry(isuvel))%gtype=u3dobc
2064 ELSE IF (trim(var_name(i)).eq. &
2065 & trim(vname(1,idsbry(isvvel)))) THEN
2066 got_var(idsbry(isvvel))=.true.
2067 err(ng)%pioVar(idsbry(isvvel))%vd=var_desc(i)
2068 err(ng)%pioVar(idsbry(isvvel))%dkind=pio_fout
2069 err(ng)%pioVar(idsbry(isvvel))%gtype=v3dobc
2070# endif
2071# endif
2072 END IF
2073# ifdef SOLVE3D
2074 DO itrc=1,nt(ng)
2075 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
2076 got_var(idtvar(itrc))=.true.
2077 err(ng)%pioTrc(itrc)%vd=var_desc(i)
2078 err(ng)%pioTrc(itrc)%dkind=pio_fout
2079 err(ng)%pioTrc(itrc)%gtype=r3dvar
2080# ifdef ADJUST_BOUNDARY
2081 ELSE IF (trim(var_name(i)).eq. &
2082 & trim(vname(1,idsbry(istvar(itrc))))) THEN
2083 got_var(idsbry(istvar(itrc)))=.true.
2084 err(ng)%pioVar(idsbry(istvar(itrc)))%vd=var_desc(i)
2085 err(ng)%pioVar(idsbry(istvar(itrc)))%dkind=pio_fout
2086 err(ng)%pioVar(idsbry(istvar(itrc)))%gtype=r3dobc
2087# endif
2088# ifdef ADJUST_STFLUX
2089 ELSE IF (trim(var_name(i)).eq. &
2090 & trim(vname(1,idtsur(itrc)))) THEN
2091 got_var(idtsur(itrc))=.true.
2092 err(ng)%pioVar(idtsur(itrc))%vd=var_desc(i)
2093 err(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
2094 err(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
2095# endif
2096 END IF
2097 END DO
2098# endif
2099 END DO
2100!
2101! Check if posterior error covariance matrix variables are available
2102! in input NetCDF file.
2103!
2104 IF (.not.got_var(idtime)) THEN
2105 IF (master) WRITE (stdout,80) trim(vname(1,idtime)), &
2106 & trim(ncname)
2107 exit_flag=3
2108 RETURN
2109 END IF
2110 IF (.not.got_var(idfsur)) THEN
2111 IF (master) WRITE (stdout,80) trim(vname(1,idfsur)), &
2112 & trim(ncname)
2113 exit_flag=3
2114 RETURN
2115 END IF
2116 IF (.not.got_var(idubar)) THEN
2117 IF (master) WRITE (stdout,80) trim(vname(1,idubar)), &
2118 & trim(ncname)
2119 exit_flag=3
2120 RETURN
2121 END IF
2122 IF (.not.got_var(idvbar)) THEN
2123 IF (master) WRITE (stdout,80) trim(vname(1,idvbar)), &
2124 & trim(ncname)
2125 exit_flag=3
2126 RETURN
2127 END IF
2128# ifdef ADJUST_BOUNDARY
2129 IF (.not.got_var(idsbry(isfsur))) THEN
2130 IF (master) WRITE (stdout,80) trim(vname(1,idsbry(isfsur))), &
2131 & trim(ncname)
2132 exit_flag=3
2133 RETURN
2134 END IF
2135 IF (.not.got_var(idsbry(isubar))) THEN
2136 IF (master) WRITE (stdout,80) trim(vname(1,idsbry(isubar))), &
2137 & trim(ncname)
2138 exit_flag=3
2139 RETURN
2140 END IF
2141 IF (.not.got_var(idsbry(isvbar))) THEN
2142 IF (master) WRITE (stdout,80) trim(vname(1,idsbry(isvbar))), &
2143 & trim(ncname)
2144 exit_flag=3
2145 RETURN
2146 END IF
2147# endif
2148# ifdef ADJUST_WSTRESS
2149 IF (.not.got_var(idusms)) THEN
2150 IF (master) WRITE (stdout,80) trim(vname(1,idusms)), &
2151 & trim(ncname)
2152 exit_flag=3
2153 RETURN
2154 END IF
2155 IF (.not.got_var(idvsms)) THEN
2156 IF (master) WRITE (stdout,80) trim(vname(1,idvsms)), &
2157 & trim(ncname)
2158 exit_flag=3
2159 RETURN
2160 END IF
2161# endif
2162# ifdef SOLVE3D
2163 IF (.not.got_var(iduvel)) THEN
2164 IF (master) WRITE (stdout,80) trim(vname(1,iduvel)), &
2165 & trim(ncname)
2166 exit_flag=3
2167 RETURN
2168 END IF
2169 IF (.not.got_var(idvvel)) THEN
2170 IF (master) WRITE (stdout,80) trim(vname(1,idvvel)), &
2171 & trim(ncname)
2172 exit_flag=3
2173 RETURN
2174 END IF
2175# ifdef ADJUST_BOUNDARY
2176 IF (.not.got_var(idsbry(isuvel))) THEN
2177 IF (master) WRITE (stdout,80) trim(vname(1,idsbry(isuvel))), &
2178 & trim(ncname)
2179 exit_flag=3
2180 RETURN
2181 END IF
2182 IF (.not.got_var(idsbry(isvvel))) THEN
2183 IF (master) WRITE (stdout,80) trim(vname(1,idsbry(isvvel))), &
2184 & trim(ncname)
2185 exit_flag=3
2186 RETURN
2187 END IF
2188# endif
2189# endif
2190# ifdef SOLVE3D
2191 DO itrc=1,nt(ng)
2192 IF (.not.got_var(idtvar(itrc))) THEN
2193 IF (master) WRITE (stdout,80) trim(vname(1,idtvar(itrc))), &
2194 & trim(ncname)
2195 exit_flag=3
2196 RETURN
2197 END IF
2198# ifdef ADJUST_BOUNDARY
2199 IF (.not.got_var(idsbry(istvar(itrc)))) THEN
2200 IF (master) WRITE (stdout,80) &
2201 & trim(vname(1,idsbry(istvar(itrc)))), &
2202 & trim(ncname)
2203 exit_flag=3
2204 RETURN
2205 END IF
2206# endif
2207# ifdef ADJUST_STFLUX
2208 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
2209 IF (master) WRITE (stdout,80) trim(vname(1,idtsur(itrc))), &
2210 & trim(ncname)
2211 exit_flag=3
2212 RETURN
2213 END IF
2214# endif
2215 END DO
2216# endif
2217!
2218! Set unlimited time record dimension to the appropriate value.
2219!
2220 err(ng)%Rindex=rec_size
2221 END IF query
2222!
2223 10 FORMAT (2x,'DEF_ERROR_PIO - creating error file,',t56, &
2224 & 'Grid ',i2.2,': ',a)
2225 20 FORMAT (2x,'DEF_ERROR_PIO - inquiring error file,',t56, &
2226 & 'Grid ',i2.2,': ',a)
2227 30 FORMAT (/,' DEF_ERROR_PIO - unable to create 4DVar error NetCDF' &
2228 & ' file:',1x,a)
2229# if defined POSTERIOR_ERROR_I
2230 40 FORMAT (a,', initial posterior error variance')
2231# elif defined POSTERIOR_ERROR_F
2232 40 FORMAT (a,', final posterior error variance')
2233# endif
2234 50 FORMAT ('(',a,')^2')
2235 60 FORMAT (1pe11.4,1x,'millimeter')
2236 70 FORMAT (/,' DEF_ERROR_PIO - unable to open error NetCDF', &
2237 & ' file: ',a)
2238 80 FORMAT (/,' DEF_ERROR_PIO - unable to find variable: ',a,2x, &
2239 & ' in 4DVar error NetCDF file: ',a)
2240!
2241 RETURN
2242 END SUBROUTINE def_error_pio
2243# endif
2244#endif
2245 END MODULE def_error_mod
def_dim_mod::def_dim
Definition def_dim.F:24
def_info_mod::def_info
Definition def_info.F:72
def_var_mod::def_var
Definition def_var.F:88
wrt_info_mod::wrt_info
Definition wrt_info.F:54
def_dim_mod
Definition def_dim.F:2
def_error_mod
Definition def_error.F:2
def_error_mod::def_error_pio
subroutine, private def_error_pio(ng)
Definition def_error.F:1120
def_error_mod::def_error
subroutine, public def_error(ng)
Definition def_error.F:51
def_error_mod::def_error_nf90
subroutine, private def_error_nf90(ng)
Definition def_error.F:88
def_info_mod
Definition def_info.F:2
def_var_mod
Definition def_var.F:2
mod_biology
Definition ecosim_mod.h:1
mod_biology::nfec
integer, parameter nfec
Definition ecosim_mod.h:204
mod_biology::nbac
integer, parameter nbac
Definition ecosim_mod.h:202
mod_biology::ndom
integer, parameter ndom
Definition ecosim_mod.h:203
mod_biology::nbands
integer, parameter nbands
Definition ecosim_mod.h:201
mod_biology::nphy
integer, parameter nphy
Definition ecosim_mod.h:205
mod_fourdvar
Definition mod_fourdvar.F:2
mod_fourdvar::nstatevar
integer, dimension(:), allocatable nstatevar
Definition mod_fourdvar.F:362
mod_iounits
Definition mod_iounits.F:2
mod_iounits::err
type(t_io), dimension(:), allocatable err
Definition mod_iounits.F:207
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::nv
integer, parameter nv
Definition mod_ncparam.F:105
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::iinfo
integer, dimension(:,:,:), allocatable iinfo
Definition mod_ncparam.F:578
mod_ncparam::idusms
integer idusms
Definition mod_ncparam.F:339
mod_ncparam::ndimid
integer, parameter ndimid
Definition mod_ncparam.F:110
mod_ncparam::idvbar
integer idvbar
Definition mod_ncparam.F:360
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::nf_tout
integer, parameter nf_tout
Definition mod_netcdf.F:207
mod_netcdf::netcdf_check_dim
subroutine, public netcdf_check_dim(ng, model, ncname, ncid)
Definition mod_netcdf.F:538
mod_netcdf::netcdf_open
subroutine, public netcdf_open(ng, model, ncname, omode, ncid)
Definition mod_netcdf.F:9293
mod_netcdf::nf_fout
integer, parameter nf_fout
Definition mod_netcdf.F:188
mod_netcdf::netcdf_enddef
subroutine, public netcdf_enddef(ng, model, ncname, ncid)
Definition mod_netcdf.F:9220
mod_netcdf::var_name
character(len=100), dimension(mvars) var_name
Definition mod_netcdf.F:169
mod_netcdf::var_id
integer, dimension(mvars) var_id
Definition mod_netcdf.F:160
mod_netcdf::n_var
integer n_var
Definition mod_netcdf.F:152
mod_netcdf::nf_type
integer, parameter nf_type
Definition mod_netcdf.F:198
mod_netcdf::rec_size
integer rec_size
Definition mod_netcdf.F:156
mod_netcdf::netcdf_create
subroutine, public netcdf_create(ng, model, ncname, ncid)
Definition mod_netcdf.F:9089
mod_netcdf::netcdf_inq_var
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
Definition mod_netcdf.F:1371
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::u2dobc
integer, parameter u2dobc
Definition mod_param.F:729
mod_param::v3dobc
integer, parameter v3dobc
Definition mod_param.F:733
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::nbed
integer nbed
Definition mod_param.F:517
mod_param::r2dobc
integer, parameter r2dobc
Definition mod_param.F:728
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::r3dvar
integer, parameter r3dvar
Definition mod_param.F:721
mod_param::r3dobc
integer, parameter r3dobc
Definition mod_param.F:731
mod_param::v2dobc
integer, parameter v2dobc
Definition mod_param.F:730
mod_param::iobounds
type(t_iobounds), dimension(:), allocatable iobounds
Definition mod_param.F:282
mod_param::u3dobc
integer, parameter u3dobc
Definition mod_param.F:732
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::nst
integer nst
Definition mod_param.F:521
mod_param::v3dvar
integer, parameter v3dvar
Definition mod_param.F:723
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::pio_type
integer, parameter pio_type
Definition mod_pio_netcdf.F:579
mod_pio_netcdf::pio_fout
integer, parameter pio_fout
Definition mod_pio_netcdf.F:569
mod_pio_netcdf::var_desc
type(var_desc_t), dimension(:), pointer var_desc
Definition mod_pio_netcdf.F:437
mod_pio_netcdf::pio_netcdf_create
subroutine, public pio_netcdf_create(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:8997
mod_pio_netcdf::pio_netcdf_inq_var
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
Definition mod_pio_netcdf.F:1923
mod_pio_netcdf::pio_netcdf_open
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
Definition mod_pio_netcdf.F:9148
mod_pio_netcdf::pio_netcdf_check_dim
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:1080
mod_pio_netcdf::pio_tout
integer, parameter pio_tout
Definition mod_pio_netcdf.F:588
mod_pio_netcdf::pio_netcdf_enddef
subroutine, public pio_netcdf_enddef(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:9096
mod_scalars
Definition mod_scalars.F:2
mod_scalars::ninner
integer ninner
Definition mod_scalars.F:353
mod_scalars::ldeferr
logical, dimension(:), allocatable ldeferr
Definition mod_scalars.F:958
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::rclock
type(t_clock) rclock
Definition mod_scalars.F:120
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::isalt
integer isalt
Definition mod_scalars.F:127
mod_scalars::itemp
integer itemp
Definition mod_scalars.F:126
mod_scalars::nbrec
integer, dimension(:), allocatable nbrec
Definition mod_scalars.F:1119
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
mod_sediment
Definition sediment_mod.h:1
mod_sediment::idsed
integer, dimension(:), allocatable idsed
Definition sediment_mod.h:88
mod_sediment::sd50
real(r8), dimension(:,:), allocatable sd50
Definition sediment_mod.h:173
strings_mod
Definition strings.F:2
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
wrt_info_mod
Definition wrt_info.F:2