ROMS
Loading...
Searching...
No Matches
read_asspar.F
Go to the documentation of this file.
1#include "cppdefs.h"
2#if defined FOUR_DVAR || defined VERIFICATION
3 SUBROUTINE read_asspar (model, inp, out, Lwrite)
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 reads and reports input data assimilation parameters. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_parallel
18# if defined FOUR_DVAR || defined VERIFICATION || \
19 (defined hessian_sv && defined bnorm)
20 USE mod_fourdvar
21# endif
22 USE mod_iounits
23 USE mod_ncparam
24 USE mod_scalars
25!
26 USE inp_decode_mod
27!
28 USE strings_mod, ONLY : founderror
29 USE strings_mod, ONLY : uppercase
30!
31 implicit none
32!
33! Imported variable declarations
34!
35 logical, intent(in) :: Lwrite
36!
37 integer, intent(in) :: model, inp, out
38!
39! Local variable declarations.
40!
41 logical :: Lvalue(4)
42
43 integer :: Mval, Npts, Nval
44 integer :: i, ib, igrid, itrc, k, ng, status
45 integer :: Cdim, Clen, Rdim
46 integer :: Ivalue(1)
47
48 integer :: Nfiles(Ngrids)
49# if defined FOUR_DVAR || defined VERIFICATION || \
50 (defined hessian_sv && defined bnorm)
51 logical, dimension(MT) :: Ltracer
52# if defined ADJUST_STFLUX && defined SOLVE3D
53 logical, dimension(MT,Ngrids) :: Ltsur
54# endif
55# ifdef ADJUST_BOUNDARY
56 logical, dimension(4,Ngrids) :: Lbry
57# ifdef SOLVE3D
58 logical, dimension(4,MT,Ngrids) :: Lbry_trc
59 logical, dimension(MT,4) :: Lboundary
60 real(r8), dimension(4,MT,Ngrids) :: Rboundary
61# endif
62# endif
63 real(r8), dimension(MT,Ngrids) :: Rtracer
64# endif
65 real(dp), dimension(nRval) :: Rval
66 real(r8) :: Rvalue(1)
67
68 character (len=1 ), parameter :: blank = ' '
69# ifdef ADJUST_BOUNDARY
70 character (len=7) :: Text
71# endif
72 character (len=40 ) :: KeyWord
73 character (len=50 ) :: label
74 character (len=256) :: fname, line
75 character (len=256), dimension(nCval) :: Cval
76
77 character (len=*), parameter :: MyFile = &
78 & __FILE__
79!
80!-----------------------------------------------------------------------
81! Initialize.
82!-----------------------------------------------------------------------
83!
84 igrid=1
85 nfiles(1:ngrids)=0
86 DO i=1,len(label)
87 label(i:i)=blank
88 END DO
89 cdim=SIZE(cval,1)
90 clen=len(cval(1))
91 rdim=SIZE(rval,1)
92
93# if defined FOUR_DVAR || defined VERIFICATION || \
94 (defined hessian_sv && defined bnorm)
95!
96!-----------------------------------------------------------------------
97! Read in 4DVAR assimilation parameters. Then, load input data into
98! module.
99!-----------------------------------------------------------------------
100!
101 DO WHILE (.true.)
102 READ (inp,'(a)',err=10,END=20) line
103 status=decode_line(line, keyword, nval, cval, rval)
104 IF (status.gt.0) THEN
105 SELECT CASE (trim(keyword))
106 CASE ('dTdz_min')
107 npts=load_r(nval, rval, ngrids, dtdz_min)
108 CASE ('ml_depth')
109 npts=load_r(nval, rval, ngrids, ml_depth)
110 DO ng=1,ngrids
111 ml_depth(ng)=abs(ml_depth(ng))
112 END DO
113# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
114 CASE ('Nbico')
115 npts=load_i(nval, rval, ngrids, nbico)
116# endif
117 CASE ('LNM_depth')
118 npts=load_r(nval, rval, ngrids, lnm_depth)
119 DO ng=1,ngrids
120 lnm_depth(ng)=abs(lnm_depth(ng))
121 END DO
122 CASE ('LNM_flag')
123 npts=load_i(nval, rval, 1, ivalue)
124 lnm_flag=ivalue(1)
125# if defined WEAK_CONSTRAINT && \
126 (defined array_modes || defined clipping)
127 CASE ('Nvct')
128 npts=load_i(nval, rval, 1, ivalue)
129 nvct=ivalue(1)
130# endif
131 CASE ('GradErr')
132 npts=load_r(nval, rval, 1, rvalue)
133 graderr=rvalue(1)
134 CASE ('HevecErr')
135 npts=load_r(nval, rval, 1, rvalue)
136 hevecerr=rvalue(1)
137 CASE ('LhessianEV')
138 npts=load_l(nval, cval, 1, lvalue)
139 lhessianev=lvalue(1)
140 CASE ('LhotStart')
141 npts=load_l(nval, cval, 1, lvalue)
142 lhotstart=lvalue(1)
143 CASE ('Lprecond')
144 npts=load_l(nval, cval, 1, lvalue)
145 lprecond=lvalue(1)
146# if defined WEAK_CONSTRAINT
147 IF ( lhessianev.and.lprecond ) THEN
148 lhessianev=.false.
149 END IF
150# endif
151 CASE ('Lritz')
152 npts=load_l(nval, cval, 1, lvalue)
153 lritz=lvalue(1)
154 CASE ('NritzEV')
155 npts=load_i(nval, rval, 1, ivalue)
156 nritzev=ivalue(1)
157 CASE ('NpostI')
158 npts=load_i(nval, rval, 1, ivalue)
159 nposti=ivalue(1)
160 CASE ('Nimpact')
161 npts=load_i(nval, rval, 1, ivalue)
162 nimpact=ivalue(1)
163# if defined SPLIT_4DVAR
164 CASE ('OuterLoop')
165 npts=load_i(nval, rval, 1, ivalue)
166 outerloop=ivalue(1)
167 CASE ('Phase4DVAR')
168 DO i=1,len(phase4dvar)
169 phase4dvar(i:i)=blank
170 END DO
171 phase4dvar=trim(adjustl(cval(nval)))
172# endif
173 CASE ('NextraObs')
174 npts=load_i(nval, rval, 1, ivalue)
175 nextraobs=ivalue(1)
176 IF (nextraobs.gt.0) THEN
177 IF (.not.allocated(extraindex)) THEN
178 allocate ( extraindex(nextraobs) )
179 END IF
180 IF (.not.allocated(extraname)) THEN
181 allocate ( extraname(nextraobs) )
182 END IF
183 END IF
184 CASE ('ExtraIndex')
185 IF (nextraobs.gt.0) THEN
186 npts=load_i(nval, rval, nextraobs, extraindex)
187 END IF
188 CASE ('ExtraName')
189 IF (nextraobs.gt.0) THEN
190 extraname(nval)=trim(cval(nval))
191 END IF
192 CASE ('tl_M2diff')
193 npts=load_r(nval, rval, ngrids, tl_m2diff)
194 CASE ('tl_M3diff')
195 npts=load_r(nval, rval, ngrids, tl_m3diff)
196 CASE ('tl_Tdiff')
197 npts=load_r(nval, rval, mt, ngrids, rtracer)
198 DO ng=1,ngrids
199 DO itrc=1,nt(ng)
200 tl_tdiff(itrc,ng)=rtracer(itrc,ng)
201 END DO
202 END DO
203 CASE ('timeIAU')
204 npts=load_r(nval, rval, ngrids, timeiau)
205 CASE ('LdefNRM')
206 npts=load_l(nval, cval, 4, ngrids, ldefnrm)
207 CASE ('LwrtNRM')
208 npts=load_l(nval, cval, 4, ngrids, lwrtnrm)
209 CASE ('CnormM(isFsur)')
210 IF (isfsur.eq.0) THEN
211 IF (master) WRITE (out,210) 'isFsur'
212 exit_flag=5
213 RETURN
214 END IF
215 npts=load_l(nval, cval, 1, lvalue)
216 cnorm(2,isfsur)=lvalue(1)
217 CASE ('CnormM(isUbar)')
218 IF (isubar.eq.0) THEN
219 IF (master) WRITE (out,210) 'isUbar'
220 exit_flag=5
221 RETURN
222 END IF
223 npts=load_l(nval, cval, 1, lvalue)
224 cnorm(2,isubar)=lvalue(1)
225 CASE ('CnormM(isVbar)')
226 IF (isvbar.eq.0) THEN
227 IF (master) WRITE (out,210) 'isVbar'
228 exit_flag=5
229 RETURN
230 END IF
231 npts=load_l(nval, cval, 1, lvalue)
232 cnorm(2,isvbar)=lvalue(1)
233# ifdef SOLVE3D
234 CASE ('CnormM(isUvel)')
235 IF (isuvel.eq.0) THEN
236 IF (master) WRITE (out,210) 'isUvel'
237 exit_flag=5
238 RETURN
239 END IF
240 npts=load_l(nval, cval, 1, lvalue)
241 cnorm(2,isuvel)=lvalue(1)
242 CASE ('CnormM(isVvel)')
243 IF (isvvel.eq.0) THEN
244 IF (master) WRITE (out,210) 'isVvel'
245 exit_flag=5
246 RETURN
247 END IF
248 npts=load_l(nval, cval, 1, lvalue)
249 cnorm(2,isvvel)=lvalue(1)
250 CASE ('CnormM(isTvar)')
251 IF (maxval(istvar).eq.0) THEN
252 IF (master) WRITE (out,210) 'isTvar'
253 exit_flag=5
254 RETURN
255 END IF
256 npts=load_l(nval, cval, mt, ltracer)
257 DO itrc=1,mt
258 i=istvar(itrc)
259 cnorm(2,i)=ltracer(itrc)
260 END DO
261# endif
262 CASE ('CnormI(isFsur)')
263 npts=load_l(nval, cval, 1, lvalue)
264 cnorm(1,isfsur)=lvalue(1)
265 CASE ('CnormI(isUbar)')
266 npts=load_l(nval, cval, 1, lvalue)
267 cnorm(1,isubar)=lvalue(1)
268 CASE ('CnormI(isVbar)')
269 npts=load_l(nval, cval, 1, lvalue)
270 cnorm(1,isvbar)=lvalue(1)
271# ifdef SOLVE3D
272 CASE ('CnormI(isUvel)')
273 npts=load_l(nval, cval, 1, lvalue)
274 cnorm(1,isuvel)=lvalue(1)
275 CASE ('CnormI(isVvel)')
276 npts=load_l(nval, cval, 1, lvalue)
277 cnorm(1,isvvel)=lvalue(1)
278 CASE ('CnormI(isTvar)')
279 npts=load_l(nval, cval, mt, ltracer)
280 DO itrc=1,mt
281 i=istvar(itrc)
282 cnorm(1,i)=ltracer(itrc)
283 END DO
284# endif
285# ifdef ADJUST_BOUNDARY
286 CASE ('CnormB(isFsur)')
287 npts=load_l(nval, cval, 4, lvalue)
288 cnormb(isfsur,1:4)=lvalue(1:4)
289 CASE ('CnormB(isUbar)')
290 npts=load_l(nval, cval, 4, lvalue)
291 cnormb(isubar,1:4)=lvalue(1:4)
292 CASE ('CnormB(isVbar)')
293 npts=load_l(nval, cval, 4, lvalue)
294 cnormb(isvbar,1:4)=lvalue(1:4)
295# ifdef SOLVE3D
296 CASE ('CnormB(isUvel)')
297 npts=load_l(nval, cval, 4, lvalue)
298 cnormb(isuvel,1:4)=lvalue(1:4)
299 CASE ('CnormB(isVvel)')
300 npts=load_l(nval, cval, 4, lvalue)
301 cnormb(isvvel,1:4)=lvalue(1:4)
302 CASE ('CnormB(isTvar)')
303 npts=load_l(nval, cval, mt, 4, lboundary)
304 DO ib=1,4
305 DO itrc=1,mt
306 i=istvar(itrc)
307 cnormb(i,ib)=lboundary(itrc,ib)
308 END DO
309 END DO
310# endif
311# endif
312# ifdef ADJUST_WSTRESS
313 CASE ('CnormF(isUstr)')
314 IF (isustr.eq.0) THEN
315 IF (master) WRITE (out,210) 'isUstr'
316 exit_flag=5
317 RETURN
318 END IF
319 npts=load_l(nval, cval, 1, lvalue)
320 cnorm(1,isustr)=lvalue(1)
321 CASE ('CnormF(isVstr)')
322 IF (isvstr.eq.0) THEN
323 IF (master) WRITE (out,210) 'isVstr'
324 exit_flag=5
325 RETURN
326 END IF
327 npts=load_l(nval, cval, 1, lvalue)
328 cnorm(1,isvstr)=lvalue(1)
329# endif
330# if defined ADJUST_STFLUX && defined SOLVE3D
331 CASE ('CnormF(isTsur)')
332 IF (maxval(istsur).eq.0) THEN
333 IF (master) WRITE (out,210) 'isTsur'
334 exit_flag=5
335 RETURN
336 END IF
337 npts=load_l(nval, cval, mt, ltracer)
338 DO itrc=1,mt
339 i=istsur(itrc)
340 cnorm(1,i)=ltracer(itrc)
341 END DO
342# endif
343# ifdef SALINITY
344 CASE ('balance(isSalt)')
345 npts=load_l(nval, cval, 1, lvalue)
346 balance(istvar(isalt))=lvalue(1)
347# endif
348 CASE ('balance(isFsur)')
349 npts=load_l(nval, cval, 1, lvalue)
350 balance(isfsur)=lvalue(1)
351 CASE ('balance(isVbar)')
352 npts=load_l(nval, cval, 1, lvalue)
353 balance(isvbar)=lvalue(1)
354 CASE ('balance(isVvel)')
355 npts=load_l(nval, cval, 1, lvalue)
356 balance(isvvel)=lvalue(1)
357 CASE ('Nmethod')
358 npts=load_i(nval, rval, ngrids, nmethod)
359 CASE ('Rscheme')
360 npts=load_i(nval, rval, ngrids, rscheme)
361 CASE ('Nrandom')
362 npts=load_i(nval, rval, 1, ivalue)
363 nrandom=ivalue(1)
364 CASE ('Hgamma')
365 npts=load_r(nval, rval, 4, hgamma)
366# ifdef SOLVE3D
367 CASE ('Vgamma')
368 npts=load_r(nval, rval, 4, vgamma)
369# endif
370 CASE ('HdecayM(isFsur)')
371 npts=load_r(nval, rval, ngrids, hdecay(2,isfsur,:))
372 CASE ('HdecayM(isUbar)')
373 npts=load_r(nval, rval, ngrids, hdecay(2,isubar,:))
374 CASE ('HdecayM(isVbar)')
375 npts=load_r(nval, rval, ngrids, hdecay(2,isvbar,:))
376# ifdef SOLVE3D
377 CASE ('HdecayM(isUvel)')
378 npts=load_r(nval, rval, ngrids, hdecay(2,isuvel,:))
379 CASE ('HdecayM(isVvel)')
380 npts=load_r(nval, rval, ngrids, hdecay(2,isvvel,:))
381 CASE ('HdecayM(isTvar)')
382 npts=load_r(nval, rval, mt, ngrids, rtracer)
383 DO ng=1,ngrids
384 DO itrc=1,nt(ng)
385 hdecay(2,istvar(itrc),ng)=rtracer(itrc,ng)
386 END DO
387 END DO
388 CASE ('VdecayM(isUvel)')
389 npts=load_r(nval, rval, ngrids, vdecay(2,isuvel,:))
390 CASE ('VdecayM(isVvel)')
391 npts=load_r(nval, rval, ngrids, vdecay(2,isvvel,:))
392 CASE ('VdecayM(isTvar)')
393 npts=load_r(nval, rval, mt, ngrids, rtracer)
394 DO ng=1,ngrids
395 DO itrc=1,nt(ng)
396 vdecay(2,istvar(itrc),ng)=rtracer(itrc,ng)
397 END DO
398 END DO
399# endif
400 CASE ('TdecayM(isFsur)')
401 npts=load_r(nval, rval, ngrids, tdecay(isfsur,:))
402 CASE ('TdecayM(isUbar)')
403 npts=load_r(nval, rval, ngrids, tdecay(isubar,:))
404 CASE ('TdecayM(isVbar)')
405 npts=load_r(nval, rval, ngrids, tdecay(isvbar,:))
406# ifdef SOLVE3D
407 CASE ('TdecayM(isUvel)')
408 npts=load_r(nval, rval, ngrids, tdecay(isuvel,:))
409 CASE ('TdecayM(isVvel)')
410 npts=load_r(nval, rval, ngrids, tdecay(isvvel,:))
411 CASE ('TdecayM(isTvar)')
412 npts=load_r(nval, rval, mt, ngrids, rtracer)
413 DO ng=1,ngrids
414 DO itrc=1,nt(ng)
415 tdecay(istvar(itrc),ng)=rtracer(itrc,ng)
416 END DO
417 END DO
418# endif
419 CASE ('HdecayI(isFsur)')
420 npts=load_r(nval, rval, ngrids, hdecay(1,isfsur,:))
421 CASE ('HdecayI(isUbar)')
422 npts=load_r(nval, rval, ngrids, hdecay(1,isubar,:))
423 CASE ('HdecayI(isVbar)')
424 npts=load_r(nval, rval, ngrids, hdecay(1,isvbar,:))
425# ifdef SOLVE3D
426 CASE ('HdecayI(isUvel)')
427 npts=load_r(nval, rval, ngrids, hdecay(1,isuvel,:))
428 CASE ('HdecayI(isVvel)')
429 npts=load_r(nval, rval, ngrids, hdecay(1,isvvel,:))
430 CASE ('HdecayI(isTvar)')
431 npts=load_r(nval, rval, mt, ngrids, rtracer)
432 DO ng=1,ngrids
433 DO itrc=1,nt(ng)
434 hdecay(1,istvar(itrc),ng)=rtracer(itrc,ng)
435 END DO
436 END DO
437 CASE ('VdecayI(isUvel)')
438 npts=load_r(nval, rval, ngrids, vdecay(1,isuvel,:))
439 CASE ('VdecayI(isVvel)')
440 npts=load_r(nval, rval, ngrids, vdecay(1,isvvel,:))
441 CASE ('VdecayI(isTvar)')
442 npts=load_r(nval, rval, mt, ngrids, rtracer)
443 DO ng=1,ngrids
444 DO itrc=1,nt(ng)
445 vdecay(1,istvar(itrc),ng)=rtracer(itrc,ng)
446 END DO
447 END DO
448# endif
449# ifdef ADJUST_BOUNDARY
450 CASE ('HdecayB(isFsur)')
451 npts=load_r(nval, rval, 4, ngrids, hdecayb(isfsur,:,:))
452 CASE ('HdecayB(isUbar)')
453 npts=load_r(nval, rval, 4, ngrids, hdecayb(isubar,:,:))
454 CASE ('HdecayB(isVbar)')
455 npts=load_r(nval, rval, 4, ngrids, hdecayb(isvbar,:,:))
456# ifdef SOLVE3D
457 CASE ('HdecayB(isUvel)')
458 npts=load_r(nval, rval, 4, ngrids, hdecayb(isuvel,:,:))
459 CASE ('HdecayB(isVvel)')
460 npts=load_r(nval, rval, 4, ngrids, hdecayb(isvvel,:,:))
461 CASE ('HdecayB(isTvar)')
462 npts=load_r(nval, rval, 4, mt, ngrids, rboundary)
463 DO ng=1,ngrids
464 DO itrc=1,nt(ng)
465 DO ib=1,4
466 hdecayb(istvar(itrc),ib,ng)=rboundary(ib,itrc,ng)
467 END DO
468 END DO
469 END DO
470 CASE ('VdecayB(isUvel)')
471 npts=load_r(nval, rval, 4, ngrids, vdecayb(isuvel,:,:))
472 CASE ('VdecayB(isVvel)')
473 npts=load_r(nval, rval, 4, ngrids, vdecayb(isvvel,:,:))
474 CASE ('VdecayB(isTvar)')
475 npts=load_r(nval, rval, 4, mt, ngrids, rboundary)
476 DO ng=1,ngrids
477 DO itrc=1,nt(ng)
478 DO ib=1,4
479 vdecayb(istvar(itrc),ib,ng)=rboundary(ib,itrc,ng)
480 END DO
481 END DO
482 END DO
483# endif
484# endif
485# ifdef ADJUST_WSTRESS
486 CASE ('HdecayF(isUstr)')
487 npts=load_r(nval, rval, ngrids, hdecay(1,isustr,:))
488 CASE ('HdecayF(isVstr)')
489 npts=load_r(nval, rval, ngrids, hdecay(1,isvstr,:))
490# endif
491# if defined ADJUST_STFLUX && defined SOLVE3D
492 CASE ('HdecayF(isTsur)')
493 npts=load_r(nval, rval, mt, ngrids, rtracer)
494 DO ng=1,ngrids
495 DO itrc=1,nt(ng)
496 hdecay(1,istsur(itrc),ng)=rtracer(itrc,ng)
497 END DO
498 END DO
499# endif
500
501# ifdef STD_MODEL
502# ifndef COMPUTE_MLD
503 CASE ('mld_uniform')
504 npts=load_r(nval, rval, ngrids, mld_uniform(ng))
505# endif
506 CASE ('Sigma_max(isFsur)')
507 npts=load_r(nval, rval, ngrids, sigma_max(isfsur,:))
508# ifdef SOLVE3D
509 CASE ('Sigma_max(isUvel)')
510 npts=load_r(nval, rval, ngrids, sigma_max(isuvel,:))
511 CASE ('Sigma_ml(isUvel)')
512 npts=load_r(nval, rval, ngrids, sigma_ml(isuvel,:))
513 CASE ('Sigma_do(isUvel)')
514 npts=load_r(nval, rval, ngrids, sigma_do(isuvel,:))
515 CASE ('Sigma_dz(isUvel)')
516 npts=load_r(nval, rval, ngrids, sigma_dz(isuvel,:))
517 CASE ('Sigma_max(isVvel)')
518 npts=load_r(nval, rval, ngrids, sigma_max(isvvel,:))
519 CASE ('Sigma_ml(isVvel)')
520 npts=load_r(nval, rval, ngrids, sigma_ml(isvvel,:))
521 CASE ('Sigma_do(isVvel)')
522 npts=load_r(nval, rval, ngrids, sigma_do(isvvel,:))
523 CASE ('Sigma_dz(isVvel)')
524 npts=load_r(nval, rval, ngrids, sigma_dz(isvvel,:))
525 CASE ('Sigma_max(isTvar)')
526 npts=load_r(nval, rval, mt, ngrids, rtracer)
527 DO ng=1,ngrids
528 DO itrc=1,nt(ng)
529 sigma_max(istvar(itrc),ng)=rtracer(itrc,ng)
530 END DO
531 END DO
532 CASE ('Sigma_ml(isTvar)')
533 npts=load_r(nval, rval, mt, ngrids, rtracer)
534 DO ng=1,ngrids
535 DO itrc=1,nt(ng)
536 sigma_ml(istvar(itrc),ng)=rtracer(itrc,ng)
537 END DO
538 END DO
539 CASE ('Sigma_do(isTvar)')
540 npts=load_r(nval, rval, mt, ngrids, rtracer)
541 DO ng=1,ngrids
542 DO itrc=1,nt(ng)
543 sigma_do(istvar(itrc),ng)=rtracer(itrc,ng)
544 END DO
545 END DO
546 CASE ('Sigma_dz(isTvar)')
547 npts=load_r(nval, rval, mt, ngrids, rtracer)
548 DO ng=1,ngrids
549 DO itrc=1,nt(ng)
550 sigma_dz(istvar(itrc),ng)=rtracer(itrc,ng)
551 END DO
552 END DO
553# endif
554# endif
555# ifdef BGQC
556 CASE ('bgqc_type')
557 npts=load_i(nval, rval, ngrids, bgqc_type)
558 CASE ('S_bgqc(isFsur)')
559 npts=load_r(nval, rval, ngrids, s_bgqc(isfsur,:))
560 CASE ('S_bgqc(isUbar)')
561 npts=load_r(nval, rval, ngrids, s_bgqc(isubar,:))
562 CASE ('S_bgqc(isVbar)')
563 npts=load_r(nval, rval, ngrids, s_bgqc(isvbar,:))
564 CASE ('S_bgqc(isUvel)')
565 npts=load_r(nval, rval, ngrids, s_bgqc(isuvel,:))
566 CASE ('S_bgqc(isVvel)')
567 npts=load_r(nval, rval, ngrids, s_bgqc(isvvel,:))
568 CASE ('S_bgqc(isTvar)')
569 npts=load_r(nval, rval, mt, ngrids, rtracer)
570 DO ng=1,ngrids
571 DO itrc=1,nt(ng)
572 s_bgqc(istvar(itrc),ng)=rtracer(itrc,ng)
573 END DO
574 END DO
575 CASE ('Nprovenance')
576 npts=load_i(nval, rval, ngrids, nprovenance)
577 IF (.not.allocated(iprovenance)) THEN
578 allocate ( iprovenance(maxval(nprovenance),ngrids))
579 END IF
580 IF (.not.allocated(p_bgqc)) THEN
581 allocate ( p_bgqc(maxval(nprovenance),ngrids))
582 END IF
583 CASE ('Iprovenance')
584 mval=maxval(nprovenance)
585 npts=load_i(nval, rval, mval, ngrids, iprovenance)
586 CASE ('P_bgqc')
587 mval=maxval(nprovenance)
588 npts=load_r(nval, rval, mval, ngrids, p_bgqc)
589# endif
590# if defined ADJUST_STFLUX && defined SOLVE3D
591 CASE ('Lstflux')
592 npts=load_l(nval, cval, mt, ngrids, ltsur)
593 DO ng=1,ngrids
594 DO itrc=1,nt(ng)
595 lstflux(itrc,ng)=ltsur(itrc,ng)
596 END DO
597 END DO
598# endif
599# ifdef ADJUST_BOUNDARY
600 CASE ('Lobc(isFsur)')
601 npts=load_l(nval, cval, 4, ngrids, lbry)
602 DO ng=1,ngrids
603 DO ib=1,4
604 lobc(ib,isfsur,ng)=lbry(ib,ng)
605 END DO
606 END DO
607 CASE ('Lobc(isUbar)')
608 npts=load_l(nval, cval, 4, ngrids, lbry)
609 DO ng=1,ngrids
610 DO ib=1,4
611 lobc(ib,isubar,ng)=lbry(ib,ng)
612 END DO
613 END DO
614 CASE ('Lobc(isVbar)')
615 npts=load_l(nval, cval, 4, ngrids, lbry)
616 DO ng=1,ngrids
617 DO ib=1,4
618 lobc(ib,isvbar,ng)=lbry(ib,ng)
619 END DO
620 END DO
621# ifdef SOLVE3D
622 CASE ('Lobc(isUvel)')
623 npts=load_l(nval, cval, 4, ngrids, lbry)
624 DO ng=1,ngrids
625 DO ib=1,4
626 lobc(ib,isuvel,ng)=lbry(ib,ng)
627 END DO
628 END DO
629 CASE ('Lobc(isVvel)')
630 npts=load_l(nval, cval, 4, ngrids, lbry)
631 DO ng=1,ngrids
632 DO ib=1,4
633 lobc(ib,isvvel,ng)=lbry(ib,ng)
634 END DO
635 END DO
636 CASE ('Lobc(isTvar)')
637 npts=load_l(nval, cval, 4, mt, ngrids, lbry_trc)
638 DO ng=1,ngrids
639 DO itrc=1,nt(ng)
640 i=istvar(itrc)
641 DO ib=1,4
642 lobc(ib,i,ng)=lbry_trc(ib,itrc,ng)
643 END DO
644 END DO
645 END DO
646# endif
647# endif
648 CASE ('STDnameI')
649 label='STD - initial conditions standard deviation'
650 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
651 & ngrids, nfiles, 5, 1, inp_lib, std)
652 CASE ('STDnameM')
653 label='STD - model error standard deviation'
654 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
655 & ngrids, nfiles, 5, 2, inp_lib, std)
656 CASE ('STDnameB')
657 label='STD - boundary conditions standard deviation'
658 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
659 & ngrids, nfiles, 5, 3, inp_lib, std)
660 CASE ('STDnameF')
661 label='STD - surface forcing standard deviation'
662 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
663 & ngrids, nfiles, 5, 4, inp_lib, std)
664# ifdef STD_MODEL
665 CASE ('STDnameC')
666 label='STD - standard deviation computed from background'
667 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
668 & ngrids, nfiles, 5, 5, inp_lib, std)
669# endif
670
671 CASE ('NRMnameI')
672 label='NRM - initial conditions normalization'
673 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
674 & ngrids, nfiles, 4, 1, inp_lib, nrm)
675 CASE ('NRMnameM')
676 label='NRM - model error normalization'
677 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
678 & ngrids, nfiles, 4, 2, inp_lib, nrm)
679 CASE ('NRMnameB')
680 label='NRM - boundary conditions normalization'
681 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
682 & ngrids, nfiles, 4, 3, inp_lib, nrm)
683 CASE ('NRMnameF')
684 label='NRM - surface forcing normalization'
685 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
686 & ngrids, nfiles, 4, 4, inp_lib, nrm)
687 CASE ('OBSname')
688 label='OBS - data assimilation observations'
689 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
690 & ngrids, nfiles, inp_lib, obs)
691 CASE ('HSSname')
692 label='HSS - Hessian eigenvectors'
693 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
694 & ngrids, nfiles, out_lib, hss)
695 CASE ('LCZname')
696 label='LCZ - Lanczos vectors'
697 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
698 & ngrids, nfiles, out_lib, lcz)
699 CASE ('LZEname')
700 label='LZE - Time-evolved Lanczos vectors'
701 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
702 & ngrids, nfiles, out_lib, lze)
703 CASE ('MODname')
704 label='DAV - 4D-Var data assimilation variables'
705 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
706 & ngrids, nfiles, out_lib, dav)
707 CASE ('ERRname')
708 label='ERR - 4D-Var posterior error covariance'
709 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
710 & ngrids, nfiles, out_lib, err)
711# ifdef SP4DVAR
712 CASE ('SPTname')
713 label='SPT - TLM Arnoldi vectors'
714 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
715 & ngrids, nfiles, out_lib, spt)
716 CASE ('SPAname')
717 label='SPA - ADM Arnoldi vectors'
718 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
719 & ngrids, nfiles, out_lib, spa)
720 CASE ('SCTname')
721 label='SCT - TLM Arnoldi vectors'
722 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
723 & ngrids, nfiles, out_lib, sct)
724 CASE ('SCAname')
725 label='SCA - ADM Arnoldi vectors'
726 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
727 & ngrids, nfiles, out_lib, sca)
728# endif
729# if defined RBL4DVAR_FCT_SENSITIVITY && defined OBS_SPACE
730 CASE ('OIFnameA')
731 label='OIFA - observation impacts forecast, analysis'
732 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
733 & ngrids, nfiles, inp_lib, oifa)
734 CASE ('OIFnameB')
735 label='OIFB - observation impacts forecast, background'
736 npts=load_s1d(nval, cval, cdim, line, label, igrid, &
737 & ngrids, nfiles, inp_lib, oifb)
738# endif
739 END SELECT
740 END IF
741 END DO
742 10 IF (master) WRITE (out,50) line
743 exit_flag=4
744 RETURN
745 20 CONTINUE
746
747# ifdef ADJUST_BOUNDARY
748!
749!-----------------------------------------------------------------------
750! Check switches to adjust boundaries for consistency.
751!-----------------------------------------------------------------------
752!
753! Make sure that both momentum components are activated for processing.
754! If adjusting 2D momentum in 3D applications, make sure that the
755! free-surface and 3D momentum switches are activated. This is because
756! the 2D momentum adjustments are computed from the vertical integral
757! of the 3D momentum increments.
758!
759 DO ng=1,ngrids
760 DO ib=1,4
761 IF (.not.lobc(ib,isubar,ng).and.lobc(ib,isvbar,ng)) THEN
762 lobc(ib,isubar,ng)=.true.
763 END IF
764 IF (.not.lobc(ib,isvbar,ng).and.lobc(ib,isubar,ng)) THEN
765 lobc(ib,isvbar,ng)=.true.
766 END IF
767# ifdef SOLVE3D
768 IF (.not.lobc(ib,isuvel,ng).and.lobc(ib,isvvel,ng)) THEN
769 lobc(ib,isuvel,ng)=.true.
770 END IF
771 IF (.not.lobc(ib,isvvel,ng).and.lobc(ib,isuvel,ng)) THEN
772 lobc(ib,isvvel,ng)=.true.
773 END IF
774 IF (.not.lobc(ib,isfsur,ng).and.lobc(ib,isubar,ng)) THEN
775 lobc(ib,isfsur,ng)=.true.
776 END IF
777 IF (.not.lobc(ib,isuvel,ng).and.lobc(ib,isubar,ng)) THEN
778 lobc(ib,isuvel,ng)=.true.
779 lobc(ib,isvvel,ng)=.true.
780 END IF
781# endif
782 END DO
783 END DO
784# endif
785# if defined WEAK_CONSTRAINT && \
786 (defined array_modes || defined clipping)
787!
788!-----------------------------------------------------------------------
789! Check array modes parameter
790!-----------------------------------------------------------------------
791!
792! Array modes parameter must be greater than zero and less or equal
793! to Ninner.
794!
795 IF ((nvct.lt.1).or.(nvct.gt.ninner)) THEN
796 IF (master) THEN
797 WRITE (out,55) 'Illegal parameter for array modes, Nvct = ', &
798 & nvct, ninner, '1 =< Nvct =< Ninner.'
799 END IF
800 exit_flag=6
801 RETURN
802 END IF
803# endif
804# ifdef BALANCE_OPERATOR
805!
806!-----------------------------------------------------------------------
807! Check balance operator switches for consitency.
808!-----------------------------------------------------------------------
809!
810# ifdef SOLVE3D
811# ifdef SALINITY
812 IF (.not.balance(istvar(isalt)).and.balance(isfsur)) THEN
813 balance(istvar(isalt))=.true.
814 END IF
815 IF (.not.balance(istvar(isalt)).and.balance(isvvel)) THEN
816 balance(istvar(isalt))=.true.
817 END IF
818 IF (balance(istvar(isalt))) THEN
819 balance(istvar(itemp))=.true.
820 END IF
821# endif
822 IF (balance(isvvel)) THEN
823 balance(isuvel)=.true.
824 END IF
825 IF (balance(isvbar)) THEN
826 balance(isvbar)=.false.
827 END IF
828# else
829 IF (balance(isvbar)) THEN
830 balance(isubar)=.true.
831 END IF
832# endif
833# endif
834!
835!-----------------------------------------------------------------------
836! Report input parameters.
837!-----------------------------------------------------------------------
838!
839 IF (master.and.lwrite) THEN
840 DO ng=1,ngrids
841# if defined FOUR_DVAR || defined VERIFICATION
842 WRITE (out,60) ng
843# endif
844# if defined FOUR_DVAR
845# ifdef WEAK_CONSTRAINT
846# ifdef RPM_RELAXATION
847 WRITE (out,120) tl_m2diff, 'tl_M2diff', &
848 & 'RPM 2D momentum diffusive relaxation coefficient.'
849# ifdef SOLVE3D
850 WRITE (out,130) tl_m3diff, 'tl_M3diff', &
851 & 'RPM 3D momentum diffusive relaxation coefficient.'
852 DO itrc=1,nt(ng)
853 WRITE (out,130) tl_tdiff(itrc,ng), 'tl_Tdiff', &
854 & 'RPM tracer diffusive relaxation coefficient, ', &
855 & trim(vname(1,idtvar(itrc)))
856 END DO
857# endif
858# endif
859# endif
860 WRITE (out,100) timeiau(ng), 'timeIAU', &
861 & 'Duration of the incremental analysis update (days).'
862# ifndef I4DVAR_ANA_SENSITIVITY
863# ifdef I4DVAR
864 WRITE (out,100) graderr, 'GradErr', &
865 & 'Upper bound on relative error of the gradient.'
866 WRITE (out,70) lhessianev, 'LhessianEV', &
867 & 'Switch to compute Hessian eigenvectors.'
868# endif
869 WRITE (out,100) hevecerr, 'HevecErr', &
870 & 'Accuracy required for eigenvectors.'
871# ifdef WEAK_CONSTRAINT
872 WRITE (out,70) lhotstart, 'LhotStart', &
873 & 'Switch for hot start of subsequent outer loops.'
874# endif
875 WRITE (out,70) lprecond, 'Lprecond', &
876 & 'Switch for conjugate gradient preconditioning.'
877 WRITE (out,70) lritz, 'Lritz', &
878 & 'Switch for Ritz limited-memory preconditioning.'
879# ifdef WEAK_CONSTRAINT
880 IF (lprecond.and.(nritzev.gt.0)) THEN
881 WRITE (out,80) nritzev, 'NritzEV', &
882 & 'Number of preconditioning eigenpairs to use.'
883 END IF
884# endif
885# endif
886# ifdef BALANCE_OPERATOR
887# ifdef ZETA_ELLIPTIC
888 WRITE (out,80) nbico(ng), 'Nbico', &
889 & 'Number of iterations in SSH elliptic equation.'
890# endif
891 WRITE (out,100) dtdz_min(ng), 'dTdz_min', &
892 & 'Minimum dTdz (C/m) used in balanced salinity.'
893 WRITE (out,100) ml_depth(ng), 'ml_depth', &
894 & 'Mixed-layer depth (m) used in balanced salinity.'
895 IF (balance(isfsur)) THEN
896 WRITE (out,100) lnm_depth(ng), 'LNM_depth', &
897 & 'Level of no motion (m) in balanced free-sruface.'
898 WRITE (out,80) lnm_flag, 'LNM_flag', &
899 & 'Level of no motion integration flag.'
900 END IF
901 WRITE (out,70) balance(isfsur), 'balance(isFsur)', &
902 'Switch to include free-surface in balance operator.'
903# ifdef SOLVE3D
904# ifdef SALINITY
905 WRITE (out,70) balance(istvar(isalt)), 'balance(isSalt)', &
906 'Switch to include salinity in balance operator.'
907# endif
908 WRITE (out,70) balance(isvvel), 'balance(isVvel)', &
909 'Switch to include 3D momentum in balance operator.'
910# else
911 WRITE (out,70) balance(isvbar), 'balance(isVbar)', &
912 'Switch to include 2D momentum in balance operator.'
913# endif
914# endif
915# ifdef WEAK_CONSTRAINT
916# if defined ARRAY_MODES
917 WRITE (out,80) nvct, 'Nvct', &
918 & 'Representer array mode eigenvector to process.'
919# elif defined CLIPPING
920 WRITE (out,80) nvct, 'Nvct', &
921 & 'Representer cut-off eigenvector to process.'
922# endif
923# endif
924# if defined POSTERIOR_EOFS && defined WEAK_CONSTRAINT
925 WRITE (out,80) nposti, 'NpostI', &
926 & 'Number of Lanczos iterations in posterior analysis.'
927# endif
928# if defined RBL4DVAR_ANA_SENSITIVITY || \
929 defined rbl4dvar_fct_sensitivity || \
930 defined r4dvar_ana_sensitivity
931 WRITE (out,80) nimpact, 'Nimpact', &
932 & 'Observations impact/sensitivity outer loop to use.'
933 IF (nimpact.gt.nouter) THEN
934 IF (master) THEN
935 WRITE (out,240) 'Nimpact', nimpact, &
936 & 'must be less or equal than Nouter'
937 END IF
938 exit_flag=5
939 RETURN
940 END IF
941# endif
942# if defined ARRAY_MODES
943 WRITE (out,80) nimpact, 'Nimpact', &
944 & 'Array mode outer loop.'
945 IF (nimpact.gt.nouter) THEN
946 IF (master) THEN
947 WRITE (out,240) 'Nimpact', nimpact, &
948 & 'must be less or equal than Nouter'
949 END IF
950 exit_flag=5
951 RETURN
952 END IF
953# endif
954# if defined SPLIT_4DVAR
955 WRITE (out,80) outerloop, 'OuterLoop', &
956 & 'Current outer loop counter.'
957 IF (outerloop.gt.nouter) THEN
958 IF (master) THEN
959 WRITE (out,240) 'OuterLoop', outerloop, &
960 & 'must be less or equal than Nouter'
961 END IF
962 exit_flag=5
963 RETURN
964 END IF
965 WRITE (out,95) phase4dvar(1:10), 'Phase4DVAR', &
966 & 'Current 4D-Var phase (first 10 characters).'
967# endif
968# ifndef TLM_CHECK
969# ifndef I4DVAR_ANA_SENSITIVITY
970 WRITE (out,170) ldefnrm(1:4,ng), 'LdefNRM', &
971 & 'Switch to create a normalization NetCDF file.'
972 WRITE (out,170) lwrtnrm(1:4,ng), 'LwrtNRM', &
973 & 'Switch to write out normalization factors.'
974 IF (any(lwrtnrm(:,ng))) THEN
975 IF (nmethod(ng).eq.0) THEN
976 WRITE (out,80) nmethod(ng), 'Nmethod', &
977 & 'Correlation normalization method: Exact.'
978 ELSE IF (nmethod(ng).eq.1) THEN
979 WRITE (out,80) nmethod(ng), 'Nmethod', &
980 & 'Correlation normalization method: Randomization.'
981 WRITE (out,80) rscheme(ng), 'Rscheme', &
982 & 'Random number generation scheme'
983 WRITE (out,80) nrandom, 'Nrandom', &
984 & 'Number of iterations for randomization.'
985 END IF
986 END IF
987# if defined RBL4DVAR || defined R4DVAR || \
988 defined sensitivity_4dvar || defined sp4dvar || \
989 defined tl_rbl4dvar || defined tl_r4dvar
990 IF (any(lwrtnrm(:,ng))) THEN
991 WRITE (out,70) cnorm(2,isfsur), 'CnormM(isFsur)', &
992 & 'Compute model 2D RHO-normalization factors.'
993 WRITE (out,70) cnorm(2,isubar), 'CnormM(isUbar)', &
994 & 'Compute model 2D U-normalization factors.'
995 WRITE (out,70) cnorm(2,isvbar), 'CnormM(isVbar)', &
996 & 'Compute model 2D V-normalization factors.'
997# ifdef SOLVE3D
998 WRITE (out,70) cnorm(2,isuvel), 'CnormM(isUvel)', &
999 & 'Compute model 3D U-normalization factors.'
1000 WRITE (out,70) cnorm(2,isvvel), 'CnormM(isVvel)', &
1001 & 'Compute model 3D V-normalization factors.'
1002 DO itrc=1,nt(ng)
1003 WRITE (out,110) cnorm(2,istvar(itrc)), 'CnormM(isTvar)', &
1004 & 'Compute model normalization factors for tracer ', &
1005 & itrc, trim(vname(1,idtvar(itrc)))
1006 END DO
1007# endif
1008 END IF
1009# endif
1010 IF (any(lwrtnrm(:,ng))) THEN
1011 WRITE (out,70) cnorm(1,isfsur), 'CnormI(isFsur)', &
1012 & 'Compute initial 2D RHO-normalization factors.'
1013 WRITE (out,70) cnorm(1,isubar), 'CnormI(isUbar)', &
1014 & 'Compute initial 2D U-normalization factors.'
1015 WRITE (out,70) cnorm(1,isvbar), 'CnormI(isVbar)', &
1016 & 'Compute initial 2D V-normalization factors.'
1017# ifdef SOLVE3D
1018 WRITE (out,70) cnorm(1,isuvel), 'CnormI(isUvel)', &
1019 & 'Compute initial 3D U-normalization factors.'
1020 WRITE (out,70) cnorm(1,isvvel), 'CnormI(isVvel)', &
1021 & 'Compute initial 3D V-normalization factors.'
1022 DO itrc=1,nt(ng)
1023 WRITE (out,110) cnorm(1,istvar(itrc)), 'CnormI(isTvar)', &
1024 & 'Compute initial normalization factors for tracer ', &
1025 & itrc, trim(vname(1,idtvar(itrc)))
1026 END DO
1027# endif
1028 END IF
1029# ifdef ADJUST_BOUNDARY
1030 IF (any(lwrtnrm(:,ng))) THEN
1031 WRITE (out,170) cnormb(isfsur,1:4), 'CnormB(isFsur)', &
1032 & 'Compute boundary 2D RHO-normalization factors.'
1033 WRITE (out,170) cnormb(isubar,1:4), 'CnormB(isUbar)', &
1034 & 'Compute boundary 2D U-normalization factors.'
1035 WRITE (out,170) cnormb(isvbar,1:4), 'CnormB(isVbar)', &
1036 & 'Compute initial 2D V-normalization factors.'
1037# ifdef SOLVE3D
1038 WRITE (out,170) cnormb(isuvel,1:4), 'CnormB(isUvel)', &
1039 & 'Compute initial 3D U-normalization factors.'
1040 WRITE (out,170) cnormb(isvvel,1:4), 'CnormI(isVvel)', &
1041 & 'Compute initial 3D V-normalization factors.'
1042 DO itrc=1,nt(ng)
1043 WRITE (out,180) cnormb(istvar(itrc),1:4),'CnormI(isTvar)',&
1044 & 'Compute initial normalization factors for tracer ', &
1045 & itrc, trim(vname(1,idtvar(itrc)))
1046 END DO
1047# endif
1048 END IF
1049# endif
1050# ifdef ADJUST_WSTRESS
1051 IF (any(lwrtnrm(:,ng))) THEN
1052 WRITE (out,70) cnorm(1,isustr), 'CnormF(isUstr)', &
1053 & 'Compute normalization factors at surface U-stress.'
1054 WRITE (out,70) cnorm(1,isvstr), 'CnormF(isVstr)', &
1055 & 'Compute normalization factors at surface V-stress.'
1056 END IF
1057# endif
1058# if defined ADJUST_STFLUX && defined SOLVE3D
1059 IF (any(lwrtnrm(:,ng))) THEN
1060 DO itrc=1,nt(ng)
1061 WRITE (out,110) cnorm(1,istsur(itrc)), 'CnormF(isTsur)', &
1062 & 'Compute normalization factors for flux of tracer ', &
1063 & itrc, trim(vname(1,idtvar(itrc)))
1064 END DO
1065 END IF
1066# endif
1067# endif
1068 WRITE (out,100) hgamma(1), 'Hgamma', &
1069 & 'Horizontal diffusion factor, initial conditions.'
1070# ifdef WEAK_CONSTRAINT
1071 WRITE (out,100) hgamma(2), 'HgammaM', &
1072 & 'Horizontal diffusion factor, model error.'
1073# endif
1074# ifdef ADJUST_BOUNDARY
1075 WRITE (out,100) hgamma(3), 'HgammaB', &
1076 & 'Horizontal diffusion factor, boundary conditions.'
1077# endif
1078# ifdef ADJUST_STFLUX
1079 WRITE (out,100) hgamma(4), 'HgammaF', &
1080 & 'Horizontal diffusion factor, surface forcing.'
1081# endif
1082# ifdef SOLVE3D
1083 WRITE (out,100) vgamma(1), 'Vgamma', &
1084 & 'Vertical diffusion factor, initial conditions.'
1085# ifdef WEAK_CONSTRAINT
1086 WRITE (out,100) vgamma(2), 'VgammaM', &
1087 & 'Vertical diffusion factor, model error.'
1088# endif
1089# ifdef ADJUST_BOUNDARY
1090 WRITE (out,100) vgamma(3), 'VgammaB', &
1091 & 'Vertical diffusion factor, boundary conditions.'
1092# endif
1093# endif
1094# if defined RBL4DVAR || defined R4DVAR || \
1095 defined sensitivity_4dvar || defined sp4dvar || \
1096 defined tl_rbl4dvar || defined tl_r4dvar
1097 IF (nadj(ng).lt.ntimes(ng)) THEN
1098 WRITE (out,120) hdecay(2,isfsur,ng), 'HdecayM(isFsur)', &
1099 & 'Model decorrelation H-scale (m), free-surface.'
1100 WRITE (out,120) hdecay(2,isubar,ng), 'HdecayM(isUbar)', &
1101 & 'Model decorrelation H-scale (m), 2D U-momentum.'
1102 WRITE (out,120) hdecay(2,isvbar,ng), 'HdecayM(isVbar)', &
1103 & 'Model decorrelation H-scale (m), 2D V-momentum.'
1104# ifdef SOLVE3D
1105 WRITE (out,120) hdecay(2,isuvel,ng), 'HdecayM(isUvel)', &
1106 & 'Model decorrelation H-scale (m), 3D U-momentum.'
1107 WRITE (out,120) hdecay(2,isvvel,ng), 'HdecayM(isVvel)', &
1108 & 'Model decorrelation H-scale (m), 3D V-momentum.'
1109 DO itrc=1,nt(ng)
1110 WRITE (out,130) hdecay(2,istvar(itrc),ng), &
1111 & 'HdecayM(idTvar)', &
1112 & 'Model decorrelation H-scale (m), ', &
1113 & trim(vname(1,idtvar(itrc)))
1114 END DO
1115 WRITE (out,120) vdecay(2,isuvel,ng), 'VdecayM(isUvel)', &
1116 & 'Model decorrelation V-scale (m), 3D U-momentum.'
1117 WRITE (out,120) vdecay(2,isvvel,ng), 'VdecayM(isVvel)', &
1118 & 'Model decorrelation V-scale (m), 3D V-momentum.'
1119 DO itrc=1,nt(ng)
1120 WRITE (out,130) vdecay(2,istvar(itrc),ng), &
1121 & 'VdecayM(idTvar)', &
1122 & 'Model decorrelation V-scale (m), ', &
1123 & trim(vname(1,idtvar(itrc)))
1124 END DO
1125# endif
1126 END IF
1127# endif
1128# if defined WEAK_CONSTRAINT && defined TIME_CONV
1129 WRITE (out,80) nrectc(ng), 'NrecTC', &
1130 & 'Number of state records for time convolution.'
1131 WRITE (out,120) tdecay(isfsur,ng), 'TdecayM(isFsur)', &
1132 & 'Model decorrelation T-scale (day), free-surface.'
1133 WRITE (out,120) tdecay(isubar,ng), 'TdecayM(isUbar)', &
1134 & 'Model decorrelation T-scale (day), 2D U-momentum.'
1135 WRITE (out,120) tdecay(isvbar,ng), 'TdecayM(isVbar)', &
1136 & 'Model decorrelation T-scale (day), 2D V-momentum.'
1137# ifdef SOLVE3D
1138 WRITE (out,120) tdecay(isuvel,ng), 'TdecayM(isUvel)', &
1139 & 'Model decorrelation T-scale (day), 3D U-momentum.'
1140 WRITE (out,120) tdecay(isvvel,ng), 'TdecayM(isVvel)', &
1141 & 'Model decorrelation T-scale (day), 3D V-momentum.'
1142 DO itrc=1,nt(ng)
1143 WRITE (out,130) tdecay(istvar(itrc),ng), &
1144 & 'TdecayM(idTvar)', &
1145 & 'Model decorrelation T-scale (day), ', &
1146 & trim(vname(1,idtvar(itrc)))
1147 END DO
1148# endif
1149# endif
1150 WRITE (out,120) hdecay(1,isfsur,ng), 'HdecayI(isFsur)', &
1151 & 'Initial decorrelation H-scale (m), free-surface.'
1152 WRITE (out,120) hdecay(1,isubar,ng), 'HdecayI(isUbar)', &
1153 & 'Initial decorrelation H-scale (m), 2D U-momentum.'
1154 WRITE (out,120) hdecay(1,isvbar,ng), 'HdecayI(isVbar)', &
1155 & 'Initial decorrelation H-scale (m), 2D V-momentum.'
1156# ifdef SOLVE3D
1157 WRITE (out,120) hdecay(1,isuvel,ng), 'HdecayI(isUvel)', &
1158 & 'Initial decorrelation H-scale (m), 3D U-momentum.'
1159 WRITE (out,120) hdecay(1,isvvel,ng), 'HdecayI(isVvel)', &
1160 & 'Initial decorrelation H-scale (m), 3D V-momentum.'
1161 DO itrc=1,nt(ng)
1162 WRITE (out,130) hdecay(1,istvar(itrc),ng), &
1163 & 'HdecayI(idTvar)', &
1164 & 'Initial decorrelation H-scale (m), ', &
1165 & trim(vname(1,idtvar(itrc)))
1166 END DO
1167 WRITE (out,120) vdecay(1,isuvel,ng), 'VdecayI(isUvel)', &
1168 & 'Initial decorrelation V-scale (m), 3D U-momentum.'
1169 WRITE (out,120) vdecay(1,isvvel,ng), 'VdecayI(isVvel)', &
1170 & 'Initial decorrelation V-scale (m), 3D V-momentum.'
1171 DO itrc=1,nt(ng)
1172 WRITE (out,130) vdecay(1,istvar(itrc),ng), &
1173 & 'VdecayI(idTvar)', &
1174 & 'Initial decorrelation V-scale (m), ', &
1175 & trim(vname(1,idtvar(itrc)))
1176 END DO
1177# endif
1178# ifdef ADJUST_BOUNDARY
1179 DO ib=1,4
1180 IF (ib.eq.iwest) THEN
1181 text='W-bry '
1182 ELSE IF (ib.eq.isouth) THEN
1183 text='S-bry '
1184 ELSE IF (ib.eq.ieast) THEN
1185 text='E-bry '
1186 ELSE IF (ib.eq.inorth) THEN
1187 text='N-bry '
1188 END IF
1189 IF (lobc(ib,isfsur,ng)) THEN
1190 WRITE (out,120) hdecayb(isfsur,ib,ng), 'HdecayB(isFsur)', &
1191 & text//' decorrelation H-scale (m), free-surface.'
1192 END IF
1193 IF (lobc(ib,isubar,ng)) THEN
1194 WRITE (out,120) hdecayb(isubar,ib,ng), 'HdecayB(isUbar)', &
1195 & text//' decorrelation H-scale (m), 2D U-momentum.'
1196 END IF
1197 IF (lobc(ib,isvbar,ng)) THEN
1198 WRITE (out,120) hdecayb(isvbar,ib,ng), 'HdecayB(isVbar)', &
1199 & text//' decorrelation H-scale (m), 2D V-momentum.'
1200 END IF
1201# ifdef SOLVE3D
1202 IF (lobc(ib,isuvel,ng)) THEN
1203 WRITE (out,120) hdecayb(isuvel,ib,ng), 'HdecayB(isUvel)', &
1204 & text//' decorrelation H-scale (m), 3D U-momentum.'
1205 END IF
1206 IF (lobc(ib,isvvel,ng)) THEN
1207 WRITE (out,120) hdecayb(isvvel,ib,ng), 'HdecayB(isVvel)', &
1208 & text//' decorrelation H-scale (m), 3D V-momentum.'
1209 END IF
1210 DO i=1,nt(ng)
1211 IF (lobc(ib,istvar(i),ng)) THEN
1212 WRITE(out,130) hdecayb(istvar(i),ib,ng), &
1213 & 'HdecayB(idTvar)', &
1214 & text//' decorrelation H-scale (m), ', &
1215 & trim(vname(1,idtvar(i)))
1216 END IF
1217 END DO
1218 IF (lobc(ib,isuvel,ng)) THEN
1219 WRITE (out,120) vdecayb(isuvel,ib,ng), 'VdecayB(isUvel)', &
1220 & text//' decorrelation V-scale (m), 3D U-momentum.'
1221 END IF
1222 IF (lobc(ib,isvvel,ng)) THEN
1223 WRITE (out,120) vdecayb(isvvel,ib,ng), 'VdecayB(isVvel)', &
1224 & text//' decorrelation V-scale (m), 3D V-momentum.'
1225 END IF
1226 DO i=1,nt(ng)
1227 IF (lobc(ib,istvar(i),ng)) THEN
1228 WRITE(out,130) vdecayb(istvar(i),ib,ng), &
1229 & 'VdecayB(idTvar)', &
1230 & text//' decorrelation V-scale (m), ', &
1231 & trim(vname(1,idtvar(i)))
1232 END IF
1233 END DO
1234# endif
1235 END DO
1236# endif
1237# ifdef ADJUST_WSTRESS
1238 WRITE (out,120) hdecay(1,isustr,ng), 'HdecayF(isUstr)', &
1239 & 'Forcing decorrelation H-scale (m), U-stress.'
1240 WRITE (out,120) hdecay(1,isvstr,ng), 'HdecayF(isVstr)', &
1241 & 'Forcing decorrelation H-scale (m), V-stress.'
1242# endif
1243# if defined ADJUST_STFLUX && defined SOLVE3D
1244 DO itrc=1,nt(ng)
1245 WRITE (out,130) hdecay(1,istsur(itrc),ng), &
1246 & 'HdecayF(idTsur)', &
1247 & 'Forcing decorrelation H-scale (m), ', &
1248 & trim(vname(1,idtvar(itrc)))
1249 END DO
1250# endif
1251# ifdef STD_MODEL
1252# ifndef COMPUTE_MLD
1253 WRITE (out,120) mld_uniform(ng), 'mld_uniform', &
1254 & 'Uniform mixed layer depth value (m).'
1255# endif
1256 WRITE (out,190) sigma_max(isfsur,ng), 'Sigma_max(isFsur)', &
1257 & 'Maximum STD value (m)', ', free-surface.'
1258# ifdef SOLVE3D
1259 WRITE (out,190) sigma_max(isuvel,ng), 'Sigma_max(isUvel)', &
1260 & 'Maximum STD value (m/s)', ', 3D U-momentum.'
1261 WRITE (out,190) sigma_ml(isuvel,ng), 'Sigma_ml(isUvel)', &
1262 & 'Minimum STD at mixed layer (m/s)', ', 3D U-momentum.'
1263 WRITE (out,190) sigma_do(isuvel,ng), 'Sigma_do(isUvel)', &
1264 & 'Minimum STD in deep ocean (m/s)', ', 3D U-momentum.'
1265 WRITE (out,130) sigma_dz(isuvel,ng), 'Sigma_dz(isUvel)', &
1266 & 'STD vertical displacement (m)', ', 3D U-momentum.'
1267 WRITE (out,190) sigma_max(isuvel,ng), 'Sigma_max(isVvel)', &
1268 & 'Maximum STD value (m/s)', ', 3D V-momentum.'
1269 WRITE (out,190) sigma_ml(isvvel,ng), 'Sigma_ml(isVvel)', &
1270 & 'Minimum STD at mixed layer (m/s)', ', 3D V-momentum.'
1271 WRITE (out,190) sigma_do(isvvel,ng), 'Sigma_do(isVvel)', &
1272 & 'Minimum STD in deep ocean (m/s)', ', 3D V-momentum.'
1273 WRITE (out,130) sigma_dz(isvvel,ng), 'Sigma_dz(isVvel)', &
1274 & 'STD vertical displacement (m)', ', 3D V-momentum.'
1275 DO itrc=1,nt(ng)
1276 WRITE (out,190) sigma_max(istvar(itrc),ng), &
1277 & 'Sigma_max(idTvar)', &
1278 & 'Maximum STD Value, ', &
1279 & trim(vname(1,idtvar(itrc)))
1280 WRITE (out,190) sigma_ml(istvar(itrc),ng), &
1281 & 'Sigma_ml(idTvar)', &
1282 & 'Minimum STD at mixed layer, ', &
1283 & trim(vname(1,idtvar(itrc)))
1284 WRITE (out,190) sigma_do(istvar(itrc),ng), &
1285 & 'Sigma_do(idTvar)', &
1286 & 'Minimum STD in deep ocean, ', &
1287 & trim(vname(1,idtvar(itrc)))
1288 WRITE (out,130) sigma_dz(istvar(itrc),ng), &
1289 & 'Sigma_dz(idTvar)', &
1290 & 'STD vertical displacement (m), ', &
1291 & trim(vname(1,idtvar(itrc)))
1292 END DO
1293# endif
1294# endif
1295# ifdef BGQC
1296 IF (bgqc_type(ng).eq.1) THEN
1297 WRITE (out,80) bgqc_type(ng), 'bgqc_type', &
1298 & 'Quality control in terms of state variable index'
1299 ELSE IF (bgqc_type(ng).eq.2) THEN
1300 WRITE (out,80) bgqc_type(ng), 'bgqc_type', &
1301 & 'Quality control in terms of observation provenance'
1302 END IF
1303 IF (bgqc_type(ng).eq.1) THEN
1304 WRITE (out,100) s_bgqc(isfsur,ng), 'S_bgqc(isFsur)', &
1305 & 'Quality control reject squared threshold, free-surface.'
1306# ifndef SOLVE3D
1307 WRITE (out,100) s_bgqc(isubar,ng), 'S_bgqc(isUbar)', &
1308 & 'Quality control reject squared threshold, 2D U-momentum.'
1309 WRITE (out,100) s_bgqc(isvbar,ng), 'S_bgqc(isVbar)', &
1310 & 'Quality control reject squared threshold, 2D V-momentum.'
1311# else
1312 WRITE (out,100) s_bgqc(isuvel,ng), 'S_bgqc(isUvel)', &
1313 & 'Quality control reject squared threshold, 3D U-momentum.'
1314 WRITE (out,100) s_bgqc(isvvel,ng), 'S_bgqc(isVvel)', &
1315 & 'Quality control reject squared threshold, 3D V-momentum.'
1316 DO itrc=1,nt(ng)
1317 WRITE (out,190) s_bgqc(istvar(itrc),ng), &
1318 & 'S_bgqc(idTvar)', &
1319 & 'Quality control reject squared threshold, ', &
1320 & trim(vname(1,idtvar(itrc)))
1321 END DO
1322# endif
1323 ELSE IF (bgqc_type(ng).eq.2) THEN
1324 WRITE (out,80) nprovenance(ng), 'Nprovenance', &
1325 & 'Number of provenances to Quality control.'
1326 DO i=1,nprovenance(ng)
1327 WRITE (out,200) p_bgqc(i,ng), 'P_bgqc', i, &
1328 & 'Quality control reject squared threshold for provenance', &
1329 & iprovenance(i,ng)
1330 END DO
1331 END IF
1332# endif
1333# if defined ADJUST_STFLUX && defined SOLVE3D
1334 DO itrc=1,nt(ng)
1335 WRITE (out,110) lstflux(itrc,ng), 'Lstflux(itrc)', &
1336 & 'Adjusting surface flux of tracer ', itrc, &
1337 & trim(vname(1,idtvar(itrc)))
1338 END DO
1339# endif
1340# ifdef ADJUST_BOUNDARY
1341 WRITE (out,170) lobc(1:4,isfsur,ng), 'Lobc(isFsur)', &
1342 & 'Adjusting free-surface boundaries.'
1343 WRITE (out,170) lobc(1:4,isubar,ng), 'Lobc(isUbar)', &
1344 & 'Adjusting 2D U-momentum boundaries.'
1345 WRITE (out,170) lobc(1:4,isvbar,ng), 'Lobc(isVbar)', &
1346 & 'Adjusting 2D V-momentum boundaries.'
1347# ifdef SOLVE3D
1348 WRITE (out,170) lobc(1:4,isuvel,ng), 'Lobc(isUvel)', &
1349 & 'Adjusting 3D U-momentum boundaries.'
1350 WRITE (out,170) lobc(1:4,isvvel,ng), 'Lobc(isVvel)', &
1351 & 'Adjusting 3D V-momentum boundaries.'
1352 DO itrc=1,nt(ng)
1353 WRITE (out,180) lobc(1:4,istvar(itrc),ng),'Lobc(isTvar)', &
1354 & 'Adjusting boundaries for tracer ', itrc, &
1355 & trim(vname(1,idtvar(itrc)))
1356 END DO
1357# endif
1358# endif
1359# endif
1360# endif
1361 IF (nextraobs.gt.0) THEN
1362 WRITE (out,80) nextraobs, 'NextraObs', &
1363 & 'Number of extra-observations classes to process.'
1364 DO i=1,nextraobs
1365 WRITE (out,85) extraindex(i), 'ExtraIndex', i, &
1366 & 'Extra-observation type index for: '// &
1367 & trim(extraname(i))
1368 END DO
1369 END IF
1370 END DO
1371 END IF
1372!
1373!-----------------------------------------------------------------------
1374! Report input files and check availability of input files.
1375!-----------------------------------------------------------------------
1376!
1377 IF (master.and.lwrite) THEN
1378 WRITE (out,150)
1379# ifdef VERIFICATION
1380 WRITE (out,160) ' Verification Parameters File: ', &
1381 & trim(aparnam)
1382# else
1383 WRITE (out,160) ' Assimilation Parameters File: ', &
1384 & trim(aparnam)
1385# endif
1386 END IF
1387!
1388 DO ng=1,ngrids
1389
1390# if defined FOUR_DVAR || \
1391 (defined hessian_sv && defined bnorm)
1392# if defined I4DVAR || defined OBS_SENSITIVITY || \
1393 defined opt_observations || defined weak_constraint
1394# if defined RBL4DVAR || defined R4DVAR || \
1395 defined sensitivity_4dvar || defined sp4dvar || \
1396 defined tl_rbl4dvar || defined tl_r4dvar
1397 fname=std(2,ng)%name
1398 IF (nsa.eq.2) THEN
1399 IF (.not.find_file(ng, out, fname, 'STDnameM')) THEN
1400 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1401 ELSE
1402 IF (master.and.lwrite) WRITE (out,160) &
1403 & ' Model STD File: ', trim(fname)
1404 END IF
1405 END IF
1406# endif
1407# ifdef STD_MODEL
1408 fname=std(5,ng)%name
1409 IF (master.and.lwrite) WRITE (out,160) &
1410 & ' Computed/Modeled IC STD File: ', trim(fname)
1411# else
1412 fname=std(1,ng)%name
1413 IF (.not.find_file(ng, out, fname, 'STDnameI')) THEN
1414 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1415 ELSE
1416 IF (master.and.lwrite) WRITE (out,160) &
1417 & ' Initial Conditions STD File: ', trim(fname)
1418 END IF
1419# endif
1420# ifdef ADJUST_BOUNDARY
1421 fname=std(3,ng)%name
1422 IF (.not.find_file(ng, out, fname, 'STDnameB')) THEN
1423 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1424 ELSE
1425 IF (master.and.lwrite) WRITE (out,160) &
1426 & ' Boundary Conditions STD File: ', trim(fname)
1427 END IF
1428# endif
1429# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1430 fname=std(4,ng)%name
1431 IF (.not.find_file(ng, out, fname, 'STDnameF')) THEN
1432 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1433 ELSE
1434 IF (master.and.lwrite) WRITE (out,160) &
1435 & ' Surface Forcing STD File: ', trim(fname)
1436 END IF
1437# endif
1438# endif
1439# if defined RBL4DVAR || defined R4DVAR || \
1440 defined sensitivity_4dvar || defined sp4dvar || \
1441 defined tl_rbl4dvar || defined tl_r4dvar
1442 fname=nrm(2,ng)%name
1443 IF (master.and.lwrite) WRITE (out,160) &
1444 & ' Model Norm File: ', trim(fname)
1445 IF (.not.ldefnrm(2,ng)) THEN
1446 IF (.not.find_file(ng, out, fname, 'NRMnameM')) THEN
1447 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1448 END IF
1449 END IF
1450# elif defined CORRELATION
1451 fname=nrm(2,ng)%name
1452 IF (master.and.lwrite) WRITE (out,160) &
1453 & ' Model Norm File: ', trim(fname)
1454 IF (.not.ldefnrm(2,ng).and.lwrtnrm(2,ng)) THEN
1455 IF (.not.find_file(ng, out, fname, 'NRMnameM')) THEN
1456 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1457 END IF
1458 END IF
1459# endif
1460# if defined CORRELATION
1461 fname=nrm(1,ng)%name
1462 IF (master.and.lwrite) WRITE (out,160) &
1463 & ' Initial Conditions Norm File: ', trim(fname)
1464 IF (.not.ldefnrm(1,ng).and.lwrtnrm(1,ng)) THEN
1465 IF (.not.find_file(ng, out, fname, 'NRMnameI')) THEN
1466 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1467 END IF
1468 END IF
1469# else
1470 fname=nrm(1,ng)%name
1471 IF (master.and.lwrite) WRITE (out,160) &
1472 & ' Initial Conditions Norm File: ', trim(fname)
1473 IF (.not.ldefnrm(1,ng)) THEN
1474 IF (.not.find_file(ng, out, fname, 'NRMnameI')) THEN
1475 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1476 END IF
1477 END IF
1478# endif
1479# ifdef ADJUST_BOUNDARY
1480# ifdef CORRELATION
1481 fname=nrm(3,ng)%name
1482 IF (master.and.lwrite) WRITE (out,160) &
1483 & ' Boundary Conditions Norm File: ', trim(fname)
1484 IF (.not.ldefnrm(3,ng).and.lwrtnrm(3,ng)) THEN
1485 IF (.not.find_file(ng, out, fname, 'NRMnameB')) THEN
1486 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1487 END IF
1488 END IF
1489# else
1490 fname=nrm(3,ng)%name
1491 IF (master.and.lwrite) WRITE (out,160) &
1492 & ' Boundary Conditions Norm File: ', trim(fname)
1493 IF (.not.ldefnrm(3,ng)) THEN
1494 IF (.not.find_file(ng, out, fname, 'NRMnameB')) THEN
1495 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1496 END IF
1497 END IF
1498# endif
1499# endif
1500# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1501# ifdef CORRELATION
1502 fname=nrm(4,ng)%name
1503 IF (master.and.lwrite) WRITE (out,160) &
1504 & ' Surface Forcing Norm File: ', trim(fname)
1505 IF (.not.ldefnrm(4,ng).and.lwrtnrm(4,ng)) THEN
1506 IF (.not.find_file(ng, out, fname, 'NRMnameF')) THEN
1507 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1508 END IF
1509 END IF
1510# else
1511 fname=nrm(4,ng)%name
1512 IF (master.and.lwrite) WRITE (out,160) &
1513 & ' Surface Forcing Norm File: ', trim(fname)
1514 IF (.not.ldefnrm(4,ng)) THEN
1515 IF (.not.find_file(ng, out, fname, 'NRMnameF')) THEN
1516 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1517 END IF
1518 END IF
1519# endif
1520# endif
1521# if !(defined CORRELATION || defined OPT_OBSERVATIONS)
1522 fname=obs(ng)%name
1523 IF (.not.find_file(ng, out, fname, 'OBSname')) THEN
1524 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1525 ELSE
1526 IF (master.and.lwrite) WRITE (out,160) &
1527 & ' Input observations File: ', trim(fname)
1528 END IF
1529# endif
1530# if !defined CORRELATION
1531 IF (master.and.lwrite) WRITE (out,160) &
1532 & ' Input/Output Lanczos File: ', trim(lcz(ng)%name)
1533# ifndef I4DVAR_ANA_SENSITIVITY
1534 IF (master.and.lwrite) WRITE (out,160) &
1535 & ' Input/Output Hessian File: ', trim(hss(ng)%name)
1536# endif
1537# ifdef EVOLVED_LCZ
1538 IF (master.and.lwrite) WRITE (out,160) &
1539 ' Output evolved Lanczos File: ', trim(lze(ng)%name)
1540# endif
1541# endif
1542# endif
1543# if !defined CORRELATION
1544# ifdef VERIFICATION
1545 fname=obs(ng)%name
1546 IF (.not.find_file(ng, out, fname, 'OBSname')) THEN
1547 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1548 ELSE
1549 IF (master.and.lwrite) WRITE (out,160) &
1550 & ' Input observations File: ', trim(fname)
1551 END IF
1552 IF (master.and.lwrite) WRITE (out,160) &
1553 & ' Output verification File: ', trim(dav(ng)%name)
1554# else
1555# ifdef SP4DVAR
1556 IF (master.and.lwrite) THEN
1557 WRITE (out,160) ' Input/Output TLM Arnoldi File: ', &
1558 & trim(spt(ng)%name)
1559 WRITE (out,160) ' Input/Output ADM Arnoldi File: ', &
1560 & trim(spa(ng)%name)
1561 WRITE (out,160) ' Input/Output TLM Scratch File: ', &
1562 & trim(sct(ng)%name)
1563 WRITE (out,160) ' Input/Output ADM Scratch File: ', &
1564 & trim(sca(ng)%name)
1565 END IF
1566# endif
1567 IF (master.and.lwrite) WRITE (out,160) &
1568 & ' Output 4D-Var File: ', trim(dav(ng)%name)
1569# endif
1570# endif
1571# if defined WEAK_CONSTRAINT && \
1572 (defined posterior_error_f || defined posterior_error_i)
1573 IF (master.and.lwrite) WRITE (out,160) &
1574 ' Output Posterior Error File: ', trim(err(ng)%name)
1575# endif
1576# if defined RBL4DVAR_FCT_SENSITIVITY && defined OBS_SPACE
1577 fname=oifa(ng)%name
1578 IF (master.and.lwrite) WRITE (out,160) &
1579 & ' Input Obs Impacts Analysis File: ', trim(fname)
1580!
1581 fname=oifb(ng)%name
1582 IF (master.and.lwrite) WRITE (out,160) &
1583 & 'Input Obs Impacts Background File: ', trim(fname)
1584# endif
1585 END DO
1586
1587# if defined WEAK_CONSTRAINT && defined RPCG
1588!
1589! Stop if activating pre-conditioning for the RBLanczos minimization
1590! algorithm. It does not work yet.
1591!
1592 DO ng=1,ngrids
1593 IF (lprecond) THEN
1594 IF (master) THEN
1595 WRITE (out,230) 'Lprecond', lprecond, &
1596 & 'pre-conditioning does not work yet with ' // &
1597 & uppercase('rpcg') // ' algorithm.', &
1598 & 'Set Lprecond to F in ' // trim(aparnam)
1599 END IF
1600 exit_flag=5
1601 RETURN
1602 END IF
1603 END DO
1604# endif
1605!
1606!-----------------------------------------------------------------------
1607! Convert time scales to seconds.
1608!-----------------------------------------------------------------------
1609!
1610 DO ng=1,ngrids
1611# ifdef FOUR_DVAR
1612 timeiau(ng)=timeiau(ng)*86400.0_dp
1613# endif
1614# if defined WEAK_CONSTRAINT && defined TIME_CONV
1615 DO i=1,mstatevar
1616 tdecay(i,ng)=tdecay(i,ng)*86400.0_r8
1617 END DO
1618# endif
1619 END DO
1620!
1621 50 FORMAT (/,' READ_AssPar - Error while processing line: ',/,a)
1622 55 FORMAT (/,' READ_AssPar - ',a,i4,2x,i4,/,15x,a)
1623# ifdef VERIFICATION
1624 60 FORMAT (/,/,' Observation Parameters, Grid: ',i2.2, &
1625 & /, ' ================================',/)
1626# else
1627 60 FORMAT (/,/,' Assimilation Parameters, Grid: ',i2.2, &
1628 & /, ' =================================',/)
1629# endif
1630 70 FORMAT (10x,l1,2x,a,t32,a)
1631 80 FORMAT (1x,i10,2x,a,t32,a)
1632 85 FORMAT (1x,i10,2x,a,'(',i2.2,')',t32,a)
1633 90 FORMAT (1x,i10,2x,a,t32,a,/,t34,a)
1634 95 FORMAT (1x,a,2x,a,t32,a)
1635 100 FORMAT (1p,e11.4,2x,a,t32,a)
1636 110 FORMAT (10x,l1,2x,a,t32,a,i2.2,':',1x,a)
1637 120 FORMAT (f11.3,2x,a,t32,a)
1638 130 FORMAT (f11.3,2x,a,t32,a,a,'.')
1639# ifdef VERIFICATION
1640 150 FORMAT (/,' Input/Output Verification Files:',/)
1641# else
1642 150 FORMAT (/,' Input/Output Assimilation Files:',/)
1643# endif
1644 160 FORMAT (2x,a,a)
1645 170 FORMAT (3x,4(1x,l1),2x,a,t32,a)
1646 180 FORMAT (3x,4(1x,l1),2x,a,t32,a,i2.2,':',1x,a)
1647 190 FORMAT (1p,e11.4,2x,a,t32,a,a,'.')
1648 200 FORMAT (1p,e11.4,2x,a,'(',i2.2,')',t32,a,':',1x,i6)
1649 210 FORMAT (/,' READ_ASSPAR - variable info not yet loaded, ', a)
1650 220 FORMAT (/,' READ_ASSPAR - Grid ', i2.2, &
1651 & ', could not find input file: ',a)
1652 230 FORMAT (/,' READ_ASSPAR - Illegal parameter, ', a, ' = ', 1x, l1, &
1653 & /,15x,a,/,15x,a)
1654 240 FORMAT (/,' READ_ASSPAR - Illegal parameter, ', a, ' = ', 1x, i2, &
1655 & /,15x,a)
1656# endif
1657
1658 RETURN
1659 END SUBROUTINE read_asspar
1660#else
1661 SUBROUTINE read_asspar
1662 END SUBROUTINE read_asspar
1663#endif
inp_decode_mod
Definition inp_decode.F:2
mod_fourdvar
Definition mod_fourdvar.F:2
mod_iounits
Definition mod_iounits.F:2
mod_iounits::err
type(t_io), dimension(:), allocatable err
Definition mod_iounits.F:207
mod_ncparam
Definition mod_ncparam.F:2
mod_parallel
Definition mod_parallel.F:2
mod_param
Definition mod_param.F:2
mod_scalars
Definition mod_scalars.F:2
strings_mod
Definition strings.F:2
strings_mod::uppercase
character(len(sinp)) function, public uppercase(sinp)
Definition strings.F:582
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
read_asspar
subroutine read_asspar(model, inp, out, lwrite)
Definition read_asspar.F:4