ROMS
Loading...
Searching...
No Matches
def_mod.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE def_mod_mod
3#if defined FOUR_DVAR || defined VERIFICATION
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 routine create model/observation output file using either the !
13! standard NetCDF library or the Parallel-IO (PIO) library. The model !
14! fields processed at observations locations. !
15! !
16! For completeness and to allow the Ensemble Kalman Filter (EnKF) !
17! with the First Guess at Appropriate Time (FGAT), several variables !
18! from the input observation file is also written. !
19! !
20!=======================================================================
21!
22 USE mod_param
23 USE mod_parallel
24 USE mod_fourdvar
25 USE mod_iounits
26 USE mod_ncparam
27 USE mod_scalars
28 USE mod_strings
29!
30 USE dateclock_mod, ONLY : time_string
31 USE def_dim_mod, ONLY : def_dim
32 USE def_var_mod, ONLY : def_var
33 USE strings_mod, ONLY : find_string
34 USE strings_mod, ONLY : founderror
35 USE strings_mod, ONLY : uppercase
36!
37 implicit none
38!
39 PUBLIC :: def_mod
40 PRIVATE :: def_mod_nf90
41# if defined PIO_LIB && defined DISTRIBUTE
42 PRIVATE :: def_mod_pio
43# endif
44!
45 CONTAINS
46!
47!***********************************************************************
48 SUBROUTINE def_mod (ng)
49!***********************************************************************
50!
51! Imported variable declarations.
52!
53 integer, intent(in) :: ng
54!
55! Local variable declarations.
56!
57 character (len=*), parameter :: myfile = &
58 & __FILE__
59!
60!-----------------------------------------------------------------------
61! Create a new history file according to IO type.
62!-----------------------------------------------------------------------
63!
64 SELECT CASE (dav(ng)%IOtype)
65 CASE (io_nf90)
66 CALL def_mod_nf90 (ng)
67
68# if defined PIO_LIB && defined DISTRIBUTE
69 CASE (io_pio)
70 CALL def_mod_pio (ng)
71# endif
72 CASE DEFAULT
73 IF (master) WRITE (stdout,10) dav(ng)%IOtype
74 exit_flag=3
75 END SELECT
76 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
77!
78 10 FORMAT (' DEF_MOD - Illegal output file type, io_type = ',i0, &
79 & /,11x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
80!
81 RETURN
82 END SUBROUTINE def_mod
83!
84!***********************************************************************
85 SUBROUTINE def_mod_nf90 (ng)
86!***********************************************************************
87!
88 USE mod_netcdf
89# ifdef DISTRIBUTE
90!
91 USE distribute_mod, ONLY : mp_bcasti
92# endif
93!
94! Imported variable declarations.
95!
96 integer, intent(in) :: ng
97!
98! Local variable declarations.
99!
100 logical, dimension(NV) :: got_var(nv)
101 logical :: foundatt(2), foundit
102!
103 integer, parameter :: natt = 25
104
105 integer :: iterdim, recorddim, surveydim, threedim
106 integer :: datumdim, datumdimp1
107 integer :: ninnerdim, ninnerdimp1, ninnerdimp2
108 integer :: nouterdim, nouterdimp1
109# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
110 integer :: retadim, rxidim
111# endif
112 integer :: statedim, statedimp1
113 integer :: fcount
114
115 integer :: i, j, lstr, nvatt, nvdim, status, varid, vindex
116 integer :: obsncid
117 integer :: vardim(3)
118# ifdef DISTRIBUTE
119 integer :: ibuffer(2)
120# endif
121!
122 real(dp) :: tstart, tfinal
123 real(r8) :: aval(6)
124!
125 character (len=22 ) :: str_date, end_date
126 character (len=40 ) :: aname, attname(2)
127 character (len=80 ) :: string
128 character (len=256) :: ncname
129 character (len=2048) :: attvalue(2)
130 character (len=MaxLen) :: vinfo(natt)
131
132 character (len=*), parameter :: myfile = &
133 & __FILE__//", def_mod_nf90"
134!
135 sourcefile=myfile
136!
137!-----------------------------------------------------------------------
138! Set and report file name.
139!-----------------------------------------------------------------------
140!
141 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
142 ncname=dav(ng)%name
143!
144 IF (master) THEN
145 IF (ldefmod(ng)) THEN
146 WRITE (stdout,10) ng, trim(ncname)
147 ELSE
148 WRITE (stdout,20) ng, trim(ncname)
149 END IF
150 END IF
151!
152! Initialize local information variable arrays.
153!
154 DO i=1,natt
155 DO j=1,len(vinfo(1))
156 vinfo(i)(j:j)=' '
157 END DO
158 END DO
159 DO i=1,6
160 aval(i)=0.0_r8
161 END DO
162!
163!=======================================================================
164! Create a new model/observation file.
165!=======================================================================
166!
167 define : IF (ldefmod(ng)) THEN
168!
169! Open input observations NetCDF.
170!
171 IF (obs(ng)%ncid.eq.-1) THEN
172 CALL netcdf_open (ng, inlm, obs(ng)%name, 1, obsncid)
173 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
174 WRITE (stdout,30) trim(obs(ng)%name)
175 RETURN
176 END IF
177 ELSE
178 obsncid=obs(ng)%ncid
179 END IF
180!
181! Inquire about input observations variables.
182!
183 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
184 & ncid = obsncid)
185 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
186!
187! Inquire if the 'state_variables' and 'obs_provenance' attributes
188! are available in the observations file.
189!
190 attname(1)='state_variables'
191 attname(2)='obs_provenance'
192!
193 CALL netcdf_get_satt (ng, inlm, obs(ng)%name, nf90_global, &
194 & attname, attvalue, foundatt, &
195 & ncid = obsncid)
196 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
197!
198! Create model/observation (DAV) file
199!
200 CALL netcdf_create (ng, inlm, trim(ncname), dav(ng)%ncid)
201 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
202 IF (master) WRITE (stdout,40) trim(ncname)
203 RETURN
204 END IF
205!
206!-----------------------------------------------------------------------
207! Define dimensions.
208!-----------------------------------------------------------------------
209!
210# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
211 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'xi_rho', &
212 & iobounds(ng)%xi_rho, rxidim)
213 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
214
215 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'eta_rho', &
216 & iobounds(ng)%eta_rho, retadim)
217 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
218# endif
219
220 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'record', &
221 & 2, recorddim)
222 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
223
224 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'survey', &
225 & nsurvey(ng), surveydim)
226 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
227
228 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'state_var', &
229 & nobsvar(ng), statedim)
230 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
231
232 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'cost_var', &
233 & nobsvar(ng)+1, statedimp1)
234 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
235
236 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'datum', &
237 & ndatum(ng), datumdim)
238 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
239
240# ifdef FOUR_DVAR
241# ifdef RPCG
242 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'datum+1', &
243 & ndatum(ng)+1, datumdimp1)
244 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
245# endif
246 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'Nouter', &
247 & nouter, nouterdim)
248 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
249
250 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'Nouter+1', &
251 & nouter+1, nouterdimp1)
252 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
253
254 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'Ninner', &
255 & ninner, ninnerdim)
256 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
257
258 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'Ninner+1', &
259 & ninner+1, ninnerdimp1)
260 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
261
262# ifdef SP4DVAR
263 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'Ninner+2', &
264 & ninner+2, ninnerdimp2)
265 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
266# endif
267
268# ifdef I4DVAR
269 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'three', &
270 & 3, threedim)
271 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
272# endif
273
274# if defined I4DVAR || defined BACKGROUND
275 status=def_dim(ng, inlm, dav(ng)%ncid, ncname, 'iteration', &
276 & nf90_unlimited, iterdim)
277 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
278# endif
279# endif
280!
281!-----------------------------------------------------------------------
282! Define global attributes.
283!-----------------------------------------------------------------------
284!
285 IF (outthread) THEN
286!
287! File type.
288!
289 IF (exit_flag.eq.noerror) THEN
290 string='ROMS 4D-Var output observation processing file'
291 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
292 & 'type', trim(string))
293 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
294 WRITE (stdout,50) 'type', trim(ncname)
295 exit_flag=3
296 ioerror=status
297 END IF
298 END IF
299!
300! Algorithm.
301!
302 IF (exit_flag.eq.noerror) THEN
303# if defined ARRAY_MODES
304 string=uppercase('array_modes')
305# elif defined SPLIT_I4DVAR
306 string=uppercase('split_i4dvar')
307# elif defined I4DVAR
308 string=uppercase('i4dvar')
309# elif defined I4DVAR_ANA_SENSITIVITY
310 string=uppercase('i4dvar_ana_sensitivity')
311# elif defined SPLIT_RBL4DVAR
312 string=uppercase('split_rbl4dvar')
313# elif defined RBL4DVAR
314 string=uppercase('rbl4dvar')
315# elif defined RBL4DVAR_ANA_SENSITIVITY
316 string=uppercase('rbl4dvar_ana_sensitivity')
317# elif defined RBL4DVAR_FCT_SENSITIVITY
318 string=uppercase('rbl4dvar_fct_sensitivity')
319# elif defined SPLIT_R4DVAR
320 string=uppercase('split_r4dvar')
321# elif defined R4DVAR
322 string=uppercase('r4dvar')
323# elif defined R4DVAR_ANA_SENSITIVITY
324 string=uppercase('r4dvar_ana_sensitivity')
325# elif defined TL_RBL4DVAR
326 string=uppercase('tl_rbl4dvar')
327# elif defined TL_R4DVAR
328 string=uppercase('tl_r4dvar')
329# elif defined VERIFICATION
330 string=uppercase('verification')
331# else
332 string=uppercase('four_dvar')
333# endif
334 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
335 & 'Algorithm', trim(string))
336 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
337 WRITE (stdout,50) 'type', trim(ncname)
338 exit_flag=3
339 ioerror=status
340 END IF
341 END IF
342!
343! Set cycle start and final time and dates attributes.
344!
345 IF (initime(ng).lt.0.0_dp) THEN
346 tstart=time(ng)+dt(ng) ! called after 'initial'
347 ELSE
348 tstart=initime(ng)
349 END IF
350 tfinal=tstart+ntimes(ng)*dt(ng)
351 CALL time_string (tstart, str_date)
352 CALL time_string (tfinal, end_date)
353!
354 IF (exit_flag.eq.noerror) THEN
355 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
356 & 'str_day', tstart*sec2day)
357 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
358 WRITE (stdout,50) 'str_day', trim(ncname)
359 exit_flag=3
360 ioerror=status
361 END IF
362 END IF
363!
364 IF (exit_flag.eq.noerror) THEN
365 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
366 & 'end_day', tfinal*sec2day)
367 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
368 WRITE (stdout,50) 'end_day', trim(ncname)
369 exit_flag=3
370 ioerror=status
371 END IF
372 END IF
373!
374 IF (exit_flag.eq.noerror) THEN
375 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
376 & 'str_date', str_date)
377 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
378 WRITE (stdout,50) 'str_date', trim(ncname)
379 exit_flag=3
380 ioerror=status
381 END IF
382 END IF
383!
384 IF (exit_flag.eq.noerror) THEN
385 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
386 & 'end_date', end_date)
387 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
388 WRITE (stdout,50) 'end_date', trim(ncname)
389 exit_flag=3
390 ioerror=status
391 END IF
392 END IF
393!
394! Input observations file.
395!
396 IF (exit_flag.eq.noerror) THEN
397 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
398 & 'obs_file', trim(obs(ng)%name))
399 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
400 WRITE (stdout,50) 'obs_file', trim(ncname)
401 exit_flag=3
402 ioerror=status
403 END IF
404 END IF
405!
406! State variables IDs for observations. Copy global attribute from
407! observation file.
408!
409 IF (exit_flag.eq.noerror) THEN
410 IF (foundatt(1)) THEN
411 status=nf90_copy_att(obsncid, nf90_global, &
412 & 'state_variables', &
413 & dav(ng)%ncid, nf90_global)
414 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
415 WRITE (stdout,50) 'state_variables', trim(ncname)
416 exit_flag=3
417 ioerror=status
418 END IF
419 IF (founderror(exit_flag, noerror, &
420 & __line__, myfile)) RETURN
421 END IF
422 END IF
423!
424! Observations provenance IDs. Copy global attribute from
425! observation file.
426!
427 IF (exit_flag.eq.noerror) THEN
428 IF (foundatt(2)) THEN
429 status=nf90_copy_att(obsncid, nf90_global, &
430 & 'obs_provenance', &
431 & dav(ng)%ncid, nf90_global)
432 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
433 WRITE (stdout,50) 'obs_provenance', trim(ncname)
434 exit_flag=3
435 ioerror=status
436 END IF
437 IF (founderror(exit_flag, noerror, &
438 & __line__, myfile)) RETURN
439 END IF
440 END IF
441!
442! SVN repository information.
443!
444 IF (exit_flag.eq.noerror) THEN
445 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
446 & 'svn_url', trim(svn_url))
447 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
448 WRITE (stdout,50) 'svn_url', trim(ncname)
449 exit_flag=3
450 ioerror=status
451 END IF
452 END IF
453
454# ifndef DEBUGGING
455# ifdef SVN_REV
456 IF (exit_flag.eq.noerror) THEN
457 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
458 & 'svn_rev', trim(svn_rev))
459 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
460 WRITE (stdout,50) 'svn_rev', trim(ncname)
461 exit_flag=3
462 ioerror=status
463 END IF
464 END IF
465# endif
466
467# ifdef ROOT_DIR
468 IF (exit_flag.eq.noerror) THEN
469 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
470 & 'code_dir', trim(rdir))
471 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
472 WRITE (stdout,50) 'code_dir', trim(ncname)
473 exit_flag=3
474 ioerror=status
475 END IF
476 END IF
477# endif
478
479# ifdef HEADER_DIR
480 IF (exit_flag.eq.noerror) THEN
481 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
482 & 'header_dir', trim(hdir))
483 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
484 WRITE (stdout,50) 'header_dir', trim(ncname)
485 exit_flag=3
486 ioerror=status
487 END IF
488 END IF
489# endif
490
491# ifdef ROMS_HEADER
492 IF (exit_flag.eq.noerror) THEN
493 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
494 & 'header_file', trim(hfile))
495 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
496 WRITE (stdout,50) 'header_file', trim(ncname)
497 exit_flag=3
498 ioerror=status
499 END IF
500 END IF
501# endif
502!
503! Attributes describing platform and compiler
504!
505 IF (exit_flag.eq.noerror) THEN
506 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
507 & 'os', trim(my_os))
508 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
509 WRITE (stdout,50) 'os', trim(ncname)
510 exit_flag=3
511 ioerror=status
512 END IF
513 END IF
514
515 IF (exit_flag.eq.noerror) THEN
516 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
517 & 'cpu', trim(my_cpu))
518 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
519 WRITE (stdout,50) 'cpu', trim(ncname)
520 exit_flag=3
521 ioerror=status
522 END IF
523 END IF
524
525 IF (exit_flag.eq.noerror) THEN
526 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
527 & 'compiler_system', trim(my_fort))
528 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
529 WRITE (stdout,50) 'compiler_system', trim(ncname)
530 exit_flag=3
531 ioerror=status
532 END IF
533 END IF
534
535 IF (exit_flag.eq.noerror) THEN
536 status=nf90_put_att(dav(ng)%ncid,nf90_global, &
537 & 'compiler_command', trim(my_fc))
538 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
539 WRITE (stdout,50) 'compiler_command', trim(ncname)
540 exit_flag=3
541 ioerror=status
542 END IF
543 END IF
544
545 IF (exit_flag.eq.noerror) THEN
546 lstr=index(my_fflags, 'free')-2
547 IF (lstr.le.0) lstr=len_trim(my_fflags)
548 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
549 & 'compiler_flags', my_fflags(1:lstr))
550 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
551 WRITE (stdout,50) 'compiler_flags', trim(ncname)
552 exit_flag=3
553 ioerror=status
554 END IF
555 END IF
556!
557! History attribute.
558!
559 IF (exit_flag.eq.noerror) THEN
560 IF (len_trim(date_str).gt.0) THEN
561 WRITE (history,'(a,1x,a,", ",a)') 'ROMS, Version', &
562 & trim(version), &
563 & trim(date_str)
564 ELSE
565 WRITE (history,'(a,1x,a)') 'ROMS, Version', &
566 & trim(version)
567 END IF
568
569 status=nf90_put_att(dav(ng)%ncid, nf90_global, &
570 & 'history', trim(history))
571 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
572 WRITE (stdout,50) 'history', trim(ncname)
573 exit_flag=3
574 ioerror=status
575 END IF
576 END IF
577# endif
578 END IF
579
580# ifdef DISTRIBUTE
581 ibuffer(1)=exit_flag
582 ibuffer(2)=ioerror
583 CALL mp_bcasti (ng, inlm, ibuffer)
584 exit_flag=ibuffer(1)
585 ioerror=ibuffer(2)
586# endif
587 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
588!
589!-----------------------------------------------------------------------
590! Define variables and their attributes.
591!-----------------------------------------------------------------------
592
593# if defined I4DVAR || defined WEAK_CONSTRAINT
594!
595! Outer and inner loop counters.
596!
597 vinfo( 1)='outer'
598 vinfo( 2)='outer loop counter'
599
600 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf90_int, &
601 & 1, (/0/), aval, vinfo, ncname, &
602 & setparaccess = .false.)
603 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
604!
605 vinfo( 1)='inner'
606 vinfo( 2)='inner loop counter'
607
608 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf90_int, &
609 & 1, (/0/), aval, vinfo, ncname, &
610 & setparaccess = .false.)
611 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
612# endif
613# if defined ARRAY_MODES || \
614 defined i4dvar_ana_sensitivity || \
615 defined rbl4dvar_ana_sensitivity || \
616 defined rbl4dvar_fct_sensitivity || \
617 defined r4dvar_ana_sensitivity
618!
619! Observations impact/sensitivity outer loop beeing processed.
620!
621 vinfo( 1)='Nimpact'
622 vinfo( 2)='Observations impact/sensitivity outer loop to use'
623
624 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf90_int, &
625 & 1, (/0/), aval, vinfo, ncname, &
626 & setparaccess = .false.)
627 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
628# endif
629!
630! Define model-observation comparison statistics.
631!
632 vinfo( 1)='Nobs'
633 vinfo( 2)='number of observations with the same survey time'
634
635 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf90_int, &
636 & 1, (/surveydim/), aval, vinfo, ncname, &
637 & setparaccess = .false.)
638 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
639
640# ifndef I4DVAR_ANA_SENSITIVITY
641!
642 vinfo( 1)='Nused_obs'
643 vinfo( 2)='Number of usable observations'
644
645 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf90_int, &
646 & 1, (/statedim/), aval, vinfo, ncname, &
647 & setparaccess = .false.)
648 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
649!
650 vinfo( 1)='obs_mean'
651 vinfo( 2)='observations mean'
652
653 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
654 & 1, (/statedim/), aval, vinfo, ncname, &
655 & setparaccess = .false.)
656 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
657!
658 vinfo( 1)='obs_std'
659 vinfo( 2)='observations standard deviation'
660
661 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
662 & 1, (/statedim/), aval, vinfo, ncname, &
663 & setparaccess = .false.)
664 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
665!
666 vinfo( 1)='model_mean'
667 vinfo( 2)='model mean'
668
669 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
670 & 1, (/statedim/), aval, vinfo, ncname, &
671 & setparaccess = .false.)
672 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
673!
674 vinfo( 1)='model_std'
675 vinfo( 2)='model standard deviation'
676
677 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
678 & 1, (/statedim/), aval, vinfo, ncname, &
679 & setparaccess = .false.)
680 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
681!
682 vinfo( 1)='model_bias'
683 vinfo( 2)='model bias'
684
685 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
686 & 1, (/statedim/), aval, vinfo,ncname, &
687 & setparaccess = .false.)
688 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
689!
690 vinfo( 1)='SDE'
691 vinfo( 2)='model-observations standard deviation error'
692
693 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
694 & 1, (/statedim/), aval, vinfo, ncname, &
695 & setparaccess = .false.)
696 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
697!
698 vinfo( 1)='CC'
699 vinfo( 2)='model-observations cross-correlation'
700
701 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
702 & 1, (/statedim/), aval, vinfo, ncname, &
703 & setparaccess = .false.)
704 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
705!
706 vinfo( 1)='MSE'
707 vinfo( 2)='model-observations mean squared error'
708
709 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
710 & 1, (/statedim/), aval, vinfo, ncname, &
711 & setparaccess = .false.)
712 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
713# endif
714# if defined I4DVAR
715!
716! Number of converged Ritz eigenvalues.
717!
718 vinfo( 1)='nConvRitz'
719 vinfo( 2)='number of converged Ritz eigenvalues'
720
721 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf90_int, &
722 & 1, (/0/), aval, vinfo, ncname, &
723 & setparaccess = .false.)
724 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
725
726# elif defined WEAK_CONSTRAINT
727!
728! Number of converged Ritz eigenvalues.
729!
730 vinfo( 1)='nConvRitz'
731 vinfo( 2)='number of converged Ritz eigenvalues'
732
733 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf90_int, &
734 & 1, (/nouterdim/), aval, vinfo, ncname, &
735 & setparaccess = .false.)
736 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
737# endif
738# if defined WEAK_CONSTRAINT && \
739 (defined array_modes || defined clipping)
740!
741! Number of converged Ritz eigenvalues.
742!
743 vinfo( 1)='Nvct'
744# if defined ARRAY_MODES
745 vinfo( 2)='representer matrix array mode eigenvector '// &
746 & 'processed'
747# elif defined CLIPPING
748 vinfo( 2)='representer matric cut-off eigenvectors'
749# endif
750 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf90_int, &
751 & 1, (/0/), aval, vinfo, ncname, &
752 & setparaccess = .false.)
753 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
754# endif
755# if defined I4DVAR
756!
757! Converged Ritz eigenvalues.
758!
759 vinfo( 1)='Ritz'
760 vinfo( 2)='converged Ritz eigenvalues to approximate Hessian'
761
762 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
763 & 1, (/ninnerdim/), aval, vinfo, ncname, &
764 & setparaccess = .false.)
765 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
766
767# elif defined WEAK_CONSTRAINT
768!
769! Converged Ritz eigenvalues.
770!
771 vinfo( 1)='Ritz'
772 vinfo( 2)='converged Ritz eigenvalues to approximate Hessian'
773 vardim(1)=ninnerdim
774 vardim(2)=nouterdim
775 vinfo(24)='_FillValue'
776 aval(6)=spval
777
778 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
779 & 2, vardim, aval, vinfo, ncname, &
780 & setparaccess = .false.)
781 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
782# endif
783# if defined I4DVAR || defined WEAK_CONSTRAINT
784!
785! Define conjugate gradient norm.
786!
787 vinfo( 1)='cg_beta'
788 vinfo( 2)='conjugate gradient beta coefficient'
789 vardim(1)=ninnerdimp1
790 vardim(2)=nouterdim
791 vinfo(24)='_FillValue'
792 aval(6)=spval
793
794 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
795 & 2, vardim, aval, vinfo, ncname, &
796 & setparaccess = .false.)
797 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
798# endif
799# if defined I4DVAR || defined WEAK_CONSTRAINT
800!
801! Define Lanczos algorithm coefficients.
802!
803 vinfo( 1)='cg_delta'
804 vinfo( 2)='Lanczos algorithm delta coefficient'
805 vardim(1)=ninnerdim
806 vardim(2)=nouterdim
807 vinfo(24)='_FillValue'
808 aval(6)=spval
809
810 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
811 & 2, vardim, aval, vinfo, ncname, &
812 & setparaccess = .false.)
813 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
814
815# ifdef WEAK_CONSTRAINT
816!
817 vinfo( 1)='cg_dla'
818 vinfo( 2)='normalization coefficients for Lanczos vectors'
819 vardim(1)=ninnerdim
820 vardim(2)=nouterdim
821 vinfo(24)='_FillValue'
822 aval(6)=spval
823
824 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
825 & 2, vardim, aval, vinfo, ncname, &
826 & setparaccess = .false.)
827 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
828# endif
829# ifdef I4DVAR
830!
831 vinfo( 1)='cg_gamma'
832 vinfo( 2)='Lanczos algorithm gamma coefficient'
833 vardim(1)=ninnerdim
834 vardim(2)=nouterdim
835 vinfo(24)='_FillValue'
836 aval(6)=spval
837
838 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
839 & 2, vardim, aval, vinfo, ncname, &
840 & setparaccess = .false.)
841 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
842# endif
843# endif
844# if defined I4DVAR
845!
846! Initial gradient vector normalization factor.
847!
848 vinfo( 1)='cg_Gnorm'
849 vinfo( 2)='initial gradient normalization factor'
850
851 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
852 & 1, (/nouterdim/), aval, vinfo, ncname, &
853 & setparaccess = .false.)
854 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
855
856# elif defined WEAK_CONSTRAINT
857!
858! Initial gradient vector normalization factor.
859!
860 vinfo( 1)='cg_Gnorm_v'
861 vinfo( 2)='initial gradient normalization factor, v-space'
862
863 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
864 & 1, (/nouterdim/), aval, vinfo, ncname, &
865 & setparaccess = .false.)
866 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
867!
868 vinfo( 1)='cg_Gnorm_y'
869 vinfo( 2)='initial gradient normalization factor, y-space'
870
871 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
872 & 1, (/nouterdim/), aval, vinfo, ncname, &
873 & setparaccess = .false.)
874 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
875# endif
876# if defined I4DVAR || defined WEAK_CONSTRAINT
877!
878! Lanczos vector normalization factor.
879!
880 vinfo( 1)='cg_QG'
881 vinfo( 2)='Lanczos vector normalization factor'
882 vardim(1)=ninnerdimp1
883 vardim(2)=nouterdim
884 vinfo(24)='_FillValue'
885 aval(6)=spval
886
887 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
888 & 2, vardim, aval, vinfo, ncname, &
889 & setparaccess = .false.)
890 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
891# endif
892# if defined I4DVAR
893!
894! Reduction in the gradient norm.
895!
896 vinfo( 1)='cg_Greduc'
897 vinfo( 2)='reduction in the gradient norm'
898 vardim(1)=ninnerdim
899 vardim(2)=nouterdim
900 vinfo(24)='_FillValue'
901 aval(6)=spval
902
903 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
904 & 2, vardim, aval, vinfo, ncname, &
905 & setparaccess = .false.)
906 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
907
908# elif defined WEAK_CONSTRAINT
909!
910! Reduction in the gradient norm.
911!
912 vinfo( 1)='cg_Greduc_v'
913 vinfo( 2)='reduction in the gradient norm, v-space'
914 vardim(1)=ninnerdim
915 vardim(2)=nouterdim
916 vinfo(24)='_FillValue'
917 aval(6)=spval
918
919 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
920 & 2, vardim, aval, vinfo, ncname, &
921 & setparaccess = .false.)
922 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
923!
924 vinfo( 1)='cg_Greduc_y'
925 vinfo( 2)='reduction in the gradient norm, y-space'
926 vardim(1)=ninnerdim
927 vardim(2)=nouterdim
928 vinfo(24)='_FillValue'
929 aval(6)=spval
930
931 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
932 & 2, vardim, aval, vinfo, ncname, &
933 & setparaccess = .false.)
934 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
935# endif
936# if defined I4DVAR
937!
938! Lanczos recurrence tridiagonal matrix.
939!
940 vinfo( 1)='cg_Tmatrix'
941 vinfo( 2)='Lanczos recurrence tridiagonal matrix'
942 vardim(1)=ninnerdim
943 vardim(2)=threedim
944
945 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
946 & 2, vardim, aval, vinfo, ncname, &
947 & setparaccess = .false.)
948 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
949!
950! Lanczos tridiagonal matrix, upper diagonal elements.
951!
952 vinfo( 1)='cg_zu'
953 vinfo( 2)='tridiagonal matrix, upper diagonal elements'
954 vardim(1)=ninnerdim
955 vardim(2)=nouterdim
956 vinfo(24)='_FillValue'
957 aval(6)=spval
958
959 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
960 & 2, vardim, aval, vinfo, ncname, &
961 & setparaccess = .false.)
962 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
963# endif
964# if defined I4DVAR || defined WEAK_CONSTRAINT
965!
966! Eigenvalues of Lanczos recurrence relationship.
967!
968 vinfo( 1)='cg_Ritz'
969 vinfo( 2)='Lanczos recurrence eigenvalues'
970 vardim(1)=ninnerdim
971 vardim(2)=nouterdim
972 vinfo(24)='_FillValue'
973 aval(6)=spval
974
975 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
976 & 2, vardim, aval, vinfo, ncname, &
977 & setparaccess = .false.)
978 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
979!
980! Eigenvalues relative error.
981!
982 vinfo( 1)='cg_RitzErr'
983 vinfo( 2)='Ritz eigenvalues relative error'
984 vardim(1)=ninnerdim
985 vardim(2)=nouterdim
986 vinfo(24)='_FillValue'
987 aval(6)=spval
988
989 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
990 & 2, vardim, aval, vinfo, ncname, &
991 & setparaccess = .false.)
992 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
993# endif
994# if defined I4DVAR
995!
996! Eigenvectors of Lanczos recurrence relationship.
997!
998 vinfo( 1)='cg_zv'
999 vinfo( 2)='Lanczos recurrence eigenvectors'
1000 vardim(1)=ninnerdim
1001 vardim(2)=ninnerdim
1002 vinfo(24)='_FillValue'
1003 aval(6)=spval
1004
1005 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1006 & 2, vardim, aval, vinfo, ncname, &
1007 & setparaccess = .false.)
1008 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1009
1010# elif defined WEAK_CONSTRAINT
1011!
1012! Eigenvectors of Lanczos recurrence relationship.
1013!
1014 vinfo( 1)='cg_zv'
1015 vinfo( 2)='Lanczos recurrence eigenvectors'
1016 vardim(1)=ninnerdim
1017 vardim(2)=ninnerdim
1018 vardim(3)=nouterdim
1019 vinfo(24)='_FillValue'
1020 aval(6)=spval
1021
1022 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1023 & 3, vardim, aval, vinfo, ncname, &
1024 & setfillval = .false., &
1025 & setparaccess = .false.)
1026 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1027# endif
1028# if defined RBL4DVAR || \
1029 defined rbl4dvar_ana_sensitivity || \
1030 defined rbl4dvar_fct_sensitivity || \
1031 defined sp4dvar || \
1032 defined tl_rbl4dvar
1033!
1034! Define NLM initial and final data penalty function.
1035!
1036 vinfo( 1)='NL_iDataPenalty'
1037 vinfo( 2)='nonlinear model initial data penalty function'
1038
1039 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1040 & 1, (/statedimp1/), aval, vinfo, ncname, &
1041 & setparaccess = .false.)
1042 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1043!
1044 vinfo( 1)='NL_fDataPenalty'
1045 vinfo( 2)='nonlinear model final data penalty function'
1046 vardim(1)=statedimp1
1047 vardim(2)=nouterdim
1048
1049 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1050 & 2, vardim, aval, vinfo, ncname, &
1051 & setparaccess = .false.)
1052 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1053# endif
1054# if (defined RECOMPUTE_4DVAR && \
1055 (defined array_modes || defined clipping)) || \
1056 defined r4dvar_ana_sensitivity || defined r4dvar || \
1057 defined tl_r4dvar
1058!
1059! Define RPM initial and final data penalty function.
1060!
1061 vinfo( 1)='RP_iDataPenalty'
1062 vinfo( 2)='representer model initial data penalty function'
1063 vardim(1)=statedimp1
1064 vardim(2)=nouterdim
1065
1066 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1067 & 2, vardim, aval, vinfo, ncname, &
1068 & setparaccess = .false.)
1069 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1070!
1071 vinfo( 1)='RP_fDataPenalty'
1072 vinfo( 2)='representer model final data penalty function'
1073 vardim(1)=statedimp1
1074 vardim(2)=nouterdim
1075
1076 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1077 & 2, vardim, aval, vinfo, ncname, &
1078 & setparaccess = .false.)
1079 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1080# endif
1081# ifdef WEAK_CONSTRAINT
1082!
1083! Define first guess initial data misfit.
1084!
1085 vinfo( 1)='Jf'
1086 vinfo( 2)='first guess initial data misfit'
1087 vardim(1)=ninnerdimp1
1088 vardim(2)=nouterdim
1089 vinfo(24)='_FillValue'
1090 aval(6)=spval
1091
1092 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1093 & 2, vardim, aval, vinfo, ncname, &
1094 & setparaccess = .false.)
1095 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1096!
1097! Define state estimate data misfit.
1098!
1099 vinfo( 1)='Jdata'
1100 vinfo( 2)='state estimate data misfit'
1101 vardim(1)=ninnerdimp1
1102 vardim(2)=nouterdim
1103 vinfo(24)='_FillValue'
1104 aval(6)=spval
1105
1106 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1107 & 2, vardim, aval, vinfo, ncname, &
1108 & setparaccess = .false.)
1109 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1110
1111# ifndef SP4DVAR
1112!
1113! Define model penalty function.
1114!
1115 vinfo( 1)='Jmod'
1116 vinfo( 2)='model penalty function'
1117 vardim(1)=ninnerdimp1
1118 vardim(2)=nouterdim
1119 vinfo(24)='_FillValue'
1120 aval(6)=spval
1121
1122 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1123 & 2, vardim, aval, vinfo, ncname, &
1124 & setparaccess = .false.)
1125 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1126!
1127! Define optimal penalty function.
1128!
1129 vinfo( 1)='Jopt'
1130 vinfo( 2)='optimal penalty function'
1131 vardim(1)=ninnerdimp1
1132 vardim(2)=nouterdim
1133 vinfo(24)='_FillValue'
1134 aval(6)=spval
1135
1136 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1137 & 2, vardim, aval, vinfo, ncname, &
1138 & setparaccess = .false.)
1139 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1140!
1141! Define actual model penalty function.
1142!
1143 vinfo( 1)='Jb'
1144 vinfo( 2)='actual model penalty function'
1145 vardim(1)=ninnerdimp1
1146 vardim(2)=nouterdim
1147 vinfo(24)='_FillValue'
1148 aval(6)=spval
1149
1150 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1151 & 2, vardim, aval, vinfo, ncname, &
1152 & setparaccess = .false.)
1153 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1154!
1155! Define actual data penalty function.
1156!
1157 vinfo( 1)='Jobs'
1158 vinfo( 2)='actual data penalty function'
1159 vardim(1)=ninnerdimp1
1160 vardim(2)=nouterdim
1161 vinfo(24)='_FillValue'
1162 aval(6)=spval
1163
1164 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1165 & 2, vardim, aval, vinfo, ncname, &
1166 & setparaccess = .false.)
1167 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1168!
1169! Define actual data penalty function.
1170!
1171 vinfo( 1)='Jact'
1172 vinfo( 2)='actual total penalty function'
1173 vardim(1)=ninnerdimp1
1174 vardim(2)=nouterdim
1175 vinfo(24)='_FillValue'
1176 aval(6)=spval
1177
1178 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1179 & 2, vardim, aval, vinfo, ncname, &
1180 & setparaccess = .false.)
1181 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1182# endif
1183# endif
1184!
1185! Observations survey time.
1186!
1187 IF (find_string(var_name,n_var,vname(1,idoday),vindex)) THEN
1188 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1189 & ncid = obsncid, &
1190 & myvarname = trim(vname(1,idoday)), &
1191 & nvardim = nvdim, &
1192 & nvaratt = nvatt)
1193 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1194 vinfo(1)=trim(vname(1,idoday))
1195 DO i=1,nvatt
1196 IF (trim(var_aname(i)).eq.'long_name') THEN
1197 vinfo(2)=trim(var_achar(i))
1198 ELSE IF (trim(var_aname(i)).eq.'units') THEN
1199 vinfo(3)=trim(var_achar(i))
1200 ELSE IF (trim(var_aname(i)).eq.'calendar') THEN
1201 vinfo(4)=trim(var_achar(i))
1202 END IF
1203 END DO
1204
1205 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idoday), &
1206 & nf_tout, 1, (/surveydim/), aval, vinfo, ncname)
1207 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1208 END IF
1209!
1210! Observation type.
1211!
1212 IF (find_string(var_name,n_var,vname(1,idotyp),vindex)) THEN
1213 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1214 & ncid = obsncid, &
1215 & myvarname = trim(vname(1,idotyp)), &
1216 & nvardim = nvdim, &
1217 & nvaratt = nvatt)
1218 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1219 vinfo(1)=trim(vname(1,idotyp))
1220
1221 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idotyp), &
1222 & nf90_int, 1, (/datumdim/), aval, vinfo, ncname)
1223 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1224! copy attributes from observations
1225 IF (outthread) THEN
1226 DO i=1,nvatt
1227 status=nf90_inq_attname(obsncid, vindex, i, aname)
1228 IF (status.eq.nf90_noerr) THEN
1229 status=nf90_copy_att(obsncid, vindex, trim(aname), &
1230 & dav(ng)%ncid, dav(ng)%Vid(idotyp))
1231 IF (founderror(status, nf90_noerr, &
1232 & __line__, myfile)) THEN
1233 WRITE (stdout,60) trim(aname), trim(vname(1,idotyp)), &
1234 & trim(ncname)
1235 exit_flag=3
1236 ioerror=status
1237 END IF
1238 ELSE
1239 WRITE (stdout,70) i, trim(vname(1,idopro)), &
1240 & trim(obs(ng)%name)
1241 END IF
1242 END DO
1243 END IF
1244
1245# ifdef DISTRIBUTE
1246 ibuffer(1)=exit_flag
1247 ibuffer(2)=ioerror
1248 CALL mp_bcasti (ng, inlm, ibuffer)
1249 exit_flag=ibuffer(1)
1250 ioerror=ibuffer(2)
1251# endif
1252 END IF
1253!
1254! Observations provenance.
1255!
1256 IF (find_string(var_name,n_var,vname(1,idopro),vindex)) THEN
1257 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1258 & ncid = obsncid, &
1259 & myvarname = trim(vname(1,idopro)), &
1260 & nvardim = nvdim, &
1261 & nvaratt = nvatt)
1262 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1263 vinfo(1)=trim(vname(1,idopro))
1264
1265 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idopro), &
1266 & nf90_int, 1, (/datumdim/), aval, vinfo, ncname)
1267 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1268! copy attributes from observations
1269 IF (outthread) THEN
1270 DO i=1,nvatt
1271 status=nf90_inq_attname(obsncid, vindex, i, aname)
1272 IF (status.eq.nf90_noerr) THEN
1273 status=nf90_copy_att(obsncid, vindex, trim(aname), &
1274 & dav(ng)%ncid, dav(ng)%Vid(idopro))
1275 IF (founderror(status, nf90_noerr, &
1276 & __line__, myfile)) THEN
1277 WRITE (stdout,60) trim(aname), trim(vname(1,idopro)), &
1278 & trim(ncname)
1279 exit_flag=3
1280 ioerror=status
1281 END IF
1282 ELSE
1283 WRITE (stdout,70) i, trim(vname(1,idopro)), &
1284 & trim(obs(ng)%name)
1285 END IF
1286 END DO
1287 END IF
1288
1289# ifdef DISTRIBUTE
1290 ibuffer(1)=exit_flag
1291 ibuffer(2)=ioerror
1292 CALL mp_bcasti (ng, inlm, ibuffer)
1293 exit_flag=ibuffer(1)
1294 ioerror=ibuffer(2)
1295# endif
1296 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1297 END IF
1298!
1299! Observations time.
1300!
1301 IF (find_string(var_name,n_var,vname(1,idobst),vindex)) THEN
1302 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1303 & ncid = obsncid, &
1304 & myvarname = trim(vname(1,idobst)), &
1305 & nvardim = nvdim, &
1306 & nvaratt = nvatt)
1307 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1308 vinfo(1)=trim(vname(1,idobst))
1309 DO i=1,nvatt
1310 IF (trim(var_aname(i)).eq.'long_name') THEN
1311 vinfo(2)=trim(var_achar(i))
1312 ELSE IF (trim(var_aname(i)).eq.'units') THEN
1313 vinfo(3)=trim(var_achar(i))
1314 ELSE IF (trim(var_aname(i)).eq.'calendar') THEN
1315 vinfo(4)=trim(var_achar(i))
1316 END IF
1317 END DO
1318
1319 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idobst), &
1320 & nf_tout, 1, (/datumdim/), aval, vinfo, ncname)
1321 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1322 END IF
1323!
1324! Observations longitude.
1325!
1326 IF (find_string(var_name,n_var,vname(1,idolon),vindex)) THEN
1327 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1328 & ncid = obsncid, &
1329 & myvarname = trim(vname(1,idolon)), &
1330 & nvardim = nvdim, &
1331 & nvaratt = nvatt)
1332 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1333 vinfo(1)=trim(vname(1,idolon))
1334 DO i=1,nvatt
1335 IF (trim(var_aname(i)).eq.'long_name') THEN
1336 vinfo(2)=trim(var_achar(i))
1337 ELSE IF (trim(var_aname(i)).eq.'units') THEN
1338 vinfo(3)=trim(var_achar(i))
1339 END IF
1340 END DO
1341
1342 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idolon), &
1343 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1344 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1345 END IF
1346!
1347! Observations latitude.
1348!
1349 IF (find_string(var_name,n_var,vname(1,idolat),vindex)) THEN
1350 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1351 & ncid = obsncid, &
1352 & myvarname = trim(vname(1,idolat)), &
1353 & nvardim = nvdim, &
1354 & nvaratt = nvatt)
1355 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1356 vinfo(1)=trim(vname(1,idolat))
1357 DO i=1,nvatt
1358 IF (trim(var_aname(i)).eq.'long_name') THEN
1359 vinfo(2)=trim(var_achar(i))
1360 ELSE IF (trim(var_aname(i)).eq.'units') THEN
1361 vinfo(3)=trim(var_achar(i))
1362 END IF
1363 END DO
1364
1365 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idolat), &
1366 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1367 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1368 END IF
1369!
1370! Observations depth.
1371!
1372 IF (find_string(var_name,n_var,vname(1,idobsd),vindex)) THEN
1373 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1374 & ncid = obsncid, &
1375 & myvarname = trim(vname(1,idobsd)), &
1376 & nvardim = nvdim, &
1377 & nvaratt = nvatt)
1378 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1379 vinfo(1)=trim(vname(1,idobsd))
1380 DO i=1,nvatt
1381 IF (trim(var_aname(i)).eq.'long_name') THEN
1382 vinfo(2)=trim(var_achar(i))
1383 ELSE IF (trim(var_aname(i)).eq.'units') THEN
1384 vinfo(3)=trim(var_achar(i))
1385 ELSE IF (trim(var_aname(i)).eq.'negative') THEN
1386 vinfo(11)='downwards'
1387 END IF
1388 END DO
1389 vinfo(17)='missing_value'
1390 aval(4)=spval
1391
1392 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idobsd), &
1393 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1394 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1395 END IF
1396!
1397! Observations X-fractional coordinate.
1398!
1399 IF (find_string(var_name,n_var,vname(1,idobsx),vindex)) THEN
1400 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1401 & ncid = obsncid, &
1402 & myvarname = trim(vname(1,idobsx)), &
1403 & nvardim = nvdim, &
1404 & nvaratt = nvatt)
1405 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1406 vinfo(1)=trim(vname(1,idobsx))
1407 DO i=1,nvatt
1408 IF (trim(var_aname(i)).eq.'long_name') THEN
1409 vinfo(2)=trim(var_achar(i))
1410 END IF
1411 END DO
1412
1413 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idobsx), &
1414 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1415 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1416 END IF
1417!
1418! Observations Y-fractional coordinate.
1419!
1420 IF (find_string(var_name,n_var,vname(1,idobsy),vindex)) THEN
1421 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1422 & ncid = obsncid, &
1423 & myvarname = trim(vname(1,idobsy)), &
1424 & nvardim = nvdim, &
1425 & nvaratt = nvatt)
1426 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1427 vinfo(1)=trim(vname(1,idobsy))
1428 DO i=1,nvatt
1429 IF (trim(var_aname(i)).eq.'long_name') THEN
1430 vinfo(2)=trim(var_achar(i))
1431 END IF
1432 END DO
1433
1434 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idobsy), &
1435 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1436 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1437 END IF
1438!
1439! Observations Z-fractional coordinate.
1440!
1441 IF (find_string(var_name,n_var,vname(1,idobsz),vindex)) THEN
1442 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1443 & ncid = obsncid, &
1444 & myvarname = trim(vname(1,idobsz)), &
1445 & nvardim = nvdim, &
1446 & nvaratt = nvatt)
1447 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1448 vinfo(1)=trim(vname(1,idobsz))
1449 DO i=1,nvatt
1450 IF (trim(var_aname(i)).eq.'long_name') THEN
1451 vinfo(2)=trim(var_achar(i))
1452 END IF
1453 END DO
1454
1455 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idobsz), &
1456 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1457 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1458 END IF
1459!
1460! Observations total error (instrument + sampling + representation).
1461!
1462 IF (find_string(var_name,n_var,vname(1,idoerr),vindex)) THEN
1463 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1464 & ncid = obsncid, &
1465 & myvarname = trim(vname(1,idoerr)), &
1466 & nvardim = nvdim, &
1467 & nvaratt = nvatt)
1468 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1469 vinfo(1)=trim(vname(1,idoerr))
1470 DO i=1,nvatt
1471 IF (trim(var_aname(i)).eq.'long_name') THEN
1472 vinfo(2)=trim(var_achar(i))
1473 END IF
1474 END DO
1475 vinfo(3)=trim(vname(3,idoerr))
1476
1477 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idoerr), &
1478 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1479 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1480 END IF
1481!
1482! Observations value.
1483!
1484 IF (find_string(var_name,n_var,vname(1,idoval),vindex)) THEN
1485 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1486 & ncid = obsncid, &
1487 & myvarname = trim(vname(1,idoval)), &
1488 & nvardim = nvdim, &
1489 & nvaratt = nvatt)
1490 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1491 vinfo(1)=trim(vname(1,idoval))
1492 DO i=1,nvatt
1493 IF (trim(var_aname(i)).eq.'long_name') THEN
1494 vinfo(2)=trim(var_achar(i))
1495 END IF
1496 END DO
1497 vinfo(3)=trim(vname(3,idoval))
1498
1499 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idoval), &
1500 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1501 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1502 END IF
1503!
1504! Observations meta value.
1505!
1506 IF (find_string(var_name,n_var,vname(1,idomet),vindex)) THEN
1507 CALL netcdf_inq_var (ng, inlm, obs(ng)%name, &
1508 & ncid = obsncid, &
1509 & myvarname = trim(vname(1,idomet)), &
1510 & nvardim = nvdim, &
1511 & nvaratt = nvatt)
1512 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1513 vinfo(1)=trim(vname(1,idomet))
1514 DO i=1,nvatt
1515 IF (trim(var_aname(i)).eq.'long_name') THEN
1516 vinfo(2)=trim(var_achar(i))
1517 END IF
1518 END DO
1519
1520 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idomet), &
1521 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1522 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1523 END IF
1524!
1525! Observations screening/normalization scale.
1526!
1527 vinfo( 1)=vname(1,idobss)
1528 vinfo( 2)=vname(2,idobss)
1529
1530 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idobss), &
1531 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1532 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1533
1534# if defined FOUR_DVAR && !defined I4DVAR_ANA_SENSITIVITY
1535!
1536! Unvetted prior nonlinear model at observation locations.
1537!
1538 vinfo( 1)=vname(1,idnlmp)
1539 vinfo( 2)=vname(2,idnlmp)
1540 vinfo( 3)=vname(3,idnlmp)
1541
1542 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idnlmp), &
1543 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1544 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1545!
1546! Initial nonlinear model at observation locations.
1547!
1548 vinfo( 1)=vname(1,idnlmi)
1549 vinfo( 2)=vname(2,idnlmi)
1550 vinfo( 3)=vname(3,idnlmi)
1551
1552 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idnlmi), &
1553 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1554 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1555!
1556! Final nonlinear model at observation locations.
1557!
1558 vinfo( 1)=vname(1,idnlmf)
1559 vinfo( 2)=vname(2,idnlmf)
1560 vinfo( 3)=vname(3,idnlmf)
1561
1562 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idnlmf), &
1563 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1564 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1565!
1566! 4D-Var background error standard deviation at observation locations.
1567!
1568 vinfo( 1)=vname(1,idbger)
1569 vinfo( 2)=vname(2,idbger)
1570 vinfo( 3)=vname(3,idbger)
1571
1572 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idbger), &
1573 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1574 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1575!
1576! 4D-Var innovation vector: observation minus background.
1577!
1578 vinfo( 1)=vname(1,idinno)
1579 vinfo( 2)=vname(2,idinno)
1580 vinfo( 3)=vname(3,idinno)
1581
1582 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idinno), &
1583 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1584 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1585!
1586! 4D-Var increment vector: analysis minus background.
1587!
1588 vinfo( 1)=vname(1,idincr)
1589 vinfo( 2)=vname(2,idincr)
1590 vinfo( 3)=vname(3,idincr)
1591
1592 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idincr), &
1593 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1594 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1595!
1596! 4D-Var residual vector: observation minus analysis.
1597!
1598 vinfo( 1)=vname(1,idresi)
1599 vinfo( 2)=vname(2,idresi)
1600 vinfo( 3)=vname(3,idresi)
1601
1602 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idresi), &
1603 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1604 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1605
1606# ifdef BGQC
1607!
1608! Threshold for background quality control check of observations.
1609!
1610 vinfo( 1)=vname(1,idbgth)
1611 vinfo( 2)=vname(2,idbgth)
1612
1613 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idbgth), &
1614 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1615 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1616# endif
1617# endif
1618
1619# if !defined I4DVAR_ANA_SENSITIVITY && \
1620 (defined i4dvar || defined weak_constraint)
1621!
1622! Unvetted nonlinear model at observation points per outer-loop.
1623!
1624 havenlmod(ng)=.false.
1625 vinfo( 1)=vname(1,idnlmu)
1626 vinfo( 2)=vname(2,idnlmu)
1627 vinfo( 3)=vname(3,idnlmu)
1628
1629 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idnlmu), &
1630 & nf_frst, 2, (/datumdim,nouterdim/), aval, vinfo, &
1631 & ncname)
1632 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1633# endif
1634
1635# ifndef I4DVAR_ANA_SENSITIVITY
1636# if defined I4DVAR || defined TLM_CHECK || \
1637 defined verification || defined weak_constraint
1638!
1639! Nonlinear model at observation points.
1640!
1641 havenlmod(ng)=.false.
1642 vinfo( 1)=vname(1,idnlmo)
1643 vinfo( 2)=vname(2,idnlmo)
1644 vinfo( 3)=vname(3,idnlmo)
1645# if defined VERIFICATION || defined TLM_CHECK
1646 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idnlmo), &
1647 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1648 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1649# else
1650 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idnlmo), &
1651 & nf_frst, 2, (/datumdim,nouterdim/), aval, vinfo, &
1652 & ncname)
1653 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1654# endif
1655# endif
1656# endif
1657
1658# if defined I4DVAR || defined I4DVAR_ANA_SENSITIVITY || \
1659 defined weak_constraint
1660!
1661! Tangent linear or representer model at observation points.
1662!
1663 havetlmod(ng)=.false.
1664 vinfo( 1)=vname(1,idtlmo)
1665# ifdef I4DVAR_ANA_SENSITIVITY
1666 vinfo( 2)='4D-Var sensitivity analysis at observations location'
1667# else
1668 vinfo( 2)=vname(2,idtlmo)
1669# endif
1670
1671 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idtlmo), &
1672 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1673 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1674# endif
1675
1676# if defined I4DVAR || defined WEAK_CONSTRAINT
1677!
1678! Initial model-observation misfit (innovation) vector.
1679!
1680 vinfo( 1)=vname(1,idmomi)
1681 vinfo( 2)=vname(2,idmomi)
1682
1683 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idmomi), &
1684 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1685 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1686!
1687! Final model-observation misfit (innovation) vector.
1688!
1689 vinfo( 1)=vname(1,idmomf)
1690 vinfo( 2)=vname(2,idmomf)
1691
1692 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idmomf), &
1693 & nf_frst, 1, (/datumdim/), aval, vinfo, ncname)
1694 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1695# endif
1696
1697# if defined I4DVAR
1698!
1699! Define model minus observations misfit NLM cost function.
1700!
1701 vinfo( 1)='NLcost_function'
1702 vinfo( 2)='nonlinear model misfit cost function'
1703 vardim(1)=statedimp1
1704 vardim(2)=nouterdimp1
1705
1706 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1707 & 2, vardim, aval, vinfo, ncname)
1708 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1709!
1710! Define model minus observations misfit TLM cost function.
1711!
1712 vinfo( 1)='TLcost_function'
1713 vinfo( 2)='tangent linear model misfit cost function'
1714
1715 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1716 & 1, (/iterdim/), aval, vinfo, ncname, &
1717 & setparaccess = .true.)
1718 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1719# endif
1720
1721# ifdef BACKGROUND
1722!
1723! Define model minus background misfit cost function.
1724!
1725 vinfo( 1)='back_function'
1726 vinfo( 2)='model minus background misfit cost function'
1727
1728 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1729 & 1, (/iterdim/), aval, vinfo, ncname, &
1730 & setparaccess = .true.)
1731 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1732# endif
1733
1734# if defined I4DVAR
1735!
1736! Define optimality property that measures the consistency between
1737! background and observation errors hypotheses (Chi-square).
1738!
1739 vinfo( 1)='Jmin'
1740 vinfo( 2)='normalized, optimal cost function minimum'
1741
1742 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1743 & 1, (/iterdim/), aval, vinfo, ncname, &
1744 & setparaccess = .true.)
1745 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1746# endif
1747
1748# ifdef WEAK_CONSTRAINT
1749# ifndef RPCG
1750!
1751! Representer coefficients estimate. Needed for restarting "congrad".
1752!
1753 vinfo( 1)='cg_pxsave'
1754 vinfo( 2)='representer coefficients estimatate'
1755 vardim(1)=datumdim
1756 vardim(2)=nouterdim
1757 aval(6)=spval
1758
1759 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1760 & 2, vardim, aval, vinfo, ncname)
1761 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1762# endif
1763!
1764! Define initial gradient for minimization.
1765!
1766 vinfo( 1)='zgrad0'
1767 vinfo( 2)='initial gradient for minimization, observation space'
1768# ifdef RPCG
1769 vardim(1)=datumdimp1
1770# else
1771 vardim(1)=datumdim
1772# endif
1773 vardim(2)=nouterdim
1774 vinfo(24)='_FillValue'
1775 aval(6)=spval
1776
1777 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1778 & 2, vardim, aval, vinfo, ncname)
1779 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1780
1781# ifdef RPCG
1782!
1783! Define initial gradient for minimization.
1784!
1785 vinfo( 1)='vgrad0'
1786 vinfo( 2)='initial gradient for minimization, v space'
1787 vardim(1)=datumdimp1
1788 vinfo(24)='_FillValue'
1789 aval(6)=spval
1790
1791 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1792 & 1, vardim, aval, vinfo, ncname)
1793 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1794!
1795! Define sum of evolved outer-loop increments in observation space.
1796!
1797 vinfo( 1)='Hbk'
1798 vinfo( 2)='evolved sum of increments in observation space'
1799 vardim(1)=datumdim
1800 vardim(2)=nouterdim
1801 vinfo(24)='_FillValue'
1802 aval(6)=spval
1803
1804 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1805 & 2, vardim, aval, vinfo, ncname)
1806 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1807!
1808! Define outer-loop background cost function.
1809!
1810 vinfo( 1)='Jb0'
1811 vinfo( 2)='Outer-loop background cost function'
1812 vardim(1)=nouterdimp1
1813 vinfo(24)='_FillValue'
1814 aval(6)=spval
1815
1816 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1817 & 1, vardim, aval, vinfo, ncname)
1818 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1819# endif
1820!
1821! Define Lanczos vectors in observation space.
1822!
1823# ifdef RPCG
1824 vinfo( 1)='vcglwk'
1825 vinfo( 2)='Preconditioned Lanczos vectors, observation space'
1826 vardim(1)=datumdimp1
1827 vardim(2)=ninnerdimp1
1828 vardim(3)=nouterdim
1829 vinfo(24)='_FillValue'
1830
1831 aval(6)=spval
1832 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1833 & 3, vardim, aval, vinfo, ncname)
1834 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1835!
1836 vinfo( 1)='vcglev'
1837 vinfo( 2)='converged Lanczos vectors, observation space'
1838 vardim(1)=datumdimp1
1839 vardim(2)=ninnerdim
1840 vardim(3)=nouterdim
1841 vinfo(24)='_FillValue'
1842 aval(6)=spval
1843
1844 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1845 & 3, vardim, aval, vinfo, ncname)
1846 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1847!
1848 vinfo( 1)='zcglwk'
1849 vinfo( 2)='Lanczos vectors, observation space'
1850 vardim(1)=datumdimp1
1851 vardim(2)=ninnerdimp1
1852 vardim(3)=nouterdim
1853 vinfo(24)='_FillValue'
1854 aval(6)=spval
1855
1856 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1857 & 3, vardim, aval, vinfo, ncname)
1858 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1859# else
1860 vinfo( 1)='zcglwk'
1861 vinfo( 2)='Lanczos vectors, observation space'
1862 vardim(1)=datumdim
1863 vardim(2)=ninnerdimp1
1864 vardim(3)=nouterdim
1865 vinfo(24)='_FillValue'
1866 aval(6)=spval
1867
1868 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1869 & 3, vardim, aval, vinfo, ncname)
1870 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1871# endif
1872!
1873! Define previous values of TLmodVal.
1874!
1875 vinfo( 1)='TLmodVal_S'
1876 vinfo( 2)='tangent linear model at observation locations'
1877 vardim(1)=datumdim
1878 vardim(2)=ninnerdim
1879 vardim(3)=nouterdim
1880
1881 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1882 & 3, vardim, aval, vinfo, ncname)
1883 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1884# endif
1885
1886# ifdef SP4DVAR
1887!
1888! Define saved values of ADmodVal.
1889!
1890 vinfo( 1)='ADmodVal_S'
1891 vinfo( 2)='adjoint model at observation locations'
1892 vardim(1)=datumdim
1893 vardim(2)=ninnerdimp2
1894
1895 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1896 & 2, vardim, aval, vinfo, ncname)
1897 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1898!
1899! Define saved values of harnoldi.
1900!
1901 vinfo( 1)='harnoldi'
1902 vinfo( 2)='GMRES upper Hessenberg matrix'
1903 vardim(1)=ninnerdimp1
1904 vardim(2)=ninnerdim
1905 vardim(3)=nouterdim
1906 vinfo(24)='_FillValue'
1907 aval(6)=spval
1908
1909 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1910 & 3, vardim, aval, vinfo, ncname)
1911 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1912!
1913! Define saved values of gmze, the Arnoldi vector weights.
1914!
1915 vinfo( 1)='gmze'
1916 vinfo( 2)='GMRES Arnoldi vector weights'
1917 vardim(1)=ninnerdim
1918 vardim(2)=nouterdim
1919 vinfo(24)='_FillValue'
1920 aval(6)=spval
1921
1922 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1923 & 2, vardim, aval, vinfo, ncname)
1924 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1925!
1926! Define saved values of cg_beta0.
1927!
1928 vinfo( 1)='cg_beta0'
1929 vinfo( 2)='Residual norm'
1930 vardim(1)=nouterdim
1931 vinfo(24)='_FillValue'
1932 aval(6)=spval
1933
1934 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1935 & 1, vardim, aval, vinfo, ncname)
1936 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1937!
1938! Define saved values of Jobs.
1939!
1940 vinfo( 1)='Jobs'
1941 vinfo( 2)='Obs cost function'
1942 vardim(1)=ninnerdimp1
1943 vardim(2)=nouterdim
1944 vinfo(24)='_FillValue'
1945 aval(6)=spval
1946
1947 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1948 & 2, vardim, aval, vinfo, ncname)
1949 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1950# endif
1951
1952# if defined R4DVAR || defined R4DVAR_ANA_SENSITIVITY || \
1953 defined tl_r4dvar
1954!
1955! Define initial values of RPmodVal.
1956!
1957 vinfo( 1)='RPmodel_initial'
1958 vinfo( 2)='initial representer model at observation locations'
1959 vardim(1)=datumdim
1960
1961 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1962 & 1, vardim, aval, vinfo, ncname)
1963 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1964# endif
1965
1966# if defined I4DVAR_ANA_SENSITIVITY || \
1967 defined rbl4dvar_ana_sensitivity || \
1968 defined rbl4dvar_fct_sensitivity || \
1969 defined r4dvar_ana_sensitivity
1970# ifdef OBS_IMPACT
1971!
1972! Define total observations impact.
1973!
1974# ifdef IMPACT_INNER
1975 vinfo( 1)='ObsImpact_total'
1976 vinfo( 2)='total observation impact'
1977 vardim(1)=datumdim
1978 vardim(2)=ninnerdim
1979
1980 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1981 & 2, vardim, aval, vinfo, ncname)
1982 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1983# else
1984 vinfo( 1)='ObsImpact_total'
1985 vinfo( 2)='total observation impact'
1986 vardim(1)=datumdim
1987
1988 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
1989 & 1, vardim, aval, vinfo, ncname)
1990 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1991# endif
1992# else
1993!
1994! Define total observation sensitivity.
1995!
1996 vinfo( 1)='ObsSens_total'
1997 vinfo( 2)='total observation sensitivity'
1998 vardim(1)=datumdim
1999
2000 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
2001 & 1, vardim, aval, vinfo, ncname)
2002 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2003# endif
2004# endif
2005
2006# if defined OBS_IMPACT_SPLIT && \
2007 (defined i4dvar_ana_sensitivity || \
2008 defined rbl4dvar_ana_sensitivity || \
2009 defined rbl4dvar_fct_sensitivity || \
2010 defined r4dvar_ana_sensitivity)
2011!
2012! Define observation impact due to initial condition increments.
2013!
2014# ifdef IMPACT_INNER
2015 vinfo( 1)='ObsImpact_IC'
2016 vinfo( 2)='observation impact due to initial conditions'
2017 vardim(1)=datumdim
2018 vardim(2)=ninnerdim
2019
2020 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
2021 & 2, vardim, aval, vinfo, ncname)
2022 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2023# else
2024 vinfo( 1)='ObsImpact_IC'
2025 vinfo( 2)='observation impact due to initial conditions'
2026 vardim(1)=datumdim
2027
2028 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
2029 & 1, vardim, aval, vinfo, ncname)
2030 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2031# endif
2032
2033# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
2034!
2035! Define observation impact due to surface forcing increments.
2036!
2037# ifdef IMPACT_INNER
2038
2039 vinfo( 1)='ObsImpact_FC'
2040 vinfo( 2)='observation impact due to surface forcing'
2041 vardim(1)=datumdim
2042 vardim(2)=ninnerdim
2043
2044 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
2045 & 2, vardim, aval, vinfo, ncname)
2046 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2047# else
2048 vinfo( 1)='ObsImpact_FC'
2049 vinfo( 2)='observation impact due to surface forcing'
2050 vardim(1)=datumdim
2051
2052 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
2053 & 1, vardim, aval, vinfo, ncname)
2054 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2055# endif
2056# endif
2057
2058# if defined ADJUST_BOUNDARY
2059!
2060! Define observation impact due to boundary condition increments.
2061!
2062# ifdef IMPACT_INNER
2063 vinfo( 1)='ObsImpact_BC'
2064 vinfo( 2)='observation impact due to open boundary conditions'
2065 vardim(1)=datumdim
2066 vardim(2)=ninnerdim
2067
2068 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
2069 & 2, vardim, aval, vinfo, ncname)
2070 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2071# else
2072 vinfo( 1)='ObsImpact_BC'
2073 vinfo( 2)='observation impact due to open boundary conditions'
2074 vardim(1)=datumdim
2075
2076 status=def_var(ng, inlm, dav(ng)%ncid, varid, nf_frst, &
2077 & 1, vardim, aval, vinfo, ncname)
2078 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2079# endif
2080# endif
2081# endif
2082
2083# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
2084!
2085! Define reference free-surface used in the balance operator.
2086!
2087 IF (balance(isfsur)) THEN
2088 vinfo( 1)='zeta_ref'
2089 vinfo( 2)='reference free-surface, balance operator'
2090 vinfo( 3)=vname(3,idfsur)
2091
2092 status=def_var(ng, inlm, dav(ng)%ncid, dav(ng)%Vid(idfsur), &
2093 & nf_frst, 2, (/rxidim, retadim/), aval, vinfo, &
2094 & ncname)
2095 END IF
2096# endif
2097!
2098!-----------------------------------------------------------------------
2099! Leave definition mode.
2100!-----------------------------------------------------------------------
2101!
2102 CALL netcdf_enddef (ng, inlm, ncname, dav(ng)%ncid)
2103 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2104!
2105! Close observations NetCDF.
2106!
2107 IF (obs(ng)%ncid.eq.-1) THEN
2108 CALL netcdf_close (ng, inlm, obsncid, obs(ng)%name, .false.)
2109 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2110 END IF
2111 END IF define
2112!
2113!=======================================================================
2114! Open an existing model/observation file and check its contents.
2115!=======================================================================
2116!
2117 query : IF (.not.ldefmod(ng)) THEN
2118 ncname=dav(ng)%name
2119!
2120! Open model/observation for read/write.
2121!
2122 CALL netcdf_open (ng, inlm, ncname, 1, dav(ng)%ncid)
2123 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
2124 WRITE (stdout,30) trim(ncname)
2125 RETURN
2126 END IF
2127!
2128! Inquire about the dimensions and check for consistency.
2129!
2130 CALL netcdf_check_dim (ng, inlm, ncname, &
2131 & ncid = dav(ng)%ncid)
2132 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2133!
2134! Inquire about the variables.
2135!
2136 CALL netcdf_inq_var (ng, inlm, ncname, &
2137 & ncid = dav(ng)%ncid)
2138 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2139!
2140! Initialize logical switches.
2141!
2142 DO i=1,nv
2143 got_var(i)=.false.
2144 END DO
2145!
2146! Scan variable list from model/observation NetCDF and activate
2147! switches for required variables.
2148!
2149 DO i=1,n_var
2150 IF (trim(var_name(i)).eq.trim(vname(1,idoday))) THEN
2151 got_var(idoday)=.true.
2152 dav(ng)%Vid(idoday)=var_id(i)
2153 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idotyp))) THEN
2154 got_var(idotyp)=.true.
2155 dav(ng)%Vid(idotyp)=var_id(i)
2156 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idopro))) THEN
2157 got_var(idopro)=.true.
2158 dav(ng)%Vid(idopro)=var_id(i)
2159 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobst))) THEN
2160 got_var(idobst)=.true.
2161 dav(ng)%Vid(idobst)=var_id(i)
2162 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idolon))) THEN
2163 got_var(idolon)=.true.
2164 dav(ng)%Vid(idolon)=var_id(i)
2165 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idolat))) THEN
2166 got_var(idolat)=.true.
2167 dav(ng)%Vid(idolat)=var_id(i)
2168 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobsd))) THEN
2169 got_var(idobsd)=.true.
2170 dav(ng)%Vid(idobsd)=var_id(i)
2171 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobsx))) THEN
2172 got_var(idobsx)=.true.
2173 dav(ng)%Vid(idobsx)=var_id(i)
2174 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobsy))) THEN
2175 got_var(idobsy)=.true.
2176 dav(ng)%Vid(idobsy)=var_id(i)
2177 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobsz))) THEN
2178 got_var(idobsz)=.true.
2179 dav(ng)%Vid(idobsz)=var_id(i)
2180 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idoerr))) THEN
2181 got_var(idoerr)=.true.
2182 dav(ng)%Vid(idoerr)=var_id(i)
2183 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idoval))) THEN
2184 got_var(idoval)=.true.
2185 dav(ng)%Vid(idoval)=var_id(i)
2186 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobss))) THEN
2187 got_var(idobss)=.true.
2188 dav(ng)%Vid(idobss)=var_id(i)
2189# ifdef FOUR_DVAR
2190 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idnlmp))) THEN
2191 got_var(idnlmp)=.true.
2192 dav(ng)%Vid(idnlmp)=var_id(i)
2193 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idnlmu))) THEN
2194 got_var(idnlmu)=.true.
2195 dav(ng)%Vid(idnlmu)=var_id(i)
2196 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idnlmi))) THEN
2197 got_var(idnlmi)=.true.
2198 dav(ng)%Vid(idnlmi)=var_id(i)
2199 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idnlmf))) THEN
2200 got_var(idnlmf)=.true.
2201 dav(ng)%Vid(idnlmf)=var_id(i)
2202# endif
2203 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idnlmo))) THEN
2204 got_var(idnlmo)=.true.
2205 havenlmod(ng)=.true.
2206 dav(ng)%Vid(idnlmo)=var_id(i)
2207# if defined I4DVAR || defined WEAK_CONSTRAINT
2208 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idtlmo))) THEN
2209 got_var(idtlmo)=.true.
2210 havetlmod(ng)=.true.
2211 dav(ng)%Vid(idtlmo)=var_id(i)
2212# endif
2213 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idbger))) THEN
2214 got_var(idbger)=.true.
2215 dav(ng)%Vid(idbger)=var_id(i)
2216 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idinno))) THEN
2217 got_var(idinno)=.true.
2218 dav(ng)%Vid(idinno)=var_id(i)
2219 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idincr))) THEN
2220 got_var(idincr)=.true.
2221 dav(ng)%Vid(idincr)=var_id(i)
2222 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idresi))) THEN
2223 got_var(idresi)=.true.
2224 dav(ng)%Vid(idresi)=var_id(i)
2225# if defined I4DVAR || defined WEAK_CONSTRAINT
2226 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idmomi))) THEN
2227 got_var(idmomi)=.true.
2228 dav(ng)%Vid(idmomi)=var_id(i)
2229 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idmomf))) THEN
2230 got_var(idmomf)=.true.
2231 dav(ng)%Vid(idmomf)=var_id(i)
2232# endif
2233 END IF
2234 END DO
2235!
2236! Check if needed variables are available.
2237!
2238 IF (.not.got_var(idoday)) THEN
2239 IF (master) WRITE (stdout,90) trim(vname(1,idoday)), &
2240 & trim(dav(ng)%name)
2241 exit_flag=2
2242 RETURN
2243 END IF
2244 IF (.not.got_var(idopro)) THEN
2245 IF (master) WRITE (stdout,90) trim(vname(1,idopro)), &
2246 & trim(dav(ng)%name)
2247 exit_flag=2
2248 RETURN
2249 END IF
2250 IF (.not.got_var(idobst)) THEN
2251 IF (master) WRITE (stdout,90) trim(vname(1,idobst)), &
2252 & trim(dav(ng)%name)
2253 exit_flag=2
2254 RETURN
2255 END IF
2256 IF (.not.got_var(idolon)) THEN
2257 IF (master) WRITE (stdout,90) trim(vname(1,idolon)), &
2258 & trim(dav(ng)%name)
2259!! exit_flag=2
2260!! RETURN
2261 END IF
2262 IF (.not.got_var(idolat)) THEN
2263 IF (master) WRITE (stdout,90) trim(vname(1,idolat)), &
2264 & trim(dav(ng)%name)
2265!! exit_flag=2
2266!! RETURN
2267 END IF
2268 IF (.not.got_var(idobsd)) THEN
2269 IF (master) WRITE (stdout,90) trim(vname(1,idobsd)), &
2270 & trim(dav(ng)%name)
2271 exit_flag=2
2272 RETURN
2273 END IF
2274 IF (.not.got_var(idobsx)) THEN
2275 IF (master) WRITE (stdout,90) trim(vname(1,idobsx)), &
2276 & trim(dav(ng)%name)
2277 exit_flag=2
2278 RETURN
2279 END IF
2280 IF (.not.got_var(idobsy)) THEN
2281 IF (master) WRITE (stdout,90) trim(vname(1,idobsy)), &
2282 & trim(dav(ng)%name)
2283 exit_flag=2
2284 RETURN
2285 END IF
2286 IF (.not.got_var(idoerr)) THEN
2287 IF (master) WRITE (stdout,90) trim(vname(1,idoerr)), &
2288 & trim(dav(ng)%name)
2289 exit_flag=2
2290 RETURN
2291 END IF
2292 IF (.not.got_var(idoval)) THEN
2293 IF (master) WRITE (stdout,90) trim(vname(1,idoval)), &
2294 & trim(dav(ng)%name)
2295 exit_flag=2
2296 RETURN
2297 END IF
2298
2299 IF (.not.got_var(idobss)) THEN
2300 IF (master) WRITE (stdout,90) trim(vname(1,idobss)), &
2301 & trim(dav(ng)%name)
2302 exit_flag=2
2303 RETURN
2304 END IF
2305# ifdef FOUR_DVAR
2306 IF (.not.got_var(idnlmp)) THEN
2307 IF (master) WRITE (stdout,90) trim(vname(1,idnlmp)), &
2308 & trim(dav(ng)%name)
2309 exit_flag=2
2310 RETURN
2311 END IF
2312
2313 IF (.not.got_var(idnlmu)) THEN
2314 IF (master) WRITE (stdout,90) trim(vname(1,idnlmu)), &
2315 & trim(dav(ng)%name)
2316 exit_flag=2
2317 RETURN
2318 END IF
2319
2320 IF (.not.got_var(idnlmi)) THEN
2321 IF (master) WRITE (stdout,90) trim(vname(1,idnlmi)), &
2322 & trim(dav(ng)%name)
2323 exit_flag=2
2324 RETURN
2325 END IF
2326
2327 IF (.not.got_var(idnlmf)) THEN
2328 IF (master) WRITE (stdout,90) trim(vname(1,idnlmf)), &
2329 & trim(dav(ng)%name)
2330 exit_flag=2
2331 RETURN
2332 END IF
2333# endif
2334 IF (.not.got_var(idnlmo)) THEN
2335 IF (master) WRITE (stdout,90) trim(vname(1,idnlmo)), &
2336 & trim(dav(ng)%name)
2337 exit_flag=2
2338 RETURN
2339 END IF
2340# if defined I4DVAR || defined WEAK_CONSTRAINT
2341 IF (.not.got_var(idtlmo)) THEN
2342 IF (master) WRITE (stdout,90) trim(vname(1,idtlmo)), &
2343 & trim(dav(ng)%name)
2344 exit_flag=2
2345 RETURN
2346 END IF
2347# endif
2348 IF (.not.got_var(idbger)) THEN
2349 IF (master) WRITE (stdout,90) trim(vname(1,idbger)), &
2350 & trim(dav(ng)%name)
2351 exit_flag=2
2352 RETURN
2353 END IF
2354 IF (.not.got_var(idinno)) THEN
2355 IF (master) WRITE (stdout,90) trim(vname(1,idinno)), &
2356 & trim(dav(ng)%name)
2357 exit_flag=2
2358 RETURN
2359 END IF
2360 IF (.not.got_var(idincr)) THEN
2361 IF (master) WRITE (stdout,90) trim(vname(1,idincr)), &
2362 & trim(dav(ng)%name)
2363 exit_flag=2
2364 RETURN
2365 END IF
2366 IF (.not.got_var(idresi)) THEN
2367 IF (master) WRITE (stdout,90) trim(vname(1,idresi)), &
2368 & trim(dav(ng)%name)
2369 exit_flag=2
2370 RETURN
2371 END IF
2372# if defined I4DVAR || defined WEAK_CONSTRAINT
2373 IF (.not.got_var(idmomi)) THEN
2374 IF (master) WRITE (stdout,90) trim(vname(1,idmomi)), &
2375 & trim(dav(ng)%name)
2376 exit_flag=2
2377 RETURN
2378 END IF
2379 IF (.not.got_var(idmomf)) THEN
2380 IF (master) WRITE (stdout,90) trim(vname(1,idmomf)), &
2381 & trim(dav(ng)%name)
2382 exit_flag=2
2383 RETURN
2384 END IF
2385# endif
2386
2387# if defined I4DVAR || defined BACKGROUND
2388!
2389! Set unlimited time record dimension to the appropriate value.
2390!
2391 dav(ng)%Rindex=rec_size
2392 fcount=dav(ng)%Fcount
2393 dav(ng)%Nrec(fcount)=rec_size
2394# endif
2395
2396 END IF query
2397!
2398 10 FORMAT (/,2x,'DEF_MOD_NF90 - creating model/observation', &
2399 & ' file,',t56,'Grid ',i2.2,': ',a)
2400 20 FORMAT (/,2x,'DEF_MOD_NF90 - inquiring model/observation', &
2401 & ' file,',t56,'Grid ',i2.2,': ',a)
2402 30 FORMAT (/,' DEF_MOD_NF90 - unable to open observation/model', &
2403 & ' file: ',a)
2404 40 FORMAT (/,' DEF_MOD_NF90 - unable to create model/observation', &
2405 & ' file:',1x,a)
2406 50 FORMAT (/,' DEF_MOD_NF90 - unable to create global attribute: ', &
2407 & a,/,11x,a)
2408 60 FORMAT (/,' DEF_MOD_NF90 - unable to copy attribute; ',a,1x, &
2409 & 'for variable: ',a,/,11x,'in file: 'a)
2410 70 FORMAT (/,' DEF_MOD_NF90 - unable to inquire attribute ',i2.2,1x, &
2411 & 'name for variable: ',a,/,11x,'in file: 'a)
2412 80 FORMAT (/,' DEF_MOD_NF90 - unable to copy attribute: ',1x,a,2x, &
2413 & 'for variable: ',1x,a,/,11x,a)
2414 90 FORMAT (/,' DEF_MOD_NF90 - unable to find model/observation' &
2415 & ' variable:',1x,a,/,11x,'in file: ',a)
2416!
2417 RETURN
2418 END SUBROUTINE def_mod_nf90
2419
2420# if defined PIO_LIB && defined DISTRIBUTE
2421!
2422!***********************************************************************
2423 SUBROUTINE def_mod_pio (ng)
2424!***********************************************************************
2425!
2426 USE mod_pio_netcdf
2427!
2428! Imported variable declarations.
2429!
2430 integer, intent(in) :: ng
2431!
2432! Local variable declarations.
2433!
2434 logical, dimension(NV) :: got_var(nv)
2435 logical :: foundatt(2), foundit
2436!
2437 integer, parameter :: natt = 25
2438
2439 integer :: iterdim, recorddim, surveydim, threedim
2440 integer :: datumdim, datumdimp1
2441 integer :: ninnerdim, ninnerdimp1, ninnerdimp2
2442 integer :: nouterdim, nouterdimp1
2443# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
2444 integer :: retadim, rxidim
2445# endif
2446 integer :: statedim, statedimp1
2447 integer :: fcount
2448
2449 integer :: i, j, lstr, nvatt, nvdim, status, varid, vindex
2450 integer :: obsncid
2451 integer :: vardim(3)
2452!
2453 real(dp) :: tstart, tfinal
2454 real(r8) :: aval(6)
2455!
2456 character (len=22 ) :: str_date, end_date
2457 character (len=40 ) :: aname, attname(2)
2458 character (len=80 ) :: string
2459 character (len=256) :: ncname
2460 character (len=2048) :: attvalue(2)
2461 character (len=MaxLen) :: vinfo(natt)
2462
2463 character (len=*), parameter :: myfile = &
2464 & __FILE__//", def_mod_pio"
2465!
2466 TYPE (file_desc_t) :: obspiofile
2467 TYPE (var_desc_t) :: vardesc
2468!
2469 sourcefile=myfile
2470!
2471!-----------------------------------------------------------------------
2472! Set and report file name.
2473!-----------------------------------------------------------------------
2474!
2475 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2476 ncname=dav(ng)%name
2477!
2478 IF (master) THEN
2479 IF (ldefmod(ng)) THEN
2480 WRITE (stdout,10) ng, trim(ncname)
2481 ELSE
2482 WRITE (stdout,20) ng, trim(ncname)
2483 END IF
2484 END IF
2485!
2486! Initialize local information variable arrays.
2487!
2488 DO i=1,natt
2489 DO j=1,len(vinfo(1))
2490 vinfo(i)(j:j)=' '
2491 END DO
2492 END DO
2493 DO i=1,6
2494 aval(i)=0.0_r8
2495 END DO
2496!
2497!=======================================================================
2498! Create a new model/observation file.
2499!=======================================================================
2500!
2501 define : IF (ldefmod(ng)) THEN
2502!
2503! Open input observations NetCDF.
2504!
2505 IF (obs(ng)%pioFile%fh.eq.-1) THEN
2506 CALL pio_netcdf_open (ng, inlm, obs(ng)%name, 1, obspiofile)
2507 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
2508 IF (master) WRITE (stdout,30) trim(obs(ng)%name)
2509 RETURN
2510 END IF
2511 ELSE
2512 obspiofile=obs(ng)%pioFile
2513 END IF
2514!
2515! Inquire about input observations variables.
2516!
2517 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
2518 & piofile = obspiofile)
2519 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2520!
2521! Inquire if the 'state_variables' and 'obs_provenance' attributes
2522! are available in the observations file.
2523!
2524 attname(1)='state_variables'
2525 attname(2)='obs_provenance'
2526!
2527 CALL pio_netcdf_get_satt (ng, inlm, obs(ng)%name, pio_global, &
2528 & attname, attvalue, foundatt, &
2529 & piofile = obspiofile)
2530!
2531! Create model/observation (DAV) file
2532!
2533 CALL pio_netcdf_create (ng, inlm, trim(ncname), dav(ng)%pioFile)
2534 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
2535 IF (master) WRITE (stdout,40) trim(ncname)
2536 RETURN
2537 END IF
2538!
2539!-----------------------------------------------------------------------
2540! Define dimensions.
2541!-----------------------------------------------------------------------
2542!
2543# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
2544 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'xi_rho', &
2545 & iobounds(ng)%xi_rho, rxidim)
2546 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2547
2548 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'eta_rho', &
2549 & iobounds(ng)%eta_rho, retadim)
2550 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2551# endif
2552
2553 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'record', &
2554 & 2, recorddim)
2555 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2556
2557 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'survey', &
2558 & nsurvey(ng), surveydim)
2559 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2560
2561 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'state_var', &
2562 & nobsvar(ng), statedim)
2563 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2564
2565 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'cost_var', &
2566 & nobsvar(ng)+1, statedimp1)
2567 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2568
2569 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'datum', &
2570 & ndatum(ng), datumdim)
2571 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2572
2573# ifdef FOUR_DVAR
2574# ifdef RPCG
2575 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'datum+1', &
2576 & ndatum(ng)+1, datumdimp1)
2577 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2578# endif
2579 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'Nouter', &
2580 & nouter, nouterdim)
2581 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2582
2583 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'Nouter+1', &
2584 & nouter+1, nouterdimp1)
2585 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2586
2587 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'Ninner', &
2588 & ninner, ninnerdim)
2589 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2590
2591 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'Ninner+1', &
2592 & ninner+1, ninnerdimp1)
2593 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2594
2595# ifdef SP4DVAR
2596 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'Ninner+2', &
2597 & ninner+2, ninnerdimp2)
2598 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2599# endif
2600
2601# ifdef I4DVAR
2602 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'three', &
2603 & 3, threedim)
2604 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2605# endif
2606
2607# if defined I4DVAR || defined BACKGROUND
2608 status=def_dim(ng, inlm, dav(ng)%pioFile, ncname, 'iteration', &
2609 & pio_unlimited, iterdim)
2610 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2611# endif
2612# endif
2613!
2614!-----------------------------------------------------------------------
2615! Define global attributes.
2616!-----------------------------------------------------------------------
2617!
2618! File type.
2619!
2620 IF (exit_flag.eq.noerror) THEN
2621 string='ROMS 4D-Var output observation processing file'
2622 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2623 & 'type', trim(string))
2624 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2625 IF (master) WRITE (stdout,50) 'type', trim(ncname)
2626 exit_flag=3
2627 ioerror=status
2628 END IF
2629 END IF
2630!
2631! Algorithm.
2632!
2633 IF (exit_flag.eq.noerror) THEN
2634# if defined ARRAY_MODES
2635 string=uppercase('array_modes')
2636# elif defined SPLIT_I4DVAR
2637 string=uppercase('split_i4dvar')
2638# elif defined I4DVAR
2639 string=uppercase('i4dvar')
2640# elif defined I4DVAR_ANA_SENSITIVITY
2641 string=uppercase('i4dvar_ana_sensitivity')
2642# elif defined SPLIT_RBL4DVAR
2643 string=uppercase('split_rbl4dvar')
2644# elif defined RBL4DVAR
2645 string=uppercase('rbl4dvar')
2646# elif defined RBL4DVAR_ANA_SENSITIVITY
2647 string=uppercase('rbl4dvar_ana_sensitivity')
2648# elif defined RBL4DVAR_FCT_SENSITIVITY
2649 string=uppercase('rbl4dvar_fct_sensitivity')
2650# elif defined SPLIT_R4DVAR
2651 string=uppercase('split_r4dvar')
2652# elif defined R4DVAR
2653 string=uppercase('r4dvar')
2654# elif defined R4DVAR_ANA_SENSITIVITY
2655 string=uppercase('r4dvar_ana_sensitivity')
2656# elif defined TL_RBL4DVAR
2657 string=uppercase('tl_rbl4dvar')
2658# elif defined TL_R4DVAR
2659 string=uppercase('tl_r4dvar')
2660# elif defined VERIFICATION
2661 string=uppercase('verification')
2662# else
2663 string=uppercase('four_dvar')
2664# endif
2665 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2666 & 'Algorithm', trim(string))
2667 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2668 IF (master) WRITE (stdout,50) 'type', trim(ncname)
2669 exit_flag=3
2670 ioerror=status
2671 END IF
2672 END IF
2673!
2674! Set cycle start and final time and dates attributes.
2675!
2676 IF (initime(ng).lt.0.0_dp) THEN
2677 tstart=time(ng)+dt(ng) ! called after 'initial'
2678 ELSE
2679 tstart=initime(ng)
2680 END IF
2681 tfinal=tstart+ntimes(ng)*dt(ng)
2682 CALL time_string (tstart, str_date)
2683 CALL time_string (tfinal, end_date)
2684!
2685 IF (exit_flag.eq.noerror) THEN
2686 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2687 & 'str_day', tstart*sec2day)
2688 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2689 IF (master) WRITE (stdout,50) 'str_day', trim(ncname)
2690 exit_flag=3
2691 ioerror=status
2692 END IF
2693 END IF
2694!
2695 IF (exit_flag.eq.noerror) THEN
2696 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2697 & 'end_day', tfinal*sec2day)
2698 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2699 IF (master) WRITE (stdout,50) 'end_day', trim(ncname)
2700 exit_flag=3
2701 ioerror=status
2702 END IF
2703 END IF
2704!
2705 IF (exit_flag.eq.noerror) THEN
2706 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2707 & 'str_date', str_date)
2708 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2709 IF (master) WRITE (stdout,50) 'str_date', trim(ncname)
2710 exit_flag=3
2711 ioerror=status
2712 END IF
2713 END IF
2714!
2715 IF (exit_flag.eq.noerror) THEN
2716 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2717 & 'end_date', end_date)
2718 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2719 IF (master) WRITE (stdout,50) 'end_date', trim(ncname)
2720 exit_flag=3
2721 ioerror=status
2722 END IF
2723 END IF
2724!
2725! Input observations file.
2726!
2727 IF (exit_flag.eq.noerror) THEN
2728 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2729 & 'obs_file', trim(obs(ng)%name))
2730 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2731 IF (master) WRITE (stdout,50) 'obs_file', trim(ncname)
2732 exit_flag=3
2733 ioerror=status
2734 END IF
2735 END IF
2736!
2737! State variables IDs for observations. Copy global attribute from
2738! observation file.
2739!
2740 IF (exit_flag.eq.noerror) THEN
2741 IF (foundatt(1)) THEN
2742 CALL pio_netcdf_copy_att (ng, inlm, 'NULL', &
2743 & 'state_variables', &
2744 & trim(obs(ng)%name), &
2745 & obspiofile, &
2746 & pio_global, &
2747 & trim(dav(ng)%name), &
2748 & dav(ng)%pioFile, &
2749 & pio_global)
2750 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2751 IF (master) WRITE (stdout,50) 'state_variables', &
2752 & trim(ncname)
2753 exit_flag=3
2754 ioerror=status
2755 END IF
2756 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2757 END IF
2758 END IF
2759!
2760! Observations provenance IDs. Copy global attribute from
2761! observation file.
2762!
2763 IF (exit_flag.eq.noerror) THEN
2764 IF (foundatt(2)) THEN
2765 CALL pio_netcdf_copy_att (ng, inlm, 'NULL', &
2766 & 'obs_provenance', &
2767 & trim(obs(ng)%name), &
2768 & obspiofile, &
2769 & pio_global, &
2770 & trim(dav(ng)%name), &
2771 & dav(ng)%pioFile, &
2772 & pio_global)
2773 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2774 IF (master) WRITE (stdout,50) 'obs_provenance', &
2775 & trim(ncname)
2776 exit_flag=3
2777 ioerror=status
2778 END IF
2779 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2780 END IF
2781 END IF
2782!
2783! SVN repository information.
2784!
2785 IF (exit_flag.eq.noerror) THEN
2786 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2787 & 'svn_url', trim(svn_url))
2788 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2789 IF (master) WRITE (stdout,50) 'svn_url', trim(ncname)
2790 exit_flag=3
2791 ioerror=status
2792 END IF
2793 END IF
2794
2795# ifndef DEBUGGING
2796# ifdef SVN_REV
2797 IF (exit_flag.eq.noerror) THEN
2798 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2799 & 'svn_rev', trim(svn_rev))
2800 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2801 IF (master) WRITE (stdout,50) 'svn_rev', trim(ncname)
2802 exit_flag=3
2803 ioerror=status
2804 END IF
2805 END IF
2806# endif
2807
2808# ifdef ROOT_DIR
2809 IF (exit_flag.eq.noerror) THEN
2810 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2811 & 'code_dir', trim(rdir))
2812 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2813 IF (master) WRITE (stdout,50) 'code_dir', trim(ncname)
2814 exit_flag=3
2815 ioerror=status
2816 END IF
2817 END IF
2818# endif
2819
2820# ifdef HEADER_DIR
2821 IF (exit_flag.eq.noerror) THEN
2822 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2823 & 'header_dir', trim(hdir))
2824 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2825 IF (master) WRITE (stdout,50) 'header_dir', trim(ncname)
2826 exit_flag=3
2827 ioerror=status
2828 END IF
2829 END IF
2830# endif
2831
2832# ifdef ROMS_HEADER
2833 IF (exit_flag.eq.noerror) THEN
2834 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2835 & 'header_file', trim(hfile))
2836 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2837 IF (master) WRITE (stdout,50) 'header_file', trim(ncname)
2838 exit_flag=3
2839 ioerror=status
2840 END IF
2841 END IF
2842# endif
2843!
2844! Attributes describing platform and compiler
2845!
2846 IF (exit_flag.eq.noerror) THEN
2847 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2848 & 'os', trim(my_os))
2849 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2850 IF (master) WRITE (stdout,50) 'os', trim(ncname)
2851 exit_flag=3
2852 ioerror=status
2853 END IF
2854 END IF
2855
2856 IF (exit_flag.eq.noerror) THEN
2857 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2858 & 'cpu', trim(my_cpu))
2859 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2860 IF (master) WRITE (stdout,50) 'cpu', trim(ncname)
2861 exit_flag=3
2862 ioerror=status
2863 END IF
2864 END IF
2865
2866 IF (exit_flag.eq.noerror) THEN
2867 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2868 & 'compiler_system', trim(my_fort))
2869 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2870 IF (master) WRITE (stdout,50) 'compiler_system', &
2871 & trim(ncname)
2872 exit_flag=3
2873 ioerror=status
2874 END IF
2875 END IF
2876
2877 IF (exit_flag.eq.noerror) THEN
2878 status=pio_put_att(dav(ng)%pioFile,pio_global, &
2879 & 'compiler_command', trim(my_fc))
2880 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2881 IF (master) WRITE (stdout,50) 'compiler_command', &
2882 & trim(ncname)
2883 exit_flag=3
2884 ioerror=status
2885 END IF
2886 END IF
2887
2888 IF (exit_flag.eq.noerror) THEN
2889 lstr=index(my_fflags, 'free')-2
2890 IF (lstr.le.0) lstr=len_trim(my_fflags)
2891 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2892 & 'compiler_flags', my_fflags(1:lstr))
2893 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2894 IF (master) WRITE (stdout,50) 'compiler_flags', trim(ncname)
2895 exit_flag=3
2896 ioerror=status
2897 END IF
2898 END IF
2899!
2900! History attribute.
2901!
2902 IF (exit_flag.eq.noerror) THEN
2903 IF (len_trim(date_str).gt.0) THEN
2904 WRITE (history,'(a,1x,a,", ",a)') 'ROMS, Version', &
2905 & trim(version), &
2906 & trim(date_str)
2907 ELSE
2908 WRITE (history,'(a,1x,a)') 'ROMS, Version', &
2909 & trim(version)
2910 END IF
2911 status=pio_put_att(dav(ng)%pioFile, pio_global, &
2912 & 'history', trim(history))
2913 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2914 IF (master) WRITE (stdout,50) 'history', trim(ncname)
2915 exit_flag=3
2916 ioerror=status
2917 END IF
2918 END IF
2919# endif
2920 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2921!
2922!-----------------------------------------------------------------------
2923! Define variables and their attributes.
2924!-----------------------------------------------------------------------
2925
2926# if defined I4DVAR || defined WEAK_CONSTRAINT
2927!
2928! Outer and inner loop counters.
2929!
2930 vinfo( 1)='outer'
2931 vinfo( 2)='outer loop counter'
2932
2933 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_int, &
2934 & 1, (/0/), aval, vinfo, ncname, &
2935 & setparaccess = .false.)
2936 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2937!
2938 vinfo( 1)='inner'
2939 vinfo( 2)='inner loop counter'
2940
2941 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_int, &
2942 & 1, (/0/), aval, vinfo, ncname, &
2943 & setparaccess = .false.)
2944 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2945# endif
2946# if defined ARRAY_MODES || \
2947 defined i4dvar_ana_sensitivity || \
2948 defined rbl4dvar_ana_sensitivity || \
2949 defined rbl4dvar_fct_sensitivity || \
2950 defined r4dvar_ana_sensitivity
2951!
2952! Observations impact/sensitivity outer loop beeing processed.
2953!
2954 vinfo( 1)='Nimpact'
2955 vinfo( 2)='Observations impact/sensitivity outer loop to use'
2956
2957 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_int, &
2958 & 1, (/0/), aval, vinfo, ncname, &
2959 & setparaccess = .false.)
2960 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2961# endif
2962!
2963! Define model-observation comparison statistics.
2964!
2965 vinfo( 1)='Nobs'
2966 vinfo( 2)='number of observations with the same survey time'
2967
2968 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_int, &
2969 & 1, (/surveydim/), aval, vinfo, ncname, &
2970 & setparaccess = .false.)
2971 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2972
2973# ifndef I4DVAR_ANA_SENSITIVITY
2974!
2975 vinfo( 1)='Nused_obs'
2976 vinfo( 2)='Number of usable observations'
2977
2978 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_int, &
2979 & 1, (/statedim/), aval, vinfo, ncname, &
2980 & setparaccess = .false.)
2981 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2982!
2983 vinfo( 1)='obs_mean'
2984 vinfo( 2)='observations mean'
2985
2986 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
2987 & 1, (/statedim/), aval, vinfo, ncname, &
2988 & setparaccess = .false.)
2989 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2990!
2991 vinfo( 1)='obs_std'
2992 vinfo( 2)='observations standard deviation'
2993
2994 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
2995 & 1, (/statedim/), aval, vinfo, ncname, &
2996 & setparaccess = .false.)
2997 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2998!
2999 vinfo( 1)='model_mean'
3000 vinfo( 2)='model mean'
3001
3002 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3003 & 1, (/statedim/), aval, vinfo, ncname, &
3004 & setparaccess = .false.)
3005 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3006!
3007 vinfo( 1)='model_std'
3008 vinfo( 2)='model standard deviation'
3009
3010 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3011 & 1, (/statedim/), aval, vinfo, ncname, &
3012 & setparaccess = .false.)
3013 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3014!
3015 vinfo( 1)='model_bias'
3016 vinfo( 2)='model bias'
3017
3018 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3019 & 1, (/statedim/), aval, vinfo,ncname, &
3020 & setparaccess = .false.)
3021 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3022!
3023 vinfo( 1)='SDE'
3024 vinfo( 2)='model-observations standard deviation error'
3025
3026 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3027 & 1, (/statedim/), aval, vinfo, ncname, &
3028 & setparaccess = .false.)
3029 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3030!
3031 vinfo( 1)='CC'
3032 vinfo( 2)='model-observations cross-correlation'
3033
3034 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3035 & 1, (/statedim/), aval, vinfo, ncname, &
3036 & setparaccess = .false.)
3037 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3038!
3039 vinfo( 1)='MSE'
3040 vinfo( 2)='model-observations mean squared error'
3041
3042 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3043 & 1, (/statedim/), aval, vinfo, ncname, &
3044 & setparaccess = .false.)
3045 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3046# endif
3047# if defined I4DVAR
3048!
3049! Number of converged Ritz eigenvalues.
3050!
3051 vinfo( 1)='nConvRitz'
3052 vinfo( 2)='number of converged Ritz eigenvalues'
3053
3054 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_int, &
3055 & 1, (/0/), aval, vinfo, ncname, &
3056 & setparaccess = .false.)
3057 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3058
3059# elif defined WEAK_CONSTRAINT
3060!
3061! Number of converged Ritz eigenvalues.
3062!
3063 vinfo( 1)='nConvRitz'
3064 vinfo( 2)='number of converged Ritz eigenvalues'
3065
3066 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_int, &
3067 & 1, (/nouterdim/), aval, vinfo, ncname, &
3068 & setparaccess = .false.)
3069 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3070# endif
3071# if defined WEAK_CONSTRAINT && \
3072 (defined array_modes || defined clipping)
3073!
3074! Number of converged Ritz eigenvalues.
3075!
3076 vinfo( 1)='Nvct'
3077# if defined ARRAY_MODES
3078 vinfo( 2)='representer matrix array mode eigenvector '// &
3079 & 'processed'
3080# elif defined CLIPPING
3081 vinfo( 2)='representer matric cut-off eigenvectors'
3082# endif
3083 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_int, &
3084 & 1, (/0/), aval, vinfo, ncname, &
3085 & setparaccess = .false.)
3086 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3087# endif
3088# if defined I4DVAR
3089!
3090! Converged Ritz eigenvalues.
3091!
3092 vinfo( 1)='Ritz'
3093 vinfo( 2)='converged Ritz eigenvalues to approximate Hessian'
3094
3095 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3096 & 1, (/ninnerdim/), aval, vinfo, ncname, &
3097 & setparaccess = .false.)
3098 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3099
3100# elif defined WEAK_CONSTRAINT
3101!
3102! Converged Ritz eigenvalues.
3103!
3104 vinfo( 1)='Ritz'
3105 vinfo( 2)='converged Ritz eigenvalues to approximate Hessian'
3106 vardim(1)=ninnerdim
3107 vardim(2)=nouterdim
3108 vinfo(24)='_FillValue'
3109 aval(6)=spval
3110
3111 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3112 & 2, vardim, aval, vinfo, ncname, &
3113 & setparaccess = .false.)
3114 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3115# endif
3116# if defined I4DVAR || defined WEAK_CONSTRAINT
3117!
3118! Define conjugate gradient norm.
3119!
3120 vinfo( 1)='cg_beta'
3121 vinfo( 2)='conjugate gradient beta coefficient'
3122 vardim(1)=ninnerdimp1
3123 vardim(2)=nouterdim
3124 vinfo(24)='_FillValue'
3125 aval(6)=spval
3126
3127 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3128 & 2, vardim, aval, vinfo, ncname, &
3129 & setparaccess = .false.)
3130 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3131# endif
3132# if defined I4DVAR || defined WEAK_CONSTRAINT
3133!
3134! Define Lanczos algorithm coefficients.
3135!
3136 vinfo( 1)='cg_delta'
3137 vinfo( 2)='Lanczos algorithm delta coefficient'
3138 vardim(1)=ninnerdim
3139 vardim(2)=nouterdim
3140 vinfo(24)='_FillValue'
3141 aval(6)=spval
3142
3143 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3144 & 2, vardim, aval, vinfo, ncname, &
3145 & setparaccess = .false.)
3146 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3147
3148# ifdef WEAK_CONSTRAINT
3149!
3150 vinfo( 1)='cg_dla'
3151 vinfo( 2)='normalization coefficients for Lanczos vectors'
3152 vardim(1)=ninnerdim
3153 vardim(2)=nouterdim
3154 vinfo(24)='_FillValue'
3155 aval(6)=spval
3156
3157 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3158 & 2, vardim, aval, vinfo, ncname, &
3159 & setparaccess = .false.)
3160 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3161# endif
3162# ifdef I4DVAR
3163!
3164 vinfo( 1)='cg_gamma'
3165 vinfo( 2)='Lanczos algorithm gamma coefficient'
3166 vardim(1)=ninnerdim
3167 vardim(2)=nouterdim
3168 vinfo(24)='_FillValue'
3169 aval(6)=spval
3170
3171 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3172 & 2, vardim, aval, vinfo, ncname, &
3173 & setparaccess = .false.)
3174 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3175# endif
3176# endif
3177# if defined I4DVAR
3178!
3179! Initial gradient vector normalization factor.
3180!
3181 vinfo( 1)='cg_Gnorm'
3182 vinfo( 2)='initial gradient normalization factor'
3183
3184 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3185 & 1, (/nouterdim/), aval, vinfo, ncname, &
3186 & setparaccess = .false.)
3187 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3188
3189# elif defined WEAK_CONSTRAINT
3190!
3191! Initial gradient vector normalization factor.
3192!
3193 vinfo( 1)='cg_Gnorm_v'
3194 vinfo( 2)='initial gradient normalization factor, v-space'
3195 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3196 & 1, (/nouterdim/), aval, vinfo, ncname, &
3197 & setparaccess = .false.)
3198 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3199!
3200 vinfo( 1)='cg_Gnorm_y'
3201 vinfo( 2)='initial gradient normalization factor, y-space'
3202 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3203 & 1, (/nouterdim/), aval, vinfo, ncname, &
3204 & setparaccess = .false.)
3205 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3206# endif
3207# if defined I4DVAR || defined WEAK_CONSTRAINT
3208!
3209! Lanczos vector normalization factor.
3210!
3211 vinfo( 1)='cg_QG'
3212 vinfo( 2)='Lanczos vector normalization factor'
3213 vardim(1)=ninnerdimp1
3214 vardim(2)=nouterdim
3215 vinfo(24)='_FillValue'
3216 aval(6)=spval
3217
3218 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3219 & 2, vardim, aval, vinfo, ncname, &
3220 & setparaccess = .false.)
3221 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3222# endif
3223# if defined I4DVAR
3224!
3225! Reduction in the gradient norm.
3226!
3227 vinfo( 1)='cg_Greduc'
3228 vinfo( 2)='reduction in the gradient norm'
3229 vardim(1)=ninnerdim
3230 vardim(2)=nouterdim
3231 vinfo(24)='_FillValue'
3232 aval(6)=spval
3233
3234 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3235 & 2, vardim, aval, vinfo, ncname, &
3236 & setparaccess = .false.)
3237 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3238
3239# elif defined WEAK_CONSTRAINT
3240!
3241! Reduction in the gradient norm.
3242!
3243 vinfo( 1)='cg_Greduc_v'
3244 vinfo( 2)='reduction in the gradient norm, v-space'
3245 vardim(1)=ninnerdim
3246 vardim(2)=nouterdim
3247 vinfo(24)='_FillValue'
3248 aval(6)=spval
3249
3250 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3251 & 2, vardim, aval, vinfo, ncname, &
3252 & setparaccess = .false.)
3253 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3254!
3255 vinfo( 1)='cg_Greduc_y'
3256 vinfo( 2)='reduction in the gradient norm, y-space'
3257 vardim(1)=ninnerdim
3258 vardim(2)=nouterdim
3259 vinfo(24)='_FillValue'
3260 aval(6)=spval
3261
3262 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3263 & 2, vardim, aval, vinfo, ncname, &
3264 & setparaccess = .false.)
3265 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3266# endif
3267# if defined I4DVAR
3268!
3269! Lanczos recurrence tridiagonal matrix.
3270!
3271 vinfo( 1)='cg_Tmatrix'
3272 vinfo( 2)='Lanczos recurrence tridiagonal matrix'
3273 vardim(1)=ninnerdim
3274 vardim(2)=threedim
3275
3276 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3277 & 2, vardim, aval, vinfo, ncname, &
3278 & setparaccess = .false.)
3279 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3280!
3281! Lanczos tridiagonal matrix, upper diagonal elements.
3282!
3283 vinfo( 1)='cg_zu'
3284 vinfo( 2)='tridiagonal matrix, upper diagonal elements'
3285 vardim(1)=ninnerdim
3286 vardim(2)=nouterdim
3287 vinfo(24)='_FillValue'
3288 aval(6)=spval
3289
3290 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3291 & 2, vardim, aval, vinfo, ncname, &
3292 & setparaccess = .false.)
3293 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3294# endif
3295# if defined I4DVAR || defined WEAK_CONSTRAINT
3296!
3297! Eigenvalues of Lanczos recurrence relationship.
3298!
3299 vinfo( 1)='cg_Ritz'
3300 vinfo( 2)='Lanczos recurrence eigenvalues'
3301 vardim(1)=ninnerdim
3302 vardim(2)=nouterdim
3303 vinfo(24)='_FillValue'
3304 aval(6)=spval
3305
3306 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3307 & 2, vardim, aval, vinfo, ncname, &
3308 & setparaccess = .false.)
3309 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3310!
3311! Eigenvalues relative error.
3312!
3313 vinfo( 1)='cg_RitzErr'
3314 vinfo( 2)='Ritz eigenvalues relative error'
3315 vardim(1)=ninnerdim
3316 vardim(2)=nouterdim
3317 vinfo(24)='_FillValue'
3318 aval(6)=spval
3319
3320 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3321 & 2, vardim, aval, vinfo, ncname, &
3322 & setparaccess = .false.)
3323 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3324# endif
3325# if defined I4DVAR
3326!
3327! Eigenvectors of Lanczos recurrence relationship.
3328!
3329 vinfo( 1)='cg_zv'
3330 vinfo( 2)='Lanczos recurrence eigenvectors'
3331 vardim(1)=ninnerdim
3332 vardim(2)=ninnerdim
3333 vinfo(24)='_FillValue'
3334 aval(6)=spval
3335!
3336 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3337 & 2, vardim, aval, vinfo, ncname, &
3338 & setparaccess = .false.)
3339 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3340
3341# elif defined WEAK_CONSTRAINT
3342!
3343! Eigenvectors of Lanczos recurrence relationship.
3344!
3345 vinfo( 1)='cg_zv'
3346 vinfo( 2)='Lanczos recurrence eigenvectors'
3347 vardim(1)=ninnerdim
3348 vardim(2)=ninnerdim
3349 vardim(3)=nouterdim
3350 vinfo(24)='_FillValue'
3351 aval(6)=spval
3352
3353 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3354 & 3, vardim, aval, vinfo, ncname, &
3355 & setfillval = .false., &
3356 & setparaccess = .false.)
3357 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3358# endif
3359# if defined RBL4DVAR || \
3360 defined rbl4dvar_ana_sensitivity || \
3361 defined rbl4dvar_fct_sensitivity || \
3362 defined sp4dvar || \
3363 defined tl_rbl4dvar
3364!
3365! Define NLM initial and final data penalty function.
3366!
3367 vinfo( 1)='NL_iDataPenalty'
3368 vinfo( 2)='nonlinear model initial data penalty function'
3369
3370 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3371 & 1, (/statedimp1/), aval, vinfo, ncname, &
3372 & setparaccess = .false.)
3373 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3374!
3375 vinfo( 1)='NL_fDataPenalty'
3376 vinfo( 2)='nonlinear model final data penalty function'
3377 vardim(1)=statedimp1
3378 vardim(2)=nouterdim
3379
3380 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3381 & 2, vardim, aval, vinfo, ncname, &
3382 & setparaccess = .false.)
3383 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3384# endif
3385# if (defined RECOMPUTE_4DVAR && \
3386 (defined array_modes || defined clipping)) || \
3387 defined r4dvar_ana_sensitivity || defined r4dvar || \
3388 defined tl_r4dvar
3389!
3390! Define RPM initial and final data penalty function.
3391!
3392 vinfo( 1)='RP_iDataPenalty'
3393 vinfo( 2)='representer model initial data penalty function'
3394 vardim(1)=statedimp1
3395 vardim(2)=nouterdim
3396
3397 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3398 & 2, vardim, aval, vinfo, ncname, &
3399 & setparaccess = .false.)
3400 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3401!
3402 vinfo( 1)='RP_fDataPenalty'
3403 vinfo( 2)='representer model final data penalty function'
3404 vardim(1)=statedimp1
3405 vardim(2)=nouterdim
3406
3407 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3408 & 2, vardim, aval, vinfo, ncname, &
3409 & setparaccess = .false.)
3410 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3411# endif
3412# ifdef WEAK_CONSTRAINT
3413!
3414! Define first guess initial data misfit.
3415!
3416 vinfo( 1)='Jf'
3417 vinfo( 2)='first guess initial data misfit'
3418 vardim(1)=ninnerdimp1
3419 vardim(2)=nouterdim
3420 vinfo(24)='_FillValue'
3421 aval(6)=spval
3422
3423 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3424 & 2, vardim, aval, vinfo, ncname, &
3425 & setparaccess = .false.)
3426 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3427!
3428! Define state estimate data misfit.
3429!
3430 vinfo( 1)='Jdata'
3431 vinfo( 2)='state estimate data misfit'
3432 vardim(1)=ninnerdimp1
3433 vardim(2)=nouterdim
3434 vinfo(24)='_FillValue'
3435 aval(6)=spval
3436
3437 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3438 & 2, vardim, aval, vinfo, ncname, &
3439 & setparaccess = .false.)
3440 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3441
3442# ifndef SP4DVAR
3443!
3444! Define model penalty function.
3445!
3446 vinfo( 1)='Jmod'
3447 vinfo( 2)='model penalty function'
3448 vardim(1)=ninnerdimp1
3449 vardim(2)=nouterdim
3450 vinfo(24)='_FillValue'
3451 aval(6)=spval
3452
3453 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3454 & 2, vardim, aval, vinfo, ncname, &
3455 & setparaccess = .false.)
3456 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3457!
3458! Define optimal penalty function.
3459!
3460 vinfo( 1)='Jopt'
3461 vinfo( 2)='optimal penalty function'
3462 vardim(1)=ninnerdimp1
3463 vardim(2)=nouterdim
3464 vinfo(24)='_FillValue'
3465 aval(6)=spval
3466
3467 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3468 & 2, vardim, aval, vinfo, ncname, &
3469 & setparaccess = .false.)
3470 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3471!
3472! Define actual model penalty function.
3473!
3474 vinfo( 1)='Jb'
3475 vinfo( 2)='actual model penalty function'
3476 vardim(1)=ninnerdimp1
3477 vardim(2)=nouterdim
3478 vinfo(24)='_FillValue'
3479 aval(6)=spval
3480
3481 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3482 & 2, vardim, aval, vinfo, ncname, &
3483 & setparaccess = .false.)
3484 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3485!
3486! Define actual data penalty function.
3487!
3488 vinfo( 1)='Jobs'
3489 vinfo( 2)='actual data penalty function'
3490 vardim(1)=ninnerdimp1
3491 vardim(2)=nouterdim
3492 vinfo(24)='_FillValue'
3493 aval(6)=spval
3494
3495 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3496 & 2, vardim, aval, vinfo, ncname, &
3497 & setparaccess = .false.)
3498 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3499!
3500! Define actual data penalty function.
3501!
3502 vinfo( 1)='Jact'
3503 vinfo( 2)='actual total penalty function'
3504 vardim(1)=ninnerdimp1
3505 vardim(2)=nouterdim
3506 vinfo(24)='_FillValue'
3507 aval(6)=spval
3508
3509 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
3510 & 2, vardim, aval, vinfo, ncname, &
3511 & setparaccess = .false.)
3512 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3513# endif
3514# endif
3515!
3516! Observations survey time.
3517!
3518 IF (find_string(var_name,n_var,vname(1,idoday),vindex)) THEN
3519 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3520 & piofile = obspiofile, &
3521 & myvarname = trim(vname(1,idoday)), &
3522 & nvardim = nvdim, &
3523 & nvaratt = nvatt)
3524 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3525 vinfo(1)=trim(vname(1,idoday))
3526 DO i=1,nvatt
3527 IF (trim(var_aname(i)).eq.'long_name') THEN
3528 vinfo(2)=trim(var_achar(i))
3529 ELSE IF (trim(var_aname(i)).eq.'units') THEN
3530 vinfo(3)=trim(var_achar(i))
3531 ELSE IF (trim(var_aname(i)).eq.'calendar') THEN
3532 vinfo(4)=trim(var_achar(i))
3533 END IF
3534 END DO
3535 dav(ng)%pioVar(idoday)%dkind=pio_tout
3536 dav(ng)%pioVar(idoday)%gtype=0
3537!
3538 status=def_var(ng, inlm, dav(ng)%pioFile, &
3539 & dav(ng)%pioVar(idoday)%vd, &
3540 & nf_tout, 1, (/surveydim/), aval, vinfo, ncname)
3541 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3542 END IF
3543!
3544! Observation type.
3545!
3546 IF (find_string(var_name,n_var,vname(1,idotyp),vindex)) THEN
3547 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3548 & piofile = obspiofile, &
3549 & myvarname = trim(vname(1,idotyp)), &
3550 & nvardim = nvdim, &
3551 & nvaratt = nvatt)
3552 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3553 vinfo(1)=trim(vname(1,idotyp))
3554 dav(ng)%pioVar(idotyp)%dkind=pio_int
3555 dav(ng)%pioVar(idotyp)%gtype=0
3556!
3557 status=def_var(ng, inlm, dav(ng)%pioFile, &
3558 & dav(ng)%pioVar(idotyp)%vd, &
3559 & pio_int, 1, (/datumdim/), aval, vinfo, ncname)
3560 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3561! copy attributes from observations
3562 CALL pio_netcdf_copy_att (ng, inlm, &
3563 & trim(vname(1,idotyp)), &
3564 & 'NULL', &
3565 & trim(obs(ng)%name), &
3566 & obspiofile, &
3567 & vindex, &
3568 & trim(dav(ng)%name), &
3569 & dav(ng)%pioFile, &
3570 & dav(ng)%pioVar(idotyp)%vd%varID)
3571 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3572 END IF
3573!
3574! Observations provenance.
3575!
3576 IF (find_string(var_name,n_var,vname(1,idopro),vindex)) THEN
3577 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3578 & piofile = obspiofile, &
3579 & myvarname = trim(vname(1,idopro)), &
3580 & nvardim = nvdim, &
3581 & nvaratt = nvatt)
3582 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3583 vinfo(1)=trim(vname(1,idopro))
3584 dav(ng)%pioVar(idopro)%dkind=pio_int
3585 dav(ng)%pioVar(idopro)%gtype=0
3586!
3587 status=def_var(ng, inlm, dav(ng)%pioFile, &
3588 & dav(ng)%pioVar(idopro)%vd, &
3589 & pio_int, 1, (/datumdim/), aval, vinfo, ncname)
3590 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3591! copy attributes from observations
3592 CALL pio_netcdf_copy_att (ng, inlm, &
3593 & trim(vname(1,idopro)), &
3594 & 'NULL', &
3595 & trim(obs(ng)%name), &
3596 & obspiofile, &
3597 & vindex, &
3598 & trim(dav(ng)%name), &
3599 & dav(ng)%pioFile, &
3600 & dav(ng)%pioVar(idopro)%vd%varID)
3601 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3602 END IF
3603!
3604! Observations time.
3605!
3606 IF (find_string(var_name,n_var,vname(1,idobst),vindex)) THEN
3607 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3608 & piofile = obspiofile, &
3609 & myvarname = trim(vname(1,idobst)), &
3610 & nvardim = nvdim, &
3611 & nvaratt = nvatt)
3612 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3613 vinfo(1)=trim(vname(1,idobst))
3614 DO i=1,nvatt
3615 IF (trim(var_aname(i)).eq.'long_name') THEN
3616 vinfo(2)=trim(var_achar(i))
3617 ELSE IF (trim(var_aname(i)).eq.'units') THEN
3618 vinfo(3)=trim(var_achar(i))
3619 ELSE IF (trim(var_aname(i)).eq.'calendar') THEN
3620 vinfo(4)=trim(var_achar(i))
3621 END IF
3622 END DO
3623 dav(ng)%pioVar(idobst)%dkind=pio_tout
3624 dav(ng)%pioVar(idobst)%gtype=0
3625!
3626 status=def_var(ng, inlm, dav(ng)%pioFile, &
3627 & dav(ng)%pioVar(idobst)%vd, &
3628 & pio_tout, 1, (/datumdim/), aval, vinfo, ncname)
3629 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3630 END IF
3631!
3632! Observations longitude.
3633!
3634 IF (find_string(var_name,n_var,vname(1,idolon),vindex)) THEN
3635 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3636 & piofile = obspiofile, &
3637 & myvarname = trim(vname(1,idolon)), &
3638 & nvardim = nvdim, &
3639 & nvaratt = nvatt)
3640 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3641 vinfo(1)=trim(vname(1,idolon))
3642 DO i=1,nvatt
3643 IF (trim(var_aname(i)).eq.'long_name') THEN
3644 vinfo(2)=trim(var_achar(i))
3645 ELSE IF (trim(var_aname(i)).eq.'units') THEN
3646 vinfo(3)=trim(var_achar(i))
3647 END IF
3648 END DO
3649 dav(ng)%pioVar(idolon)%dkind=pio_frst
3650 dav(ng)%pioVar(idolon)%gtype=0
3651!
3652 status=def_var(ng, inlm, dav(ng)%pioFile, &
3653 & dav(ng)%pioVar(idolon)%vd, &
3654 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3655 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3656 END IF
3657!
3658! Observations latitude.
3659!
3660 IF (find_string(var_name,n_var,vname(1,idolat),vindex)) THEN
3661 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3662 & piofile = obspiofile, &
3663 & myvarname = trim(vname(1,idolat)), &
3664 & nvardim = nvdim, &
3665 & nvaratt = nvatt)
3666 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3667 vinfo(1)=trim(vname(1,idolat))
3668 DO i=1,nvatt
3669 IF (trim(var_aname(i)).eq.'long_name') THEN
3670 vinfo(2)=trim(var_achar(i))
3671 ELSE IF (trim(var_aname(i)).eq.'units') THEN
3672 vinfo(3)=trim(var_achar(i))
3673 END IF
3674 END DO
3675 dav(ng)%pioVar(idolat)%dkind=pio_frst
3676 dav(ng)%pioVar(idolat)%gtype=0
3677!
3678 status=def_var(ng, inlm, dav(ng)%pioFile, &
3679 & dav(ng)%pioVar(idolat)%vd, &
3680 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3681 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3682 END IF
3683!
3684! Observations depth.
3685!
3686 IF (find_string(var_name,n_var,vname(1,idobsd),vindex)) THEN
3687 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3688 & piofile = obspiofile, &
3689 & myvarname = trim(vname(1,idobsd)), &
3690 & nvardim = nvdim, &
3691 & nvaratt = nvatt)
3692 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3693 vinfo(1)=trim(vname(1,idobsd))
3694 DO i=1,nvatt
3695 IF (trim(var_aname(i)).eq.'long_name') THEN
3696 vinfo(2)=trim(var_achar(i))
3697 ELSE IF (trim(var_aname(i)).eq.'units') THEN
3698 vinfo(3)=trim(var_achar(i))
3699 ELSE IF (trim(var_aname(i)).eq.'negative') THEN
3700 vinfo(11)='downwards'
3701 END IF
3702 END DO
3703 vinfo(17)='missing_value'
3704 aval(4)=spval
3705 dav(ng)%pioVar(idobsd)%dkind=pio_frst
3706 dav(ng)%pioVar(idobsd)%gtype=0
3707!
3708 status=def_var(ng, inlm, dav(ng)%pioFile, &
3709 & dav(ng)%pioVar(idobsd)%vd, &
3710 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3711 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3712 END IF
3713!
3714! Observations X-fractional coordinate.
3715!
3716 IF (find_string(var_name,n_var,vname(1,idobsx),vindex)) THEN
3717 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3718 & piofile = obspiofile, &
3719 & myvarname = trim(vname(1,idobsx)), &
3720 & nvardim = nvdim, &
3721 & nvaratt = nvatt)
3722 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3723 vinfo(1)=trim(vname(1,idobsx))
3724 DO i=1,nvatt
3725 IF (trim(var_aname(i)).eq.'long_name') THEN
3726 vinfo(2)=trim(var_achar(i))
3727 END IF
3728 END DO
3729 dav(ng)%pioVar(idobsx)%dkind=pio_frst
3730 dav(ng)%pioVar(idobsx)%gtype=0
3731!
3732 status=def_var(ng, inlm, dav(ng)%pioFile, &
3733 & dav(ng)%pioVar(idobsx)%vd, &
3734 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3735 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3736 END IF
3737!
3738! Observations Y-fractional coordinate.
3739!
3740 IF (find_string(var_name,n_var,vname(1,idobsy),vindex)) THEN
3741 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3742 & piofile = obspiofile, &
3743 & myvarname = trim(vname(1,idobsy)), &
3744 & nvardim = nvdim, &
3745 & nvaratt = nvatt)
3746 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3747 vinfo(1)=trim(vname(1,idobsy))
3748 DO i=1,nvatt
3749 IF (trim(var_aname(i)).eq.'long_name') THEN
3750 vinfo(2)=trim(var_achar(i))
3751 END IF
3752 END DO
3753 dav(ng)%pioVar(idobsy)%dkind=pio_frst
3754 dav(ng)%pioVar(idobsy)%gtype=0
3755!
3756 status=def_var(ng, inlm, dav(ng)%pioFile, &
3757 & dav(ng)%pioVar(idobsy)%vd, &
3758 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3759 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3760 END IF
3761!
3762! Observations Z-fractional coordinate.
3763!
3764 IF (find_string(var_name,n_var,vname(1,idobsz),vindex)) THEN
3765 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3766 & piofile = obspiofile, &
3767 & myvarname = trim(vname(1,idobsz)), &
3768 & nvardim = nvdim, &
3769 & nvaratt = nvatt)
3770 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3771 vinfo(1)=trim(vname(1,idobsz))
3772 DO i=1,nvatt
3773 IF (trim(var_aname(i)).eq.'long_name') THEN
3774 vinfo(2)=trim(var_achar(i))
3775 END IF
3776 END DO
3777 dav(ng)%pioVar(idobsz)%dkind=pio_frst
3778 dav(ng)%pioVar(idobsz)%gtype=0
3779!
3780 status=def_var(ng, inlm, dav(ng)%pioFile, &
3781 & dav(ng)%pioVar(idobsz)%vd, &
3782 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3783 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3784 END IF
3785!
3786! Observations total error (instrument + sampling + representation).
3787!
3788 IF (find_string(var_name,n_var,vname(1,idoerr),vindex)) THEN
3789 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3790 & piofile = obspiofile, &
3791 & myvarname = trim(vname(1,idoerr)), &
3792 & nvardim = nvdim, &
3793 & nvaratt = nvatt)
3794 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3795 vinfo(1)=trim(vname(1,idoerr))
3796 DO i=1,nvatt
3797 IF (trim(var_aname(i)).eq.'long_name') THEN
3798 vinfo(2)=trim(var_achar(i))
3799 END IF
3800 END DO
3801 vinfo(3)=trim(vname(3,idoerr))
3802 dav(ng)%pioVar(idoerr)%dkind=pio_frst
3803 dav(ng)%pioVar(idoerr)%gtype=0
3804!
3805 status=def_var(ng, inlm, dav(ng)%pioFile, &
3806 & dav(ng)%pioVar(idoerr)%vd, &
3807 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3808 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3809 END IF
3810!
3811! Observations value.
3812!
3813 IF (find_string(var_name,n_var,vname(1,idoval),vindex)) THEN
3814 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3815 & piofile = obspiofile, &
3816 & myvarname = trim(vname(1,idoval)), &
3817 & nvardim = nvdim, &
3818 & nvaratt = nvatt)
3819 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3820 vinfo(1)=trim(vname(1,idoval))
3821 DO i=1,nvatt
3822 IF (trim(var_aname(i)).eq.'long_name') THEN
3823 vinfo(2)=trim(var_achar(i))
3824 END IF
3825 END DO
3826 vinfo(3)=trim(vname(3,idoval))
3827 dav(ng)%pioVar(idoval)%dkind=pio_frst
3828 dav(ng)%pioVar(idoval)%gtype=0
3829!
3830 status=def_var(ng, inlm, dav(ng)%pioFile, &
3831 & dav(ng)%pioVar(idoval)%vd, &
3832 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3833 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3834 END IF
3835!
3836! Observations meta value.
3837!
3838 IF (find_string(var_name,n_var,vname(1,idomet),vindex)) THEN
3839 CALL pio_netcdf_inq_var (ng, inlm, obs(ng)%name, &
3840 & piofile = obspiofile, &
3841 & myvarname = trim(vname(1,idomet)), &
3842 & nvardim = nvdim, &
3843 & nvaratt = nvatt)
3844 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3845 vinfo(1)=trim(vname(1,idomet))
3846 DO i=1,nvatt
3847 IF (trim(var_aname(i)).eq.'long_name') THEN
3848 vinfo(2)=trim(var_achar(i))
3849 END IF
3850 END DO
3851 dav(ng)%pioVar(idomet)%dkind=pio_frst
3852 dav(ng)%pioVar(idomet)%gtype=0
3853!
3854 status=def_var(ng, inlm, dav(ng)%pioFile, &
3855 & dav(ng)%pioVar(idomet)%vd, &
3856 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3857 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3858 END IF
3859!
3860! Observations screening/normalization scale.
3861!
3862 vinfo( 1)=vname(1,idobss)
3863 vinfo( 2)=vname(2,idobss)
3864 dav(ng)%pioVar(idobss)%dkind=pio_frst
3865 dav(ng)%pioVar(idobss)%gtype=0
3866!
3867 status=def_var(ng, inlm, dav(ng)%pioFile, &
3868 & dav(ng)%pioVar(idobss)%vd, &
3869 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3870 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3871
3872# if defined FOUR_DVAR && !defined I4DVAR_ANA_SENSITIVITY
3873!
3874! Unvetted prior nonlinear model at observation locations.
3875!
3876 vinfo( 1)=vname(1,idnlmp)
3877 vinfo( 2)=vname(2,idnlmp)
3878 vinfo( 3)=vname(3,idnlmp)
3879 dav(ng)%pioVar(idnlmp)%dkind=pio_frst
3880 dav(ng)%pioVar(idnlmp)%gtype=0
3881!
3882 status=def_var(ng, inlm, dav(ng)%pioFile, &
3883 & dav(ng)%pioVar(idnlmp)%vd, &
3884 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3885 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3886!
3887! Initial nonlinear model at observation locations.
3888!
3889 vinfo( 1)=vname(1,idnlmi)
3890 vinfo( 2)=vname(2,idnlmi)
3891 vinfo( 3)=vname(3,idnlmi)
3892 dav(ng)%pioVar(idnlmi)%dkind=pio_frst
3893 dav(ng)%pioVar(idnlmi)%gtype=0
3894!
3895 status=def_var(ng, inlm, dav(ng)%pioFile, &
3896 & dav(ng)%pioVar(idnlmi)%vd, &
3897 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3898 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3899!
3900! Final nonlinear model at observation locations.
3901!
3902 vinfo( 1)=vname(1,idnlmf)
3903 vinfo( 2)=vname(2,idnlmf)
3904 vinfo( 3)=vname(3,idnlmf)
3905 dav(ng)%pioVar(idnlmf)%dkind=pio_frst
3906 dav(ng)%pioVar(idnlmf)%gtype=0
3907!
3908 status=def_var(ng, inlm, dav(ng)%pioFile, &
3909 & dav(ng)%pioVar(idnlmf)%vd, &
3910 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3911 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3912!
3913! 4D-Var background error standard deviation at observation locations.
3914!
3915 vinfo( 1)=vname(1,idbger)
3916 vinfo( 2)=vname(2,idbger)
3917 vinfo( 3)=vname(3,idbger)
3918 dav(ng)%pioVar(idbger)%dkind=pio_frst
3919 dav(ng)%pioVar(idbger)%gtype=0
3920!
3921 status=def_var(ng, inlm, dav(ng)%pioFile, &
3922 & dav(ng)%pioVar(idbger)%vd, &
3923 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3924 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3925!
3926! 4D-Var innovation vector: observation minus background.
3927!
3928 vinfo( 1)=vname(1,idinno)
3929 vinfo( 2)=vname(2,idinno)
3930 vinfo( 3)=vname(3,idinno)
3931 dav(ng)%pioVar(idinno)%dkind=pio_frst
3932 dav(ng)%pioVar(idinno)%gtype=0
3933!
3934 status=def_var(ng, inlm, dav(ng)%pioFile, &
3935 & dav(ng)%pioVar(idinno)%vd, &
3936 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3937 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3938!
3939! 4D-Var increment vector: analysis minus background.
3940!
3941 vinfo( 1)=vname(1,idincr)
3942 vinfo( 2)=vname(2,idincr)
3943 vinfo( 3)=vname(3,idincr)
3944 dav(ng)%pioVar(idincr)%dkind=pio_frst
3945 dav(ng)%pioVar(idincr)%gtype=0
3946!
3947 status=def_var(ng, inlm, dav(ng)%pioFile, &
3948 & dav(ng)%pioVar(idincr)%vd, &
3949 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3950 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3951!
3952! 4D-Var residual vector: observation minus analysis.
3953!
3954 vinfo( 1)=vname(1,idresi)
3955 vinfo( 2)=vname(2,idresi)
3956 vinfo( 3)=vname(3,idresi)
3957 dav(ng)%pioVar(idresi)%dkind=pio_frst
3958 dav(ng)%pioVar(idresi)%gtype=0
3959!
3960 status=def_var(ng, inlm, dav(ng)%pioFile, &
3961 & dav(ng)%pioVar(idresi)%vd, &
3962 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3963 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3964
3965# ifdef BGQC
3966!
3967! Threshold for background quality control check of observations.
3968!
3969 vinfo( 1)=vname(1,idbgth)
3970 vinfo( 2)=vname(2,idbgth)
3971 dav(ng)%pioVar(idbgth)%dkind=pio_frst
3972 dav(ng)%pioVar(idbgth)%gtype=0
3973!
3974 status=def_var(ng, inlm, dav(ng)%pioFile, &
3975 & dav(ng)%pioVar(idbgth)%vd, &
3976 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
3977 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3978# endif
3979# endif
3980
3981# if !defined I4DVAR_ANA_SENSITIVITY && \
3982 (defined i4dvar || defined weak_constraint)
3983!
3984! Unvetted nonlinear model at observation points per outer-loop.
3985!
3986 havenlmod(ng)=.false.
3987 vinfo( 1)=vname(1,idnlmu)
3988 vinfo( 2)=vname(2,idnlmu)
3989 vinfo( 3)=vname(3,idnlmu)
3990 dav(ng)%pioVar(idnlmu)%dkind=pio_frst
3991 dav(ng)%pioVar(idnlmu)%gtype=0
3992!
3993 status=def_var(ng, inlm, dav(ng)%pioFile, &
3994 & dav(ng)%pioVar(idnlmu)%vd, &
3995 & pio_frst, 2, (/datumdim,nouterdim/), aval, &
3996 & vinfo, ncname)
3997 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3998# endif
3999
4000# ifndef I4DVAR_ANA_SENSITIVITY
4001# if defined I4DVAR || defined TLM_CHECK || \
4002 defined verification || defined weak_constraint
4003!
4004! Nonlinear model at observation points.
4005!
4006 havenlmod(ng)=.false.
4007 vinfo( 1)=vname(1,idnlmo)
4008 vinfo( 2)=vname(2,idnlmo)
4009 vinfo( 3)=vname(3,idnlmo)
4010 dav(ng)%pioVar(idnlmo)%dkind=pio_frst
4011 dav(ng)%pioVar(idnlmo)%gtype=0
4012!
4013# if defined VERIFICATION || defined TLM_CHECK
4014 status=def_var(ng, inlm, dav(ng)%pioFile, &
4015 & dav(ng)%pioVar(idnlmo)%vd, &
4016 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
4017 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4018# else
4019 status=def_var(ng, inlm, dav(ng)%pioFile, &
4020 & dav(ng)%pioVar(idnlmo)%vd, &
4021 & pio_frst, 2, (/datumdim,nouterdim/), aval, &
4022 & vinfo, ncname)
4023 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4024# endif
4025# endif
4026# endif
4027
4028# if defined I4DVAR || defined I4DVAR_ANA_SENSITIVITY || \
4029 defined weak_constraint
4030!
4031! Tangent linear or representer model at observation points.
4032!
4033 havetlmod(ng)=.false.
4034 vinfo( 1)=vname(1,idtlmo)
4035# ifdef I4DVAR_ANA_SENSITIVITY
4036 vinfo( 2)='4D-Var sensitivity analysis at observations location'
4037# else
4038 vinfo( 2)=vname(2,idtlmo)
4039# endif
4040 dav(ng)%pioVar(idtlmo)%dkind=pio_frst
4041 dav(ng)%pioVar(idtlmo)%gtype=0
4042!
4043 status=def_var(ng, inlm, dav(ng)%pioFile, &
4044 & dav(ng)%pioVar(idtlmo)%vd, &
4045 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
4046 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4047# endif
4048
4049# if defined I4DVAR || defined WEAK_CONSTRAINT
4050!
4051! Initial model-observation misfit (innovation) vector.
4052!
4053 vinfo( 1)=vname(1,idmomi)
4054 vinfo( 2)=vname(2,idmomi)
4055 dav(ng)%pioVar(idmomi)%dkind=pio_frst
4056 dav(ng)%pioVar(idmomi)%gtype=0
4057!
4058 status=def_var(ng, inlm, dav(ng)%pioFile, &
4059 & dav(ng)%pioVar(idmomi)%vd, &
4060 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
4061 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4062!
4063! Final model-observation misfit (innovation) vector.
4064!
4065 vinfo( 1)=vname(1,idmomf)
4066 vinfo( 2)=vname(2,idmomf)
4067 dav(ng)%pioVar(idmomf)%dkind=pio_frst
4068 dav(ng)%pioVar(idmomf)%gtype=0
4069!
4070 status=def_var(ng, inlm, dav(ng)%pioFile, &
4071 & dav(ng)%pioVar(idmomf)%vd, &
4072 & pio_frst, 1, (/datumdim/), aval, vinfo, ncname)
4073 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4074# endif
4075
4076# if defined I4DVAR
4077!
4078! Define model minus observations misfit NLM cost function.
4079!
4080 vinfo( 1)='NLcost_function'
4081 vinfo( 2)='nonlinear model misfit cost function'
4082 vardim(1)=statedimp1
4083 vardim(2)=nouterdimp1
4084
4085 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4086 & 2, vardim, aval, vinfo, ncname)
4087 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4088!
4089! Define model minus observations misfit TLM cost function.
4090!
4091 vinfo( 1)='TLcost_function'
4092 vinfo( 2)='tangent linear model misfit cost function'
4093
4094 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4095 & 1, (/iterdim/), aval, vinfo, ncname, &
4096 & setparaccess = .true.)
4097 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4098# endif
4099
4100# ifdef BACKGROUND
4101!
4102! Define model minus background misfit cost function.
4103!
4104 vinfo( 1)='back_function'
4105 vinfo( 2)='model minus background misfit cost function'
4106
4107 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4108 & 1, (/iterdim/), aval, vinfo, ncname, &
4109 & setparaccess = .true.)
4110 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4111# endif
4112
4113# if defined I4DVAR
4114!
4115! Define optimality property that measures the consistency between
4116! background and observation errors hypotheses (Chi-square).
4117!
4118 vinfo( 1)='Jmin'
4119 vinfo( 2)='normalized, optimal cost function minimum'
4120
4121 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4122 & 1, (/iterdim/), aval, vinfo, ncname, &
4123 & setparaccess = .true.)
4124 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4125# endif
4126
4127# ifdef WEAK_CONSTRAINT
4128# ifndef RPCG
4129!
4130! Representer coefficients estimate. Needed for restarting "congrad".
4131!
4132 vinfo( 1)='cg_pxsave'
4133 vinfo( 2)='representer coefficients estimatate'
4134 vardim(1)=datumdim
4135 vardim(2)=nouterdim
4136 aval(6)=spval
4137
4138 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4139 & 2, vardim, aval, vinfo, ncname)
4140 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4141# endif
4142!
4143! Define initial gradient for minimization.
4144!
4145 vinfo( 1)='zgrad0'
4146 vinfo( 2)='initial gradient for minimization, observation space'
4147# ifdef RPCG
4148 vardim(1)=datumdimp1
4149# else
4150 vardim(1)=datumdim
4151# endif
4152 vardim(2)=nouterdim
4153 vinfo(24)='_FillValue'
4154 aval(6)=spval
4155
4156 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4157 & 2, vardim, aval, vinfo, ncname)
4158 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4159
4160# ifdef RPCG
4161!
4162! Define initial gradient for minimization.
4163!
4164 vinfo( 1)='vgrad0'
4165 vinfo( 2)='initial gradient for minimization, v space'
4166 vardim(1)=datumdimp1
4167 vinfo(24)='_FillValue'
4168 aval(6)=spval
4169
4170 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4171 & 1, vardim, aval, vinfo, ncname)
4172 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4173!
4174! Define sum of evolved outer-loop increments in observation space.
4175!
4176 vinfo( 1)='Hbk'
4177 vinfo( 2)='evolved sum of increments in observation space'
4178 vardim(1)=datumdim
4179 vardim(2)=nouterdim
4180 vinfo(24)='_FillValue'
4181 aval(6)=spval
4182
4183 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4184 & 2, vardim, aval, vinfo, ncname)
4185 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4186!
4187! Define outer-loop background cost function.
4188!
4189 vinfo( 1)='Jb0'
4190 vinfo( 2)='Outer-loop background cost function'
4191 vardim(1)=nouterdimp1
4192 vinfo(24)='_FillValue'
4193 aval(6)=spval
4194
4195 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4196 & 1, vardim, aval, vinfo, ncname)
4197 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4198# endif
4199!
4200! Define Lanczos vectors in observation space.
4201!
4202# ifdef RPCG
4203 vinfo( 1)='vcglwk'
4204 vinfo( 2)='Preconditioned Lanczos vectors, observation space'
4205 vardim(1)=datumdimp1
4206 vardim(2)=ninnerdimp1
4207 vardim(3)=nouterdim
4208 vinfo(24)='_FillValue'
4209 aval(6)=spval
4210
4211 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4212 & 3, vardim, aval, vinfo, ncname)
4213 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4214!
4215 vinfo( 1)='vcglev'
4216 vinfo( 2)='converged Lanczos vectors, observation space'
4217 vardim(1)=datumdimp1
4218 vardim(2)=ninnerdim
4219 vardim(3)=nouterdim
4220 vinfo(24)='_FillValue'
4221 aval(6)=spval
4222
4223 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4224 & 3, vardim, aval, vinfo, ncname)
4225 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4226!
4227 vinfo( 1)='zcglwk'
4228 vinfo( 2)='Lanczos vectors, observation space'
4229 vardim(1)=datumdimp1
4230 vardim(2)=ninnerdimp1
4231 vardim(3)=nouterdim
4232 vinfo(24)='_FillValue'
4233 aval(6)=spval
4234
4235 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4236 & 3, vardim, aval, vinfo, ncname)
4237 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4238# else
4239 vinfo( 1)='zcglwk'
4240 vinfo( 2)='Lanczos vectors, observation space'
4241 vardim(1)=datumdim
4242 vardim(2)=ninnerdimp1
4243 vardim(3)=nouterdim
4244 vinfo(24)='_FillValue'
4245 aval(6)=spval
4246
4247 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4248 & 3, vardim, aval, vinfo, ncname)
4249 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4250# endif
4251!
4252! Define previous values of TLmodVal.
4253!
4254 vinfo( 1)='TLmodVal_S'
4255 vinfo( 2)='tangent linear model at observation locations'
4256 vardim(1)=datumdim
4257 vardim(2)=ninnerdim
4258 vardim(3)=nouterdim
4259
4260 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4261 & 3, vardim, aval, vinfo, ncname)
4262 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4263# endif
4264
4265# ifdef SP4DVAR
4266!
4267! Define saved values of ADmodVal.
4268!
4269 vinfo( 1)='ADmodVal_S'
4270 vinfo( 2)='adjoint model at observation locations'
4271 vardim(1)=datumdim
4272 vardim(2)=ninnerdimp2
4273
4274 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4275 & 2, vardim, aval, vinfo, ncname)
4276 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4277!
4278! Define saved values of harnoldi.
4279!
4280 vinfo( 1)='harnoldi'
4281 vinfo( 2)='GMRES upper Hessenberg matrix'
4282 vardim(1)=ninnerdimp1
4283 vardim(2)=ninnerdim
4284 vardim(3)=nouterdim
4285 vinfo(24)='_FillValue'
4286 aval(6)=spval
4287
4288 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4289 & 3, vardim, aval, vinfo, ncname)
4290 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4291!
4292! Define saved values of gmze, the Arnoldi vector weights.
4293!
4294 vinfo( 1)='gmze'
4295 vinfo( 2)='GMRES Arnoldi vector weights'
4296 vardim(1)=ninnerdim
4297 vardim(2)=nouterdim
4298 vinfo(24)='_FillValue'
4299 aval(6)=spval
4300
4301 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4302 & 2, vardim, aval, vinfo, ncname)
4303 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4304!
4305! Define saved values of cg_beta0.
4306!
4307 vinfo( 1)='cg_beta0'
4308 vinfo( 2)='Residual norm'
4309 vardim(1)=nouterdim
4310 vinfo(24)='_FillValue'
4311 aval(6)=spval
4312
4313 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4314 & 1, vardim, aval, vinfo, ncname)
4315 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4316!
4317! Define saved values of Jobs.
4318!
4319 vinfo( 1)='Jobs'
4320 vinfo( 2)='Obs cost function'
4321 vardim(1)=ninnerdimp1
4322 vardim(2)=nouterdim
4323 vinfo(24)='_FillValue'
4324 aval(6)=spval
4325
4326 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4327 & 2, vardim, aval, vinfo, ncname)
4328 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4329# endif
4330
4331# if defined R4DVAR || defined R4DVAR_ANA_SENSITIVITY || \
4332 defined tl_r4dvar
4333!
4334! Define initial values of RPmodVal.
4335!
4336 vinfo( 1)='RPmodel_initial'
4337 vinfo( 2)='initial representer model at observation locations'
4338 vardim(1)=datumdim
4339
4340 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4341 & 1, vardim, aval, vinfo, ncname)
4342 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4343# endif
4344
4345# if defined I4DVAR_ANA_SENSITIVITY || \
4346 defined rbl4dvar_ana_sensitivity || \
4347 defined rbl4dvar_fct_sensitivity || \
4348 defined r4dvar_ana_sensitivity
4349# ifdef OBS_IMPACT
4350!
4351! Define total observations impact.
4352!
4353# ifdef IMPACT_INNER
4354 vinfo( 1)='ObsImpact_total'
4355 vinfo( 2)='total observation impact'
4356 vardim(1)=datumdim
4357 vardim(2)=ninnerdim
4358
4359 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4360 & 2, vardim, aval, vinfo, ncname)
4361 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4362# else
4363 vinfo( 1)='ObsImpact_total'
4364 vinfo( 2)='total observation impact'
4365 vardim(1)=datumdim
4366
4367 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4368 & 1, vardim, aval, vinfo, ncname)
4369 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4370# endif
4371# else
4372!
4373! Define total observation sensitivity.
4374!
4375 vinfo( 1)='ObsSens_total'
4376 vinfo( 2)='total observation sensitivity'
4377 vardim(1)=datumdim
4378
4379 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4380 & 1, vardim, aval, vinfo, ncname)
4381 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4382# endif
4383# endif
4384
4385# if defined OBS_IMPACT_SPLIT && \
4386 (defined i4dvar_ana_sensitivity || \
4387 defined rbl4dvar_ana_sensitivity || \
4388 defined rbl4dvar_fct_sensitivity || \
4389 defined r4dvar_ana_sensitivity)
4390!
4391! Define observation impact due to initial condition increments.
4392!
4393# ifdef IMPACT_INNER
4394 vinfo( 1)='ObsImpact_IC'
4395 vinfo( 2)='observation impact due to initial conditions'
4396 vardim(1)=datumdim
4397 vardim(2)=ninnerdim
4398
4399 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4400 & 2, vardim, aval, vinfo, ncname)
4401 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4402# else
4403 vinfo( 1)='ObsImpact_IC'
4404 vinfo( 2)='observation impact due to initial conditions'
4405 vardim(1)=datumdim
4406
4407 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4408 & 1, vardim, aval, vinfo, ncname)
4409 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4410# endif
4411
4412# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
4413!
4414! Define observation impact due to surface forcing increments.
4415!
4416# ifdef IMPACT_INNER
4417
4418 vinfo( 1)='ObsImpact_FC'
4419 vinfo( 2)='observation impact due to surface forcing'
4420 vardim(1)=datumdim
4421 vardim(2)=ninnerdim
4422
4423 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4424 & 2, vardim, aval, vinfo, ncname)
4425 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4426# else
4427 vinfo( 1)='ObsImpact_FC'
4428 vinfo( 2)='observation impact due to surface forcing'
4429 vardim(1)=datumdim
4430
4431 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4432 & 1, vardim, aval, vinfo, ncname)
4433 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4434# endif
4435# endif
4436
4437# if defined ADJUST_BOUNDARY
4438!
4439! Define observation impact due to boundary condition increments.
4440!
4441# ifdef IMPACT_INNER
4442 vinfo( 1)='ObsImpact_BC'
4443 vinfo( 2)='observation impact due to open boundary conditions'
4444 vardim(1)=datumdim
4445 vardim(2)=ninnerdim
4446
4447 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4448 & 2, vardim, aval, vinfo, ncname)
4449 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4450# else
4451 vinfo( 1)='ObsImpact_BC'
4452 vinfo( 2)='observation impact due to open boundary conditions'
4453 vardim(1)=datumdim
4454
4455 status=def_var(ng, inlm, dav(ng)%pioFile, vardesc, pio_frst, &
4456 & 1, vardim, aval, vinfo, ncname)
4457 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4458# endif
4459# endif
4460# endif
4461
4462# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
4463!
4464! Define reference free-surface used in the balance operator.
4465!
4466 IF (balance(isfsur)) THEN
4467 vinfo( 1)='zeta_ref'
4468 vinfo( 2)='reference free-surface, balance operator'
4469 vinfo( 3)=vname(3,idfsur)
4470 dav(ng)%pioVar(idfsur)%dkind=pio_frst
4471 dav(ng)%pioVar(idfsur)%gtype=r2dvar
4472!
4473 status=def_var(ng, inlm, dav(ng)%pioFile, &
4474 & dav(ng)%pioVar(idfsur)%vd, &
4475 & pio_frst, 2, (/rxidim, retadim/), aval, vinfo, &
4476 & ncname)
4477 END IF
4478# endif
4479!
4480!-----------------------------------------------------------------------
4481! Leave definition mode.
4482!-----------------------------------------------------------------------
4483!
4484 CALL pio_netcdf_enddef (ng, inlm, ncname, dav(ng)%pioFile)
4485 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4486!
4487! Close observations NetCDF.
4488!
4489 IF (obs(ng)%pioFile%fh.eq.-1) THEN
4490 CALL pio_netcdf_close (ng, inlm, obspiofile, obs(ng)%name, &
4491 & .false.)
4492 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4493 END IF
4494 END IF define
4495!
4496!=======================================================================
4497! Open an existing model/observation file and check its contents.
4498!=======================================================================
4499!
4500 query : IF (.not.ldefmod(ng)) THEN
4501 ncname=dav(ng)%name
4502!
4503! Open model/observation for read/write.
4504!
4505 CALL pio_netcdf_open (ng, inlm, ncname, 1, dav(ng)%pioFile)
4506 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
4507 WRITE (stdout,30) trim(ncname)
4508 RETURN
4509 END IF
4510!
4511! Inquire about the dimensions and check for consistency.
4512!
4513 CALL pio_netcdf_check_dim (ng, inlm, ncname, &
4514 & piofile = dav(ng)%pioFile)
4515 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4516!
4517! Inquire about the variables.
4518!
4519 CALL pio_netcdf_inq_var (ng, inlm, ncname, &
4520 & piofile = dav(ng)%pioFile)
4521 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4522!
4523! Initialize logical switches.
4524!
4525 DO i=1,nv
4526 got_var(i)=.false.
4527 END DO
4528!
4529! Scan variable list from model/observation NetCDF and activate
4530! switches for required variables.
4531!
4532 DO i=1,n_var
4533 IF (trim(var_name(i)).eq.trim(vname(1,idoday))) THEN
4534 got_var(idoday)=.true.
4535 dav(ng)%pioVar(idoday)%vd=var_desc(i)
4536 dav(ng)%pioVar(idoday)%dkind=pio_tout
4537 dav(ng)%pioVar(idoday)%gtype=0
4538 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idotyp))) THEN
4539 got_var(idotyp)=.true.
4540 dav(ng)%pioVar(idotyp)%vd=var_desc(i)
4541 dav(ng)%pioVar(idotyp)%dkind=pio_int
4542 dav(ng)%pioVar(idotyp)%gtype=0
4543 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idopro))) THEN
4544 got_var(idopro)=.true.
4545 dav(ng)%pioVar(idopro)%vd=var_desc(i)
4546 dav(ng)%pioVar(idopro)%dkind=pio_int
4547 dav(ng)%pioVar(idopro)%gtype=0
4548 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobst))) THEN
4549 got_var(idobst)=.true.
4550 dav(ng)%pioVar(idobst)%vd=var_desc(i)
4551 dav(ng)%pioVar(idobst)%dkind=pio_tout
4552 dav(ng)%pioVar(idobst)%gtype=0
4553 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idolon))) THEN
4554 got_var(idolon)=.true.
4555 dav(ng)%pioVar(idolon)%vd=var_desc(i)
4556 dav(ng)%pioVar(idolon)%dkind=pio_frst
4557 dav(ng)%pioVar(idolon)%gtype=0
4558 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idolat))) THEN
4559 got_var(idolat)=.true.
4560 dav(ng)%pioVar(idolat)%vd=var_desc(i)
4561 dav(ng)%pioVar(idolat)%dkind=pio_frst
4562 dav(ng)%pioVar(idolat)%gtype=0
4563 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobsd))) THEN
4564 got_var(idobsd)=.true.
4565 dav(ng)%pioVar(idobsd)%vd=var_desc(i)
4566 dav(ng)%pioVar(idobsd)%dkind=pio_frst
4567 dav(ng)%pioVar(idobsd)%gtype=0
4568 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobsx))) THEN
4569 got_var(idobsx)=.true.
4570 dav(ng)%pioVar(idobsx)%vd=var_desc(i)
4571 dav(ng)%pioVar(idobsx)%dkind=pio_frst
4572 dav(ng)%pioVar(idobsx)%gtype=0
4573 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobsy))) THEN
4574 got_var(idobsy)=.true.
4575 dav(ng)%pioVar(idobsy)%vd=var_desc(i)
4576 dav(ng)%pioVar(idobsy)%dkind=pio_frst
4577 dav(ng)%pioVar(idobsy)%gtype=0
4578 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobsz))) THEN
4579 got_var(idobsz)=.true.
4580 dav(ng)%pioVar(idobsz)%vd=var_desc(i)
4581 dav(ng)%pioVar(idobsz)%dkind=pio_frst
4582 dav(ng)%pioVar(idobsz)%gtype=0
4583 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idoerr))) THEN
4584 got_var(idoerr)=.true.
4585 dav(ng)%pioVar(idoerr)%vd=var_desc(i)
4586 dav(ng)%pioVar(idoerr)%dkind=pio_frst
4587 dav(ng)%pioVar(idoerr)%gtype=0
4588 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idoval))) THEN
4589 got_var(idoval)=.true.
4590 dav(ng)%pioVar(idoval)%vd=var_desc(i)
4591 dav(ng)%pioVar(idoval)%dkind=pio_frst
4592 dav(ng)%pioVar(idoval)%gtype=0
4593 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idomet))) THEN
4594 got_var(idomet)=.true.
4595 dav(ng)%pioVar(idomet)%vd=var_desc(i)
4596 dav(ng)%pioVar(idomet)%dkind=pio_frst
4597 dav(ng)%pioVar(idomet)%gtype=0
4598 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idobss))) THEN
4599 got_var(idobss)=.true.
4600 dav(ng)%pioVar(idobss)%vd=var_desc(i)
4601 dav(ng)%pioVar(idobss)%dkind=pio_frst
4602 dav(ng)%pioVar(idobss)%gtype=0
4603# ifdef FOUR_DVAR
4604 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idnlmp))) THEN
4605 got_var(idnlmp)=.true.
4606 dav(ng)%pioVar(idnlmp)%vd=var_desc(i)
4607 dav(ng)%pioVar(idnlmp)%dkind=pio_frst
4608 dav(ng)%pioVar(idnlmp)%gtype=0
4609 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idnlmu))) THEN
4610 got_var(idnlmu)=.true.
4611 dav(ng)%pioVar(idnlmu)%vd=var_desc(i)
4612 dav(ng)%pioVar(idnlmu)%dkind=pio_frst
4613 dav(ng)%pioVar(idnlmu)%gtype=0
4614 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idnlmi))) THEN
4615 got_var(idnlmi)=.true.
4616 dav(ng)%pioVar(idnlmi)%vd=var_desc(i)
4617 dav(ng)%pioVar(idnlmi)%dkind=pio_frst
4618 dav(ng)%pioVar(idnlmi)%gtype=0
4619 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idnlmf))) THEN
4620 got_var(idnlmf)=.true.
4621 dav(ng)%pioVar(idnlmf)%vd=var_desc(i)
4622 dav(ng)%pioVar(idnlmf)%dkind=pio_frst
4623 dav(ng)%pioVar(idnlmf)%gtype=0
4624# endif
4625 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idnlmo))) THEN
4626 got_var(idnlmo)=.true.
4627 havenlmod(ng)=.true.
4628 dav(ng)%pioVar(idnlmo)%vd=var_desc(i)
4629 dav(ng)%pioVar(idnlmo)%dkind=pio_frst
4630 dav(ng)%pioVar(idnlmo)%gtype=0
4631# if defined I4DVAR || defined WEAK_CONSTRAINT
4632 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idtlmo))) THEN
4633 got_var(idtlmo)=.true.
4634 havetlmod(ng)=.true.
4635 dav(ng)%pioVar(idtlmo)%vd=var_desc(i)
4636 dav(ng)%pioVar(idtlmo)%dkind=pio_frst
4637 dav(ng)%pioVar(idtlmo)%gtype=0
4638# endif
4639 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idbger))) THEN
4640 got_var(idbger)=.true.
4641 dav(ng)%pioVar(idbger)%vd=var_desc(i)
4642 dav(ng)%pioVar(idbger)%dkind=pio_frst
4643 dav(ng)%pioVar(idbger)%gtype=0
4644 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idinno))) THEN
4645 got_var(idinno)=.true.
4646 dav(ng)%pioVar(idinno)%vd=var_desc(i)
4647 dav(ng)%pioVar(idinno)%dkind=pio_frst
4648 dav(ng)%pioVar(idinno)%gtype=0
4649 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idincr))) THEN
4650 got_var(idincr)=.true.
4651 dav(ng)%pioVar(idincr)%vd=var_desc(i)
4652 dav(ng)%pioVar(idincr)%dkind=pio_frst
4653 dav(ng)%pioVar(idincr)%gtype=0
4654 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idresi))) THEN
4655 got_var(idresi)=.true.
4656 dav(ng)%pioVar(idresi)%vd=var_desc(i)
4657 dav(ng)%pioVar(idresi)%dkind=pio_frst
4658 dav(ng)%pioVar(idresi)%gtype=0
4659# if defined I4DVAR || defined WEAK_CONSTRAINT
4660 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idmomi))) THEN
4661 got_var(idmomi)=.true.
4662 dav(ng)%pioVar(idmomi)%vd=var_desc(i)
4663 dav(ng)%pioVar(idmomi)%dkind=pio_frst
4664 dav(ng)%pioVar(idmomi)%gtype=0
4665 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idmomf))) THEN
4666 got_var(idmomf)=.true.
4667 dav(ng)%pioVar(idmomf)%vd=var_desc(i)
4668 dav(ng)%pioVar(idmomf)%dkind=pio_frst
4669 dav(ng)%pioVar(idmomf)%gtype=0
4670# endif
4671 END IF
4672 END DO
4673!
4674! Check if needed variables are available.
4675!
4676 IF (.not.got_var(idoday)) THEN
4677 IF (master) WRITE (stdout,90) trim(vname(1,idoday)), &
4678 & trim(dav(ng)%name)
4679 exit_flag=2
4680 RETURN
4681 END IF
4682 IF (.not.got_var(idopro)) THEN
4683 IF (master) WRITE (stdout,90) trim(vname(1,idopro)), &
4684 & trim(dav(ng)%name)
4685 exit_flag=2
4686 RETURN
4687 END IF
4688 IF (.not.got_var(idobst)) THEN
4689 IF (master) WRITE (stdout,90) trim(vname(1,idobst)), &
4690 & trim(dav(ng)%name)
4691 exit_flag=2
4692 RETURN
4693 END IF
4694 IF (.not.got_var(idolon)) THEN
4695 IF (master) WRITE (stdout,90) trim(vname(1,idolon)), &
4696 & trim(dav(ng)%name)
4697!! exit_flag=2
4698!! RETURN
4699 END IF
4700 IF (.not.got_var(idolat)) THEN
4701 IF (master) WRITE (stdout,90) trim(vname(1,idolat)), &
4702 & trim(dav(ng)%name)
4703!! exit_flag=2
4704!! RETURN
4705 END IF
4706 IF (.not.got_var(idobsd)) THEN
4707 IF (master) WRITE (stdout,90) trim(vname(1,idobsd)), &
4708 & trim(dav(ng)%name)
4709 exit_flag=2
4710 RETURN
4711 END IF
4712 IF (.not.got_var(idobsx)) THEN
4713 IF (master) WRITE (stdout,90) trim(vname(1,idobsx)), &
4714 & trim(dav(ng)%name)
4715 exit_flag=2
4716 RETURN
4717 END IF
4718 IF (.not.got_var(idobsy)) THEN
4719 IF (master) WRITE (stdout,90) trim(vname(1,idobsy)), &
4720 & trim(dav(ng)%name)
4721 exit_flag=2
4722 RETURN
4723 END IF
4724 IF (.not.got_var(idoerr)) THEN
4725 IF (master) WRITE (stdout,90) trim(vname(1,idoerr)), &
4726 & trim(dav(ng)%name)
4727 exit_flag=2
4728 RETURN
4729 END IF
4730 IF (.not.got_var(idoval)) THEN
4731 IF (master) WRITE (stdout,90) trim(vname(1,idoval)), &
4732 & trim(dav(ng)%name)
4733 exit_flag=2
4734 RETURN
4735 END IF
4736
4737 IF (.not.got_var(idobss)) THEN
4738 IF (master) WRITE (stdout,90) trim(vname(1,idobss)), &
4739 & trim(dav(ng)%name)
4740 exit_flag=2
4741 RETURN
4742 END IF
4743# ifdef FOUR_DVAR
4744 IF (.not.got_var(idnlmp)) THEN
4745 IF (master) WRITE (stdout,90) trim(vname(1,idnlmp)), &
4746 & trim(dav(ng)%name)
4747 exit_flag=2
4748 RETURN
4749 END IF
4750
4751 IF (.not.got_var(idnlmu)) THEN
4752 IF (master) WRITE (stdout,90) trim(vname(1,idnlmu)), &
4753 & trim(dav(ng)%name)
4754 exit_flag=2
4755 RETURN
4756 END IF
4757
4758 IF (.not.got_var(idnlmi)) THEN
4759 IF (master) WRITE (stdout,90) trim(vname(1,idnlmi)), &
4760 & trim(dav(ng)%name)
4761 exit_flag=2
4762 RETURN
4763 END IF
4764
4765 IF (.not.got_var(idnlmf)) THEN
4766 IF (master) WRITE (stdout,90) trim(vname(1,idnlmf)), &
4767 & trim(dav(ng)%name)
4768 exit_flag=2
4769 RETURN
4770 END IF
4771# endif
4772 IF (.not.got_var(idnlmo)) THEN
4773 IF (master) WRITE (stdout,90) trim(vname(1,idnlmo)), &
4774 & trim(dav(ng)%name)
4775 exit_flag=2
4776 RETURN
4777 END IF
4778# if defined I4DVAR || defined WEAK_CONSTRAINT
4779 IF (.not.got_var(idtlmo)) THEN
4780 IF (master) WRITE (stdout,90) trim(vname(1,idtlmo)), &
4781 & trim(dav(ng)%name)
4782 exit_flag=2
4783 RETURN
4784 END IF
4785# endif
4786 IF (.not.got_var(idbger)) THEN
4787 IF (master) WRITE (stdout,90) trim(vname(1,idbger)), &
4788 & trim(dav(ng)%name)
4789 exit_flag=2
4790 RETURN
4791 END IF
4792 IF (.not.got_var(idinno)) THEN
4793 IF (master) WRITE (stdout,90) trim(vname(1,idinno)), &
4794 & trim(dav(ng)%name)
4795 exit_flag=2
4796 RETURN
4797 END IF
4798 IF (.not.got_var(idincr)) THEN
4799 IF (master) WRITE (stdout,90) trim(vname(1,idincr)), &
4800 & trim(dav(ng)%name)
4801 exit_flag=2
4802 RETURN
4803 END IF
4804 IF (.not.got_var(idresi)) THEN
4805 IF (master) WRITE (stdout,90) trim(vname(1,idresi)), &
4806 & trim(dav(ng)%name)
4807 exit_flag=2
4808 RETURN
4809 END IF
4810# if defined I4DVAR || defined WEAK_CONSTRAINT
4811 IF (.not.got_var(idmomi)) THEN
4812 IF (master) WRITE (stdout,90) trim(vname(1,idmomi)), &
4813 & trim(dav(ng)%name)
4814 exit_flag=2
4815 RETURN
4816 END IF
4817 IF (.not.got_var(idmomf)) THEN
4818 IF (master) WRITE (stdout,90) trim(vname(1,idmomf)), &
4819 & trim(dav(ng)%name)
4820 exit_flag=2
4821 RETURN
4822 END IF
4823# endif
4824
4825# if defined I4DVAR || defined BACKGROUND
4826!
4827! Set unlimited time record dimension to the appropriate value.
4828!
4829 dav(ng)%Rindex=rec_size
4830 fcount=dav(ng)%Fcount
4831 dav(ng)%Nrec(fcount)=rec_size
4832# endif
4833
4834 END IF query
4835!
4836 10 FORMAT (/,2x,'DEF_MOD_PIO - creating model/observation', &
4837 & ' file,',t56,'Grid ',i2.2,': ',a)
4838 20 FORMAT (/,2x,'DEF_MOD_PIO - inquiring model/observation', &
4839 & ' file,',t56,'Grid ',i2.2,': ',a)
4840 30 FORMAT (/,' DEF_MOD_PIO - unable to open observation/model', &
4841 & ' file: ',a)
4842 40 FORMAT (/,' DEF_MOD_PIO - unable to create model/observation', &
4843 & ' file:',1x,a)
4844 50 FORMAT (/,' DEF_MOD_PIO - unable to create global attribute: ', &
4845 & a,/,11x,a)
4846 60 FORMAT (/,' DEF_MOD_PIO - unable to copy attribute; ',a,1x, &
4847 & 'for variable: ',a,/,11x,'in file: 'a)
4848 70 FORMAT (/,' DEF_MOD_PIO - unable to inquire attribute ',i2.2,1x, &
4849 & 'name for variable: ',a,/,11x,'in file: 'a)
4850 80 FORMAT (/,' DEF_MOD_PIO - unable to copy attribute: ',1x,a,2x, &
4851 & 'for variable: ',1x,a,/,11x,a)
4852 90 FORMAT (/,' DEF_MOD_PIO - unable to find model/observation' &
4853 & ' variable:',1x,a,/,11x,'in file: ',a)
4854!
4855 RETURN
4856 END SUBROUTINE def_mod_pio
4857# endif
4858#endif
4859 END MODULE def_mod_mod
4860
def_dim_mod::def_dim
Definition def_dim.F:24
def_var_mod::def_var
Definition def_var.F:88
distribute_mod::mp_bcasti
Definition distribute.F:95
mod_pio_netcdf::pio_netcdf_get_satt
Definition mod_pio_netcdf.F:84
dateclock_mod
Definition dateclock.F:2
dateclock_mod::time_string
subroutine, public time_string(mytime, date_string)
Definition dateclock.F:1272
def_dim_mod
Definition def_dim.F:2
def_mod_mod
Definition def_mod.F:2
def_mod_mod::def_mod_nf90
subroutine, private def_mod_nf90(ng)
Definition def_mod.F:86
def_mod_mod::def_mod_pio
subroutine, private def_mod_pio(ng)
Definition def_mod.F:2424
def_mod_mod::def_mod
subroutine, public def_mod(ng)
Definition def_mod.F:49
def_var_mod
Definition def_var.F:2
distribute_mod
Definition distribute.F:3
mod_fourdvar
Definition mod_fourdvar.F:2
mod_fourdvar::ndatum
integer, dimension(:), allocatable ndatum
Definition mod_fourdvar.F:409
mod_fourdvar::nobsvar
integer, dimension(:), allocatable nobsvar
Definition mod_fourdvar.F:372
mod_fourdvar::havenlmod
logical, dimension(:), allocatable havenlmod
Definition mod_fourdvar.F:554
mod_fourdvar::havetlmod
logical, dimension(:), allocatable havetlmod
Definition mod_fourdvar.F:555
mod_fourdvar::nsurvey
integer, dimension(:), allocatable nsurvey
Definition mod_fourdvar.F:413
mod_iounits
Definition mod_iounits.F:2
mod_iounits::ioerror
integer ioerror
Definition mod_iounits.F:313
mod_iounits::obs
type(t_io), dimension(:), allocatable obs
Definition mod_iounits.F:232
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::idoerr
integer idoerr
Definition mod_ncparam.F:254
mod_ncparam::idnlmo
integer idnlmo
Definition mod_ncparam.F:243
mod_ncparam::idobss
integer idobss
Definition mod_ncparam.F:248
mod_ncparam::idtlmo
integer idtlmo
Definition mod_ncparam.F:304
mod_ncparam::idobst
integer idobst
Definition mod_ncparam.F:249
mod_ncparam::io_nf90
integer, parameter io_nf90
Definition mod_ncparam.F:95
mod_ncparam::version
character(len=5) version
Definition mod_ncparam.F:586
mod_ncparam::idinno
integer idinno
Definition mod_ncparam.F:216
mod_ncparam::idolat
integer idolat
Definition mod_ncparam.F:255
mod_ncparam::idopro
integer idopro
Definition mod_ncparam.F:258
mod_ncparam::nv
integer, parameter nv
Definition mod_ncparam.F:105
mod_ncparam::idobsy
integer idobsy
Definition mod_ncparam.F:251
mod_ncparam::idobsd
integer idobsd
Definition mod_ncparam.F:247
mod_ncparam::idnlmi
integer idnlmi
Definition mod_ncparam.F:242
mod_ncparam::idolon
integer idolon
Definition mod_ncparam.F:256
mod_ncparam::idnlmf
integer idnlmf
Definition mod_ncparam.F:241
mod_ncparam::io_pio
integer, parameter io_pio
Definition mod_ncparam.F:96
mod_ncparam::idomet
integer idomet
Definition mod_ncparam.F:257
mod_ncparam::idoval
integer idoval
Definition mod_ncparam.F:260
mod_ncparam::date_str
character(len=44) date_str
Definition mod_ncparam.F:588
mod_ncparam::history
character(len=maxlen) history
Definition mod_ncparam.F:590
mod_ncparam::idfsur
integer idfsur
Definition mod_ncparam.F:206
mod_ncparam::idobsz
integer idobsz
Definition mod_ncparam.F:252
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_ncparam::idresi
integer idresi
Definition mod_ncparam.F:299
mod_ncparam::svn_rev
character(len=80) svn_rev
Definition mod_ncparam.F:617
mod_ncparam::vname
character(len=maxlen), dimension(6, 0:nv) vname
Definition mod_ncparam.F:591
mod_ncparam::idbgth
integer idbgth
Definition mod_ncparam.F:196
mod_ncparam::idnlmu
integer idnlmu
Definition mod_ncparam.F:245
mod_ncparam::idoday
integer idoday
Definition mod_ncparam.F:253
mod_ncparam::idbger
integer idbger
Definition mod_ncparam.F:195
mod_ncparam::idmomi
integer idmomi
Definition mod_ncparam.F:231
mod_ncparam::idobsx
integer idobsx
Definition mod_ncparam.F:250
mod_ncparam::idnlmp
integer idnlmp
Definition mod_ncparam.F:244
mod_ncparam::idincr
integer idincr
Definition mod_ncparam.F:215
mod_ncparam::svn_url
character(len=256) svn_url
Definition mod_ncparam.F:618
mod_ncparam::idotyp
integer idotyp
Definition mod_ncparam.F:259
mod_ncparam::idmomf
integer idmomf
Definition mod_ncparam.F:232
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::netcdf_close
subroutine, public netcdf_close(ng, model, ncid, ncname, lupdate)
Definition mod_netcdf.F:8930
mod_netcdf::netcdf_get_satt
subroutine, public netcdf_get_satt(ng, model, ncname, varid, attname, attvalue, foundit, ncid)
Definition mod_netcdf.F:2339
mod_netcdf::var_achar
character(len=1024), dimension(nvara) var_achar
Definition mod_netcdf.F:183
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::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::rec_size
integer rec_size
Definition mod_netcdf.F:156
mod_netcdf::var_aname
character(len=100), dimension(nvara) var_aname
Definition mod_netcdf.F:181
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_netcdf::nf_frst
integer, parameter nf_frst
Definition mod_netcdf.F:193
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_parallel::outthread
logical outthread
Definition mod_parallel.F:48
mod_param
Definition mod_param.F:2
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::iobounds
type(t_iobounds), dimension(:), allocatable iobounds
Definition mod_param.F:282
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::pio_netcdf_copy_att
subroutine pio_netcdf_copy_att(ng, model, varname, attname, inp_ncname, inp_piofile, inp_varid, out_ncname, out_piofile, out_varid)
Definition mod_pio_netcdf.F:597
mod_pio_netcdf::var_desc
type(var_desc_t), dimension(:), pointer var_desc
Definition mod_pio_netcdf.F:437
mod_pio_netcdf::pio_frst
integer, parameter pio_frst
Definition mod_pio_netcdf.F:574
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_close
subroutine, public pio_netcdf_close(ng, model, piofile, ncname, lupdate)
Definition mod_pio_netcdf.F:8858
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::nouter
integer nouter
Definition mod_scalars.F:354
mod_scalars::spval
real(dp), parameter spval
Definition mod_scalars.F:821
mod_scalars::ntimes
integer, dimension(:), allocatable ntimes
Definition mod_scalars.F:336
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
mod_scalars::balance
logical, dimension(:), allocatable balance
Definition mod_scalars.F:1314
mod_scalars::sec2day
real(dp), parameter sec2day
Definition mod_scalars.F:817
mod_scalars::ldefmod
logical, dimension(:), allocatable ldefmod
Definition mod_scalars.F:967
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::time
real(dp), dimension(:), allocatable time
Definition mod_scalars.F:262
mod_scalars::initime
real(dp), dimension(:), allocatable initime
Definition mod_scalars.F:276
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
mod_strings
Definition mod_strings.F:2
mod_strings::rdir
character(len=256) rdir
Definition mod_strings.F:281
mod_strings::hdir
character(len=256) hdir
Definition mod_strings.F:271
mod_strings::my_cpu
character(len=80) my_cpu
Definition mod_strings.F:258
mod_strings::hfile
character(len=256) hfile
Definition mod_strings.F:276
mod_strings::my_os
character(len=80) my_os
Definition mod_strings.F:257
mod_strings::my_fort
character(len=80) my_fort
Definition mod_strings.F:259
mod_strings::my_fflags
character(len=512) my_fflags
Definition mod_strings.F:261
mod_strings::my_fc
character(len=80) my_fc
Definition mod_strings.F:260
strings_mod
Definition strings.F:2
strings_mod::uppercase
character(len(sinp)) function, public uppercase(sinp)
Definition strings.F:582
strings_mod::find_string
logical function, public find_string(a, asize, string, aindex)
Definition strings.F:417
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52