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