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

Functions/Subroutines

subroutine, public def_hessian (ng)
 
subroutine, private def_hessian_nf90 (ng)
 
subroutine, private def_hessian_pio (ng)
 

Function/Subroutine Documentation

◆ def_hessian()

subroutine, public def_hessian_mod::def_hessian ( integer, intent(in) ng)

Definition at line 56 of file def_hessian.F.

57!***********************************************************************
58!
59! Imported variable declarations.
60!
61 integer, intent(in) :: ng
62!
63! Local variable declarations.
64!
65 character (len=*), parameter :: MyFile = &
66 & __FILE__
67!
68!-----------------------------------------------------------------------
69! Create a new history file according to IO type.
70!-----------------------------------------------------------------------
71!
72 SELECT CASE (hss(ng)%IOtype)
73 CASE (io_nf90)
74 CALL def_hessian_nf90 (ng)
75
76# if defined PIO_LIB && defined DISTRIBUTE
77 CASE (io_pio)
78 CALL def_hessian_pio (ng)
79# endif
80 CASE DEFAULT
81 IF (master) WRITE (stdout,10) hss(ng)%IOtype
82 exit_flag=3
83 END SELECT
84 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
85!
86 10 FORMAT (' DEF_HESSIAN - Illegal output file type, io_type = ',i0, &
87 & /,15x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
88!
89 RETURN

References def_hessian_nf90(), def_hessian_pio(), mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::hss, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_parallel::master, mod_scalars::noerror, and mod_iounits::stdout.

Referenced by i4dvar_mod::increment(), r4dvar_mod::increment(), and rbl4dvar_mod::increment().

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

◆ def_hessian_nf90()

subroutine, private def_hessian_mod::def_hessian_nf90 ( integer, intent(in) ng)
private

Definition at line 93 of file def_hessian.F.

94!**********************************************************************
95!
96 USE mod_netcdf
97!
98! Imported variable declarations.
99!
100 integer, intent(in) :: ng
101!
102! Local variable declarations.
103!
104 logical :: got_var(NV)
105!
106 integer, parameter :: Natt = 25
107
108 integer :: i, j, ifield, itrc, nrec, nvd, nvd3, nvd4
109 integer :: recdim, status, varid
110# ifdef ADJUST_BOUNDARY
111 integer :: IorJdim, brecdim
112# endif
113# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
114 integer :: frecdim
115# endif
116# if defined POSTERIOR_EOFS && defined WEAK_CONSTRAINT
117 integer :: NpostDim
118# endif
119 integer :: DimIDs(nDimID)
120 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
121# ifdef ADJUST_BOUNDARY
122 integer :: t2dobc(4)
123# endif
124# ifdef EVOLVED_LCZ
125 integer :: MinnerDim, NinnerDim, NouterDim
126 integer :: vardim(2)
127# endif
128
129# ifdef SOLVE3D
130 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
131# ifdef ADJUST_BOUNDARY
132 integer :: t3dobc(5)
133# endif
134# ifdef ADJUST_STFLUX
135 integer :: t3dfrc(4)
136# endif
137# endif
138# ifdef ADJUST_WSTRESS
139 integer :: u3dfrc(4), v3dfrc(4)
140# endif
141!
142 real(r8) :: Aval(6)
143!
144 character (len=256) :: ncname
145 character (len=MaxLen) :: Vinfo(Natt)
146
147 character (len=*), parameter :: MyFile = &
148 & __FILE__//", def_hessian_nf90"
149!
150 sourcefile=myfile
151!
152!-----------------------------------------------------------------------
153! Set and report file name.
154!-----------------------------------------------------------------------
155!
156 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
157 ncname=hss(ng)%name
158!
159 IF (master) THEN
160 IF (ldefhss(ng)) THEN
161 WRITE (stdout,10) ng, trim(ncname)
162 ELSE
163 WRITE (stdout,20) ng, trim(ncname)
164 END IF
165 END IF
166!
167!=======================================================================
168! Create a new Hessian eigenvectors file.
169!=======================================================================
170!
171 define : IF (ldefhss(ng)) THEN
172 CALL netcdf_create (ng, iadm, trim(ncname), hss(ng)%ncid)
173 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
174 IF (master) WRITE (stdout,30) trim(ncname)
175 RETURN
176 END IF
177!
178!-----------------------------------------------------------------------
179! Define file dimensions.
180!-----------------------------------------------------------------------
181!
182 dimids=0
183!
184 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xi_rho', &
185 & iobounds(ng)%xi_rho, dimids( 1))
186 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
187
188 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xi_u', &
189 & iobounds(ng)%xi_u, dimids( 2))
190 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
191
192 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xi_v', &
193 & iobounds(ng)%xi_v, dimids( 3))
194 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
195
196 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xi_psi', &
197 & iobounds(ng)%xi_psi, dimids( 4))
198 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
199
200 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'eta_rho', &
201 & iobounds(ng)%eta_rho, dimids( 5))
202 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
203
204 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'eta_u', &
205 & iobounds(ng)%eta_u, dimids( 6))
206 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
207
208 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'eta_v', &
209 & iobounds(ng)%eta_v, dimids( 7))
210 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
211
212 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'eta_psi', &
213 & iobounds(ng)%eta_psi, dimids( 8))
214 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
215
216# ifdef ADJUST_BOUNDARY
217 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'IorJ', &
218 & iobounds(ng)%IorJ, iorjdim)
219 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
220# endif
221
222# if defined WRITE_WATER && defined MASKING
223 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xy_rho', &
224 & iobounds(ng)%xy_rho, dimids(17))
225 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
226
227 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xy_u', &
228 & iobounds(ng)%xy_u, dimids(18))
229 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
230
231 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xy_v', &
232 & iobounds(ng)%xy_v, dimids(19))
233 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
234# endif
235
236# ifdef EVOLVED_LCZ
237
238 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'Ninner', &
239 & ninner, ninnerdim)
240 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
241
242 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'Minner', &
243 & ninner+1, minnerdim)
244 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
245
246 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'Nouter', &
247 & nouter, nouterdim)
248 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
249
250# endif
251
252# ifdef SOLVE3D
253# if defined WRITE_WATER && defined MASKING
254 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xyz_rho', &
255 & iobounds(ng)%xy_rho*n(ng), dimids(20))
256 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
257
258 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xyz_u', &
259 & iobounds(ng)%xy_u*n(ng), dimids(21))
260 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
261
262 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xyz_v', &
263 & iobounds(ng)%xy_v*n(ng), dimids(22))
264 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
265
266 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xyz_w', &
267 & iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
268 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
269# endif
270
271 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'N', &
272 & n(ng), dimids( 9))
273 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
274
275 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 's_rho', &
276 & n(ng), dimids( 9))
277 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
278
279 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 's_w', &
280 & n(ng)+1, dimids(10))
281 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
282
283 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'tracer', &
284 & nt(ng), dimids(11))
285 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
286
287# ifdef SEDIMENT
288 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'NST', &
289 & nst, dimids(32))
290 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
291
292 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'Nbed', &
293 & nbed, dimids(16))
294 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
295
296# if defined WRITE_WATER && defined MASKING
297 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'xybed', &
298 & iobounds(ng)%xy_rho*nbed, dimids(24))
299 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
300# endif
301# endif
302
303# ifdef ECOSIM
304 status=def_dim(ng, inlm, hss(ng)%ncid, ncname, 'Nbands', &
305 & nbands, dimids(33))
306 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
307
308 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'Nphy', &
309 & nphy, dimids(25))
310 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
311
312 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'Nbac', &
313 & nbac, dimids(26))
314 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
315
316 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'Ndom', &
317 & ndom, dimids(27))
318 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
319
320 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'Nfec', &
321 & nfec, dimids(28))
322 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
323# endif
324# endif
325
326 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'boundary', &
327 & 4, dimids(14))
328 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
329
330# ifdef FOUR_DVAR
331 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'Nstate', &
332 & nstatevar(ng), dimids(29))
333 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
334# endif
335
336# if defined POSTERIOR_EOFS && defined WEAK_CONSTRAINT
337 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'Nposterior', &
338 & nposti+1, npostdim)
339 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
340# endif
341
342# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
343 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'frc_adjust', &
344 & nfrec(ng), dimids(30))
345 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
346# endif
347
348# ifdef ADJUST_BOUNDARY
349 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, 'obc_adjust', &
350 & nbrec(ng), dimids(31))
351 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
352# endif
353
354 status=def_dim(ng, iadm, hss(ng)%ncid, ncname, &
355 & trim(adjustl(vname(5,idtime))), &
356 & nf90_unlimited, dimids(12))
357 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
358
359 recdim=dimids(12)
360# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
361 frecdim=dimids(30)
362# endif
363# ifdef ADJUST_BOUNDARY
364 brecdim=dimids(31)
365# endif
366!
367! Set number of dimensions for output variables.
368!
369# if defined WRITE_WATER && defined MASKING
370 nvd3=2
371 nvd4=2
372# else
373 nvd3=3
374 nvd4=4
375# endif
376!
377! Define dimension vectors for staggered tracer type variables.
378!
379# if defined WRITE_WATER && defined MASKING
380 t2dgrd(1)=dimids(17)
381 t2dgrd(2)=dimids(12)
382# ifdef SOLVE3D
383 t3dgrd(1)=dimids(20)
384 t3dgrd(2)=dimids(12)
385# endif
386# else
387 t2dgrd(1)=dimids( 1)
388 t2dgrd(2)=dimids( 5)
389 t2dgrd(3)=dimids(12)
390# ifdef SOLVE3D
391 t3dgrd(1)=dimids( 1)
392 t3dgrd(2)=dimids( 5)
393 t3dgrd(3)=dimids( 9)
394 t3dgrd(4)=dimids(12)
395# endif
396# ifdef ADJUST_STFLUX
397 t3dfrc(1)=dimids( 1)
398 t3dfrc(2)=dimids( 5)
399 t3dfrc(3)=frecdim
400 t3dfrc(4)=dimids(12)
401# endif
402# endif
403# ifdef ADJUST_BOUNDARY
404 t2dobc(1)=iorjdim
405 t2dobc(2)=dimids(14)
406 t2dobc(3)=brecdim
407 t2dobc(4)=dimids(12)
408# ifdef SOLVE3D
409 t3dobc(1)=iorjdim
410 t3dobc(2)=dimids( 9)
411 t3dobc(3)=dimids(14)
412 t3dobc(4)=brecdim
413 t3dobc(5)=dimids(12)
414# endif
415# endif
416!
417! Define dimension vectors for staggered u-momentum type variables.
418!
419# if defined WRITE_WATER && defined MASKING
420 u2dgrd(1)=dimids(18)
421 u2dgrd(2)=dimids(12)
422# ifdef SOLVE3D
423 u3dgrd(1)=dimids(21)
424 u3dgrd(2)=dimids(12)
425# endif
426# else
427 u2dgrd(1)=dimids( 2)
428 u2dgrd(2)=dimids( 6)
429 u2dgrd(3)=dimids(12)
430# ifdef SOLVE3D
431 u3dgrd(1)=dimids( 2)
432 u3dgrd(2)=dimids( 6)
433 u3dgrd(3)=dimids( 9)
434 u3dgrd(4)=dimids(12)
435# endif
436# ifdef ADJUST_WSTRESS
437 u3dfrc(1)=dimids( 2)
438 u3dfrc(2)=dimids( 6)
439 u3dfrc(3)=frecdim
440 u3dfrc(4)=dimids(12)
441# endif
442# endif
443!
444! Define dimension vectors for staggered v-momentum type variables.
445!
446# if defined WRITE_WATER && defined MASKING
447 v2dgrd(1)=dimids(19)
448 v2dgrd(2)=dimids(12)
449# ifdef SOLVE3D
450 v3dgrd(1)=dimids(22)
451 v3dgrd(2)=dimids(12)
452# endif
453# else
454 v2dgrd(1)=dimids( 3)
455 v2dgrd(2)=dimids( 7)
456 v2dgrd(3)=dimids(12)
457# ifdef SOLVE3D
458 v3dgrd(1)=dimids( 3)
459 v3dgrd(2)=dimids( 7)
460 v3dgrd(3)=dimids( 9)
461 v3dgrd(4)=dimids(12)
462# endif
463# ifdef ADJUST_WSTRESS
464 v3dfrc(1)=dimids( 3)
465 v3dfrc(2)=dimids( 7)
466 v3dfrc(3)=frecdim
467 v3dfrc(4)=dimids(12)
468# endif
469# endif
470# ifdef SOLVE3D
471!
472! Define dimension vector for staggered w-momentum type variables.
473!
474# if defined WRITE_WATER && defined MASKING
475 w3dgrd(1)=dimids(23)
476 w3dgrd(2)=dimids(12)
477# else
478 w3dgrd(1)=dimids( 1)
479 w3dgrd(2)=dimids( 5)
480 w3dgrd(3)=dimids(10)
481 w3dgrd(4)=dimids(12)
482# endif
483# endif
484!
485! Initialize unlimited time record dimension.
486!
487 hss(ng)%Rindex=0
488!
489! Initialize local information variable arrays.
490!
491 DO i=1,natt
492 DO j=1,len(vinfo(1))
493 vinfo(i)(j:j)=' '
494 END DO
495 END DO
496 DO i=1,6
497 aval(i)=0.0_r8
498 END DO
499!
500!-----------------------------------------------------------------------
501! Define time-recordless information variables.
502!-----------------------------------------------------------------------
503!
504 CALL def_info (ng, iadm, hss(ng)%ncid, ncname, dimids)
505 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
506!
507!-----------------------------------------------------------------------
508! Define time-varying variables.
509!-----------------------------------------------------------------------
510!
511! Define number of converged Ritz eigenvalues.
512!
513 vinfo( 1)='nConvRitz'
514 vinfo( 2)='number of converged Ritz eigenvalues'
515 status=def_var(ng, iadm, hss(ng)%ncid, varid, nf90_int, &
516 & 1, (/0/), aval, vinfo, ncname, &
517 & setparaccess = .false.)
518 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
519!
520! Define Ritz eigenvalues.
521!
522 vinfo( 1)='Ritz'
523 vinfo( 2)='Ritz eigenvalues'
524 status=def_var(ng, iadm, hss(ng)%ncid, varid, nf_type, &
525 & 1, (/recdim/), aval, vinfo, ncname, &
526 & setparaccess = .true.)
527 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
528!
529! Define accuracy of Ritz eigenvalues .
530!
531 vinfo( 1)='Ritz_error'
532 vinfo( 2)='accuracy of Ritz eigenvalues'
533 status=def_var(ng, iadm, hss(ng)%ncid, varid, nf_type, &
534 & 1, (/recdim/), aval, vinfo, ncname, &
535 & setparaccess = .true.)
536 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
537
538# ifdef POSTERIOR_EOFS
539!
540! Define posterior analysis error covariance matrix trace.
541!
542 vinfo( 1)='ae_trace'
543 vinfo( 2)='posterior analysis error covariance matrix trace'
544 status=def_var(ng, iadm, hss(ng)%ncid, varid, nf_type, &
545 & 1, (/npostdim/), aval, vinfo, ncname, &
546 & setparaccess = .false.)
547 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
548# endif
549!
550! Define model time.
551!
552 vinfo( 1)=vname(1,idtime)
553 vinfo( 2)=vname(2,idtime)
554 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
555 vinfo( 4)=trim(rclock%calendar)
556 vinfo(14)=vname(4,idtime)
557 vinfo(21)=vname(6,idtime)
558 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(idtime), &
559 & nf_tout, 1, (/recdim/), aval, vinfo,ncname, &
560 & setparaccess = .true.)
561 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
562!
563! Define free-surface.
564!
565 vinfo( 1)=vname(1,idfsur)
566 WRITE (vinfo( 2),40) trim(vname(2,idfsur))
567 vinfo( 3)='nondimensional'
568 vinfo(14)=vname(4,idfsur)
569 vinfo(16)=vname(1,idtime)
570# if defined WRITE_WATER && defined MASKING
571 vinfo(20)='mask_rho'
572# endif
573 vinfo(21)=vname(6,idfsur)
574 vinfo(22)='coordinates'
575 aval(5)=real(iinfo(1,idfsur,ng),r8)
576 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(idfsur), &
577 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
578 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
579
580# ifdef ADJUST_BOUNDARY
581!
582! Define free-surface open boundaries.
583!
584 IF (any(lobc(:,isfsur,ng))) THEN
585 ifield=idsbry(isfsur)
586 vinfo( 1)=vname(1,ifield)
587 WRITE (vinfo( 2),40) trim(vname(2,ifield))
588 vinfo( 3)='nondimensional'
589 vinfo(14)=vname(4,ifield)
590 vinfo(16)=vname(1,idtime)
591 vinfo(21)=vname(6,ifield)
592 aval(5)=real(iinfo(1,ifield,ng),r8)
593 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(ifield), &
594 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
595 & setfillval = .false.)
596 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
597 END IF
598# endif
599!
600! Define 2D U-momentum component.
601!
602 vinfo( 1)=vname(1,idubar)
603 WRITE (vinfo( 2),40) trim(vname(2,idubar))
604 vinfo( 3)='nondimensional'
605 vinfo(14)=vname(4,idubar)
606 vinfo(16)=vname(1,idtime)
607# if defined WRITE_WATER && defined MASKING
608 vinfo(20)='mask_u'
609# endif
610 vinfo(21)=vname(6,idubar)
611 vinfo(22)='coordinates'
612 aval(5)=real(iinfo(1,idubar,ng),r8)
613 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(idubar), &
614 & nf_fout, nvd3, u2dgrd, aval, vinfo, ncname)
615 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
616
617# ifdef ADJUST_BOUNDARY
618!
619! Define 2D U-momentum component open boundaries.
620!
621 IF (any(lobc(:,isubar,ng))) THEN
622 ifield=idsbry(isubar)
623 vinfo( 1)=vname(1,ifield)
624 WRITE (vinfo( 2),40) trim(vname(2,ifield))
625 vinfo( 3)='nondimensional'
626 vinfo(14)=vname(4,ifield)
627 vinfo(16)=vname(1,idtime)
628 vinfo(21)=vname(6,ifield)
629 aval(5)=real(iinfo(1,ifield,ng),r8)
630 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(ifield), &
631 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
632 & setfillval = .false.)
633 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
634 END IF
635# endif
636!
637! Define 2D V-momentum component.
638!
639 vinfo( 1)=vname(1,idvbar)
640 WRITE (vinfo( 2),40) trim(vname(2,idvbar))
641 vinfo( 3)='nondimensional'
642 vinfo(14)=vname(4,idvbar)
643 vinfo(16)=vname(1,idtime)
644# if defined WRITE_WATER && defined MASKING
645 vinfo(20)='mask_v'
646# endif
647 vinfo(21)=vname(6,idvbar)
648 vinfo(22)='coordinates'
649 aval(5)=real(iinfo(1,idvbar,ng),r8)
650 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(idvbar), &
651 & nf_fout, nvd3, v2dgrd, aval, vinfo, ncname)
652 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
653
654# ifdef ADJUST_BOUNDARY
655!
656! Define 2D V-momentum component open boundaries.
657!
658 IF (any(lobc(:,isvbar,ng))) THEN
659 ifield=idsbry(isvbar)
660 vinfo( 1)=vname(1,ifield)
661 WRITE (vinfo( 2),40) trim(vname(2,ifield))
662 vinfo( 3)='nondimensional'
663 vinfo(14)=vname(4,ifield)
664 vinfo(16)=vname(1,idtime)
665 vinfo(21)=vname(6,ifield)
666 aval(5)=real(iinfo(1,ifield,ng),r8)
667 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(ifield), &
668 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
669 & setfillval = .false.)
670 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
671 END IF
672# endif
673# ifdef SOLVE3D
674!
675! Define 3D U-momentum component.
676!
677 vinfo( 1)=vname(1,iduvel)
678 WRITE (vinfo( 2),40) trim(vname(2,iduvel))
679 vinfo( 3)='nondimensional'
680 vinfo(14)=vname(4,iduvel)
681 vinfo(16)=vname(1,idtime)
682# if defined WRITE_WATER && defined MASKING
683 vinfo(20)='mask_u'
684# endif
685 vinfo(21)=vname(6,iduvel)
686 vinfo(22)='coordinates'
687 aval(5)=real(iinfo(1,iduvel,ng),r8)
688 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(iduvel), &
689 & nf_fout, nvd4, u3dgrd, aval, vinfo, ncname)
690 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
691
692# ifdef ADJUST_BOUNDARY
693!
694! Define 3D U-momentum component open boundaries.
695!
696 IF (any(lobc(:,isuvel,ng))) THEN
697 ifield=idsbry(isuvel)
698 vinfo( 1)=vname(1,ifield)
699 WRITE (vinfo( 2),40) trim(vname(2,ifield))
700 vinfo( 3)='nondimensional'
701 vinfo(14)=vname(4,ifield)
702 vinfo(16)=vname(1,idtime)
703 vinfo(21)=vname(6,ifield)
704 aval(5)=real(iinfo(1,ifield,ng),r8)
705 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(ifield), &
706 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
707 & setfillval = .false.)
708 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
709 END IF
710# endif
711!
712! Define 3D V-momentum component.
713!
714 vinfo( 1)=vname(1,idvvel)
715 WRITE (vinfo( 2),40) trim(vname(2,idvvel))
716 vinfo( 3)='nondimensional'
717 vinfo(14)=vname(4,idvvel)
718 vinfo(16)=vname(1,idtime)
719# if defined WRITE_WATER && defined MASKING
720 vinfo(20)='mask_v'
721# endif
722 vinfo(21)=vname(6,idvvel)
723 vinfo(22)='coordinates'
724 aval(5)=real(iinfo(1,idvvel,ng),r8)
725 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(idvvel), &
726 & nf_fout, nvd4, v3dgrd, aval, vinfo, ncname)
727 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
728
729# ifdef ADJUST_BOUNDARY
730!
731! Define 3D V-momentum component open boundaries.
732!
733 IF (any(lobc(:,isvvel,ng))) THEN
734 ifield=idsbry(isvvel)
735 vinfo( 1)=vname(1,ifield)
736 WRITE (vinfo( 2),40) trim(vname(2,ifield))
737 vinfo( 3)='nondimensional'
738 vinfo(14)=vname(4,ifield)
739 vinfo(16)=vname(1,idtime)
740 vinfo(21)=vname(6,ifield)
741 aval(5)=real(iinfo(1,ifield,ng),r8)
742 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(ifield), &
743 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
744 & setfillval = .false.)
745 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
746 END IF
747# endif
748!
749! Define tracer type variables.
750!
751 DO itrc=1,nt(ng)
752 vinfo( 1)=vname(1,idtvar(itrc))
753 WRITE (vinfo( 2),40) trim(vname(2,idtvar(itrc)))
754 vinfo( 3)='nondimensional'
755 vinfo(14)=vname(4,idtvar(itrc))
756 vinfo(16)=vname(1,idtime)
757# ifdef SEDIMENT
758 DO i=1,nst
759 IF (itrc.eq.idsed(i)) THEN
760 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
761 END IF
762 END DO
763# endif
764# if defined WRITE_WATER && defined MASKING
765 vinfo(20)='mask_rho'
766# endif
767 vinfo(21)=vname(6,idtvar(itrc))
768 vinfo(22)='coordinates'
769 aval(5)=real(r3dvar,r8)
770 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Tid(itrc), &
771 & nf_fout, nvd4, t3dgrd, aval, vinfo, ncname)
772 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
773 END DO
774
775# ifdef ADJUST_BOUNDARY
776!
777! Define tracer type variables open boundaries.
778!
779 DO itrc=1,nt(ng)
780 IF (any(lobc(:,istvar(itrc),ng))) THEN
781 ifield=idsbry(istvar(itrc))
782 vinfo( 1)=vname(1,ifield)
783 WRITE (vinfo( 2),40) trim(vname(2,ifield))
784 vinfo( 3)='nondimensional'
785 vinfo(14)=vname(4,ifield)
786 vinfo(16)=vname(1,idtime)
787# ifdef SEDIMENT
788 DO i=1,nst
789 IF (itrc.eq.idsed(i)) THEN
790 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
791 END IF
792 END DO
793# endif
794 vinfo(21)=vname(6,ifield)
795 aval(5)=real(iinfo(1,ifield,ng),r8)
796 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(ifield), &
797 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
798 & setfillval = .false.)
799 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
800 END IF
801 END DO
802# endif
803# ifdef ADJUST_STFLUX
804!
805! Define surface tracer fluxes.
806!
807 DO itrc=1,nt(ng)
808 IF (lstflux(itrc,ng)) THEN
809 vinfo( 1)=vname(1,idtsur(itrc))
810 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
811 vinfo( 3)='nondimensional'
812 IF (itrc.eq.itemp) THEN
813 vinfo(11)='upward flux, cooling'
814 vinfo(12)='downward flux, heating'
815 ELSE IF (itrc.eq.isalt) THEN
816 vinfo(11)='upward flux, freshening (net precipitation)'
817 vinfo(12)='downward flux, salting (net evaporation)'
818 END IF
819 vinfo(14)=vname(4,idtsur(itrc))
820 vinfo(16)=vname(1,idtime)
821# if defined WRITE_WATER && defined MASKING
822 vinfo(20)='mask_rho'
823# endif
824 vinfo(21)=vname(6,idtsur(itrc))
825 vinfo(22)='coordinates'
826 aval(5)=real(r2dvar,r8)
827 status=def_var(ng, iadm, hss(ng)%ncid, &
828 & hss(ng)%Vid(idtsur(itrc)), &
829 & nf_fout, nvd4, t3dfrc, aval, vinfo, ncname)
830 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
831 END IF
832 END DO
833# endif
834# endif
835# ifdef ADJUST_WSTRESS
836!
837! Define surface U-momentum stress.
838!
839 vinfo( 1)=vname(1,idusms)
840 WRITE (vinfo( 2),40) trim(vname(2,idusms))
841 vinfo( 3)='nondimensional'
842 vinfo(14)=vname(4,idusms)
843 vinfo(16)=vname(1,idtime)
844# if defined WRITE_WATER && defined MASKING
845 vinfo(20)='mask_u'
846# endif
847 vinfo(21)=vname(6,idusms)
848 vinfo(22)='coordinates'
849 aval(5)=real(u2dvar,r8)
850 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(idusms), &
851 & nf_fout, nvd4, u3dfrc, aval, vinfo, ncname)
852 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
853!
854! Define surface V-momentum stress.
855!
856 vinfo( 1)=vname(1,idvsms)
857 WRITE (vinfo( 2),40) trim(vname(2,idvsms))
858 vinfo( 2)=vname(2,idvsms)
859 vinfo( 3)='nondimensional'
860 vinfo(14)=vname(4,idvsms)
861 vinfo(16)=vname(1,idtime)
862# if defined WRITE_WATER && defined MASKING
863 vinfo(20)='mask_v'
864# endif
865 vinfo(21)=vname(6,idvsms)
866 vinfo(22)='coordinates'
867 aval(5)=real(v2dvar,r8)
868 status=def_var(ng, iadm, hss(ng)%ncid, hss(ng)%Vid(idvsms), &
869 & nf_fout, nvd4, v3dfrc, aval, vinfo, ncname)
870 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
871# endif
872!
873!-----------------------------------------------------------------------
874! Leave definition mode.
875!-----------------------------------------------------------------------
876!
877 CALL netcdf_enddef (ng, iadm, ncname, hss(ng)%ncid)
878 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
879!
880!-----------------------------------------------------------------------
881! Write out time-recordless, information variables.
882!-----------------------------------------------------------------------
883!
884 CALL wrt_info (ng, iadm, hss(ng)%ncid, ncname)
885 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
886 END IF define
887!
888!=======================================================================
889! Open an existing Hessian eigenvectors file, check its contents, and
890! prepare for appending data.
891!=======================================================================
892!
893 query: IF (.not.ldefhss(ng)) THEN
894 ncname=hss(ng)%name
895!
896! Open Hessian eigenvectors file for read/write.
897!
898 CALL netcdf_open (ng, iadm, ncname, 1, hss(ng)%ncid)
899 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
900 WRITE (stdout,60) trim(ncname)
901 RETURN
902 END IF
903!
904! Inquire about the dimensions and check for consistency.
905!
906 CALL netcdf_check_dim (ng, iadm, ncname, &
907 & ncid = hss(ng)%ncid)
908 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
909!
910! Inquire about the variables.
911!
912 CALL netcdf_inq_var (ng, iadm, ncname, &
913 & ncid = hss(ng)%ncid)
914 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
915!
916! Initialize logical switches.
917!
918 DO i=1,nv
919 got_var(i)=.false.
920 END DO
921!
922! Scan variable list from input NetCDF and activate switches for
923! Hessian eigenvectors variables. Get variable IDs.
924!
925 DO i=1,n_var
926 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
927 got_var(idtime)=.true.
928 hss(ng)%Vid(idtime)=var_id(i)
929 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
930 got_var(idfsur)=.true.
931 hss(ng)%Vid(idfsur)=var_id(i)
932 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
933 got_var(idubar)=.true.
934 hss(ng)%Vid(idubar)=var_id(i)
935 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
936 got_var(idvbar)=.true.
937 hss(ng)%Vid(idvbar)=var_id(i)
938# ifdef ADJUST_BOUNDARY
939 ELSE IF (trim(var_name(i)).eq. &
940 & trim(vname(1,idsbry(isfsur)))) THEN
941 got_var(idsbry(isfsur))=.true.
942 hss(ng)%Vid(idsbry(isfsur))=var_id(i)
943 ELSE IF (trim(var_name(i)).eq. &
944 & trim(vname(1,idsbry(isubar)))) THEN
945 got_var(idsbry(isubar))=.true.
946 hss(ng)%Vid(idsbry(isubar))=var_id(i)
947 ELSE IF (trim(var_name(i)).eq. &
948 & trim(vname(1,idsbry(isvbar)))) THEN
949 got_var(idsbry(isvbar))=.true.
950 hss(ng)%Vid(idsbry(isvbar))=var_id(i)
951# endif
952# ifdef ADJUST_WSTRESS
953 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
954 got_var(idusms)=.true.
955 hss(ng)%Vid(idusms)=var_id(i)
956 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
957 got_var(idvsms)=.true.
958 hss(ng)%Vid(idvsms)=var_id(i)
959# endif
960# ifdef SOLVE3D
961 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
962 got_var(iduvel)=.true.
963 hss(ng)%Vid(iduvel)=var_id(i)
964 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
965 got_var(idvvel)=.true.
966 hss(ng)%Vid(idvvel)=var_id(i)
967# ifdef ADJUST_BOUNDARY
968 ELSE IF (trim(var_name(i)).eq. &
969 & trim(vname(1,idsbry(isuvel)))) THEN
970 got_var(idsbry(isuvel))=.true.
971 hss(ng)%Vid(idsbry(isuvel))=var_id(i)
972 ELSE IF (trim(var_name(i)).eq. &
973 & trim(vname(1,idsbry(isvvel)))) THEN
974 got_var(idsbry(isvvel))=.true.
975 hss(ng)%Vid(idsbry(isvvel))=var_id(i)
976# endif
977# endif
978 END IF
979# ifdef SOLVE3D
980 DO itrc=1,nt(ng)
981 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
982 got_var(idtvar(itrc))=.true.
983 hss(ng)%Tid(itrc)=var_id(i)
984# ifdef ADJUST_BOUNDARY
985 ELSE IF (trim(var_name(i)).eq. &
986 & trim(vname(1,idsbry(istvar(itrc))))) THEN
987 got_var(idsbry(istvar(itrc)))=.true.
988 hss(ng)%Vid(idsbry(istvar(itrc)))=var_id(i)
989# endif
990# ifdef ADJUST_STFLUX
991 ELSE IF (trim(var_name(i)).eq. &
992 & trim(vname(1,idtsur(itrc)))) THEN
993 got_var(idtsur(itrc))=.true.
994 hss(ng)%Vid(idtsur(itrc))=var_id(i)
995# endif
996 END IF
997 END DO
998# endif
999 END DO
1000!
1001! Check if Hessian eigenvectors variables are available in input
1002! NetCDF file.
1003!
1004 IF (.not.got_var(idtime)) THEN
1005 IF (master) WRITE (stdout,70) trim(vname(1,idtime)), &
1006 & trim(ncname)
1007 exit_flag=3
1008 RETURN
1009 END IF
1010 IF (.not.got_var(idfsur)) THEN
1011 IF (master) WRITE (stdout,70) trim(vname(1,idfsur)), &
1012 & trim(ncname)
1013 exit_flag=3
1014 RETURN
1015 END IF
1016 IF (.not.got_var(idubar)) THEN
1017 IF (master) WRITE (stdout,70) trim(vname(1,idubar)), &
1018 & trim(ncname)
1019 exit_flag=3
1020 RETURN
1021 END IF
1022 IF (.not.got_var(idvbar)) THEN
1023 IF (master) WRITE (stdout,70) trim(vname(1,idvbar)), &
1024 & trim(ncname)
1025 exit_flag=3
1026 RETURN
1027 END IF
1028# ifdef ADJUST_BOUNDARY
1029 IF (.not.got_var(idsbry(isfsur))) THEN
1030 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isfsur))), &
1031 & trim(ncname)
1032 exit_flag=3
1033 RETURN
1034 END IF
1035 IF (.not.got_var(idsbry(isubar))) THEN
1036 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isubar))), &
1037 & trim(ncname)
1038 exit_flag=3
1039 RETURN
1040 END IF
1041 IF (.not.got_var(idsbry(isvbar))) THEN
1042 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvbar))), &
1043 & trim(ncname)
1044 exit_flag=3
1045 RETURN
1046 END IF
1047# endif
1048# ifdef ADJUST_WSTRESS
1049 IF (.not.got_var(idusms)) THEN
1050 IF (master) WRITE (stdout,70) trim(vname(1,idusms)), &
1051 & trim(ncname)
1052 exit_flag=3
1053 RETURN
1054 END IF
1055 IF (.not.got_var(idvsms)) THEN
1056 IF (master) WRITE (stdout,70) trim(vname(1,idvsms)), &
1057 & trim(ncname)
1058 exit_flag=3
1059 RETURN
1060 END IF
1061# endif
1062# ifdef SOLVE3D
1063 IF (.not.got_var(iduvel)) THEN
1064 IF (master) WRITE (stdout,70) trim(vname(1,iduvel)), &
1065 & trim(ncname)
1066 exit_flag=3
1067 RETURN
1068 END IF
1069 IF (.not.got_var(idvvel)) THEN
1070 IF (master) WRITE (stdout,70) trim(vname(1,idvvel)), &
1071 & trim(ncname)
1072 exit_flag=3
1073 RETURN
1074 END IF
1075# ifdef ADJUST_BOUNDARY
1076 IF (.not.got_var(idsbry(isuvel))) THEN
1077 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isuvel))), &
1078 & trim(ncname)
1079 exit_flag=3
1080 RETURN
1081 END IF
1082 IF (.not.got_var(idsbry(isvvel))) THEN
1083 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvvel))), &
1084 & trim(ncname)
1085 exit_flag=3
1086 RETURN
1087 END IF
1088# endif
1089# endif
1090# ifdef SOLVE3D
1091 DO itrc=1,nt(ng)
1092 IF (.not.got_var(idtvar(itrc))) THEN
1093 IF (master) WRITE (stdout,70) trim(vname(1,idtvar(itrc))), &
1094 & trim(ncname)
1095 exit_flag=3
1096 RETURN
1097 END IF
1098# ifdef ADJUST_BOUNDARY
1099 IF (.not.got_var(idsbry(istvar(itrc)))) THEN
1100 IF (master) WRITE (stdout,70) &
1101 & trim(vname(1,idsbry(istvar(itrc)))), &
1102 & trim(ncname)
1103 exit_flag=3
1104 RETURN
1105 END IF
1106# endif
1107# ifdef ADJUST_STFLUX
1108 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
1109 IF (master) WRITE (stdout,70) trim(vname(1,idtsur(itrc))), &
1110 & trim(ncname)
1111 exit_flag=3
1112 RETURN
1113 END IF
1114# endif
1115 END DO
1116# endif
1117!
1118! Set unlimited time record dimension to the appropriate value.
1119!
1120 hss(ng)%Rindex=rec_size
1121 END IF query
1122!
1123 10 FORMAT (2x,'DEF_HESSIAN_NF90 - creating Hessian file,',t56, &
1124 & 'Grid ',i2.2,': ',a)
1125 20 FORMAT (2x,'DEF_HESSIAN_NF90 - inquiring Hessian file,',t56, &
1126 & 'Grid ',i2.2,': ',a)
1127 30 FORMAT (/,' DEF_HESSIAN_NF90 - unable to create Hessian NetCDF', &
1128 & ' file:',1x,a)
1129 40 FORMAT (a,', Hessian eigenvectors')
1130 50 FORMAT (1pe11.4,1x,'millimeter')
1131 60 FORMAT (/,' DEF_HESSIAN_NF90 - unable to open Hessian NetCDF', &
1132 & ' file: ',a)
1133 70 FORMAT (/,' DEF_HESSIAN_NF90 - unable to find variable: ',a,2x, &
1134 & ' in Hessian NetCDF file: ',a)
1135!
1136 RETURN
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::nf_tout
integer, parameter nf_tout
Definition mod_netcdf.F:207
mod_netcdf::netcdf_check_dim
subroutine, public netcdf_check_dim(ng, model, ncname, ncid)
Definition mod_netcdf.F:538
mod_netcdf::netcdf_open
subroutine, public netcdf_open(ng, model, ncname, omode, ncid)
Definition mod_netcdf.F:9293
mod_netcdf::nf_fout
integer, parameter nf_fout
Definition mod_netcdf.F:188
mod_netcdf::netcdf_enddef
subroutine, public netcdf_enddef(ng, model, ncname, ncid)
Definition mod_netcdf.F:9220
mod_netcdf::var_name
character(len=100), dimension(mvars) var_name
Definition mod_netcdf.F:169
mod_netcdf::var_id
integer, dimension(mvars) var_id
Definition mod_netcdf.F:160
mod_netcdf::n_var
integer n_var
Definition mod_netcdf.F:152
mod_netcdf::nf_type
integer, parameter nf_type
Definition mod_netcdf.F:198
mod_netcdf::rec_size
integer rec_size
Definition mod_netcdf.F:156
mod_netcdf::netcdf_create
subroutine, public netcdf_create(ng, model, ncname, ncid)
Definition mod_netcdf.F:9089
mod_netcdf::netcdf_inq_var
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
Definition mod_netcdf.F:1371

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::hss, mod_param::iadm, mod_ncparam::idfsur, mod_ncparam::idsbry, mod_sediment::idsed, mod_ncparam::idtime, mod_ncparam::idtsur, mod_ncparam::idtvar, mod_ncparam::idubar, mod_ncparam::idusms, mod_ncparam::iduvel, mod_ncparam::idvbar, mod_ncparam::idvsms, mod_ncparam::idvvel, mod_ncparam::iinfo, mod_param::inlm, mod_param::iobounds, mod_scalars::isalt, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::itemp, mod_scalars::ldefhss, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_netcdf::n_var, mod_biology::nbac, mod_biology::nbands, mod_param::nbed, mod_scalars::nbrec, mod_biology::ndom, mod_netcdf::netcdf_check_dim(), mod_netcdf::netcdf_create(), mod_netcdf::netcdf_enddef(), mod_netcdf::netcdf_inq_var(), mod_netcdf::netcdf_open(), mod_netcdf::nf_fout, mod_netcdf::nf_tout, mod_netcdf::nf_type, mod_biology::nfec, mod_scalars::nfrec, mod_scalars::ninner, mod_scalars::noerror, mod_scalars::nouter, mod_biology::nphy, mod_fourdvar::nposti, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, mod_ncparam::nv, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::rclock, mod_netcdf::rec_size, mod_sediment::sd50, mod_iounits::sourcefile, mod_iounits::stdout, mod_param::u2dvar, mod_param::v2dvar, mod_netcdf::var_id, mod_netcdf::var_name, and mod_ncparam::vname.

Referenced by def_hessian().

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

◆ def_hessian_pio()

subroutine, private def_hessian_mod::def_hessian_pio ( integer, intent(in) ng)
private

Definition at line 1142 of file def_hessian.F.

1143!**********************************************************************
1144!
1145 USE mod_pio_netcdf
1146!
1147! Imported variable declarations.
1148!
1149 integer, intent(in) :: ng
1150!
1151! Local variable declarations.
1152!
1153 logical :: got_var(NV)
1154!
1155 integer, parameter :: Natt = 25
1156
1157 integer :: i, j, ifield, itrc, nrec, nvd, nvd3, nvd4
1158 integer :: recdim, status
1159# ifdef ADJUST_BOUNDARY
1160 integer :: IorJdim, brecdim
1161# endif
1162# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1163 integer :: frecdim
1164# endif
1165# if defined POSTERIOR_EOFS && defined WEAK_CONSTRAINT
1166 integer :: NpostDim
1167# endif
1168 integer :: DimIDs(nDimID)
1169 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
1170# ifdef ADJUST_BOUNDARY
1171 integer :: t2dobc(4)
1172# endif
1173# ifdef EVOLVED_LCZ
1174 integer :: MinnerDim, NinnerDim, NouterDim
1175 integer :: vardim(2)
1176# endif
1177
1178# ifdef SOLVE3D
1179 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
1180# ifdef ADJUST_BOUNDARY
1181 integer :: t3dobc(5)
1182# endif
1183# ifdef ADJUST_STFLUX
1184 integer :: t3dfrc(4)
1185# endif
1186# endif
1187# ifdef ADJUST_WSTRESS
1188 integer :: u3dfrc(4), v3dfrc(4)
1189# endif
1190!
1191 real(r8) :: Aval(6)
1192!
1193 character (len=256) :: ncname
1194 character (len=MaxLen) :: Vinfo(Natt)
1195
1196 character (len=*), parameter :: MyFile = &
1197 & __FILE__//", def_hessian_pio"
1198!
1199 TYPE (Var_desc_t) :: varDesc
1200!
1201 sourcefile=myfile
1202!
1203!-----------------------------------------------------------------------
1204! Set and report file name.
1205!-----------------------------------------------------------------------
1206!
1207 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1208 ncname=hss(ng)%name
1209!
1210 IF (master) THEN
1211 IF (ldefhss(ng)) THEN
1212 WRITE (stdout,10) ng, trim(ncname)
1213 ELSE
1214 WRITE (stdout,20) ng, trim(ncname)
1215 END IF
1216 END IF
1217!
1218!=======================================================================
1219! Create a new Hessian eigenvectors file.
1220!=======================================================================
1221!
1222 define : IF (ldefhss(ng)) THEN
1223 CALL pio_netcdf_create (ng, iadm, trim(ncname), hss(ng)%pioFile)
1224 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1225 IF (master) WRITE (stdout,30) trim(ncname)
1226 RETURN
1227 END IF
1228!
1229!-----------------------------------------------------------------------
1230! Define file dimensions.
1231!-----------------------------------------------------------------------
1232!
1233 dimids=0
1234!
1235 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xi_rho', &
1236 & iobounds(ng)%xi_rho, dimids( 1))
1237 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1238
1239 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xi_u', &
1240 & iobounds(ng)%xi_u, dimids( 2))
1241 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1242
1243 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xi_v', &
1244 & iobounds(ng)%xi_v, dimids( 3))
1245 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1246
1247 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xi_psi', &
1248 & iobounds(ng)%xi_psi, dimids( 4))
1249 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1250
1251 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'eta_rho', &
1252 & iobounds(ng)%eta_rho, dimids( 5))
1253 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1254
1255 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'eta_u', &
1256 & iobounds(ng)%eta_u, dimids( 6))
1257 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1258
1259 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'eta_v', &
1260 & iobounds(ng)%eta_v, dimids( 7))
1261 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1262
1263 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'eta_psi', &
1264 & iobounds(ng)%eta_psi, dimids( 8))
1265 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1266
1267# ifdef ADJUST_BOUNDARY
1268 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'IorJ', &
1269 & iobounds(ng)%IorJ, iorjdim)
1270 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1271# endif
1272
1273# if defined WRITE_WATER && defined MASKING
1274 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xy_rho', &
1275 & iobounds(ng)%xy_rho, dimids(17))
1276 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1277
1278 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xy_u', &
1279 & iobounds(ng)%xy_u, dimids(18))
1280 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1281
1282 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xy_v', &
1283 & iobounds(ng)%xy_v, dimids(19))
1284 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1285# endif
1286
1287# ifdef EVOLVED_LCZ
1288
1289 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'Ninner', &
1290 & ninner, ninnerdim)
1291 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1292
1293 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'Minner', &
1294 & ninner+1, minnerdim)
1295 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1296
1297 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'Nouter', &
1298 & nouter, nouterdim)
1299 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1300
1301# endif
1302
1303# ifdef SOLVE3D
1304# if defined WRITE_WATER && defined MASKING
1305 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xyz_rho', &
1306 & iobounds(ng)%xy_rho*n(ng), dimids(20))
1307 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1308
1309 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xyz_u', &
1310 & iobounds(ng)%xy_u*n(ng), dimids(21))
1311 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1312
1313 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xyz_v', &
1314 & iobounds(ng)%xy_v*n(ng), dimids(22))
1315 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1316
1317 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xyz_w', &
1318 & iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
1319 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1320# endif
1321
1322 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'N', &
1323 & n(ng), dimids( 9))
1324 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1325
1326 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 's_rho', &
1327 & n(ng), dimids( 9))
1328 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1329
1330 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 's_w', &
1331 & n(ng)+1, dimids(10))
1332 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1333
1334 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'tracer', &
1335 & nt(ng), dimids(11))
1336 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1337
1338# ifdef SEDIMENT
1339 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'NST', &
1340 & nst, dimids(32))
1341 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1342
1343 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'Nbed', &
1344 & nbed, dimids(16))
1345 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1346
1347# if defined WRITE_WATER && defined MASKING
1348 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'xybed', &
1349 & iobounds(ng)%xy_rho*nbed, dimids(24))
1350 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1351# endif
1352# endif
1353
1354# ifdef ECOSIM
1355 status=def_dim(ng, inlm, hss(ng)%pioFile, ncname, 'Nbands', &
1356 & nbands, dimids(33))
1357 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1358
1359 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'Nphy', &
1360 & nphy, dimids(25))
1361 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1362
1363 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'Nbac', &
1364 & nbac, dimids(26))
1365 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1366
1367 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'Ndom', &
1368 & ndom, dimids(27))
1369 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1370
1371 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'Nfec', &
1372 & nfec, dimids(28))
1373 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1374# endif
1375# endif
1376
1377 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'boundary', &
1378 & 4, dimids(14))
1379 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1380
1381# ifdef FOUR_DVAR
1382 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'Nstate', &
1383 & nstatevar(ng), dimids(29))
1384 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1385# endif
1386
1387# if defined POSTERIOR_EOFS && defined WEAK_CONSTRAINT
1388 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'Nposterior', &
1389 & nposti+1, npostdim)
1390 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1391# endif
1392
1393# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1394 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'frc_adjust', &
1395 & nfrec(ng), dimids(30))
1396 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1397# endif
1398
1399# ifdef ADJUST_BOUNDARY
1400 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, 'obc_adjust', &
1401 & nbrec(ng), dimids(31))
1402 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1403# endif
1404
1405 status=def_dim(ng, iadm, hss(ng)%pioFile, ncname, &
1406 & trim(adjustl(vname(5,idtime))), &
1407 & pio_unlimited, dimids(12))
1408 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1409
1410 recdim=dimids(12)
1411# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1412 frecdim=dimids(30)
1413# endif
1414# ifdef ADJUST_BOUNDARY
1415 brecdim=dimids(31)
1416# endif
1417!
1418! Set number of dimensions for output variables.
1419!
1420# if defined WRITE_WATER && defined MASKING
1421 nvd3=2
1422 nvd4=2
1423# else
1424 nvd3=3
1425 nvd4=4
1426# endif
1427!
1428! Define dimension vectors for staggered tracer type variables.
1429!
1430# if defined WRITE_WATER && defined MASKING
1431 t2dgrd(1)=dimids(17)
1432 t2dgrd(2)=dimids(12)
1433# ifdef SOLVE3D
1434 t3dgrd(1)=dimids(20)
1435 t3dgrd(2)=dimids(12)
1436# endif
1437# else
1438 t2dgrd(1)=dimids( 1)
1439 t2dgrd(2)=dimids( 5)
1440 t2dgrd(3)=dimids(12)
1441# ifdef SOLVE3D
1442 t3dgrd(1)=dimids( 1)
1443 t3dgrd(2)=dimids( 5)
1444 t3dgrd(3)=dimids( 9)
1445 t3dgrd(4)=dimids(12)
1446# endif
1447# ifdef ADJUST_STFLUX
1448 t3dfrc(1)=dimids( 1)
1449 t3dfrc(2)=dimids( 5)
1450 t3dfrc(3)=frecdim
1451 t3dfrc(4)=dimids(12)
1452# endif
1453# endif
1454# ifdef ADJUST_BOUNDARY
1455 t2dobc(1)=iorjdim
1456 t2dobc(2)=dimids(14)
1457 t2dobc(3)=brecdim
1458 t2dobc(4)=dimids(12)
1459# ifdef SOLVE3D
1460 t3dobc(1)=iorjdim
1461 t3dobc(2)=dimids( 9)
1462 t3dobc(3)=dimids(14)
1463 t3dobc(4)=brecdim
1464 t3dobc(5)=dimids(12)
1465# endif
1466# endif
1467!
1468! Define dimension vectors for staggered u-momentum type variables.
1469!
1470# if defined WRITE_WATER && defined MASKING
1471 u2dgrd(1)=dimids(18)
1472 u2dgrd(2)=dimids(12)
1473# ifdef SOLVE3D
1474 u3dgrd(1)=dimids(21)
1475 u3dgrd(2)=dimids(12)
1476# endif
1477# else
1478 u2dgrd(1)=dimids( 2)
1479 u2dgrd(2)=dimids( 6)
1480 u2dgrd(3)=dimids(12)
1481# ifdef SOLVE3D
1482 u3dgrd(1)=dimids( 2)
1483 u3dgrd(2)=dimids( 6)
1484 u3dgrd(3)=dimids( 9)
1485 u3dgrd(4)=dimids(12)
1486# endif
1487# ifdef ADJUST_WSTRESS
1488 u3dfrc(1)=dimids( 2)
1489 u3dfrc(2)=dimids( 6)
1490 u3dfrc(3)=frecdim
1491 u3dfrc(4)=dimids(12)
1492# endif
1493# endif
1494!
1495! Define dimension vectors for staggered v-momentum type variables.
1496!
1497# if defined WRITE_WATER && defined MASKING
1498 v2dgrd(1)=dimids(19)
1499 v2dgrd(2)=dimids(12)
1500# ifdef SOLVE3D
1501 v3dgrd(1)=dimids(22)
1502 v3dgrd(2)=dimids(12)
1503# endif
1504# else
1505 v2dgrd(1)=dimids( 3)
1506 v2dgrd(2)=dimids( 7)
1507 v2dgrd(3)=dimids(12)
1508# ifdef SOLVE3D
1509 v3dgrd(1)=dimids( 3)
1510 v3dgrd(2)=dimids( 7)
1511 v3dgrd(3)=dimids( 9)
1512 v3dgrd(4)=dimids(12)
1513# endif
1514# ifdef ADJUST_WSTRESS
1515 v3dfrc(1)=dimids( 3)
1516 v3dfrc(2)=dimids( 7)
1517 v3dfrc(3)=frecdim
1518 v3dfrc(4)=dimids(12)
1519# endif
1520# endif
1521# ifdef SOLVE3D
1522!
1523! Define dimension vector for staggered w-momentum type variables.
1524!
1525# if defined WRITE_WATER && defined MASKING
1526 w3dgrd(1)=dimids(23)
1527 w3dgrd(2)=dimids(12)
1528# else
1529 w3dgrd(1)=dimids( 1)
1530 w3dgrd(2)=dimids( 5)
1531 w3dgrd(3)=dimids(10)
1532 w3dgrd(4)=dimids(12)
1533# endif
1534# endif
1535!
1536! Initialize unlimited time record dimension.
1537!
1538 hss(ng)%Rindex=0
1539!
1540! Initialize local information variable arrays.
1541!
1542 DO i=1,natt
1543 DO j=1,len(vinfo(1))
1544 vinfo(i)(j:j)=' '
1545 END DO
1546 END DO
1547 DO i=1,6
1548 aval(i)=0.0_r8
1549 END DO
1550!
1551!-----------------------------------------------------------------------
1552! Define time-recordless information variables.
1553!-----------------------------------------------------------------------
1554!
1555 CALL def_info (ng, iadm, hss(ng)%pioFile, ncname, dimids)
1556 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1557!
1558!-----------------------------------------------------------------------
1559! Define time-varying variables.
1560!-----------------------------------------------------------------------
1561!
1562! Define number of converged Ritz eigenvalues.
1563!
1564 vinfo( 1)='nConvRitz'
1565 vinfo( 2)='number of converged Ritz eigenvalues'
1566 status=def_var(ng, iadm, hss(ng)%pioFile, vardesc, pio_int, &
1567 & 1, (/0/), aval, vinfo, ncname, &
1568 & setparaccess = .false.)
1569 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1570!
1571! Define Ritz eigenvalues.
1572!
1573 vinfo( 1)='Ritz'
1574 vinfo( 2)='Ritz eigenvalues'
1575 status=def_var(ng, iadm, hss(ng)%pioFile, vardesc, pio_type, &
1576 & 1, (/recdim/), aval, vinfo, ncname, &
1577 & setparaccess = .true.)
1578 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1579!
1580! Define accuracy of Ritz eigenvalues .
1581!
1582 vinfo( 1)='Ritz_error'
1583 vinfo( 2)='accuracy of Ritz eigenvalues'
1584 status=def_var(ng, iadm, hss(ng)%pioFile, vardesc, pio_type, &
1585 & 1, (/recdim/), aval, vinfo, ncname, &
1586 & setparaccess = .true.)
1587 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1588
1589# ifdef POSTERIOR_EOFS
1590!
1591! Define posterior analysis error covariance matrix trace.
1592!
1593 vinfo( 1)='ae_trace'
1594 vinfo( 2)='posterior analysis error covariance matrix trace'
1595 status=def_var(ng, iadm, hss(ng)%pioFile, vardesc, pio_type, &
1596 & 1, (/npostdim/), aval, vinfo, ncname, &
1597 & setparaccess = .false.)
1598 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1599# endif
1600!
1601! Define model time.
1602!
1603 vinfo( 1)=vname(1,idtime)
1604 vinfo( 2)=vname(2,idtime)
1605 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
1606 vinfo( 4)=trim(rclock%calendar)
1607 vinfo(14)=vname(4,idtime)
1608 vinfo(21)=vname(6,idtime)
1609 hss(ng)%pioVar(idtime)%dkind=pio_tout
1610 hss(ng)%pioVar(idtime)%gtype=0
1611!
1612 status=def_var(ng, iadm, hss(ng)%pioFile, &
1613 & hss(ng)%pioVar(idtime)%vd, &
1614 & pio_tout, 1, (/recdim/), aval, vinfo, ncname, &
1615 & setparaccess = .true.)
1616 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1617!
1618! Define free-surface.
1619!
1620 vinfo( 1)=vname(1,idfsur)
1621 WRITE (vinfo( 2),40) trim(vname(2,idfsur))
1622 vinfo( 3)='nondimensional'
1623 vinfo(14)=vname(4,idfsur)
1624 vinfo(16)=vname(1,idtime)
1625# if defined WRITE_WATER && defined MASKING
1626 vinfo(20)='mask_rho'
1627# endif
1628 vinfo(21)=vname(6,idfsur)
1629 vinfo(22)='coordinates'
1630 aval(5)=real(iinfo(1,idfsur,ng),r8)
1631 hss(ng)%pioVar(idfsur)%dkind=pio_fout
1632 hss(ng)%pioVar(idfsur)%gtype=r2dvar
1633!
1634 status=def_var(ng, iadm, hss(ng)%pioFile, &
1635 & hss(ng)%pioVar(idfsur)%vd, &
1636 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
1637 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1638
1639# ifdef ADJUST_BOUNDARY
1640!
1641! Define free-surface open boundaries.
1642!
1643 IF (any(lobc(:,isfsur,ng))) THEN
1644 ifield=idsbry(isfsur)
1645 vinfo( 1)=vname(1,ifield)
1646 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1647 vinfo( 3)='nondimensional'
1648 vinfo(14)=vname(4,ifield)
1649 vinfo(16)=vname(1,idtime)
1650 vinfo(21)=vname(6,ifield)
1651 aval(5)=real(iinfo(1,ifield,ng),r8)
1652 hss(ng)%pioVar(ifield)%dkind=pio_fout
1653 hss(ng)%pioVar(ifield)%gtype=r2dobc
1654!
1655 status=def_var(ng, iadm, hss(ng)%pioFile, &
1656 & hss(ng)%pioVar(ifield)%vd, &
1657 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1658 & setfillval = .false.)
1659 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1660 END IF
1661# endif
1662!
1663! Define 2D U-momentum component.
1664!
1665 vinfo( 1)=vname(1,idubar)
1666 WRITE (vinfo( 2),40) trim(vname(2,idubar))
1667 vinfo( 3)='nondimensional'
1668 vinfo(14)=vname(4,idubar)
1669 vinfo(16)=vname(1,idtime)
1670# if defined WRITE_WATER && defined MASKING
1671 vinfo(20)='mask_u'
1672# endif
1673 vinfo(21)=vname(6,idubar)
1674 vinfo(22)='coordinates'
1675 aval(5)=real(iinfo(1,idubar,ng),r8)
1676 hss(ng)%pioVar(idubar)%dkind=pio_fout
1677 hss(ng)%pioVar(idubar)%gtype=u2dvar
1678!
1679 status=def_var(ng, iadm, hss(ng)%pioFile, &
1680 & hss(ng)%pioVar(idubar)%vd, &
1681 & pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
1682 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1683
1684# ifdef ADJUST_BOUNDARY
1685!
1686! Define 2D U-momentum component open boundaries.
1687!
1688 IF (any(lobc(:,isubar,ng))) THEN
1689 ifield=idsbry(isubar)
1690 vinfo( 1)=vname(1,ifield)
1691 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1692 vinfo( 3)='nondimensional'
1693 vinfo(14)=vname(4,ifield)
1694 vinfo(16)=vname(1,idtime)
1695 vinfo(21)=vname(6,ifield)
1696 aval(5)=real(iinfo(1,ifield,ng),r8)
1697 hss(ng)%pioVar(ifield)%dkind=pio_fout
1698 hss(ng)%pioVar(ifield)%gtype=u2dobc
1699!
1700 status=def_var(ng, iadm, hss(ng)%pioFile, &
1701 & hss(ng)%pioVar(ifield)%vd, &
1702 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1703 & setfillval = .false.)
1704 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1705 END IF
1706# endif
1707!
1708! Define 2D V-momentum component.
1709!
1710 vinfo( 1)=vname(1,idvbar)
1711 WRITE (vinfo( 2),40) trim(vname(2,idvbar))
1712 vinfo( 3)='nondimensional'
1713 vinfo(14)=vname(4,idvbar)
1714 vinfo(16)=vname(1,idtime)
1715# if defined WRITE_WATER && defined MASKING
1716 vinfo(20)='mask_v'
1717# endif
1718 vinfo(21)=vname(6,idvbar)
1719 vinfo(22)='coordinates'
1720 aval(5)=real(iinfo(1,idvbar,ng),r8)
1721 hss(ng)%pioVar(idvbar)%dkind=pio_fout
1722 hss(ng)%pioVar(idvbar)%gtype=v2dvar
1723!
1724 status=def_var(ng, iadm, hss(ng)%pioFile, &
1725 & hss(ng)%pioVar(idvbar)%vd, &
1726 & pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
1727 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1728
1729# ifdef ADJUST_BOUNDARY
1730!
1731! Define 2D V-momentum component open boundaries.
1732!
1733 IF (any(lobc(:,isvbar,ng))) THEN
1734 ifield=idsbry(isvbar)
1735 vinfo( 1)=vname(1,ifield)
1736 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1737 vinfo( 3)='nondimensional'
1738 vinfo(14)=vname(4,ifield)
1739 vinfo(16)=vname(1,idtime)
1740 vinfo(21)=vname(6,ifield)
1741 aval(5)=real(iinfo(1,ifield,ng),r8)
1742 hss(ng)%pioVar(ifield)%dkind=pio_fout
1743 hss(ng)%pioVar(ifield)%gtype=v2dobc
1744!
1745 status=def_var(ng, iadm, hss(ng)%pioFile, &
1746 & hss(ng)%pioVar(ifield)%vd, &
1747 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1748 & setfillval = .false.)
1749 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1750 END IF
1751# endif
1752# ifdef SOLVE3D
1753!
1754! Define 3D U-momentum component.
1755!
1756 vinfo( 1)=vname(1,iduvel)
1757 WRITE (vinfo( 2),40) trim(vname(2,iduvel))
1758 vinfo( 3)='nondimensional'
1759 vinfo(14)=vname(4,iduvel)
1760 vinfo(16)=vname(1,idtime)
1761# if defined WRITE_WATER && defined MASKING
1762 vinfo(20)='mask_u'
1763# endif
1764 vinfo(21)=vname(6,iduvel)
1765 vinfo(22)='coordinates'
1766 aval(5)=real(iinfo(1,iduvel,ng),r8)
1767 hss(ng)%pioVar(iduvel)%dkind=pio_fout
1768 hss(ng)%pioVar(iduvel)%gtype=u3dvar
1769!
1770 status=def_var(ng, iadm, hss(ng)%pioFile, &
1771 & hss(ng)%pioVar(iduvel)%vd, &
1772 & pio_fout, nvd4, u3dgrd, aval, vinfo, ncname)
1773 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1774
1775# ifdef ADJUST_BOUNDARY
1776!
1777! Define 3D U-momentum component open boundaries.
1778!
1779 IF (any(lobc(:,isuvel,ng))) THEN
1780 ifield=idsbry(isuvel)
1781 vinfo( 1)=vname(1,ifield)
1782 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1783 vinfo( 3)='nondimensional'
1784 vinfo(14)=vname(4,ifield)
1785 vinfo(16)=vname(1,idtime)
1786 vinfo(21)=vname(6,ifield)
1787 aval(5)=real(iinfo(1,ifield,ng),r8)
1788 hss(ng)%pioVar(ifield)%dkind=pio_fout
1789 hss(ng)%pioVar(ifield)%gtype=u3dobc
1790!
1791 status=def_var(ng, iadm, hss(ng)%pioFile, &
1792 & hss(ng)%pioVar(ifield)%vd, &
1793 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1794 & setfillval = .false.)
1795 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1796 END IF
1797# endif
1798!
1799! Define 3D V-momentum component.
1800!
1801 vinfo( 1)=vname(1,idvvel)
1802 WRITE (vinfo( 2),40) trim(vname(2,idvvel))
1803 vinfo( 3)='nondimensional'
1804 vinfo(14)=vname(4,idvvel)
1805 vinfo(16)=vname(1,idtime)
1806# if defined WRITE_WATER && defined MASKING
1807 vinfo(20)='mask_v'
1808# endif
1809 vinfo(21)=vname(6,idvvel)
1810 vinfo(22)='coordinates'
1811 aval(5)=real(iinfo(1,idvvel,ng),r8)
1812 hss(ng)%pioVar(idvvel)%dkind=pio_fout
1813 hss(ng)%pioVar(idvvel)%gtype=v3dvar
1814!
1815 status=def_var(ng, iadm, hss(ng)%pioFile, &
1816 & hss(ng)%pioVar(idvvel)%vd, &
1817 & pio_fout, nvd4, v3dgrd, aval, vinfo, ncname)
1818 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1819
1820# ifdef ADJUST_BOUNDARY
1821!
1822! Define 3D V-momentum component open boundaries.
1823!
1824 IF (any(lobc(:,isvvel,ng))) THEN
1825 ifield=idsbry(isvvel)
1826 vinfo( 1)=vname(1,ifield)
1827 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1828 vinfo( 3)='nondimensional'
1829 vinfo(14)=vname(4,ifield)
1830 vinfo(16)=vname(1,idtime)
1831 vinfo(21)=vname(6,ifield)
1832 aval(5)=real(iinfo(1,ifield,ng),r8)
1833 hss(ng)%pioVar(ifield)%dkind=pio_fout
1834 hss(ng)%pioVar(ifield)%gtype=v3dobc
1835!
1836 status=def_var(ng, iadm, hss(ng)%pioFile, &
1837 & hss(ng)%pioVar(ifield)%vd, &
1838 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1839 & setfillval = .false.)
1840 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1841 END IF
1842# endif
1843!
1844! Define tracer type variables.
1845!
1846 DO itrc=1,nt(ng)
1847 vinfo( 1)=vname(1,idtvar(itrc))
1848 WRITE (vinfo( 2),40) trim(vname(2,idtvar(itrc)))
1849 vinfo( 3)='nondimensional'
1850 vinfo(14)=vname(4,idtvar(itrc))
1851 vinfo(16)=vname(1,idtime)
1852# ifdef SEDIMENT
1853 DO i=1,nst
1854 IF (itrc.eq.idsed(i)) THEN
1855 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
1856 END IF
1857 END DO
1858# endif
1859# if defined WRITE_WATER && defined MASKING
1860 vinfo(20)='mask_rho'
1861# endif
1862 vinfo(21)=vname(6,idtvar(itrc))
1863 vinfo(22)='coordinates'
1864 aval(5)=real(r3dvar,r8)
1865 hss(ng)%pioTrc(itrc)%dkind=pio_fout
1866 hss(ng)%pioTrc(itrc)%gtype=r3dvar
1867!
1868 status=def_var(ng, iadm, hss(ng)%pioFile, &
1869 & hss(ng)%pioTrc(itrc)%vd, &
1870 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
1871 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1872 END DO
1873
1874# ifdef ADJUST_BOUNDARY
1875!
1876! Define tracer type variables open boundaries.
1877!
1878 DO itrc=1,nt(ng)
1879 IF (any(lobc(:,istvar(itrc),ng))) THEN
1880 ifield=idsbry(istvar(itrc))
1881 vinfo( 1)=vname(1,ifield)
1882 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1883 vinfo( 3)='nondimensional'
1884 vinfo(14)=vname(4,ifield)
1885 vinfo(16)=vname(1,idtime)
1886# ifdef SEDIMENT
1887 DO i=1,nst
1888 IF (itrc.eq.idsed(i)) THEN
1889 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
1890 END IF
1891 END DO
1892# endif
1893 vinfo(21)=vname(6,ifield)
1894 aval(5)=real(iinfo(1,ifield,ng),r8)
1895 hss(ng)%pioVar(ifield)%dkind=pio_fout
1896 hss(ng)%pioVar(ifield)%gtype=r3dobc
1897!
1898 status=def_var(ng, iadm, hss(ng)%pioFile, &
1899 & hss(ng)%pioVar(ifield)%vd, &
1900 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1901 & setfillval = .false.)
1902 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1903 END IF
1904 END DO
1905# endif
1906# ifdef ADJUST_STFLUX
1907!
1908! Define surface tracer fluxes.
1909!
1910 DO itrc=1,nt(ng)
1911 IF (lstflux(itrc,ng)) THEN
1912 vinfo( 1)=vname(1,idtsur(itrc))
1913 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
1914 vinfo( 3)='nondimensional'
1915 IF (itrc.eq.itemp) THEN
1916 vinfo(11)='upward flux, cooling'
1917 vinfo(12)='downward flux, heating'
1918 ELSE IF (itrc.eq.isalt) THEN
1919 vinfo(11)='upward flux, freshening (net precipitation)'
1920 vinfo(12)='downward flux, salting (net evaporation)'
1921 END IF
1922 vinfo(14)=vname(4,idtsur(itrc))
1923 vinfo(16)=vname(1,idtime)
1924# if defined WRITE_WATER && defined MASKING
1925 vinfo(20)='mask_rho'
1926# endif
1927 vinfo(21)=vname(6,idtsur(itrc))
1928 vinfo(22)='coordinates'
1929 aval(5)=real(r2dvar,r8)
1930 hss(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
1931 hss(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1932!
1933 status=def_var(ng, iadm, hss(ng)%pioFile, &
1934 & hss(ng)%pioVar(idtsur(itrc))%vd, &
1935 & pio_fout, nvd4, t3dfrc, aval, vinfo, ncname)
1936 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1937 END IF
1938 END DO
1939# endif
1940# endif
1941# ifdef ADJUST_WSTRESS
1942!
1943! Define surface U-momentum stress.
1944!
1945 vinfo( 1)=vname(1,idusms)
1946 WRITE (vinfo( 2),40) trim(vname(2,idusms))
1947 vinfo( 3)='nondimensional'
1948 vinfo(14)=vname(4,idusms)
1949 vinfo(16)=vname(1,idtime)
1950# if defined WRITE_WATER && defined MASKING
1951 vinfo(20)='mask_u'
1952# endif
1953 vinfo(21)=vname(6,idusms)
1954 vinfo(22)='coordinates'
1955 aval(5)=real(u2dvar,r8)
1956 hss(ng)%pioVar(idusms)%dkind=pio_fout
1957 hss(ng)%pioVar(idusms)%gtype=u2dvar
1958!
1959 status=def_var(ng, iadm, hss(ng)%pioFile, &
1960 & hss(ng)%pioVar(idusms)%vd, &
1961 & pio_fout, nvd4, u3dfrc, aval, vinfo, ncname)
1962 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1963!
1964! Define surface V-momentum stress.
1965!
1966 vinfo( 1)=vname(1,idvsms)
1967 WRITE (vinfo( 2),40) trim(vname(2,idvsms))
1968 vinfo( 2)=vname(2,idvsms)
1969 vinfo( 3)='nondimensional'
1970 vinfo(14)=vname(4,idvsms)
1971 vinfo(16)=vname(1,idtime)
1972# if defined WRITE_WATER && defined MASKING
1973 vinfo(20)='mask_v'
1974# endif
1975 vinfo(21)=vname(6,idvsms)
1976 vinfo(22)='coordinates'
1977 aval(5)=real(v2dvar,r8)
1978 hss(ng)%pioVar(idvsms)%dkind=pio_fout
1979 hss(ng)%pioVar(idvsms)%gtype=v2dvar
1980!
1981 status=def_var(ng, iadm, hss(ng)%pioFile, &
1982 & hss(ng)%pioVar(idvsms)%vd, &
1983 & pio_fout, nvd4, v3dfrc, aval, vinfo, ncname)
1984 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1985# endif
1986!
1987!-----------------------------------------------------------------------
1988! Leave definition mode.
1989!-----------------------------------------------------------------------
1990!
1991 CALL pio_netcdf_enddef (ng, iadm, ncname, hss(ng)%pioFile)
1992 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1993!
1994!-----------------------------------------------------------------------
1995! Write out time-recordless, information variables.
1996!-----------------------------------------------------------------------
1997!
1998 CALL wrt_info (ng, iadm, hss(ng)%pioFile, ncname)
1999 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2000 END IF define
2001!
2002!=======================================================================
2003! Open an existing Hessian eigenvectors file, check its contents, and
2004! prepare for appending data.
2005!=======================================================================
2006!
2007 query: IF (.not.ldefhss(ng)) THEN
2008 ncname=hss(ng)%name
2009!
2010! Open Hessian eigenvectors file for read/write.
2011!
2012 CALL pio_netcdf_open (ng, iadm, ncname, 1, hss(ng)%pioFile)
2013 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
2014 WRITE (stdout,60) trim(ncname)
2015 RETURN
2016 END IF
2017!
2018! Inquire about the dimensions and check for consistency.
2019!
2020 CALL pio_netcdf_check_dim (ng, iadm, ncname, &
2021 & piofile = hss(ng)%pioFile)
2022 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2023!
2024! Inquire about the variables.
2025!
2026 CALL pio_netcdf_inq_var (ng, iadm, ncname, &
2027 & piofile = hss(ng)%pioFile)
2028 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2029!
2030! Initialize logical switches.
2031!
2032 DO i=1,nv
2033 got_var(i)=.false.
2034 END DO
2035!
2036! Scan variable list from input NetCDF and activate switches for
2037! Hessian eigenvectors variables. Get variable IDs.
2038!
2039 DO i=1,n_var
2040 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
2041 got_var(idtime)=.true.
2042 hss(ng)%pioVar(idtime)%vd=var_desc(i)
2043 hss(ng)%pioVar(idtime)%dkind=pio_tout
2044 hss(ng)%pioVar(idtime)%gtype=0
2045 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
2046 got_var(idfsur)=.true.
2047 hss(ng)%pioVar(idfsur)%vd=var_desc(i)
2048 hss(ng)%pioVar(idfsur)%dkind=pio_fout
2049 hss(ng)%pioVar(idfsur)%gtype=r2dvar
2050 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
2051 got_var(idubar)=.true.
2052 hss(ng)%pioVar(idubar)%vd=var_desc(i)
2053 hss(ng)%pioVar(idubar)%dkind=pio_fout
2054 hss(ng)%pioVar(idubar)%gtype=u2dvar
2055 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
2056 got_var(idvbar)=.true.
2057 hss(ng)%pioVar(idvbar)%vd=var_desc(i)
2058 hss(ng)%pioVar(idvbar)%dkind=pio_fout
2059 hss(ng)%pioVar(idvbar)%gtype=v2dvar
2060# ifdef ADJUST_BOUNDARY
2061 ELSE IF (trim(var_name(i)).eq. &
2062 & trim(vname(1,idsbry(isfsur)))) THEN
2063 got_var(idsbry(isfsur))=.true.
2064 hss(ng)%pioVar(idsbry(isfsur))%vd=var_desc(i)
2065 hss(ng)%pioVar(idsbry(isfsur))%dkind=pio_fout
2066 hss(ng)%pioVar(idsbry(isfsur))%gtype=r2dobc
2067 ELSE IF (trim(var_name(i)).eq. &
2068 & trim(vname(1,idsbry(isubar)))) THEN
2069 got_var(idsbry(isubar))=.true.
2070 hss(ng)%pioVar(idsbry(isubar))%vd=var_desc(i)
2071 hss(ng)%pioVar(idsbry(isubar))%dkind=pio_fout
2072 hss(ng)%pioVar(idsbry(isubar))%gtype=u2dobc
2073 ELSE IF (trim(var_name(i)).eq. &
2074 & trim(vname(1,idsbry(isvbar)))) THEN
2075 got_var(idsbry(isvbar))=.true.
2076 hss(ng)%pioVar(idsbry(isvbar))%vd=var_desc(i)
2077 hss(ng)%pioVar(idsbry(isvbar))%dkind=pio_fout
2078 hss(ng)%pioVar(idsbry(isvbar))%gtype=v2dobc
2079# endif
2080# ifdef ADJUST_WSTRESS
2081 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
2082 got_var(idusms)=.true.
2083 hss(ng)%pioVar(idusms)%vd=var_desc(i)
2084 hss(ng)%pioVar(idusms)%dkind=pio_fout
2085 hss(ng)%pioVar(idusms)%gtype=u2dvar
2086 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
2087 got_var(idvsms)=.true.
2088 hss(ng)%pioVar(idvsms)%vd=var_desc(i)
2089 hss(ng)%pioVar(idvsms)%dkind=pio_fout
2090 hss(ng)%pioVar(idvsms)%gtype=v2dvar
2091# endif
2092# ifdef SOLVE3D
2093 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
2094 got_var(iduvel)=.true.
2095 hss(ng)%pioVar(iduvel)%vd=var_desc(i)
2096 hss(ng)%pioVar(iduvel)%dkind=pio_fout
2097 hss(ng)%pioVar(iduvel)%gtype=u3dvar
2098 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
2099 got_var(idvvel)=.true.
2100 hss(ng)%pioVar(idvvel)%vd=var_desc(i)
2101 hss(ng)%pioVar(idvvel)%dkind=pio_fout
2102 hss(ng)%pioVar(idvvel)%gtype=v3dvar
2103# ifdef ADJUST_BOUNDARY
2104 ELSE IF (trim(var_name(i)).eq. &
2105 & trim(vname(1,idsbry(isuvel)))) THEN
2106 got_var(idsbry(isuvel))=.true.
2107 hss(ng)%pioVar(idsbry(isuvel))%vd=var_desc(i)
2108 hss(ng)%pioVar(idsbry(isuvel))%dkind=pio_fout
2109 hss(ng)%pioVar(idsbry(isuvel))%gtype=u3dobc
2110 ELSE IF (trim(var_name(i)).eq. &
2111 & trim(vname(1,idsbry(isvvel)))) THEN
2112 got_var(idsbry(isvvel))=.true.
2113 hss(ng)%pioVar(idsbry(isvvel))%vd=var_desc(i)
2114 hss(ng)%pioVar(idsbry(isvvel))%dkind=pio_fout
2115 hss(ng)%pioVar(idsbry(isvvel))%gtype=v3dobc
2116# endif
2117# endif
2118 END IF
2119# ifdef SOLVE3D
2120 DO itrc=1,nt(ng)
2121 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
2122 got_var(idtvar(itrc))=.true.
2123 hss(ng)%pioTrc(itrc)%vd=var_desc(i)
2124 hss(ng)%pioTrc(itrc)%dkind=pio_fout
2125 hss(ng)%pioTrc(itrc)%gtype=r3dvar
2126# ifdef ADJUST_BOUNDARY
2127 ELSE IF (trim(var_name(i)).eq. &
2128 & trim(vname(1,idsbry(istvar(itrc))))) THEN
2129 got_var(idsbry(istvar(itrc)))=.true.
2130 hss(ng)%pioVar(idsbry(istvar(itrc)))%vd=var_desc(i)
2131 hss(ng)%pioVar(idsbry(istvar(itrc)))%dkind=pio_fout
2132 hss(ng)%pioVar(idsbry(istvar(itrc)))%gtype=r3dobc
2133# endif
2134# ifdef ADJUST_STFLUX
2135 ELSE IF (trim(var_name(i)).eq. &
2136 & trim(vname(1,idtsur(itrc)))) THEN
2137 got_var(idtsur(itrc))=.true.
2138 hss(ng)%pioVar(idtsur(itrc))%vd=var_desc(i)
2139 hss(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
2140 hss(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
2141# endif
2142 END IF
2143 END DO
2144# endif
2145 END DO
2146!
2147! Check if Hessian eigenvectors variables are available in input
2148! NetCDF file.
2149!
2150 IF (.not.got_var(idtime)) THEN
2151 IF (master) WRITE (stdout,70) trim(vname(1,idtime)), &
2152 & trim(ncname)
2153 exit_flag=3
2154 RETURN
2155 END IF
2156 IF (.not.got_var(idfsur)) THEN
2157 IF (master) WRITE (stdout,70) trim(vname(1,idfsur)), &
2158 & trim(ncname)
2159 exit_flag=3
2160 RETURN
2161 END IF
2162 IF (.not.got_var(idubar)) THEN
2163 IF (master) WRITE (stdout,70) trim(vname(1,idubar)), &
2164 & trim(ncname)
2165 exit_flag=3
2166 RETURN
2167 END IF
2168 IF (.not.got_var(idvbar)) THEN
2169 IF (master) WRITE (stdout,70) trim(vname(1,idvbar)), &
2170 & trim(ncname)
2171 exit_flag=3
2172 RETURN
2173 END IF
2174# ifdef ADJUST_BOUNDARY
2175 IF (.not.got_var(idsbry(isfsur))) THEN
2176 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isfsur))), &
2177 & trim(ncname)
2178 exit_flag=3
2179 RETURN
2180 END IF
2181 IF (.not.got_var(idsbry(isubar))) THEN
2182 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isubar))), &
2183 & trim(ncname)
2184 exit_flag=3
2185 RETURN
2186 END IF
2187 IF (.not.got_var(idsbry(isvbar))) THEN
2188 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvbar))), &
2189 & trim(ncname)
2190 exit_flag=3
2191 RETURN
2192 END IF
2193# endif
2194# ifdef ADJUST_WSTRESS
2195 IF (.not.got_var(idusms)) THEN
2196 IF (master) WRITE (stdout,70) trim(vname(1,idusms)), &
2197 & trim(ncname)
2198 exit_flag=3
2199 RETURN
2200 END IF
2201 IF (.not.got_var(idvsms)) THEN
2202 IF (master) WRITE (stdout,70) trim(vname(1,idvsms)), &
2203 & trim(ncname)
2204 exit_flag=3
2205 RETURN
2206 END IF
2207# endif
2208# ifdef SOLVE3D
2209 IF (.not.got_var(iduvel)) THEN
2210 IF (master) WRITE (stdout,70) trim(vname(1,iduvel)), &
2211 & trim(ncname)
2212 exit_flag=3
2213 RETURN
2214 END IF
2215 IF (.not.got_var(idvvel)) THEN
2216 IF (master) WRITE (stdout,70) trim(vname(1,idvvel)), &
2217 & trim(ncname)
2218 exit_flag=3
2219 RETURN
2220 END IF
2221# ifdef ADJUST_BOUNDARY
2222 IF (.not.got_var(idsbry(isuvel))) THEN
2223 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isuvel))), &
2224 & trim(ncname)
2225 exit_flag=3
2226 RETURN
2227 END IF
2228 IF (.not.got_var(idsbry(isvvel))) THEN
2229 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvvel))), &
2230 & trim(ncname)
2231 exit_flag=3
2232 RETURN
2233 END IF
2234# endif
2235# endif
2236# ifdef SOLVE3D
2237 DO itrc=1,nt(ng)
2238 IF (.not.got_var(idtvar(itrc))) THEN
2239 IF (master) WRITE (stdout,70) trim(vname(1,idtvar(itrc))), &
2240 & trim(ncname)
2241 exit_flag=3
2242 RETURN
2243 END IF
2244# ifdef ADJUST_BOUNDARY
2245 IF (.not.got_var(idsbry(istvar(itrc)))) THEN
2246 IF (master) WRITE (stdout,70) &
2247 & trim(vname(1,idsbry(istvar(itrc)))), &
2248 & trim(ncname)
2249 exit_flag=3
2250 RETURN
2251 END IF
2252# endif
2253# ifdef ADJUST_STFLUX
2254 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
2255 IF (master) WRITE (stdout,70) trim(vname(1,idtsur(itrc))), &
2256 & trim(ncname)
2257 exit_flag=3
2258 RETURN
2259 END IF
2260# endif
2261 END DO
2262# endif
2263!
2264! Set unlimited time record dimension to the appropriate value.
2265!
2266 hss(ng)%Rindex=rec_size
2267 END IF query
2268!
2269 10 FORMAT (2x,'DEF_HESSIAN_PIO - creating Hessian file,',t56, &
2270 & 'Grid ',i2.2,': ',a)
2271 20 FORMAT (2x,'DEF_HESSIAN_PIO - inquiring Hessian file,',t56, &
2272 & 'Grid ',i2.2,': ',a)
2273 30 FORMAT (/,' DEF_HESSIAN_PIO - unable to create Hessian NetCDF', &
2274 & ' file:',1x,a)
2275 40 FORMAT (a,', Hessian eigenvectors')
2276 50 FORMAT (1pe11.4,1x,'millimeter')
2277 60 FORMAT (/,' DEF_HESSIAN_PIO - unable to open Hessian NetCDF', &
2278 & ' file: ',a)
2279 70 FORMAT (/,' DEF_HESSIAN_PIO - unable to find variable: ',a,2x, &
2280 & ' in Hessian NetCDF file: ',a)
2281!
2282 RETURN
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::pio_type
integer, parameter pio_type
Definition mod_pio_netcdf.F:579
mod_pio_netcdf::pio_fout
integer, parameter pio_fout
Definition mod_pio_netcdf.F:569
mod_pio_netcdf::var_desc
type(var_desc_t), dimension(:), pointer var_desc
Definition mod_pio_netcdf.F:437
mod_pio_netcdf::pio_netcdf_create
subroutine, public pio_netcdf_create(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:8997
mod_pio_netcdf::pio_netcdf_inq_var
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
Definition mod_pio_netcdf.F:1923
mod_pio_netcdf::pio_netcdf_open
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
Definition mod_pio_netcdf.F:9148
mod_pio_netcdf::pio_netcdf_check_dim
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:1080
mod_pio_netcdf::pio_tout
integer, parameter pio_tout
Definition mod_pio_netcdf.F:588
mod_pio_netcdf::pio_netcdf_enddef
subroutine, public pio_netcdf_enddef(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:9096

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::hss, mod_param::iadm, mod_ncparam::idfsur, mod_ncparam::idsbry, mod_sediment::idsed, mod_ncparam::idtime, mod_ncparam::idtsur, mod_ncparam::idtvar, mod_ncparam::idubar, mod_ncparam::idusms, mod_ncparam::iduvel, mod_ncparam::idvbar, mod_ncparam::idvsms, mod_ncparam::idvvel, mod_ncparam::iinfo, mod_param::inlm, mod_param::iobounds, mod_scalars::isalt, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::itemp, mod_scalars::ldefhss, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_biology::nbac, mod_biology::nbands, mod_param::nbed, mod_scalars::nbrec, mod_biology::ndom, mod_biology::nfec, mod_scalars::nfrec, mod_scalars::ninner, mod_scalars::noerror, mod_scalars::nouter, mod_biology::nphy, mod_fourdvar::nposti, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, mod_ncparam::nv, mod_pio_netcdf::pio_fout, mod_pio_netcdf::pio_netcdf_check_dim(), mod_pio_netcdf::pio_netcdf_create(), mod_pio_netcdf::pio_netcdf_enddef(), mod_pio_netcdf::pio_netcdf_inq_var(), mod_pio_netcdf::pio_netcdf_open(), mod_pio_netcdf::pio_tout, mod_pio_netcdf::pio_type, mod_param::r2dobc, mod_param::r2dvar, mod_param::r3dobc, mod_param::r3dvar, mod_scalars::rclock, mod_sediment::sd50, mod_iounits::sourcefile, mod_iounits::stdout, mod_param::u2dobc, mod_param::u2dvar, mod_param::u3dobc, mod_param::u3dvar, mod_param::v2dobc, mod_param::v2dvar, mod_param::v3dobc, mod_param::v3dvar, mod_pio_netcdf::var_desc, and mod_ncparam::vname.

Referenced by def_hessian().

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