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

Functions/Subroutines

subroutine, public ini_lanczos (ng, tile, ladj, lini)
 
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)
 

Function/Subroutine Documentation

◆ ini_lanczos()

subroutine, public ini_lanczos_mod::ini_lanczos ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) ladj,
integer, intent(in) lini )

Definition at line 67 of file ini_lanczos.F.

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
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

References mod_boundary::boundary, mod_forces::forces, mod_grid::grid, ini_lanczos_tile(), mod_param::itlm, mod_ocean::ocean, wclock_off(), and wclock_on().

Referenced by tl_initial().

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

◆ ini_lanczos_tile()

subroutine ini_lanczos_mod::ini_lanczos_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) lbij,
integer, intent(in) ubij,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) ladj,
integer, intent(in) lini,
real(r8), dimension(lbi:,lbj:), intent(in) rmask,
real(r8), dimension(lbi:,lbj:), intent(in) umask,
real(r8), dimension(lbi:,lbj:), intent(in) vmask,
real(r8), dimension(lbij:,:,:,:,:,:), intent(inout) ad_t_obc,
real(r8), dimension(lbij:,:,:,:,:), intent(inout) ad_u_obc,
real(r8), dimension(lbij:,:,:,:,:), intent(inout) ad_v_obc,
real(r8), dimension(lbij:,:,:,:), intent(inout) ad_ubar_obc,
real(r8), dimension(lbij:,:,:,:), intent(inout) ad_vbar_obc,
real(r8), dimension(lbij:,:,:,:), intent(inout) ad_zeta_obc,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) ad_ustr,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) ad_vstr,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(inout) ad_tflux,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(inout) ad_t,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) ad_u,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) ad_v,
real(r8), dimension(lbi:,lbj:,:), intent(inout) ad_zeta,
real(r8), dimension(lbij:,:,:,:,:,:), intent(inout) tl_t_obc,
real(r8), dimension(lbij:,:,:,:,:), intent(inout) tl_u_obc,
real(r8), dimension(lbij:,:,:,:,:), intent(inout) tl_v_obc,
real(r8), dimension(lbij:,:,:,:), intent(inout) tl_ubar_obc,
real(r8), dimension(lbij:,:,:,:), intent(inout) tl_vbar_obc,
real(r8), dimension(lbij:,:,:,:), intent(inout) tl_zeta_obc,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) tl_ustr,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) tl_vstr,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(inout) tl_tflux,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(inout) tl_t,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) tl_u,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) tl_v,
real(r8), dimension(lbi:,lbj:,:), intent(inout) tl_zeta )
private

Definition at line 153 of file ini_lanczos.F.

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

References mod_iounits::calledfrom, mod_fourdvar::cg_beta, mod_fourdvar::cg_delta, mod_scalars::exit_flag, strings_mod::founderror(), mod_param::iadm, mod_scalars::inner, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_param::itlm, mod_iounits::lcz, mod_scalars::ninner, mod_scalars::noerror, mod_fourdvar::nstatevar, mod_iounits::sourcefile, state_addition_mod::state_addition(), state_dotprod_mod::state_dotprod(), state_initialize_mod::state_initialize(), and state_read_mod::state_read().

Referenced by ini_lanczos().

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