ROMS
Loading...
Searching...
No Matches
ini_lanczos.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE ini_lanczos_mod
3
4#ifdef I4DVAR_ANA_SENSITIVITY
5!
6!git $Id$
7!================================================== Hernan G. Arango ===
8! Copyright (c) 2002-2025 The ROMS Group Andrew M. Moore !
9! Licensed under a MIT/X style license !
10! See License_ROMS.md !
11!=======================================================================
12! !
13! This routine computes the tangent linear model initial conditions !
14! as the weighted sum of all Lanczos vectors computed from the first !
15! outer loop of the I4D-Var Lanczos algorithm. It is used to study !
16! the spatial/temporal impact of observations on the circulation. !
17! !
18! Notice: !
19! !
20! (1) Additional outer loops will required different scaling and !
21! saving of the Lanczos vectors. Currently, I4D-Var destroys !
22! the Lanczos vectors in each outer loop. !
23! !
24! (2) The I4D-Var algorithm computes Ninner+1 Lanczos vectors in !
25! the inner loop (0:Ninner). The input NetCDF file contains !
26! Ninner+1 records. We will ignore the last record since it !
27! has gradient information that is only relevant to the next !
28! inner loop. The coefficients "cg_beta" and "cg_delta" take !
29! this inner loop design into consideration. !
30! !
31!=======================================================================
32!
33 USE mod_param
34 USE mod_parallel
35# ifdef ADJUST_BOUNDARY
36 USE mod_boundary
37# endif
38# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
39 USE mod_forces
40# endif
41 USE mod_fourdvar
42 USE mod_grid
43 USE mod_iounits
44 USE mod_ncparam
45 USE mod_netcdf
46 USE mod_ocean
47# if defined PIO_LIB && defined DISTRIBUTE
48 USE mod_pio_netcdf
49# endif
50 USE mod_scalars
51!
52 USE state_addition_mod, ONLY : state_addition
53 USE state_dotprod_mod, ONLY : state_dotprod
54 USE state_initialize_mod, ONLY : state_initialize
55 USE state_read_mod, ONLY : state_read
56 USE state_scale_mod, ONLY : state_scale
57 USE strings_mod, ONLY : founderror
58!
59 implicit none
60!
61 PRIVATE
62 PUBLIC :: ini_lanczos
63!
64 CONTAINS
65!
66!***********************************************************************
67 SUBROUTINE ini_lanczos (ng, tile, Ladj, Lini)
68!***********************************************************************
69!
70! Imported variable declarations.
71!
72 integer, intent(in) :: ng, tile, ladj, lini
73!
74! Local variable declarations.
75!
76 character (len=*), parameter :: myfile = &
77 & __FILE__
78!
79# include "tile.h"
80!
81# ifdef PROFILE
82 CALL wclock_on (ng, itlm, 2, __line__, myfile)
83# endif
84 CALL ini_lanczos_tile (ng, tile, &
85 & lbi, ubi, lbj, ubj, lbij, ubij, &
86 & imins, imaxs, jmins, jmaxs, &
87 & ladj, lini, &
88# ifdef MASKING
89 & grid(ng) % rmask, &
90 & grid(ng) % umask, &
91 & grid(ng) % vmask, &
92# endif
93# ifdef ADJUST_BOUNDARY
94# ifdef SOLVE3D
95 & boundary(ng) % ad_t_obc, &
96 & boundary(ng) % ad_u_obc, &
97 & boundary(ng) % ad_v_obc, &
98# endif
99 & boundary(ng) % ad_ubar_obc, &
100 & boundary(ng) % ad_vbar_obc, &
101 & boundary(ng) % ad_zeta_obc, &
102# endif
103# ifdef ADJUST_WSTRESS
104 & forces(ng) % ad_ustr, &
105 & forces(ng) % ad_vstr, &
106# endif
107# if defined ADJUST_STFLUX && defined SOLVE3D
108 & forces(ng) % ad_tflux, &
109# endif
110# ifdef SOLVE3D
111 & ocean(ng) % ad_t, &
112 & ocean(ng) % ad_u, &
113 & ocean(ng) % ad_v, &
114# else
115 & ocean(ng) % ad_ubar, &
116 & ocean(ng) % ad_vbar, &
117# endif
118 & ocean(ng) % ad_zeta, &
119# ifdef ADJUST_BOUNDARY
120# ifdef SOLVE3D
121 & boundary(ng) % tl_t_obc, &
122 & boundary(ng) % tl_u_obc, &
123 & boundary(ng) % tl_v_obc, &
124# endif
125 & boundary(ng) % tl_ubar_obc, &
126 & boundary(ng) % tl_vbar_obc, &
127 & boundary(ng) % tl_zeta_obc, &
128# endif
129# ifdef ADJUST_WSTRESS
130 & forces(ng) % tl_ustr, &
131 & forces(ng) % tl_vstr, &
132# endif
133# if defined ADJUST_STFLUX && defined SOLVE3D
134 & forces(ng) % tl_tflux, &
135# endif
136# ifdef SOLVE3D
137 & ocean(ng) % tl_t, &
138 & ocean(ng) % tl_u, &
139 & ocean(ng) % tl_v, &
140# else
141 & ocean(ng) % tl_ubar, &
142 & ocean(ng) % tl_vbar, &
143# endif
144 & ocean(ng) % tl_zeta)
145# ifdef PROFILE
146 CALL wclock_off (ng, itlm, 2, __line__, myfile)
147# endif
148!
149 RETURN
150 END SUBROUTINE ini_lanczos
151!
152!***********************************************************************
153 SUBROUTINE ini_lanczos_tile (ng, tile, &
154 & LBi, UBi, LBj, UBj, LBij, UBij, &
155 & IminS, ImaxS, JminS, JmaxS, &
156 & Ladj, Lini, &
157# ifdef MASKING
158 & rmask, umask, vmask, &
159# endif
160# ifdef ADJUST_BOUNDARY
161# ifdef SOLVE3D
162 & ad_t_obc, ad_u_obc, ad_v_obc, &
163# endif
164 & ad_ubar_obc, ad_vbar_obc, &
165 & ad_zeta_obc, &
166# endif
167# ifdef ADJUST_WSTRESS
168 & ad_ustr, ad_vstr, &
169# endif
170# if defined ADJUST_STFLUX && defined SOLVE3D
171 & ad_tflux, &
172# endif
173# ifdef SOLVE3D
174 & ad_t, ad_u, ad_v, &
175# else
176 & ad_ubar, ad_vbar, &
177# endif
178 & ad_zeta, &
179# ifdef ADJUST_BOUNDARY
180# ifdef SOLVE3D
181 & tl_t_obc, tl_u_obc, tl_v_obc, &
182# endif
183 & tl_ubar_obc, tl_vbar_obc, &
184 & tl_zeta_obc, &
185# endif
186# ifdef ADJUST_WSTRESS
187 & tl_ustr, tl_vstr, &
188# endif
189# if defined ADJUST_STFLUX && defined SOLVE3D
190 & tl_tflux, &
191# endif
192# ifdef SOLVE3D
193 & tl_t, tl_u, tl_v, &
194# else
195 & tl_ubar, tl_vbar, &
196# endif
197 & tl_zeta)
198!***********************************************************************
199!
200! Imported variable declarations.
201!
202 integer, intent(in) :: ng, tile
203 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
204 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
205 integer, intent(in) :: Ladj, Lini
206!
207# ifdef ASSUMED_SHAPE
208# ifdef MASKING
209 real(r8), intent(in) :: rmask(LBi:,LBj:)
210 real(r8), intent(in) :: umask(LBi:,LBj:)
211 real(r8), intent(in) :: vmask(LBi:,LBj:)
212# endif
213# ifdef ADJUST_BOUNDARY
214# ifdef SOLVE3D
215 real(r8), intent(inout) :: ad_t_obc(LBij:,:,:,:,:,:)
216 real(r8), intent(inout) :: ad_u_obc(LBij:,:,:,:,:)
217 real(r8), intent(inout) :: ad_v_obc(LBij:,:,:,:,:)
218# endif
219 real(r8), intent(inout) :: ad_ubar_obc(LBij:,:,:,:)
220 real(r8), intent(inout) :: ad_vbar_obc(LBij:,:,:,:)
221 real(r8), intent(inout) :: ad_zeta_obc(LBij:,:,:,:)
222# endif
223# ifdef ADJUST_WSTRESS
224 real(r8), intent(inout) :: ad_ustr(LBi:,LBj:,:,:)
225 real(r8), intent(inout) :: ad_vstr(LBi:,LBj:,:,:)
226# endif
227# if defined ADJUST_STFLUX && defined SOLVE3D
228 real(r8), intent(inout) :: ad_tflux(LBi:,LBj:,:,:,:)
229# endif
230# ifdef SOLVE3D
231 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
232 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
233 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
234# else
235 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
236 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
237# endif
238 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
239# ifdef ADJUST_BOUNDARY
240# ifdef SOLVE3D
241 real(r8), intent(inout) :: tl_t_obc(LBij:,:,:,:,:,:)
242 real(r8), intent(inout) :: tl_u_obc(LBij:,:,:,:,:)
243 real(r8), intent(inout) :: tl_v_obc(LBij:,:,:,:,:)
244# endif
245 real(r8), intent(inout) :: tl_ubar_obc(LBij:,:,:,:)
246 real(r8), intent(inout) :: tl_vbar_obc(LBij:,:,:,:)
247 real(r8), intent(inout) :: tl_zeta_obc(LBij:,:,:,:)
248# endif
249# ifdef ADJUST_WSTRESS
250 real(r8), intent(inout) :: tl_ustr(LBi:,LBj:,:,:)
251 real(r8), intent(inout) :: tl_vstr(LBi:,LBj:,:,:)
252# endif
253# if defined ADJUST_STFLUX && defined SOLVE3D
254 real(r8), intent(inout) :: tl_tflux(LBi:,LBj:,:,:,:)
255# endif
256# ifdef SOLVE3D
257 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
258 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
259 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
260# else
261 real(r8), intent(inout) :: tl_ubar(LBi:,LBj:,:)
262 real(r8), intent(inout) :: tl_vbar(LBi:,LBj:,:)
263# endif
264 real(r8), intent(inout) :: tl_zeta(LBi:,LBj:,:)
265# else
266# ifdef MASKING
267 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
268 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
269 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
270# endif
271# ifdef ADJUST_BOUNDARY
272# ifdef SOLVE3D
273 real(r8), intent(inout) :: ad_t_obc(LBij:UBij,N(ng),4, &
274 & Nbrec(ng),2,NT(ng))
275 real(r8), intent(inout) :: ad_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
276 real(r8), intent(inout) :: ad_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
277# endif
278 real(r8), intent(inout) :: ad_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
279 real(r8), intent(inout) :: ad_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
280 real(r8), intent(inout) :: ad_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
281# endif
282# ifdef ADJUST_WSTRESS
283 real(r8), intent(inout) :: ad_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
284 real(r8), intent(inout) :: ad_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
285# endif
286# if defined ADJUST_STFLUX && defined SOLVE3D
287 real(r8), intent(inout) :: ad_tflux(LBi:UBi,LBj:UBj, &
288 & Nfrec(ng),2,NT(ng))
289# endif
290# ifdef SOLVE3D
291 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
292 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
293 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
294# else
295 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
296 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
297# endif
298 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
299# ifdef ADJUST_BOUNDARY
300# ifdef SOLVE3D
301 real(r8), intent(inout) :: tl_t_obc(LBij:UBij,N(ng),4, &
302 & Nbrec(ng),2,NT(ng))
303 real(r8), intent(inout) :: tl_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
304 real(r8), intent(inout) :: tl_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
305# endif
306 real(r8), intent(inout) :: tl_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
307 real(r8), intent(inout) :: tl_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
308 real(r8), intent(inout) :: tl_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
309# endif
310# ifdef ADJUST_WSTRESS
311 real(r8), intent(inout) :: tl_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
312 real(r8), intent(inout) :: tl_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
313# endif
314# if defined ADJUST_STFLUX && defined SOLVE3D
315 real(r8), intent(inout) :: tl_tflux(LBi:UBi,LBj:UBj, &
316 & Nfrec(ng),2,NT(ng))
317# endif
318# ifdef SOLVE3D
319 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
320 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
321 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
322# else
323 real(r8), intent(inout) :: tl_ubar(LBi:UBi,LBj:UBj,:)
324 real(r8), intent(inout) :: tl_vbar(LBi:UBi,LBj:UBj,:)
325# endif
326 real(r8), intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
327# endif
328!
329! Local variable declarations.
330!
331 integer :: Lwrk, i, j, lstr, ndefLCZ, outLoop, rec
332# ifdef SOLVE3D
333 integer :: itrc, k
334# endif
335!
336 real(r8) :: fac, fac1, fac2
337 real(r8) :: zbeta
338
339 real(r8), dimension(0:NstateVar(ng)) :: dot
340 real(r8), dimension(Ninner) :: DotProd
341 real(r8), dimension(Ninner) :: bvector
342 real(r8), dimension(Ninner) :: zgamma
343!
344 character (len=256) :: ncname
345
346 character (len=*), parameter :: MyFile = &
347 & __FILE__//", ini_lanczos_tile"
348
349# include "set_bounds.h"
350!
351 calledfrom=myfile
352 sourcefile=myfile
353!
354!-----------------------------------------------------------------------
355! Compute tangent linear model initial conditions from the weighted
356! sum of the Lanczos vectors.
357!-----------------------------------------------------------------------
358!
359! Determine if single or multiple Lanczos vector NetCDF files.
360!
361 SELECT CASE (lcz(ng)%IOtype)
362 CASE (io_nf90)
363 CALL netcdf_get_ivar (ng, iadm, trim(lcz(ng)%name), &
364 & 'ndefADJ', ndeflcz)
365
366# if defined PIO_LIB && defined DISTRIBUTE
367 CASE (io_pio)
368 CALL pio_netcdf_get_ivar (ng, iadm, trim(lcz(ng)%name), &
369 & 'ndefADJ', ndeflcz)
370# endif
371 END SELECT
372 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
373!
374 lwrk=1
375 DO inner=1,ninner ! last record ignored
376!
377! Determine Lanczos vector file to read. The Lanczos vectors are
378! written into the adjoint NetCDF in the I4D-Var Lanczos algorithm.
379! The Lanczos vector for each inner loop is accumulated in the
380! unlimited dimension. The name of this file is provided here in
381! the LCZ(ng)%name variable since the ADM(ng)%name value will be
382! use in the adjoint sensitivity part.
383!
384 IF (ndeflcz.gt.0) THEN
385 lstr=len_trim(lcz(ng)%name)
386 WRITE (ncname,10) lcz(ng)%name(1:lstr-8), inner
387 10 FORMAT (a,'_',i4.4,'.nc')
388 ELSE
389 ncname=lcz(ng)%name
390 END IF
391!
392! Read in the Lanczos vectors (q_i, where i=1,2,...k) computed from
393! k inner-loops of the I4D-Var algorithm first outer loop. Load
394! Lanczos vectors into TANGENT LINEAR STATE ARRAYS at index Lwrk.
395!
396 CALL state_read (ng, tile, itlm, lcz(ng)%IOtype, &
397 & lbi, ubi, lbj, ubj, lbij, ubij, &
398 & lwrk, inner, &
399 & ndeflcz, lcz(ng)%ncid, &
400# if defined PIO_LIB && defined DISTRIBUTE
401 & lcz(ng)%pioFile, &
402# endif
403 & trim(ncname), &
404# ifdef MASKING
405 & rmask, umask, vmask, &
406# endif
407# ifdef ADJUST_BOUNDARY
408# ifdef SOLVE3D
409 & tl_t_obc, tl_u_obc, tl_v_obc, &
410# endif
411 & tl_ubar_obc, tl_vbar_obc, &
412 & tl_zeta_obc, &
413# endif
414# ifdef ADJUST_WSTRESS
415 & tl_ustr, tl_vstr, &
416# endif
417# if defined ADJUST_STFLUX && defined SOLVE3D
418 & tl_tflux, &
419# endif
420# ifdef SOLVE3D
421 & tl_t, tl_u, tl_v, &
422# else
423 & tl_ubar, tl_vbar, &
424# endif
425 & tl_zeta)
426 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
427!
428! Compute dot product between the adjoint sensitivity solution, x(0),
429! and Lanczos vectors, q_i. The x(0) solution is assumed to be in
430! ADJOINT STATE ARRAYS at index Ladj.
431!
432! DotProd(inner) = a_i = < x(0), q_i) >
433!
434 CALL state_dotprod (ng, tile, itlm, &
435 & lbi, ubi, lbj, ubj, lbij, ubij, &
436 & nstatevar(ng), dot(0:), &
437# ifdef MASKING
438 & rmask, umask, vmask, &
439# endif
440# ifdef ADJUST_BOUNDARY
441# ifdef SOLVE3D
442 & ad_t_obc(:,:,:,:,ladj,:), &
443 & tl_t_obc(:,:,:,:,lwrk,:), &
444 & ad_u_obc(:,:,:,:,ladj), &
445 & tl_u_obc(:,:,:,:,lwrk), &
446 & ad_v_obc(:,:,:,:,ladj), &
447 & tl_v_obc(:,:,:,:,lwrk), &
448# endif
449 & ad_ubar_obc(:,:,:,ladj), &
450 & tl_ubar_obc(:,:,:,lwrk), &
451 & ad_vbar_obc(:,:,:,ladj), &
452 & tl_vbar_obc(:,:,:,lwrk), &
453 & ad_zeta_obc(:,:,:,ladj), &
454 & tl_zeta_obc(:,:,:,lwrk), &
455# endif
456# ifdef ADJUST_WSTRESS
457 & ad_ustr(:,:,:,ladj), tl_ustr(:,:,:,lwrk), &
458 & ad_vstr(:,:,:,ladj), tl_vstr(:,:,:,lwrk), &
459# endif
460# if defined ADJUST_STFLUX && defined SOLVE3D
461 & ad_tflux(:,:,:,ladj,:), &
462 & tl_tflux(:,:,:,lwrk,:), &
463# endif
464# ifdef SOLVE3D
465 & ad_t(:,:,:,ladj,:), tl_t(:,:,:,lwrk,:), &
466 & ad_u(:,:,:,ladj), tl_u(:,:,:,lwrk), &
467 & ad_v(:,:,:,ladj), tl_v(:,:,:,lwrk), &
468# else
469 & ad_ubar(:,:,ladj), tl_ubar(:,:,lwrk), &
470 & ad_vbar(:,:,ladj), tl_vbar(:,:,lwrk), &
471# endif
472 & ad_zeta(:,:,ladj), tl_zeta(:,:,lwrk))
473!
474! Store dot product.
475!
476 dotprod(inner)=dot(0)
477 END DO
478!
479!-----------------------------------------------------------------------
480! Invert tri-diagonal matrix, T, associated with the Lanczos vectors.
481!
482! T * b_i = a_i, where i = 1,2,...k
483!
484! Here T is (k,k) matrix computed from the I4D-Var Lanczos algorithm
485! and b_i is the solution to the tri-diagonal system. The Lanczos
486! algorithms coefficients (cg_beta, cg_gamma) used to build the
487! tri-diagonal system are assumed to be read elsewhere.
488!-----------------------------------------------------------------------
489!
490! For now, we can only use the first outer loop. A different scaling
491! is required for additional outer loops.
492!
493 outloop=1
494!
495! Decomposition and forward substitution.
496!
497 zbeta=cg_delta(1,outloop)
498 bvector(1)=dotprod(1)/zbeta
499 DO i=2,ninner
500 zgamma(i)=cg_beta(i,outloop)/zbeta
501 zbeta=cg_delta(i,outloop)-cg_beta(i,outloop)*zgamma(i)
502 bvector(i)=(dotprod(i)-cg_beta(i,outloop)*bvector(i-1))/zbeta
503 END DO
504!
505! Back substitution.
506!
507 DO i=ninner-1,1,-1
508 bvector(i)=bvector(i)-zgamma(i+1)*bvector(i+1)
509 END DO
510!
511!-----------------------------------------------------------------------
512! Compute Lanczos vectors weigthed sum.
513!-----------------------------------------------------------------------
514!
515! Initialize tangent linear state arrays: tl_var(Lini) = fac
516!
517 fac=0.0_r8
518
519 CALL state_initialize (ng, tile, &
520 & lbi, ubi, lbj, ubj, lbij, ubij, &
521 & lini, fac, &
522# ifdef MASKING
523 & rmask, umask, vmask, &
524# endif
525# ifdef ADJUST_BOUNDARY
526# ifdef SOLVE3D
527 & tl_t_obc, tl_u_obc, tl_v_obc, &
528# endif
529 & tl_ubar_obc, tl_vbar_obc, &
530 & tl_zeta_obc, &
531# endif
532# ifdef ADJUST_WSTRESS
533 & tl_ustr, tl_vstr, &
534# endif
535# if defined ADJUST_STFLUX && defined SOLVE3D
536 & tl_tflux, &
537# endif
538# ifdef SOLVE3D
539 & tl_t, tl_u, tl_v, &
540# else
541 & tl_ubar, tl_vbar, &
542# endif
543 & tl_zeta)
544!
545! Read in the Lanczos vectors (q_i, where i=1,2,...k) computed from
546! k inner-loops of the I4D-Var algorithm first outer loop. Load
547! Lanczos vectors into ADJOINT STATE ARRAYS at index Lwrk.
548!
549 IF (ladj.eq.3) THEN
550 lwrk=1
551 ELSE
552 lwrk=3-ladj
553 END IF
554 DO inner=1,ninner ! last record ignored
555 IF (ndeflcz.gt.0) THEN
556 lstr=len_trim(lcz(ng)%name)
557 WRITE (ncname,10) lcz(ng)%name(1:lstr-8), inner
558 ELSE
559 ncname=lcz(ng)%name
560 END IF
561 CALL state_read (ng, tile, itlm, lcz(ng)%IOtype, &
562 & lbi, ubi, lbj, ubj, lbij, ubij, &
563 & lwrk, inner, &
564 & ndeflcz, lcz(ng)%ncid, &
565# if defined PIO_LIB && defined DISTRIBUTE
566 & lcz(ng)%pioFile, &
567# endif
568 & ncname, &
569# ifdef MASKING
570 & rmask, umask, vmask, &
571# endif
572# ifdef ADJUST_BOUNDARY
573# ifdef SOLVE3D
574 & ad_t_obc, ad_u_obc, ad_v_obc, &
575# endif
576 & ad_ubar_obc, ad_vbar_obc, &
577 & ad_zeta_obc, &
578# endif
579# ifdef ADJUST_WSTRESS
580 & ad_ustr, ad_vstr, &
581# endif
582# if defined ADJUST_STFLUX && defined SOLVE3D
583 & ad_tflux, &
584# endif
585# ifdef SOLVE3D
586 & ad_t, ad_u, ad_v, &
587# else
588 & ad_ubar, ad_vbar, &
589# endif
590 & ad_zeta)
591 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
592!
593! Sum over all Lanczos vectors:
594!
595! tl_var(Lini) = fac1 * tl_var(Lini) + fac2 * ad_var(Lwrk)
596!
597! This will become the tangent linear model initial conditions at
598! time index Lnew.
599!
600 fac1=1.0_r8
601 fac2=bvector(inner)
602
603 CALL state_addition (ng, tile, &
604 & lbi, ubi, lbj, ubj, lbij, ubij, &
605 & lini, lwrk, lini, fac1, fac2, &
606# ifdef MASKING
607 & rmask, umask, vmask, &
608# endif
609# ifdef ADJUST_BOUNDARY
610# ifdef SOLVE3D
611 & tl_t_obc, ad_t_obc, &
612 & tl_u_obc, ad_u_obc, &
613 & tl_v_obc, ad_v_obc, &
614# endif
615 & tl_ubar_obc, ad_ubar_obc, &
616 & tl_vbar_obc, ad_vbar_obc, &
617 & tl_zeta_obc, ad_zeta_obc, &
618# endif
619# ifdef ADJUST_WSTRESS
620 & tl_ustr, ad_ustr, &
621 & tl_vstr, ad_vstr, &
622# endif
623# if defined ADJUST_STFLUX && defined SOLVE3D
624 & tl_tflux, ad_tflux, &
625# endif
626# ifdef SOLVE3D
627 & tl_t, ad_t, &
628 & tl_u, ad_u, &
629 & tl_v, ad_v, &
630# else
631 & tl_ubar, ad_ubar, &
632 & tl_vbar, ad_vbar, &
633# endif
634 & tl_zeta, ad_zeta)
635 END DO
636
637 RETURN
638 END SUBROUTINE ini_lanczos_tile
639#endif
640 END MODULE ini_lanczos_mod
641
mod_netcdf::netcdf_get_ivar
Definition mod_netcdf.F:59
mod_pio_netcdf::pio_netcdf_get_ivar
Definition mod_pio_netcdf.F:66
ini_lanczos_mod
Definition ini_lanczos.F:2
ini_lanczos_mod::ini_lanczos_tile
subroutine ini_lanczos_tile(ng, tile, lbi, ubi, lbj, ubj, lbij, ubij, imins, imaxs, jmins, jmaxs, ladj, lini, rmask, umask, vmask, ad_t_obc, ad_u_obc, ad_v_obc, ad_ubar_obc, ad_vbar_obc, ad_zeta_obc, ad_ustr, ad_vstr, ad_tflux, ad_t, ad_u, ad_v, ad_zeta, tl_t_obc, tl_u_obc, tl_v_obc, tl_ubar_obc, tl_vbar_obc, tl_zeta_obc, tl_ustr, tl_vstr, tl_tflux, tl_t, tl_u, tl_v, tl_zeta)
Definition ini_lanczos.F:198
ini_lanczos_mod::ini_lanczos
subroutine, public ini_lanczos(ng, tile, ladj, lini)
Definition ini_lanczos.F:68
mod_boundary
Definition mod_boundary.F:2
mod_boundary::boundary
type(t_boundary), dimension(:), allocatable boundary
Definition mod_boundary.F:746
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
mod_fourdvar
Definition mod_fourdvar.F:2
mod_fourdvar::cg_beta
real(dp), dimension(:,:), allocatable cg_beta
Definition mod_fourdvar.F:654
mod_fourdvar::cg_delta
real(dp), dimension(:,:), allocatable cg_delta
Definition mod_fourdvar.F:691
mod_fourdvar::nstatevar
integer, dimension(:), allocatable nstatevar
Definition mod_fourdvar.F:362
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_iounits
Definition mod_iounits.F:2
mod_iounits::lcz
type(t_io), dimension(:), allocatable lcz
Definition mod_iounits.F:228
mod_iounits::calledfrom
character(len=256) calledfrom
Definition mod_iounits.F:315
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::io_pio
integer, parameter io_pio
Definition mod_ncparam.F:96
mod_netcdf
Definition mod_netcdf.F:2
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_parallel
Definition mod_parallel.F:2
mod_param
Definition mod_param.F:2
mod_param::iadm
integer, parameter iadm
Definition mod_param.F:665
mod_param::itlm
integer, parameter itlm
Definition mod_param.F:663
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_scalars
Definition mod_scalars.F:2
mod_scalars::ninner
integer ninner
Definition mod_scalars.F:353
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::inner
integer inner
Definition mod_scalars.F:360
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
state_addition_mod
Definition state_addition.F:2
state_addition_mod::state_addition
subroutine, public state_addition(ng, tile, lbi, ubi, lbj, ubj, lbij, ubij, lin1, lin2, lout, fac1, fac2, rmask, umask, vmask, s1_t_obc, s2_t_obc, s1_u_obc, s2_u_obc, s1_v_obc, s2_v_obc, s1_ubar_obc, s2_ubar_obc, s1_vbar_obc, s2_vbar_obc, s1_zeta_obc, s2_zeta_obc, s1_sustr, s2_sustr, s1_svstr, s2_svstr, s1_tflux, s2_tflux, s1_t, s2_t, s1_u, s2_u, s1_v, s2_v, s1_ubar, s2_ubar, s1_vbar, s2_vbar, s1_zeta, s2_zeta)
Definition state_addition.F:64
state_dotprod_mod
Definition state_dotprod.F:2
state_dotprod_mod::state_dotprod
subroutine, public state_dotprod(ng, tile, model, lbi, ubi, lbj, ubj, lbij, ubij, nstatevars, dotprod, rmask, umask, vmask, s1_t_obc, s2_t_obc, s1_u_obc, s2_u_obc, s1_v_obc, s2_v_obc, s1_ubar_obc, s2_ubar_obc, s1_vbar_obc, s2_vbar_obc, s1_zeta_obc, s2_zeta_obc, s1_sustr, s2_sustr, s1_svstr, s2_svstr, s1_tflux, s2_tflux, s1_t, s2_t, s1_u, s2_u, s1_v, s2_v, s1_zeta, s2_zeta)
Definition state_dotprod.F:85
state_initialize_mod
Definition state_initialize.F:2
state_initialize_mod::state_initialize
subroutine, public state_initialize(ng, tile, lbi, ubi, lbj, ubj, lbij, ubij, lout, fac, rmask, umask, vmask, s_t_obc, s_u_obc, s_v_obc, s_ubar_obc, s_vbar_obc, s_zeta_obc, s_sustr, s_svstr, s_tflux, s_t, s_u, s_v, s_zeta)
Definition state_initialize.F:52
state_read_mod
Definition state_read.F:2
state_read_mod::state_read
subroutine, public state_read(ng, tile, model, iotype, lbi, ubi, lbj, ubj, lbij, ubij, lout, rec, nopen, ncid, piofile, ncname, rmask, umask, vmask, s_t_obc, s_u_obc, s_v_obc, s_ubar_obc, s_vbar_obc, s_zeta_obc, s_ustr, s_vstr, s_tflux, s_t, s_u, s_v, s_zeta)
Definition state_read.F:137
state_scale_mod
Definition state_scale.F:2
state_scale_mod::state_scale
subroutine, public state_scale(ng, tile, lbi, ubi, lbj, ubj, lbij, ubij, linp, lout, fac, rmask, umask, vmask, s_t_obc, s_u_obc, s_v_obc, s_ubar_obc, s_vbar_obc, s_zeta_obc, s_sustr, s_svstr, s_tflux, s_t, s_u, s_v, s_zeta)
Definition state_scale.F:50
strings_mod
Definition strings.F:2
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
wclock_off
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
wclock_on
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3