ROMS
Loading...
Searching...
No Matches
def_ini.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE def_ini_mod
3#ifdef FOUR_DVAR
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This module open existing nonlinear model initial conditions file !
13! using either the standard NetCDF library or the Parallel-IO (PIO) !
14! library. It either define new new variables or inquire about the !
15! existing variable IDs. !
16! !
17!=======================================================================
18!
19 USE mod_param
20 USE mod_parallel
21 USE mod_iounits
22 USE mod_ncparam
23 USE mod_scalars
24!
25 USE def_dim_mod, ONLY : def_dim
26 USE def_var_mod, ONLY : def_var
27 USE strings_mod, ONLY : founderror
28!
29 implicit none
30!
31 PUBLIC :: def_ini
32 PRIVATE :: def_ini_nf90
33# if defined PIO_LIB && defined DISTRIBUTE
34 PRIVATE :: def_ini_pio
35# endif
36!
37 CONTAINS
38!
39!***********************************************************************
40 SUBROUTINE def_ini (ng)
41!***********************************************************************
42!
43! Imported variable declarations.
44!
45 integer, intent(in) :: ng
46!
47! Local variable declarations.
48!
49 character (len=*), parameter :: myfile = &
50 & __FILE__
51!
52!-----------------------------------------------------------------------
53! Open existing nonlinear initial conditions NetCDF file and inquire
54! about its contains and define new variables, if needed.
55!-----------------------------------------------------------------------
56!
57 SELECT CASE (ini(ng)%IOtype)
58 CASE (io_nf90)
59 CALL def_ini_nf90 (ng)
60
61# if defined PIO_LIB && defined DISTRIBUTE
62 CASE (io_pio)
63 CALL def_ini_pio (ng)
64# endif
65 CASE DEFAULT
66 IF (master) WRITE (stdout,10) ini(ng)%IOtype
67 exit_flag=3
68 END SELECT
69 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
70!
71 10 FORMAT (' DEF_INI - Illegal output file type, io_type = ',i0, &
72 & /,11x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
73!
74 RETURN
75 END SUBROUTINE def_ini
76!
77!***********************************************************************
78 SUBROUTINE def_ini_nf90 (ng)
79!***********************************************************************
80!
81 USE mod_netcdf
82!
83! Imported variable declarations.
84!
85 integer, intent(in) :: ng
86!
87! Local variable declarations.
88!
89# ifdef ADJUST_BOUNDARY
90 logical :: got_iorj, got_boundary, got_obc_adjust
91# endif
92# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
93 logical :: got_frc_adjust
94# endif
95 logical :: got_var(nv)
96 logical :: ldefine = .false.
97!
98 integer, parameter :: natt = 25
99
100 integer :: i, j, ifield, itrc, status
101 integer :: fcount
102# ifdef ADJUST_BOUNDARY
103 integer :: iorjdim, brecdim, brecsize
104# endif
105# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
106 integer :: frecdim, frecsize
107# endif
108 integer :: dimids(ndimid)
109# ifdef ADJUST_BOUNDARY
110 integer :: t2dobc(4)
111# ifdef SOLVE3D
112 integer :: t3dobc(5)
113# endif
114# endif
115# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
116 integer :: t4dfrc(4), u4dfrc(4), v4dfrc(4)
117# endif
118!
119 real(r8) :: aval(6)
120!
121 character (len=256) :: ncname
122 character (len=MaxLen) :: vinfo(natt)
123
124 character (len=*), parameter :: myfile = &
125 & __FILE__//", def_ini_nf90"
126!
127 sourcefile=myfile
128
129# if !defined CORRELATION && \
130 (defined adjust_boundary || defined adjust_stflux || \
131 defined adjust_wstress)
132!
133!=======================================================================
134! Open existing nonlinear model initial conditions and define new
135! variables.
136!=======================================================================
137!
138 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
139 ncname=ini(ng)%name
140!
141! Open initialization file for read/write.
142!
143 CALL netcdf_open (ng, inlm, ncname, 1, ini(ng)%ncid)
144 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
145 IF (master) WRITE (stdout,10) trim(ncname)
146 RETURN
147 END IF
148!
149! Inquire about the dimensions and check for consistency.
150!
151 CALL netcdf_check_dim (ng, inlm, ncname, &
152 & ncid = ini(ng)%ncid)
153 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
154!
155! Inquire about the variables.
156!
157 CALL netcdf_inq_var (ng, inlm, ncname, &
158 & ncid = ini(ng)%ncid)
159 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
160!
161! Check if surface forcing variables have been already defined.
162!
163 DO i=1,nv
164 got_var(i)=.false.
165 END DO
166!
167 DO i=1,n_var
168# ifdef ADJUST_BOUNDARY
169 IF (trim(var_name(i)).eq. &
170 & trim(vname(1,idsbry(isfsur)))) THEN
171 got_var(idsbry(isfsur))=.true.
172 ini(ng)%Vid(idsbry(isfsur))=var_id(i)
173 ELSE IF (trim(var_name(i)).eq. &
174 & trim(vname(1,idsbry(isubar)))) THEN
175 got_var(idsbry(isubar))=.true.
176 ini(ng)%Vid(idsbry(isubar))=var_id(i)
177 ELSE IF (trim(var_name(i)).eq. &
178 & trim(vname(1,idsbry(isvbar)))) THEN
179 got_var(idsbry(isvbar))=.true.
180 ini(ng)%Vid(idsbry(isvbar))=var_id(i)
181# ifdef SOLVE3D
182 ELSE IF (trim(var_name(i)).eq. &
183 & trim(vname(1,idsbry(isuvel)))) THEN
184 got_var(idsbry(isuvel))=.true.
185 ini(ng)%Vid(idsbry(isuvel))=var_id(i)
186 ELSE IF (trim(var_name(i)).eq. &
187 & trim(vname(1,idsbry(isvvel)))) THEN
188 got_var(idsbry(isvvel))=.true.
189 ini(ng)%Vid(idsbry(isvvel))=var_id(i)
190# endif
191 END IF
192# ifdef SOLVE3D
193 DO itrc=1,nt(ng)
194 IF (trim(var_name(i)).eq. &
195 & trim(vname(1,idsbry(istvar(itrc))))) THEN
196 got_var(idsbry(istvar(itrc)))=.true.
197 ini(ng)%Vid(idsbry(istvar(itrc)))=var_id(i)
198 END IF
199 END DO
200# endif
201# endif
202# ifdef ADJUST_WSTRESS
203 IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
204 got_var(idusms)=.true.
205 ini(ng)%Vid(idusms)=var_id(i)
206 IF (var_ndim(i).ne.4) THEN
207 IF (master) THEN
208 WRITE (stdout,20) trim(vname(1,idusms)), &
209 & var_ndim(i), 'frc_adjust', &
210 & trim(ncname)
211 END IF
212 exit_flag=2
213 RETURN
214 END IF
215 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
216 got_var(idvsms)=.true.
217 ini(ng)%Vid(idvsms)=var_id(i)
218 IF (var_ndim(i).ne.4) THEN
219 IF (master) THEN
220 WRITE (stdout,20) trim(vname(1,idusms)), &
221 & var_ndim(i), 'frc_adjust', &
222 & trim(ncname)
223 END IF
224 exit_flag=2
225 RETURN
226 END IF
227 END IF
228# endif
229# if defined ADJUST_STFLUX && defined SOLVE3D
230 DO itrc=1,nt(ng)
231 IF (lstflux(itrc,ng)) THEN
232 IF (trim(var_name(i)).eq.trim(vname(1,idtsur(itrc)))) THEN
233 got_var(idtsur(itrc))=.true.
234 ini(ng)%Vid(idtsur(itrc))=var_id(i)
235 IF (var_ndim(i).ne.4) THEN
236 IF (master) THEN
237 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
238 & var_ndim(i), 'frc_adjust', &
239 & trim(ncname)
240 END IF
241 exit_flag=2
242 RETURN
243 END IF
244 END IF
245 END IF
246 END DO
247# endif
248 END DO
249
250# ifdef ADJUST_BOUNDARY
251 IF (.not.got_var(idsbry(isfsur))) ldefine=.true.
252 IF (.not.got_var(idsbry(isubar))) ldefine=.true.
253 IF (.not.got_var(idsbry(isvbar))) ldefine=.true.
254# ifdef SOLVE3D
255 IF (.not.got_var(idsbry(isuvel))) ldefine=.true.
256 IF (.not.got_var(idsbry(isvvel))) ldefine=.true.
257 DO itrc=1,nt(ng)
258 IF (.not.got_var(idsbry(istvar(itrc))).and. &
259 & any(lobc(:,istvar(itrc),ng))) ldefine=.true.
260 END DO
261# endif
262# endif
263# ifdef ADJUST_WSTRESS
264 IF (.not.got_var(idusms)) ldefine=.true.
265 IF (.not.got_var(idvsms)) ldefine=.true.
266# endif
267# if defined ADJUST_STFLUX && defined SOLVE3D
268 DO itrc=1,nt(ng)
269 IF (lstflux(itrc,ng)) THEN
270 IF (.not.got_var(idtsur(itrc))) ldefine=.true.
271 END IF
272 END DO
273# endif
274!
275! Put existing file into define mode so new variables can be added.
276!
277 IF (ldefine) THEN
278 CALL netcdf_redef (ng, inlm, ncname, ini(ng)%ncid)
279 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
280 IF (master) WRITE (stdout,30) trim(ncname)
281 RETURN
282 END IF
283 END IF
284!
285!-----------------------------------------------------------------------
286! Define the dimensions of staggered fields.
287!-----------------------------------------------------------------------
288!
289 define: IF (ldefine) THEN
290
291# ifdef ADJUST_BOUNDARY
292 got_iorj=.false.
293 got_boundary=.false.
294 got_obc_adjust=.false.
295# endif
296# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
297 got_frc_adjust=.false.
298# endif
299 DO i=1,n_dim
300 SELECT CASE (trim(adjustl(dim_name(i))))
301 CASE ('xi_rho')
302 dimids( 1)=dim_id(i)
303 CASE ('xi_u')
304 dimids( 2)=dim_id(i)
305 CASE ('xi_v')
306 dimids( 3)=dim_id(i)
307 CASE ('eta_rho')
308 dimids( 5)=dim_id(i)
309 CASE ('eta_u')
310 dimids( 6)=dim_id(i)
311 CASE ('eta_v')
312 dimids( 7)=dim_id(i)
313# ifdef SOLVE3D
314 CASE ('s_rho')
315 dimids( 9)=dim_id(i)
316 CASE ('s_w')
317 dimids(10)=dim_id(i)
318# endif
319# ifdef ADJUST_BOUNDARY
320 CASE ('boundary')
321 dimids(14)=dim_id(i)
322 got_boundary=.true.
323 CASE ('IorJ')
324 iorjdim=dim_id(i)
325 got_iorj=.true.
326# endif
327# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
328 CASE ('frc_adjust')
329 frecdim=dim_id(i)
330 frecsize=dim_size(i)
331 got_frc_adjust=.true.
332# endif
333# ifdef ADJUST_BOUNDARY
334 CASE ('obc_adjust')
335 brecdim=dim_id(i)
336 brecsize=dim_size(i)
337 got_obc_adjust=.true.
338# endif
339 END SELECT
340 END DO
341
342 dimids(12)=rec_id
343# ifdef ADJUST_BOUNDARY
344 IF (.not.got_boundary) THEN
345 status=def_dim(ng, inlm, ini(ng)%ncid, ncname, &
346 & 'boundary', 4, dimids(14))
347 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
348 END IF
349 IF (.not.got_iorj) THEN
350 status=def_dim(ng, inlm, ini(ng)%ncid, ncname, &
351 & 'IorJ', iobounds(ng)%IorJ, iorjdim)
352 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
353 END IF
354# endif
355# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
356 IF (.not.got_frc_adjust) THEN
357 status=def_dim(ng, inlm, ini(ng)%ncid, ncname, &
358 & 'frc_adjust', nfrec(ng), frecdim)
359 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
360 END IF
361# endif
362# ifdef ADJUST_BOUNDARY
363 IF (.not.got_obc_adjust) THEN
364 status=def_dim(ng, inlm, ini(ng)%ncid, ncname, &
365 & 'obc_adjust', nbrec(ng), brecdim)
366 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
367 END IF
368# endif
369!
370! Define dimension vectors for staggered tracer type variables.
371!
372# ifdef ADJUST_BOUNDARY
373 t2dobc(1)=iorjdim
374 t2dobc(2)=dimids(14)
375 t2dobc(3)=brecdim
376 t2dobc(4)=dimids(12)
377# ifdef SOLVE3D
378 t3dobc(1)=iorjdim
379 t3dobc(2)=dimids( 9)
380 t3dobc(3)=dimids(14)
381 t3dobc(4)=brecdim
382 t3dobc(5)=dimids(12)
383# endif
384# endif
385# ifdef ADJUST_STFLUX
386 t4dfrc(1)=dimids( 1)
387 t4dfrc(2)=dimids( 5)
388 t4dfrc(3)=frecdim
389 t4dfrc(4)=dimids(12)
390# endif
391# ifdef ADJUST_WSTRESS
392!
393! Define dimension vectors for staggered u-momentum type variables.
394!
395 u4dfrc(1)=dimids( 2)
396 u4dfrc(2)=dimids( 6)
397 u4dfrc(3)=frecdim
398 u4dfrc(4)=dimids(12)
399# endif
400# ifdef ADJUST_WSTRESS
401!
402! Define dimension vectors for staggered v-momentum type variables.
403!
404 v4dfrc(1)=dimids( 3)
405 v4dfrc(2)=dimids( 7)
406 v4dfrc(3)=frecdim
407 v4dfrc(4)=dimids(12)
408# endif
409!
410! Initialize local information variable arrays.
411!
412 DO i=1,natt
413 DO j=1,len(vinfo(1))
414 vinfo(i)(j:j)=' '
415 END DO
416 END DO
417 DO i=1,6
418 aval(i)=0.0_r8
419 END DO
420!
421!-----------------------------------------------------------------------
422! Define additional variables. Notice that these variables have their
423! own fixed time-dimension to allow 4DVAR adjustments at other times
424! in addition to initialization time.
425!-----------------------------------------------------------------------
426
427# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
428!
429! Define free-surface open boundaries.
430!
431 IF (.not.got_var(idsbry(isfsur)).and. &
432 & any(lobc(:,isfsur,ng))) THEN
433 ifield=idsbry(isfsur)
434 vinfo( 1)=vname(1,ifield)
435 vinfo( 2)=vname(2,ifield)
436 vinfo( 3)=vname(3,ifield)
437 vinfo(14)=vname(4,ifield)
438 vinfo(16)=vname(1,idtime)
439 vinfo(21)=vname(6,ifield)
440 aval(5)=real(iinfo(1,ifield,ng),r8)
441 status=def_var(ng, inlm, ini(ng)%ncid, ini(ng)%Vid(ifield), &
442 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
443 & setfillval = .false.)
444 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
445 END IF
446!
447! Define 2D U-momentum component open boundaries.
448!
449 IF (.not.got_var(idsbry(isubar)).and. &
450 & any(lobc(:,isubar,ng))) THEN
451 ifield=idsbry(isubar)
452 vinfo( 1)=vname(1,ifield)
453 vinfo( 2)=vname(2,ifield)
454 vinfo( 3)=vname(3,ifield)
455 vinfo(14)=vname(4,ifield)
456 vinfo(16)=vname(1,idtime)
457 vinfo(21)=vname(6,ifield)
458 aval(5)=real(iinfo(1,ifield,ng),r8)
459 status=def_var(ng, inlm, ini(ng)%ncid, ini(ng)%Vid(ifield), &
460 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
461 & setfillval = .false.)
462 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
463 END IF
464!
465! Define 2D V-momentum component open boundaries.
466!
467 IF (.not.got_var(idsbry(isvbar)).and. &
468 & any(lobc(:,isvbar,ng))) THEN
469 ifield=idsbry(isvbar)
470 vinfo( 1)=vname(1,ifield)
471 vinfo( 2)=vname(2,ifield)
472 vinfo( 3)=vname(3,ifield)
473 vinfo(14)=vname(4,ifield)
474 vinfo(16)=vname(1,idtime)
475 vinfo(21)=vname(6,ifield)
476 aval(5)=real(iinfo(1,ifield,ng),r8)
477 status=def_var(ng, inlm, ini(ng)%ncid, ini(ng)%Vid(ifield), &
478 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
479 & setfillval = .false.)
480 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
481 END IF
482
483# ifdef SOLVE3D
484!
485! Define 3D U-momentum component open boundaries.
486!
487 IF (.not.got_var(idsbry(isuvel)).and. &
488 & any(lobc(:,isuvel,ng))) THEN
489 ifield=idsbry(isuvel)
490 vinfo( 1)=vname(1,ifield)
491 vinfo( 2)=vname(2,ifield)
492 vinfo( 3)=vname(3,ifield)
493 vinfo(14)=vname(4,ifield)
494 vinfo(16)=vname(1,idtime)
495 vinfo(21)=vname(6,ifield)
496 aval(5)=real(iinfo(1,ifield,ng),r8)
497 status=def_var(ng, inlm, ini(ng)%ncid, ini(ng)%Vid(ifield), &
498 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
499 & setfillval = .false.)
500 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
501 END IF
502!
503! Define 3D V-momentum component open boundaries.
504!
505 IF (.not.got_var(idsbry(isvvel)).and. &
506 & any(lobc(:,isvvel,ng))) THEN
507 ifield=idsbry(isvvel)
508 vinfo( 1)=vname(1,ifield)
509 vinfo( 2)=vname(2,ifield)
510 vinfo( 3)=vname(3,ifield)
511 vinfo(14)=vname(4,ifield)
512 vinfo(16)=vname(1,idtime)
513 vinfo(21)=vname(6,ifield)
514 aval(5)=real(iinfo(1,ifield,ng),r8)
515 status=def_var(ng, inlm, ini(ng)%ncid, ini(ng)%Vid(ifield), &
516 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
517 & setfillval = .false.)
518 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
519 END IF
520!
521! Define tracer type variables open boundaries.
522!
523 DO itrc=1,nt(ng)
524 IF (.not.got_var(idsbry(istvar(itrc))).and. &
525 & any(lobc(:,istvar(itrc),ng))) THEN
526 ifield=idsbry(istvar(itrc))
527 vinfo( 1)=vname(1,ifield)
528 vinfo( 2)=vname(2,ifield)
529 vinfo( 3)=vname(3,ifield)
530 vinfo(14)=vname(4,ifield)
531 vinfo(16)=vname(1,idtime)
532 vinfo(21)=vname(6,ifield)
533 aval(5)=real(iinfo(1,ifield,ng),r8)
534 status=def_var(ng, inlm, ini(ng)%ncid, ini(ng)%Vid(ifield), &
535 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
536 & setfillval = .false.)
537 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
538 END IF
539 END DO
540# endif
541# endif
542# ifdef ADJUST_WSTRESS
543!
544! Define surface U-momentum stress.
545!
546 IF (.not.got_var(idusms)) THEN
547 vinfo( 1)=vname(1,idusms)
548 vinfo( 2)=vname(2,idusms)
549 vinfo( 3)=vname(3,idusms)
550# if defined WRITE_WATER && defined MASKING
551 vinfo(20)='mask_u'
552# endif
553 vinfo(22)='coordinates'
554 aval(5)=real(u2dvar,r8)
555 status=def_var(ng, inlm, ini(ng)%ncid, ini(ng)%Vid(idusms), &
556 & nf_fout, 4, u4dfrc, aval, vinfo, ncname)
557 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
558 END IF
559!
560! Define surface V-momentum stress.
561!
562 IF (.not.got_var(idvsms)) THEN
563 vinfo( 1)=vname(1,idvsms)
564 vinfo( 2)=vname(2,idvsms)
565 vinfo( 3)=vname(3,idvsms)
566# if defined WRITE_WATER && defined MASKING
567 vinfo(20)='mask_v'
568# endif
569 vinfo(22)='coordinates'
570 aval(5)=real(v2dvar,r8)
571 status=def_var(ng, inlm, ini(ng)%ncid, ini(ng)%Vid(idvsms), &
572 & nf_fout, 4, v4dfrc, aval, vinfo, ncname)
573 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
574 END IF
575# endif
576# if defined ADJUST_STFLUX && defined SOLVE3D
577!
578! Define surface tracer flux.
579!
580 DO itrc=1,nt(ng)
581 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
582 vinfo( 1)=vname(1,idtsur(itrc))
583 vinfo( 2)=vname(2,idtsur(itrc))
584 vinfo( 3)=vname(3,idtsur(itrc))
585 IF (itrc.eq.itemp) THEN
586 vinfo(11)='upward flux, cooling'
587 vinfo(12)='downward flux, heating'
588 ELSE IF (itrc.eq.isalt) THEN
589 vinfo(11)='upward flux, freshening (net precipitation)'
590 vinfo(12)='downward flux, salting (net evaporation)'
591 END IF
592# if defined WRITE_WATER && defined MASKING
593 vinfo(20)='mask_rho'
594# endif
595 vinfo(22)='coordinates'
596 aval(5)=real(r2dvar,r8)
597 status=def_var(ng, inlm, ini(ng)%ncid, &
598 & ini(ng)%Vid(idtsur(itrc)), nf_fout, &
599 & 4, t4dfrc, aval, vinfo, ncname)
600 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
601 END IF
602 END DO
603# endif
604!
605!-----------------------------------------------------------------------
606! Leave definition mode.
607!-----------------------------------------------------------------------
608!
609 CALL netcdf_enddef (ng, inlm, ncname, ini(ng)%ncid)
610 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
611
612 END IF define
613# endif
614!
615!=======================================================================
616! Open an existing initialization file, check its contents, and
617! prepare for appending data.
618!=======================================================================
619!
620 IF (.not.ldefini(ng)) THEN
621 ncname=ini(ng)%name
622!
623! Open initialization file for read/write.
624!
625 IF (ini(ng)%ncid.eq.-1) THEN
626 CALL netcdf_open (ng, inlm, ncname, 1, ini(ng)%ncid)
627 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
628 WRITE (stdout,10) trim(ncname)
629 RETURN
630 END IF
631 END IF
632!
633! Inquire about the dimensions and check for consistency.
634!
635 CALL netcdf_check_dim (ng, inlm, ncname, &
636 & ncid = ini(ng)%ncid)
637 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
638!
639! Inquire about the variables.
640!
641 CALL netcdf_inq_var (ng, inlm, ncname, &
642 & ncid = ini(ng)%ncid)
643 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
644!
645! Initialize logical switches.
646!
647 DO i=1,nv
648 got_var(i)=.false.
649 END DO
650!
651! Scan variable list from input NetCDF and activate switches for
652! initialization variables. Get variable IDs.
653!
654 DO i=1,n_var
655 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
656 got_var(idtime)=.true.
657 ini(ng)%Vid(idtime)=var_id(i)
658 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
659 got_var(idfsur)=.true.
660 ini(ng)%Vid(idfsur)=var_id(i)
661 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
662 got_var(idubar)=.true.
663 ini(ng)%Vid(idubar)=var_id(i)
664 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
665 got_var(idvbar)=.true.
666 ini(ng)%Vid(idvbar)=var_id(i)
667# ifdef ADJUST_BOUNDARY
668 ELSE IF (trim(var_name(i)).eq. &
669 & trim(vname(1,idsbry(isfsur)))) THEN
670 got_var(idsbry(isfsur))=.true.
671 ini(ng)%Vid(idsbry(isfsur))=var_id(i)
672 ELSE IF (trim(var_name(i)).eq. &
673 & trim(vname(1,idsbry(isubar)))) THEN
674 got_var(idsbry(isubar))=.true.
675 ini(ng)%Vid(idsbry(isubar))=var_id(i)
676 ELSE IF (trim(var_name(i)).eq. &
677 & trim(vname(1,idsbry(isvbar)))) THEN
678 got_var(idsbry(isvbar))=.true.
679 ini(ng)%Vid(idsbry(isvbar))=var_id(i)
680# endif
681# ifdef ADJUST_WSTRESS
682 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
683 got_var(idusms)=.true.
684 ini(ng)%Vid(idusms)=var_id(i)
685 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
686 got_var(idvsms)=.true.
687 ini(ng)%Vid(idvsms)=var_id(i)
688# endif
689# ifdef SOLVE3D
690 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
691 got_var(iduvel)=.true.
692 ini(ng)%Vid(iduvel)=var_id(i)
693 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
694 got_var(idvvel)=.true.
695 ini(ng)%Vid(idvvel)=var_id(i)
696# ifdef ADJUST_BOUNDARY
697 ELSE IF (trim(var_name(i)).eq. &
698 & trim(vname(1,idsbry(isuvel)))) THEN
699 got_var(idsbry(isuvel))=.true.
700 ini(ng)%Vid(idsbry(isuvel))=var_id(i)
701 ELSE IF (trim(var_name(i)).eq. &
702 & trim(vname(1,idsbry(isvvel)))) THEN
703 got_var(idsbry(isvvel))=.true.
704 ini(ng)%Vid(idsbry(isvvel))=var_id(i)
705# endif
706# if defined BVF_MIXING || defined LMD_MIXING || \
707 defined gls_mixing || defined my25_mixing
708 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvis))) THEN
709 got_var(idvvis)=.true.
710 ini(ng)%Vid(idvvis)=var_id(i)
711 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idtdif))) THEN
712 got_var(idtdif)=.true.
713 ini(ng)%Vid(idtdif)=var_id(i)
714 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idsdif))) THEN
715 got_var(idsdif)=.true.
716 ini(ng)%Vid(idsdif)=var_id(i)
717# endif
718# endif
719 END IF
720# ifdef SOLVE3D
721 DO itrc=1,nt(ng)
722 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
723 got_var(idtvar(itrc))=.true.
724 ini(ng)%Tid(itrc)=var_id(i)
725# ifdef ADJUST_BOUNDARY
726 ELSE IF (trim(var_name(i)).eq. &
727 & trim(vname(1,idsbry(istvar(itrc))))) THEN
728 got_var(idsbry(istvar(itrc)))=.true.
729 ini(ng)%Vid(idsbry(istvar(itrc)))=var_id(i)
730# endif
731# ifdef ADJUST_STFLUX
732 ELSE IF (trim(var_name(i)).eq. &
733 & trim(vname(1,idtsur(itrc)))) THEN
734 got_var(idtsur(itrc))=.true.
735 ini(ng)%Vid(idtsur(itrc))=var_id(i)
736# endif
737 END IF
738 END DO
739# endif
740 END DO
741!
742! Check if initialization variables are available in input NetCDF
743! file.
744!
745 IF (.not.got_var(idtime)) THEN
746 IF (master) WRITE (stdout,40) trim(vname(1,idtime)), &
747 & trim(ncname)
748 exit_flag=3
749 RETURN
750 END IF
751 IF (.not.got_var(idfsur)) THEN
752 IF (master) WRITE (stdout,40) trim(vname(1,idfsur)), &
753 & trim(ncname)
754 exit_flag=3
755 RETURN
756 END IF
757 IF (.not.got_var(idubar)) THEN
758 IF (master) WRITE (stdout,40) trim(vname(1,idubar)), &
759 & trim(ncname)
760 exit_flag=3
761 RETURN
762 END IF
763 IF (.not.got_var(idvbar)) THEN
764 IF (master) WRITE (stdout,40) trim(vname(1,idvbar)), &
765 & trim(ncname)
766 exit_flag=3
767 RETURN
768 END IF
769# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
770 IF (.not.got_var(idsbry(isfsur)).and. &
771 & any(lobc(:,isfsur,ng))) THEN
772 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isfsur))), &
773 & trim(ncname)
774 exit_flag=3
775 RETURN
776 END IF
777 IF (.not.got_var(idsbry(isubar)).and. &
778 & any(lobc(:,isubar,ng))) THEN
779 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isubar))), &
780 & trim(ncname)
781 exit_flag=3
782 RETURN
783 END IF
784 IF (.not.got_var(idsbry(isvbar)).and. &
785 & any(lobc(:,isvbar,ng))) THEN
786 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isvbar))), &
787 & trim(ncname)
788 exit_flag=3
789 RETURN
790 END IF
791# endif
792# ifdef ADJUST_WSTRESS
793 IF (.not.got_var(idusms)) THEN
794 IF (master) WRITE (stdout,40) trim(vname(1,idusms)), &
795 & trim(ncname)
796 exit_flag=3
797 RETURN
798 END IF
799 IF (.not.got_var(idvsms)) THEN
800 IF (master) WRITE (stdout,40) trim(vname(1,idvsms)), &
801 & trim(ncname)
802 exit_flag=3
803 RETURN
804 END IF
805# endif
806# ifdef SOLVE3D
807 IF (.not.got_var(iduvel)) THEN
808 IF (master) WRITE (stdout,40) trim(vname(1,iduvel)), &
809 & trim(ncname)
810 exit_flag=3
811 RETURN
812 END IF
813 IF (.not.got_var(idvvel)) THEN
814 IF (master) WRITE (stdout,40) trim(vname(1,idvvel)), &
815 & trim(ncname)
816 exit_flag=3
817 RETURN
818 END IF
819# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
820 IF (.not.got_var(idsbry(isuvel)).and. &
821 & any(lobc(:,isuvel,ng))) THEN
822 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isuvel))), &
823 & trim(ncname)
824 exit_flag=3
825 RETURN
826 END IF
827 IF (.not.got_var(idsbry(isvvel)).and. &
828 & any(lobc(:,isvvel,ng))) THEN
829 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isvvel))), &
830 & trim(ncname)
831 exit_flag=3
832 RETURN
833 END IF
834# endif
835 DO itrc=1,nt(ng)
836 IF (.not.got_var(idtvar(itrc))) THEN
837 IF (master) WRITE (stdout,40) trim(vname(1,idtvar(itrc))), &
838 & trim(ncname)
839 exit_flag=3
840 RETURN
841 END IF
842# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
843 IF (.not.got_var(idsbry(istvar(itrc))).and. &
844 & any(lobc(:,istvar(itrc),ng))) THEN
845 IF (master) WRITE (stdout,40) &
846 & trim(vname(1,idsbry(istvar(itrc)))), &
847 & trim(ncname)
848 exit_flag=3
849 RETURN
850 END IF
851# endif
852# ifdef ADJUST_STFLUX
853 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
854 IF (master) WRITE (stdout,40) trim(vname(1,idtsur(itrc))), &
855 & trim(ncname)
856 exit_flag=3
857 RETURN
858 END IF
859# endif
860 END DO
861# endif
862!
863! Set unlimited time record dimension to the appropriate value.
864!
865 ini(ng)%Rindex=rec_size
866 fcount=ini(ng)%Fcount
867 ini(ng)%Nrec(fcount)=rec_size
868 END IF
869!
870 10 FORMAT (/,' DEF_INI_NF90 - unable to open initial NetCDF', &
871 & ' file: ',a)
872 20 FORMAT (/,' DEF_INI_NF90 - illegal dimensions for variable : ',a, &
873 & /,16x,'Nvardims = ',i0,', missing dimension: ''',a,'''', &
874 & /,16x,'in file: ',a, &
875 & /,16x,'Remove such variable from input file.')
876 30 FORMAT (/,' DEF_INI_NF90 - unable to put in define mode initial', &
877 & ' NetCDF file: ',a)
878 40 FORMAT (/,' DEF_INI_NF90 - unable to find variable: ',a,2x, &
879 & ' in file: ',a)
880!
881 RETURN
882 END SUBROUTINE def_ini_nf90
883
884# if defined PIO_LIB && defined DISTRIBUTE
885!
886!***********************************************************************
887 SUBROUTINE def_ini_pio (ng)
888!***********************************************************************
889!
890 USE mod_pio_netcdf
891!
892! Imported variable declarations.
893!
894 integer, intent(in) :: ng
895!
896! Local variable declarations.
897!
898# ifdef ADJUST_BOUNDARY
899 logical :: got_iorj, got_boundary, got_obc_adjust
900# endif
901# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
902 logical :: got_frc_adjust
903# endif
904 logical :: got_var(nv)
905 logical :: ldefine = .false.
906!
907 integer, parameter :: natt = 25
908
909 integer :: i, j, ifield, itrc, status
910 integer :: fcount
911# ifdef ADJUST_BOUNDARY
912 integer :: iorjdim, brecdim, brecsize
913# endif
914# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
915 integer :: frecdim, frecsize
916# endif
917 integer :: dimids(ndimid)
918# ifdef ADJUST_BOUNDARY
919 integer :: t2dobc(4)
920# ifdef SOLVE3D
921 integer :: t3dobc(5)
922# endif
923# endif
924# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
925 integer :: t4dfrc(4), u4dfrc(4), v4dfrc(4)
926# endif
927!
928 real(r8) :: aval(6)
929!
930 character (len=256) :: ncname
931 character (len=MaxLen) :: vinfo(natt)
932
933 character (len=*), parameter :: myfile = &
934 & __FILE__//", def_ini_pio"
935!
936 sourcefile=myfile
937
938# if !defined CORRELATION && \
939 (defined adjust_boundary || defined adjust_stflux || \
940 defined adjust_wstress)
941!
942!=======================================================================
943! Open existing nonlinear model initial conditions and define new
944! variables.
945!=======================================================================
946!
947 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
948 ncname=ini(ng)%name
949!
950! Open initialization file for read/write.
951!
952 CALL pio_netcdf_open (ng, inlm, ncname, 1, ini(ng)%pioFile)
953 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
954 IF (master) WRITE (stdout,10) trim(ncname)
955 RETURN
956 END IF
957!
958! Inquire about the dimensions and check for consistency.
959!
960 CALL pio_netcdf_check_dim (ng, inlm, ncname, &
961 & piofile = ini(ng)%pioFile)
962 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
963!
964! Inquire about the variables.
965!
966 CALL pio_netcdf_inq_var (ng, inlm, ncname, &
967 & piofile = ini(ng)%pioFile)
968 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
969!
970! Check if surface forcing variables have been already defined.
971!
972 DO i=1,nv
973 got_var(i)=.false.
974 END DO
975!
976 DO i=1,n_var
977# ifdef ADJUST_BOUNDARY
978 IF (trim(var_name(i)).eq. &
979 & trim(vname(1,idsbry(isfsur)))) THEN
980 got_var(idsbry(isfsur))=.true.
981 ini(ng)%pioVar(idsbry(isfsur))%vd=var_desc(i)
982 ini(ng)%pioVar(idsbry(isfsur))%dkind=pio_fout
983 ini(ng)%pioVar(idsbry(isfsur))%gtype=r2dobc
984 ELSE IF (trim(var_name(i)).eq. &
985 & trim(vname(1,idsbry(isubar)))) THEN
986 got_var(idsbry(isubar))=.true.
987 ini(ng)%pioVar(idsbry(isubar))%vd=var_desc(i)
988 ini(ng)%pioVar(idsbry(isubar))%dkind=pio_fout
989 ini(ng)%pioVar(idsbry(isubar))%gtype=u2dobc
990 ELSE IF (trim(var_name(i)).eq. &
991 & trim(vname(1,idsbry(isvbar)))) THEN
992 got_var(idsbry(isvbar))=.true.
993 ini(ng)%pioVar(idsbry(isvbar))%vd=var_desc(i)
994 ini(ng)%pioVar(idsbry(isvbar))%dkind=pio_fout
995 ini(ng)%pioVar(idsbry(isvbar))%gtype=v2dobc
996# ifdef SOLVE3D
997 ELSE IF (trim(var_name(i)).eq. &
998 & trim(vname(1,idsbry(isuvel)))) THEN
999 got_var(idsbry(isuvel))=.true.
1000 ini(ng)%pioVar(idsbry(isuvel))%vd=var_desc(i)
1001 ini(ng)%pioVar(idsbry(isuvel))%dkind=pio_fout
1002 ini(ng)%pioVar(idsbry(isuvel))%gtype=u3dobc
1003 ELSE IF (trim(var_name(i)).eq. &
1004 & trim(vname(1,idsbry(isvvel)))) THEN
1005 got_var(idsbry(isvvel))=.true.
1006 ini(ng)%pioVar(idsbry(isvvel))%vd=var_desc(i)
1007 ini(ng)%pioVar(idsbry(isvvel))%dkind=pio_fout
1008 ini(ng)%pioVar(idsbry(isvvel))%gtype=v3dobc
1009# endif
1010 END IF
1011# ifdef SOLVE3D
1012 DO itrc=1,nt(ng)
1013 IF (trim(var_name(i)).eq. &
1014 & trim(vname(1,idsbry(istvar(itrc))))) THEN
1015 got_var(idsbry(istvar(itrc)))=.true.
1016 ini(ng)%pioVar(idsbry(istvar(itrc)))%vd=var_desc(i)
1017 ini(ng)%pioVar(idsbry(istvar(itrc)))%dkind=pio_fout
1018 ini(ng)%pioVar(idsbry(istvar(itrc)))%gtype=r3dobc
1019 END IF
1020 END DO
1021# endif
1022# endif
1023# ifdef ADJUST_WSTRESS
1024 IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
1025 got_var(idusms)=.true.
1026 ini(ng)%pioVar(idusms)%vd=var_desc(i)
1027 ini(ng)%pioVar(idusms)%dkind=pio_fout
1028 ini(ng)%pioVar(idusms)%gtype=u2dvar
1029 IF (var_ndim(i).ne.4) THEN
1030 IF (master) THEN
1031 WRITE (stdout,20) trim(vname(1,idusms)), &
1032 & var_ndim(i), 'frc_adjust', &
1033 & trim(ncname)
1034 END IF
1035 exit_flag=2
1036 RETURN
1037 END IF
1038 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
1039 got_var(idvsms)=.true.
1040 ini(ng)%pioVar(idvsms)%vd=var_desc(i)
1041 ini(ng)%pioVar(idvsms)%dkind=pio_fout
1042 ini(ng)%pioVar(idvsms)%gtype=v2dvar
1043 IF (var_ndim(i).ne.4) THEN
1044 IF (master) THEN
1045 WRITE (stdout,20) trim(vname(1,idvsms)), &
1046 & var_ndim(i), 'frc_adjust', &
1047 & trim(ncname)
1048 END IF
1049 exit_flag=2
1050 RETURN
1051 END IF
1052 END IF
1053# endif
1054# if defined ADJUST_STFLUX && defined SOLVE3D
1055 DO itrc=1,nt(ng)
1056 IF (lstflux(itrc,ng)) THEN
1057 IF (trim(var_name(i)).eq.trim(vname(1,idtsur(itrc)))) THEN
1058 got_var(idtsur(itrc))=.true.
1059 ini(ng)%pioVar(idtsur(itrc))%vd=var_desc(i)
1060 ini(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
1061 ini(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1062 IF (var_ndim(i).ne.4) THEN
1063 IF (master) THEN
1064 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
1065 & var_ndim(i), 'frc_adjust', &
1066 & trim(ncname)
1067 END IF
1068 exit_flag=2
1069 RETURN
1070 END IF
1071 END IF
1072 END IF
1073 END DO
1074# endif
1075 END DO
1076
1077# ifdef ADJUST_BOUNDARY
1078 IF (.not.got_var(idsbry(isfsur))) ldefine=.true.
1079 IF (.not.got_var(idsbry(isubar))) ldefine=.true.
1080 IF (.not.got_var(idsbry(isvbar))) ldefine=.true.
1081# ifdef SOLVE3D
1082 IF (.not.got_var(idsbry(isuvel))) ldefine=.true.
1083 IF (.not.got_var(idsbry(isvvel))) ldefine=.true.
1084 DO itrc=1,nt(ng)
1085 IF (.not.got_var(idsbry(istvar(itrc))).and. &
1086 & any(lobc(:,istvar(itrc),ng))) ldefine=.true.
1087 END DO
1088# endif
1089# endif
1090# ifdef ADJUST_WSTRESS
1091 IF (.not.got_var(idusms)) ldefine=.true.
1092 IF (.not.got_var(idvsms)) ldefine=.true.
1093# endif
1094# if defined ADJUST_STFLUX && defined SOLVE3D
1095 DO itrc=1,nt(ng)
1096 IF (lstflux(itrc,ng)) THEN
1097 IF (.not.got_var(idtsur(itrc))) ldefine=.true.
1098 END IF
1099 END DO
1100# endif
1101!
1102! Put existing file into define mode so new variables can be added.
1103!
1104 IF (ldefine) THEN
1105 CALL pio_netcdf_redef (ng, inlm, ncname, ini(ng)%pioFile)
1106 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1107 IF (master) WRITE (stdout,30) trim(ncname)
1108 RETURN
1109 END IF
1110 END IF
1111!
1112!-----------------------------------------------------------------------
1113! Define the dimensions of staggered fields.
1114!-----------------------------------------------------------------------
1115!
1116 define: IF (ldefine) THEN
1117
1118# ifdef ADJUST_BOUNDARY
1119 got_iorj=.false.
1120 got_boundary=.false.
1121 got_obc_adjust=.false.
1122# endif
1123# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1124 got_frc_adjust=.false.
1125# endif
1126 DO i=1,n_dim
1127 SELECT CASE (trim(adjustl(dim_name(i))))
1128 CASE ('xi_rho')
1129 dimids( 1)=dim_id(i)
1130 CASE ('xi_u')
1131 dimids( 2)=dim_id(i)
1132 CASE ('xi_v')
1133 dimids( 3)=dim_id(i)
1134 CASE ('eta_rho')
1135 dimids( 5)=dim_id(i)
1136 CASE ('eta_u')
1137 dimids( 6)=dim_id(i)
1138 CASE ('eta_v')
1139 dimids( 7)=dim_id(i)
1140# ifdef SOLVE3D
1141 CASE ('s_rho')
1142 dimids( 9)=dim_id(i)
1143 CASE ('s_w')
1144 dimids(10)=dim_id(i)
1145# endif
1146# ifdef ADJUST_BOUNDARY
1147 CASE ('boundary')
1148 dimids(14)=dim_id(i)
1149 got_boundary=.true.
1150 CASE ('IorJ')
1151 iorjdim=dim_id(i)
1152 got_iorj=.true.
1153# endif
1154# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1155 CASE ('frc_adjust')
1156 frecdim=dim_id(i)
1157 frecsize=dim_size(i)
1158 got_frc_adjust=.true.
1159# endif
1160# ifdef ADJUST_BOUNDARY
1161 CASE ('obc_adjust')
1162 brecdim=dim_id(i)
1163 brecsize=dim_size(i)
1164 got_obc_adjust=.true.
1165# endif
1166 END SELECT
1167 END DO
1168!
1169 dimids(12)=rec_id
1170# ifdef ADJUST_BOUNDARY
1171 IF (.not.got_boundary) THEN
1172 status=def_dim(ng, inlm, ini(ng)%pioFile, ncname, &
1173 & 'boundary', 4, dimids(14))
1174 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1175 END IF
1176 IF (.not.got_iorj) THEN
1177 status=def_dim(ng, inlm, ini(ng)%pioFile, ncname, &
1178 & 'IorJ', iobounds(ng)%IorJ, iorjdim)
1179 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1180 END IF
1181# endif
1182# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1183 IF (.not.got_frc_adjust) THEN
1184 status=def_dim(ng, inlm, ini(ng)%pioFile, ncname, &
1185 & 'frc_adjust', nfrec(ng), frecdim)
1186 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1187 END IF
1188# endif
1189# ifdef ADJUST_BOUNDARY
1190 IF (.not.got_obc_adjust) THEN
1191 status=def_dim(ng, inlm, ini(ng)%pioFile, ncname, &
1192 & 'obc_adjust', nbrec(ng), brecdim)
1193 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1194 END IF
1195# endif
1196!
1197! Define dimension vectors for staggered tracer type variables.
1198!
1199# ifdef ADJUST_BOUNDARY
1200 t2dobc(1)=iorjdim
1201 t2dobc(2)=dimids(14)
1202 t2dobc(3)=brecdim
1203 t2dobc(4)=dimids(12)
1204# ifdef SOLVE3D
1205 t3dobc(1)=iorjdim
1206 t3dobc(2)=dimids( 9)
1207 t3dobc(3)=dimids(14)
1208 t3dobc(4)=brecdim
1209 t3dobc(5)=dimids(12)
1210# endif
1211# endif
1212# ifdef ADJUST_STFLUX
1213 t4dfrc(1)=dimids( 1)
1214 t4dfrc(2)=dimids( 5)
1215 t4dfrc(3)=frecdim
1216 t4dfrc(4)=dimids(12)
1217# endif
1218# ifdef ADJUST_WSTRESS
1219!
1220! Define dimension vectors for staggered u-momentum type variables.
1221!
1222 u4dfrc(1)=dimids( 2)
1223 u4dfrc(2)=dimids( 6)
1224 u4dfrc(3)=frecdim
1225 u4dfrc(4)=dimids(12)
1226# endif
1227# ifdef ADJUST_WSTRESS
1228!
1229! Define dimension vectors for staggered v-momentum type variables.
1230!
1231 v4dfrc(1)=dimids( 3)
1232 v4dfrc(2)=dimids( 7)
1233 v4dfrc(3)=frecdim
1234 v4dfrc(4)=dimids(12)
1235# endif
1236!
1237! Initialize local information variable arrays.
1238!
1239 DO i=1,natt
1240 DO j=1,len(vinfo(1))
1241 vinfo(i)(j:j)=' '
1242 END DO
1243 END DO
1244 DO i=1,6
1245 aval(i)=0.0_r8
1246 END DO
1247!
1248!-----------------------------------------------------------------------
1249! Define additional variables. Notice that these variables have their
1250! own fixed time-dimension to allow 4DVAR adjustments at other times
1251! in addition to initialization time.
1252!-----------------------------------------------------------------------
1253
1254# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
1255!
1256! Define free-surface open boundaries.
1257!
1258 IF (.not.got_var(idsbry(isfsur)).and. &
1259 & any(lobc(:,isfsur,ng))) THEN
1260 ifield=idsbry(isfsur)
1261 vinfo( 1)=vname(1,ifield)
1262 vinfo( 2)=vname(2,ifield)
1263 vinfo( 3)=vname(3,ifield)
1264 vinfo(14)=vname(4,ifield)
1265 vinfo(16)=vname(1,idtime)
1266 vinfo(21)=vname(6,ifield)
1267 aval(5)=real(iinfo(1,ifield,ng),r8)
1268 ini(ng)%pioVar(ifield)%dkind=pio_fout
1269 ini(ng)%pioVar(ifield)%gtype=r2dobc
1270!
1271 status=def_var(ng, inlm, ini(ng)%pioFile, &
1272 & ini(ng)%pioVar(ifield)%vd, &
1273 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1274 & setfillval = .false.)
1275 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1276 END IF
1277!
1278! Define 2D U-momentum component open boundaries.
1279!
1280 IF (.not.got_var(idsbry(isubar)).and. &
1281 & any(lobc(:,isubar,ng))) THEN
1282 ifield=idsbry(isubar)
1283 vinfo( 1)=vname(1,ifield)
1284 vinfo( 2)=vname(2,ifield)
1285 vinfo( 3)=vname(3,ifield)
1286 vinfo(14)=vname(4,ifield)
1287 vinfo(16)=vname(1,idtime)
1288 vinfo(21)=vname(6,ifield)
1289 aval(5)=real(iinfo(1,ifield,ng),r8)
1290 ini(ng)%pioVar(ifield)%dkind=pio_fout
1291 ini(ng)%pioVar(ifield)%gtype=u2dobc
1292!
1293 status=def_var(ng, inlm, ini(ng)%pioFile, &
1294 & ini(ng)%pioVar(ifield)%vd, &
1295 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1296 & setfillval = .false.)
1297 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1298 END IF
1299!
1300! Define 2D V-momentum component open boundaries.
1301!
1302 IF (.not.got_var(idsbry(isvbar)).and. &
1303 & any(lobc(:,isvbar,ng))) THEN
1304 ifield=idsbry(isvbar)
1305 vinfo( 1)=vname(1,ifield)
1306 vinfo( 2)=vname(2,ifield)
1307 vinfo( 3)=vname(3,ifield)
1308 vinfo(14)=vname(4,ifield)
1309 vinfo(16)=vname(1,idtime)
1310 vinfo(21)=vname(6,ifield)
1311 aval(5)=real(iinfo(1,ifield,ng),r8)
1312 ini(ng)%pioVar(ifield)%dkind=pio_fout
1313 ini(ng)%pioVar(ifield)%gtype=v2dobc
1314!
1315 status=def_var(ng, inlm, ini(ng)%pioFile, &
1316 & ini(ng)%pioVar(ifield)%vd, &
1317 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1318 & setfillval = .false.)
1319 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1320 END IF
1321
1322# ifdef SOLVE3D
1323!
1324! Define 3D U-momentum component open boundaries.
1325!
1326 IF (.not.got_var(idsbry(isuvel)).and. &
1327 & any(lobc(:,isuvel,ng))) THEN
1328 ifield=idsbry(isuvel)
1329 vinfo( 1)=vname(1,ifield)
1330 vinfo( 2)=vname(2,ifield)
1331 vinfo( 3)=vname(3,ifield)
1332 vinfo(14)=vname(4,ifield)
1333 vinfo(16)=vname(1,idtime)
1334 vinfo(21)=vname(6,ifield)
1335 aval(5)=real(iinfo(1,ifield,ng),r8)
1336 ini(ng)%pioVar(ifield)%dkind=pio_fout
1337 ini(ng)%pioVar(ifield)%gtype=u3dobc
1338!
1339 status=def_var(ng, inlm, ini(ng)%pioFile, &
1340 & ini(ng)%pioVar(ifield)%vd, &
1341 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1342 & setfillval = .false.)
1343 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1344 END IF
1345!
1346! Define 3D V-momentum component open boundaries.
1347!
1348 IF (.not.got_var(idsbry(isvvel)).and. &
1349 & any(lobc(:,isvvel,ng))) THEN
1350 ifield=idsbry(isvvel)
1351 vinfo( 1)=vname(1,ifield)
1352 vinfo( 2)=vname(2,ifield)
1353 vinfo( 3)=vname(3,ifield)
1354 vinfo(14)=vname(4,ifield)
1355 vinfo(16)=vname(1,idtime)
1356 vinfo(21)=vname(6,ifield)
1357 aval(5)=real(iinfo(1,ifield,ng),r8)
1358 ini(ng)%pioVar(ifield)%dkind=pio_fout
1359 ini(ng)%pioVar(ifield)%gtype=v3dobc
1360!
1361 status=def_var(ng, inlm, ini(ng)%pioFile, &
1362 & ini(ng)%pioVar(ifield)%vd, &
1363 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1364 & setfillval = .false.)
1365 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1366 END IF
1367!
1368! Define tracer type variables open boundaries.
1369!
1370 DO itrc=1,nt(ng)
1371 IF (.not.got_var(idsbry(istvar(itrc))).and. &
1372 & any(lobc(:,istvar(itrc),ng))) THEN
1373 ifield=idsbry(istvar(itrc))
1374 vinfo( 1)=vname(1,ifield)
1375 vinfo( 2)=vname(2,ifield)
1376 vinfo( 3)=vname(3,ifield)
1377 vinfo(14)=vname(4,ifield)
1378 vinfo(16)=vname(1,idtime)
1379 vinfo(21)=vname(6,ifield)
1380 aval(5)=real(iinfo(1,ifield,ng),r8)
1381 ini(ng)%pioVar(ifield)%dkind=pio_fout
1382 ini(ng)%pioVar(ifield)%gtype=r3dobc
1383!
1384 status=def_var(ng, inlm, ini(ng)%pioFile, &
1385 & ini(ng)%pioVar(ifield)%vd, &
1386 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1387 & setfillval = .false.)
1388 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1389 END IF
1390 END DO
1391# endif
1392# endif
1393# ifdef ADJUST_WSTRESS
1394!
1395! Define surface U-momentum stress.
1396!
1397 IF (.not.got_var(idusms)) THEN
1398 vinfo( 1)=vname(1,idusms)
1399 vinfo( 2)=vname(2,idusms)
1400 vinfo( 3)=vname(3,idusms)
1401# if defined WRITE_WATER && defined MASKING
1402 vinfo(20)='mask_u'
1403# endif
1404 vinfo(22)='coordinates'
1405 aval(5)=real(u2dvar,r8)
1406 ini(ng)%pioVar(idusms)%dkind=pio_fout
1407 ini(ng)%pioVar(idusms)%gtype=u2dvar
1408!
1409 status=def_var(ng, inlm, ini(ng)%pioFile, &
1410 & ini(ng)%pioVar(idusms)%vd, &
1411 & pio_fout, 4, u4dfrc, aval, vinfo, ncname)
1412 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1413 END IF
1414!
1415! Define surface V-momentum stress.
1416!
1417 IF (.not.got_var(idvsms)) THEN
1418 vinfo( 1)=vname(1,idvsms)
1419 vinfo( 2)=vname(2,idvsms)
1420 vinfo( 3)=vname(3,idvsms)
1421# if defined WRITE_WATER && defined MASKING
1422 vinfo(20)='mask_v'
1423# endif
1424 vinfo(22)='coordinates'
1425 aval(5)=real(v2dvar,r8)
1426 ini(ng)%pioVar(idvsms)%dkind=pio_fout
1427 ini(ng)%pioVar(idvsms)%gtype=v2dvar
1428!
1429 status=def_var(ng, inlm, ini(ng)%pioFile, &
1430 & ini(ng)%pioVar(idvsms)%vd, &
1431 & pio_fout, 4, v4dfrc, aval, vinfo, ncname)
1432 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1433 END IF
1434# endif
1435
1436# if defined ADJUST_STFLUX && defined SOLVE3D
1437!
1438! Define surface tracer flux.
1439!
1440 DO itrc=1,nt(ng)
1441 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
1442 vinfo( 1)=vname(1,idtsur(itrc))
1443 vinfo( 2)=vname(2,idtsur(itrc))
1444 vinfo( 3)=vname(3,idtsur(itrc))
1445 IF (itrc.eq.itemp) THEN
1446 vinfo(11)='upward flux, cooling'
1447 vinfo(12)='downward flux, heating'
1448 ELSE IF (itrc.eq.isalt) THEN
1449 vinfo(11)='upward flux, freshening (net precipitation)'
1450 vinfo(12)='downward flux, salting (net evaporation)'
1451 END IF
1452# if defined WRITE_WATER && defined MASKING
1453 vinfo(20)='mask_rho'
1454# endif
1455 vinfo(22)='coordinates'
1456 aval(5)=real(r2dvar,r8)
1457 ini(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
1458 ini(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1459!
1460 status=def_var(ng, inlm, ini(ng)%pioFile, &
1461 & ini(ng)%pioVar(idtsur(itrc))%vd, &
1462 & pio_fout, 4, t4dfrc, aval, vinfo, ncname)
1463 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1464 END IF
1465 END DO
1466# endif
1467!
1468!-----------------------------------------------------------------------
1469! Leave definition mode.
1470!-----------------------------------------------------------------------
1471!
1472 CALL pio_netcdf_enddef (ng, inlm, ncname, ini(ng)%pioFile)
1473 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1474
1475 END IF define
1476# endif
1477!
1478!=======================================================================
1479! Open an existing initialization file, check its contents, and
1480! prepare for appending data.
1481!=======================================================================
1482!
1483 IF (.not.ldefini(ng)) THEN
1484 ncname=ini(ng)%name
1485!
1486! Open initialization file for read/write.
1487!
1488 IF (ini(ng)%pioFile%fh.eq.-1) THEN
1489 CALL pio_netcdf_open (ng, inlm, ncname, 1, ini(ng)%pioFile)
1490 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1491 WRITE (stdout,10) trim(ncname)
1492 RETURN
1493 END IF
1494 END IF
1495!
1496! Inquire about the dimensions and check for consistency.
1497!
1498 CALL pio_netcdf_check_dim (ng, inlm, ncname, &
1499 & piofile = ini(ng)%pioFile)
1500 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1501!
1502! Inquire about the variables.
1503!
1504 CALL pio_netcdf_inq_var (ng, inlm, ncname, &
1505 & piofile = ini(ng)%pioFile)
1506 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1507!
1508! Initialize logical switches.
1509!
1510 DO i=1,nv
1511 got_var(i)=.false.
1512 END DO
1513!
1514! Scan variable list from input NetCDF and activate switches for
1515! initialization variables. Get variable IDs.
1516!
1517 DO i=1,n_var
1518 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
1519 got_var(idtime)=.true.
1520 ini(ng)%pioVar(idtime)%vd=var_desc(i)
1521 ini(ng)%pioVar(idtime)%dkind=pio_tout
1522 ini(ng)%pioVar(idtime)%gtype=0
1523 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
1524 got_var(idfsur)=.true.
1525 ini(ng)%pioVar(idfsur)%vd=var_desc(i)
1526 ini(ng)%pioVar(idfsur)%dkind=pio_fout
1527 ini(ng)%pioVar(idfsur)%gtype=r2dvar
1528 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
1529 got_var(idubar)=.true.
1530 ini(ng)%pioVar(idubar)%vd=var_desc(i)
1531 ini(ng)%pioVar(idubar)%dkind=pio_fout
1532 ini(ng)%pioVar(idubar)%gtype=u2dvar
1533 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
1534 got_var(idvbar)=.true.
1535 ini(ng)%pioVar(idvbar)%vd=var_desc(i)
1536 ini(ng)%pioVar(idvbar)%dkind=pio_fout
1537 ini(ng)%pioVar(idvbar)%gtype=v2dvar
1538# ifdef ADJUST_BOUNDARY
1539 ELSE IF (trim(var_name(i)).eq. &
1540 & trim(vname(1,idsbry(isfsur)))) THEN
1541 got_var(idsbry(isfsur))=.true.
1542 ini(ng)%pioVar(idsbry(isfsur))%vd=var_desc(i)
1543 ini(ng)%pioVar(idsbry(isfsur))%dkind=pio_fout
1544 ini(ng)%pioVar(idsbry(isfsur))%gtype=r2dobc
1545 ELSE IF (trim(var_name(i)).eq. &
1546 & trim(vname(1,idsbry(isubar)))) THEN
1547 got_var(idsbry(isubar))=.true.
1548 ini(ng)%pioVar(idsbry(isubar))%vd=var_desc(i)
1549 ini(ng)%pioVar(idsbry(isubar))%dkind=pio_fout
1550 ini(ng)%pioVar(idsbry(isubar))%gtype=u2dobc
1551 ELSE IF (trim(var_name(i)).eq. &
1552 & trim(vname(1,idsbry(isvbar)))) THEN
1553 got_var(idsbry(isvbar))=.true.
1554 ini(ng)%pioVar(idsbry(isvbar))%vd=var_desc(i)
1555 ini(ng)%pioVar(idsbry(isvbar))%dkind=pio_fout
1556 ini(ng)%pioVar(idsbry(isvbar))%gtype=v2dobc
1557# endif
1558# ifdef ADJUST_WSTRESS
1559 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
1560 got_var(idusms)=.true.
1561 ini(ng)%pioVar(idusms)%vd=var_desc(i)
1562 ini(ng)%pioVar(idusms)%dkind=pio_fout
1563 ini(ng)%pioVar(idusms)%gtype=u2dvar
1564 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
1565 got_var(idvsms)=.true.
1566 ini(ng)%pioVar(idvsms)%vd=var_desc(i)
1567 ini(ng)%pioVar(idvsms)%dkind=pio_fout
1568 ini(ng)%pioVar(idvsms)%gtype=v2dvar
1569# endif
1570# ifdef SOLVE3D
1571 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
1572 got_var(iduvel)=.true.
1573 ini(ng)%pioVar(iduvel)%vd=var_desc(i)
1574 ini(ng)%pioVar(iduvel)%dkind=pio_fout
1575 ini(ng)%pioVar(iduvel)%gtype=u3dvar
1576 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
1577 got_var(idvvel)=.true.
1578 ini(ng)%pioVar(idvvel)%vd=var_desc(i)
1579 ini(ng)%pioVar(idvvel)%dkind=pio_fout
1580 ini(ng)%pioVar(idvvel)%gtype=v3dvar
1581# ifdef ADJUST_BOUNDARY
1582 ELSE IF (trim(var_name(i)).eq. &
1583 & trim(vname(1,idsbry(isuvel)))) THEN
1584 got_var(idsbry(isuvel))=.true.
1585 ini(ng)%pioVar(idsbry(isuvel))%vd=var_desc(i)
1586 ini(ng)%pioVar(idsbry(isuvel))%dkind=pio_fout
1587 ini(ng)%pioVar(idsbry(isuvel))%gtype=u3dobc
1588 ELSE IF (trim(var_name(i)).eq. &
1589 & trim(vname(1,idsbry(isvvel)))) THEN
1590 got_var(idsbry(isvvel))=.true.
1591 ini(ng)%pioVar(idsbry(isvvel))%vd=var_desc(i)
1592 ini(ng)%pioVar(idsbry(isvvel))%dkind=pio_fout
1593 ini(ng)%pioVar(idsbry(isvvel))%gtype=v3dobc
1594# endif
1595# if defined BVF_MIXING || defined LMD_MIXING || \
1596 defined gls_mixing || defined my25_mixing
1597 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvis))) THEN
1598 got_var(idvvis)=.true.
1599 ini(ng)%pioVar(idvvis)%vd=var_desc(i)
1600 ini(ng)%pioVar(idvvis)%dkind=pio_fout
1601 ini(ng)%pioVar(idvvis)%gtype=w3dvar
1602 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idtdif))) THEN
1603 got_var(idtdif)=.true.
1604 ini(ng)%pioVar(idtdif)%vd=var_desc(i)
1605 ini(ng)%pioVar(idtdif)%dkind=pio_fout
1606 ini(ng)%pioVar(idtdif)%gtype=w3dvar
1607 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idsdif))) THEN
1608 got_var(idsdif)=.true.
1609 ini(ng)%pioVar(idsdif)%vd=var_desc(i)
1610 ini(ng)%pioVar(idsdif)%dkind=pio_fout
1611 ini(ng)%pioVar(idsdif)%gtype=w3dvar
1612# endif
1613# endif
1614 END IF
1615# ifdef SOLVE3D
1616 DO itrc=1,nt(ng)
1617 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
1618 got_var(idtvar(itrc))=.true.
1619 ini(ng)%pioTrc(itrc)%vd=var_desc(i)
1620 ini(ng)%pioTrc(itrc)%dkind=pio_fout
1621 ini(ng)%pioTrc(itrc)%gtype=r3dvar
1622# ifdef ADJUST_BOUNDARY
1623 ELSE IF (trim(var_name(i)).eq. &
1624 & trim(vname(1,idsbry(istvar(itrc))))) THEN
1625 got_var(idsbry(istvar(itrc)))=.true.
1626 ini(ng)%pioVar(idsbry(istvar(itrc)))%vd=var_desc(i)
1627 ini(ng)%pioVar(idsbry(istvar(itrc)))%dkind=pio_fout
1628 ini(ng)%pioVar(idsbry(istvar(itrc)))%gtype=r3dobc
1629# endif
1630# ifdef ADJUST_STFLUX
1631 ELSE IF (trim(var_name(i)).eq. &
1632 & trim(vname(1,idtsur(itrc)))) THEN
1633 got_var(idtsur(itrc))=.true.
1634 ini(ng)%pioVar(idtsur(itrc))%vd=var_desc(i)
1635 ini(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
1636 ini(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1637# endif
1638 END IF
1639 END DO
1640# endif
1641 END DO
1642!
1643! Check if initialization variables are available in input NetCDF
1644! file.
1645!
1646 IF (.not.got_var(idtime)) THEN
1647 IF (master) WRITE (stdout,40) trim(vname(1,idtime)), &
1648 & trim(ncname)
1649 exit_flag=3
1650 RETURN
1651 END IF
1652 IF (.not.got_var(idfsur)) THEN
1653 IF (master) WRITE (stdout,40) trim(vname(1,idfsur)), &
1654 & trim(ncname)
1655 exit_flag=3
1656 RETURN
1657 END IF
1658 IF (.not.got_var(idubar)) THEN
1659 IF (master) WRITE (stdout,40) trim(vname(1,idubar)), &
1660 & trim(ncname)
1661 exit_flag=3
1662 RETURN
1663 END IF
1664 IF (.not.got_var(idvbar)) THEN
1665 IF (master) WRITE (stdout,40) trim(vname(1,idvbar)), &
1666 & trim(ncname)
1667 exit_flag=3
1668 RETURN
1669 END IF
1670# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
1671 IF (.not.got_var(idsbry(isfsur)).and. &
1672 & any(lobc(:,isfsur,ng))) THEN
1673 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isfsur))), &
1674 & trim(ncname)
1675 exit_flag=3
1676 RETURN
1677 END IF
1678 IF (.not.got_var(idsbry(isubar)).and. &
1679 & any(lobc(:,isubar,ng))) THEN
1680 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isubar))), &
1681 & trim(ncname)
1682 exit_flag=3
1683 RETURN
1684 END IF
1685 IF (.not.got_var(idsbry(isvbar)).and. &
1686 & any(lobc(:,isvbar,ng))) THEN
1687 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isvbar))), &
1688 & trim(ncname)
1689 exit_flag=3
1690 RETURN
1691 END IF
1692# endif
1693# ifdef ADJUST_WSTRESS
1694 IF (.not.got_var(idusms)) THEN
1695 IF (master) WRITE (stdout,40) trim(vname(1,idusms)), &
1696 & trim(ncname)
1697 exit_flag=3
1698 RETURN
1699 END IF
1700 IF (.not.got_var(idvsms)) THEN
1701 IF (master) WRITE (stdout,40) trim(vname(1,idvsms)), &
1702 & trim(ncname)
1703 exit_flag=3
1704 RETURN
1705 END IF
1706# endif
1707# ifdef SOLVE3D
1708 IF (.not.got_var(iduvel)) THEN
1709 IF (master) WRITE (stdout,40) trim(vname(1,iduvel)), &
1710 & trim(ncname)
1711 exit_flag=3
1712 RETURN
1713 END IF
1714 IF (.not.got_var(idvvel)) THEN
1715 IF (master) WRITE (stdout,40) trim(vname(1,idvvel)), &
1716 & trim(ncname)
1717 exit_flag=3
1718 RETURN
1719 END IF
1720# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
1721 IF (.not.got_var(idsbry(isuvel)).and. &
1722 & any(lobc(:,isuvel,ng))) THEN
1723 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isuvel))), &
1724 & trim(ncname)
1725 exit_flag=3
1726 RETURN
1727 END IF
1728 IF (.not.got_var(idsbry(isvvel)).and. &
1729 & any(lobc(:,isvvel,ng))) THEN
1730 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isvvel))), &
1731 & trim(ncname)
1732 exit_flag=3
1733 RETURN
1734 END IF
1735# endif
1736 DO itrc=1,nt(ng)
1737 IF (.not.got_var(idtvar(itrc))) THEN
1738 IF (master) WRITE (stdout,40) trim(vname(1,idtvar(itrc))), &
1739 & trim(ncname)
1740 exit_flag=3
1741 RETURN
1742 END IF
1743# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
1744 IF (.not.got_var(idsbry(istvar(itrc))).and. &
1745 & any(lobc(:,istvar(itrc),ng))) THEN
1746 IF (master) WRITE (stdout,40) &
1747 & trim(vname(1,idsbry(istvar(itrc)))), &
1748 & trim(ncname)
1749 exit_flag=3
1750 RETURN
1751 END IF
1752# endif
1753# ifdef ADJUST_STFLUX
1754 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
1755 IF (master) WRITE (stdout,40) trim(vname(1,idtsur(itrc))), &
1756 & trim(ncname)
1757 exit_flag=3
1758 RETURN
1759 END IF
1760# endif
1761 END DO
1762# endif
1763!
1764! Set unlimited time record dimension to the appropriate value.
1765!
1766 ini(ng)%Rindex=rec_size
1767 fcount=ini(ng)%Fcount
1768 ini(ng)%Nrec(fcount)=rec_size
1769 END IF
1770!
1771 10 FORMAT (/,' DEF_INI_PIO - unable to open initial NetCDF', &
1772 & ' file: ',a)
1773 20 FORMAT (/,' DEF_INI_PIO - illegal dimensions for variable : ',a, &
1774 & /,16x,'Nvardims = ',i0,', missing dimension: ''',a,'''', &
1775 & /,16x,'in file: ',a, &
1776 & /,16x,'Remove such variable from input file.')
1777 30 FORMAT (/,' DEF_INI_PIO - unable to put in define mode initial', &
1778 & ' NetCDF file: ',a)
1779 40 FORMAT (/,' DEF_INI_pio - unable to find variable: ',a,2x, &
1780 & ' in file: ',a)
1781!
1782 RETURN
1783 END SUBROUTINE def_ini_pio
1784# endif
1785#endif
1786 END MODULE def_ini_mod
1787
def_dim_mod::def_dim
Definition def_dim.F:24
def_var_mod::def_var
Definition def_var.F:88
def_dim_mod
Definition def_dim.F:2
def_ini_mod
Definition def_ini.F:2
def_ini_mod::def_ini_nf90
subroutine, private def_ini_nf90(ng)
Definition def_ini.F:79
def_ini_mod::def_ini
subroutine, public def_ini(ng)
Definition def_ini.F:41
def_ini_mod::def_ini_pio
subroutine, private def_ini_pio(ng)
Definition def_ini.F:888
def_var_mod
Definition def_var.F:2
mod_iounits
Definition mod_iounits.F:2
mod_iounits::ini
type(t_io), dimension(:), allocatable ini
Definition mod_iounits.F:225
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::idsdif
integer idsdif
Definition mod_ncparam.F:290
mod_ncparam::idtsur
integer, dimension(:), allocatable idtsur
Definition mod_ncparam.F:453
mod_ncparam::idtdif
integer idtdif
Definition mod_ncparam.F:306
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::idvvis
integer idvvis
Definition mod_ncparam.F:382
mod_ncparam::idvbar
integer idvbar
Definition mod_ncparam.F:360
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::netcdf_redef
subroutine, public netcdf_redef(ng, model, ncname, ncid)
Definition mod_netcdf.F:9440
mod_netcdf::dim_id
integer, dimension(mdims) dim_id
Definition mod_netcdf.F:158
mod_netcdf::netcdf_check_dim
subroutine, public netcdf_check_dim(ng, model, ncname, ncid)
Definition mod_netcdf.F:538
mod_netcdf::dim_name
character(len=100), dimension(mdims) dim_name
Definition mod_netcdf.F:168
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_ndim
integer, dimension(mvars) var_ndim
Definition mod_netcdf.F:164
mod_netcdf::dim_size
integer, dimension(mdims) dim_size
Definition mod_netcdf.F:159
mod_netcdf::var_name
character(len=100), dimension(mvars) var_name
Definition mod_netcdf.F:169
mod_netcdf::n_dim
integer n_dim
Definition mod_netcdf.F:151
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::rec_id
integer rec_id
Definition mod_netcdf.F:155
mod_netcdf::netcdf_inq_var
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
Definition mod_netcdf.F:1371
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_param
Definition mod_param.F:2
mod_param::u2dobc
integer, parameter u2dobc
Definition mod_param.F:729
mod_param::v3dobc
integer, parameter v3dobc
Definition mod_param.F:733
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::r2dobc
integer, parameter r2dobc
Definition mod_param.F:728
mod_param::r3dvar
integer, parameter r3dvar
Definition mod_param.F:721
mod_param::r3dobc
integer, parameter r3dobc
Definition mod_param.F:731
mod_param::v2dobc
integer, parameter v2dobc
Definition mod_param.F:730
mod_param::iobounds
type(t_iobounds), dimension(:), allocatable iobounds
Definition mod_param.F:282
mod_param::u3dobc
integer, parameter u3dobc
Definition mod_param.F:732
mod_param::u3dvar
integer, parameter u3dvar
Definition mod_param.F:722
mod_param::u2dvar
integer, parameter u2dvar
Definition mod_param.F:718
mod_param::w3dvar
integer, parameter w3dvar
Definition mod_param.F:724
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_param::v2dvar
integer, parameter v2dvar
Definition mod_param.F:719
mod_param::v3dvar
integer, parameter v3dvar
Definition mod_param.F:723
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::pio_netcdf_redef
subroutine, public pio_netcdf_redef(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:9224
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_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::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::ldefini
logical, dimension(:), allocatable ldefini
Definition mod_scalars.F:962
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::isalt
integer isalt
Definition mod_scalars.F:127
mod_scalars::itemp
integer itemp
Definition mod_scalars.F:126
mod_scalars::nbrec
integer, dimension(:), allocatable nbrec
Definition mod_scalars.F:1119
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
strings_mod
Definition strings.F:2
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52