i4dvar_mod Module Reference

Functions/Subroutines
subroutine, public	background_initialize (my_outer)
subroutine, public	background (my_outer, runinterval)
subroutine, public	increment (my_outer, runinterval)
subroutine, public	analysis (my_outer, runinterval)
subroutine, public	posterior_analysis_initialize
subroutine, public	posterior_analysis (runinterval)
subroutine, public	prior_error (ng)

Variables
logical	lgetnrm
logical	lgetstd
logical	ldone
integer	ltlm1 = 1
integer	ltlm2 = 2
integer	ltlm3 = 3
integer	ladj1 = 1
integer	ladj2 = 2
integer	lini = 1
integer	lbck = 2
integer	rec1 = 1
integer	rec2 = 2
integer	rec3 = 3
integer	rec4 = 4
integer	rec5 = 5

Function/Subroutine Documentation

analysis()

subroutine, public i4dvar_mod::analysis	(	integer, intent(in)	my_outer,
		real(dp), intent(in)	runinterval )

Definition at line 1701 of file i4dvar.F.

!
!=======================================================================
!                                                                      !
!  This routine computes 4D-Var data assimilation analysis, Xa. The    !
!  nonlinear model initial conditions are computed by adding the       !
!  4D-Var increments to the current background:  Xa = Xb + dXa.        !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     my_outer        Outer-loop counter (integer)                     !
!     RunInterval     NLM kernel time stepping window (seconds)        !
!                                                                      !
!=======================================================================
!
!  Imported variable declarations
!
      logical :: Lweak = .false.
!
      integer, intent(in) :: my_outer
!
      real(dp), intent(in) :: RunInterval
!
!  Local variable declarations.
!
      integer :: ng, tile
      integer :: Fcount, Lcon, Nrec
      integer :: InpRec, OutRec
# ifdef PROFILE
      integer :: thread
# endif
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", analysis"
!
      sourcefile=myfile
!
!=======================================================================
!  Compute new nonlinear initial conditions by adding minimization
!  increment to previous outer loop initial conditions:
!
!         Xi(outer+1) = Xi(outer) + deltaX(Lcon)
!
!=======================================================================
 
# ifdef PROFILE
!
!  Start profile clock.
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_on (ng, inlm, 88, __line__, myfile)
        END DO
      END DO
# endif
!
!  Clear nonlinear state variables.
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, inlm)
        END DO
      END DO
 
# ifdef SPLIT_4DVAR
!
!-----------------------------------------------------------------------
!  If split 4D-Var algorithm, set several variables that computed or
!  assigned in other 4D-Var phase executable.
!-----------------------------------------------------------------------
!
!  Open nonlinear model initial conditions NetCDF file (INI struc) and
!  inquire about its variable IDs.
!
      DO ng=1,ngrids
        ldefini(ng)=.false.
        CALL def_ini (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!  Open tangent linear model initial conditions NetCDF file (ITL struc)
!  and inquire about its variable IDs.
!
      DO ng=1,ngrids
        ldefitl(ng)=.false.
        CALL tl_def_ini (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!  Open 4D-Var NetCDF file (DAV struc) and inquire about its variables.
!  It is used in "tl_wrt_ini" to write out observation and background
!  cost functions.
!
      DO ng=1,ngrids
        ldefmod(ng)=.false.
        CALL def_mod (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        nrec=dav(ng)%Rindex
      END DO
!
!  Set Nrun>1, set Nrun couter. The counter is only allow to increase
!  in the "increment" phase.
!
      nrun=1+(my_outer-1)*(ninner+1)
      erstr=nrun
 
#  ifdef MASKING
!
!  Set internal mask arrays to process I/O NetCDF files.
!
      DO ng=1,ngrids
       DO tile=first_tile(ng),last_tile(ng),+1
          CALL set_masks (ng, tile, inlm)
        END DO
      END DO
#  endif
# endif
!
!-----------------------------------------------------------------------
!  Compute nonlinear model initial from the 4D-Var analysis.
!-----------------------------------------------------------------------
!
!  In order to use the correct fields, the model time indices are set
!  to Lini.
!
!  The appropriate TLM correction for the NLM model resides in record 1
!  of the ITL file.
!
      DO ng=1,ngrids
        kstp(ng)=lini
# ifdef SOLVE3D
        nstp(ng)=lini
# endif
        inprec=lini
        CALL get_state (ng, inlm, 1, ini(ng), inprec, lini)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        inprec=ltlm1
        CALL get_state (ng, itlm, 1, itl(ng), inprec, ltlm1)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL ini_adjust (ng, tile, ltlm1, lini)
!!        CALL ini_fields (ng, tile, iNLM)
        END DO
      END DO
!
!  Write out new nonlinear model initial conditions into record Lini
!  of INI(ng)%name.
!
      DO ng=1,ngrids
        fcount=ini(ng)%load
        ini(ng)%Nrec(fcount)=1
        outrec=lini
# ifdef DISTRIBUTE
        CALL wrt_ini (ng, myrank, lini, outrec)
# else
        CALL wrt_ini (ng, -1, lini, outrec)
# endif
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!  Gather the v-space increments from the final inner-loop and
!  save in record 4 of the ITL file. The current v-space increment
!  is in record 3 and the sum so far is in record 4.
!
      DO ng=1,ngrids
        inprec=rec3
        CALL get_state (ng, itlm, 8, itl(ng), inprec, ltlm1)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        inprec=rec4
        CALL get_state (ng, itlm, 8, itl(ng), inprec, ltlm2)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL sum_grad (ng, tile, ltlm1, ltlm2)
        END DO
      END DO
!
! Write the current sum into record 4 of the ITL file.
!
      DO ng=1,ngrids
# ifdef DISTRIBUTE
        CALL tl_wrt_ini (ng, myrank, ltlm2, rec4)
# else
        CALL tl_wrt_ini (ng, -1, ltlm2, rec4)
# endif
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
 
# if defined ADJUST_STFLUX   || defined ADJUST_WSTRESS || \
     defined adjust_boundary
!
!  Set index containing the surface forcing increments used the run
!  the nonlinear model in the outer loop and read the forcing
!  increments. For bulk fluxes, we read Rec1 because the stress
!  fluxes change by virtue of the changing initial conditions.
!  When not using bulk fluxes, we read Rec4 because the background
!  stress and flux is prescribed by input files which are not
!  overwritten so we need to correct the background using the
!  sum of the increments from all previous outer-loops.
!  If using Rec4 we need to convert from v-space to x-space
!  by applying the convolution.
!  Note that Lfinp=Lbinp so the the forcing and boundary
!  adjustments are both processsed correctly.
#  ifdef BALANCE_OPERATOR
!  Currently, We do not need the call to tl_balance below, but we
!  might later if we impose a balance constraint on the wind stress
!  corrections.
#  endif
!
!  AMM: CHECK WHAT HAPPENS WITH SECONDARY PRECONDITIONING.
!
      DO ng=1,ngrids
        lfinp(ng)=ltlm1
#  if defined BULK_FLUXES && !defined FORWARD_FLUXES
        inprec=rec1
        CALL get_state (ng, itlm, 1, itl(ng), inprec, lfinp(ng))
#  endif
#  if defined FORWARD_FLUXES || !defined BULK_FLUXES
        inprec=rec4
        CALL get_state (ng, itlm, 1, itl(ng), rec4, lfinp(ng))
        lcon=lfinp(ng)
!
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL tl_convolution (ng, tile, lcon, lweak, 2)
          CALL tl_variability (ng, tile, lcon, lweak)
#   ifdef BALANCE_OPERATOR
!!        CALL tl_balance (ng, tile, Lini, Lcon)
#   endif
        END DO
#  endif
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
 
#  ifdef SPLIT_4DVAR
!
!  If split 4D-Var, write out surface forcing and lateral boundary
!  condition increments (X-space) needed for the nonlinear model into
!  Rec5.
!
      DO ng=1,ngrids
#   ifdef DISTRIBUTE
        CALL tl_wrt_ini (ng, myrank, lfinp(ng), rec5)
#   else
        CALL tl_wrt_ini (ng, -1, lfinp(ng), rec5)
#   endif
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
#  endif
# endif
!
!  Clear tangent linear state variables.
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, itlm)
        END DO
      END DO
!
!  Close current forward NetCDF file.
!
      sourcefile=myfile
      DO ng=1,ngrids
        CALL close_file (ng, inlm, fwd(ng))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
 
# ifdef PROFILE
!
!  Stop profile clock
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_off (ng, inlm, 88, __line__, myfile)
        END DO
      END DO
# endif
!
      RETURN

References close_io_mod::close_file(), mod_iounits::dav, def_ini_mod::def_ini(), def_mod_mod::def_mod(), mod_scalars::erstr, mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_iounits::fwd, get_state_mod::get_state(), mod_iounits::ini, ini_adjust_mod::ini_adjust(), mod_ocean::initialize_ocean(), mod_param::inlm, mod_iounits::itl, mod_param::itlm, mod_stepping::kstp, mod_parallel::last_tile, mod_scalars::ldefini, mod_scalars::ldefitl, mod_scalars::ldefmod, mod_stepping::lfinp, lini, ltlm1, ltlm2, mod_parallel::myrank, mod_param::ngrids, mod_scalars::ninner, mod_scalars::noerror, mod_scalars::nrun, mod_stepping::nstp, rec1, rec3, rec4, rec5, set_masks_mod::set_masks(), mod_iounits::sourcefile, sum_grad_mod::sum_grad(), tl_convolution_mod::tl_convolution(), tl_def_ini_mod::tl_def_ini(), tl_variability_mod::tl_variability(), tl_wrt_ini_mod::tl_wrt_ini(), wclock_off(), wclock_on(), and wrt_ini_mod::wrt_ini().

Here is the call graph for this function:

background()

subroutine, public i4dvar_mod::background	(	integer, intent(in)	my_outer,
		real(dp), intent(in)	runinterval )

Definition at line 547 of file i4dvar.F.

!
!=======================================================================
!                                                                      !
!  This routine computes the backgound state trajectory, Xb_n-1(t),    !
!  used to linearize the tangent linear and adjoint models in the      !
!  inner loops. It interpolates the background at the observations     !
!  locations, and computes the accept/reject quality control flag,     !
!  ObsScale.                                                           !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     my_outer        Outer-loop counter (integer)                     !
!     RunInterval     NLM kernel time stepping window (seconds)        !
!                                                                      !
!=======================================================================
!
!  Imported variable declarations
!
      integer, intent(in)  :: my_outer
!
      real(dp), intent(in) :: RunInterval
!
!  Local variable declarations.
!
      logical :: DoneStepping
!
      integer :: i, lstr, ng
# ifdef PROFILE
      integer :: thread
# endif
# if defined MODEL_COUPLING && !defined MCT_LIB
      integer :: NstrStep, NendStep, extra
!
      real(dp) :: ENDtime, NEXTtime
# endif
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", background"
!
      sourcefile=myfile
 
# if !(defined MODEL_COUPLING && defined ESMF_LIB)
!
!-----------------------------------------------------------------------
!  Set nonlinear model initial conditions.
!-----------------------------------------------------------------------
!
      CALL background_initialize (my_outer)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
!
!-----------------------------------------------------------------------
!  Run nonlinear model. Save nonlinear tracjectory needed by the
!  adjoint and tangent linear models. Interpolate nonlinear model
!  to observation locations (compute and save H x). It processes
!  and writes the observations accept/reject flag (ObsScale) once
!  to allow background quality control, if any.
# if defined MODEL_COUPLING && !defined MCT_LIB
!  Since the ROMS kernel has a delayed output and line diagnostics by
!  one timestep, subtact an extra value to the report of starting and
!  ending timestep for clarity. Usually, the model coupling interval
!  is of the same size as ROMS timestep.
# endif
!-----------------------------------------------------------------------
 
# ifdef PROFILE
!
!  Start profile clock.
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_on (ng, inlm, 86, __line__, myfile)
        END DO
      END DO
# endif
!
!  Initialize various parameters and switches.
!
      myruninterval=runinterval
!
      DO ng=1,ngrids
# ifdef AVERAGES
        idefavg(ng)=-1
        ldefavg(ng)=.true.
        lwrtavg(ng)=.true.
        WRITE (avg(ng)%name,10) trim(avg(ng)%head), my_outer
        lstr=len_trim(avg(ng)%name)
        avg(ng)%base=avg(ng)%name(1:lstr-3)
# endif
# ifdef DIAGNOSTICS
        idefdia(ng)=-1
        ldefdia(ng)=.true.
        lwrtdia(ng)=.true.
        WRITE (dia(ng)%name,10) trim(dia(ng)%head), my_outer
        lstr=len_trim(dia(ng)%name)
        dia(ng)%base=dia(ng)%name(1:lstr-3)
# endif
        wrtobsscale(ng)=.true.
# if defined MODEL_COUPLING && !defined MCT_LIB
!
        nexttime=time(ng)+runinterval
        endtime=initime(ng)+(ntimes(ng)-1)*dt(ng)
        IF ((nexttime.eq.endtime).and.(ng.eq.1)) THEN
          extra=0                                   ! last time interval
        ELSE
          extra=1
        END IF
        step_counter(ng)=0
        nstrstep=iic(ng)
        nendstep=nstrstep+int((myruninterval)/dt(ng))-extra
        IF (master) WRITE (stdout,20) 'NL', ng, my_outer, 0,            &
     &                                nstrstep, nendstep
# else
        IF (master) WRITE (stdout,20) 'NL', ng, my_outer, 0,            &
     &                                ntstart(ng), ntend(ng)
# endif
      END DO
!
# ifdef SOLVE3D
      CALL main3d (runinterval)
# else
      CALL main2d (runinterval)
# endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  If completed stepping, write out into NetCDF files.
# if defined MODEL_COUPLING && !defined MCT_LIB
!  In coupled applications, RunInterval is much less than ntimes*dt,
!  so we need to wait until the last coupling interval is finished.
!  Otherwise, the control switches will be turned off prematurely.
# endif
!-----------------------------------------------------------------------
!
# if defined MODEL_COUPLING && !defined MCT_LIB
      IF (nendstep.eq.ntend(1)) THEN
        donestepping=.true.
      ELSE
        donestepping=.false.
      END IF
# else
      donestepping=.true.
# endif
!
      IF (donestepping) THEN
 
# if defined ADJUST_BOUNDARY || defined ADJUST_STFLUX || \
     defined adjust_wstress
!
!  Write out initial and background surface forcing into initial
!  INI(ng)%name NetCDF file for latter use.
!
        DO ng=1,ngrids
#  ifdef DISTRIBUTE
          CALL wrt_frc (ng, myrank, lfout(ng), lini)
#  else
          CALL wrt_frc (ng, -1, lfout(ng), lini)
#  endif
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
          IF (my_outer.eq.1) THEN
#  ifdef DISTRIBUTE
            CALL wrt_frc (ng, myrank, lfout(ng), lbck)
#  else
            CALL wrt_frc (ng, -1, lfout(ng), lbck)
#  endif
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END DO
# endif
!
!  Write out nonlinear model misfit cost function into DAV(ng)%name
!  NetCDF file.
!
        sourcefile=myfile
        DO ng=1,ngrids
          SELECT CASE (dav(ng)%IOtype)
            CASE (io_nf90)
              CALL netcdf_put_fvar (ng, inlm, dav(ng)%name,             &
     &                              'NLcost_function',                  &
     &                              fourdvar(ng)%NLobsCost(0:),         &
     &                              (/1,my_outer/),                     &
     &                              (/nobsvar(ng)+1,1/),                &
     &                              ncid = dav(ng)%ncid)
 
# if defined PIO_LIB && defined DISTRIBUTE
            CASE (io_pio)
              CALL pio_netcdf_put_fvar (ng, inlm, dav(ng)%name,         &
     &                                  'NLcost_function',              &
     &                                  fourdvar(ng)%NLobsCost(0:),     &
     &                                  (/1,my_outer/),                 &
     &                                  (/nobsvar(ng)+1,1/),            &
     &                                  piofile = dav(ng)%pioFile)
# endif
          END SELECT
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
      END IF
 
# ifdef PROFILE
!
!  Stop profile clock
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_off (ng, inlm, 86, __line__, myfile)
        END DO
      END DO
# endif
!
 10   FORMAT (a,'_outer',i0,'.nc')
 20   FORMAT (/,1x,a,1x,'ROMS: started time-stepping:',                 &
     &        ' (Grid: ',i0,', Outer: ',i2.2,', Inner: ',i3.3,          &
              ', TimeSteps: ',i0,' - ',i0,')',/)
!
      RETURN

References mod_iounits::avg, background_initialize(), mod_iounits::dav, mod_iounits::dia, mod_scalars::dt, mod_scalars::exit_flag, strings_mod::founderror(), mod_fourdvar::fourdvar, mod_ncparam::idefavg, mod_ncparam::idefdia, mod_scalars::iic, mod_scalars::initime, mod_param::inlm, mod_ncparam::io_nf90, mod_ncparam::io_pio, lbck, mod_scalars::ldefavg, mod_scalars::ldefdia, mod_stepping::lfout, lini, mod_scalars::lwrtavg, mod_scalars::lwrtdia, main2d(), main3d(), mod_parallel::master, mod_parallel::myrank, mod_scalars::myruninterval, mod_param::ngrids, mod_fourdvar::nobsvar, mod_scalars::noerror, mod_scalars::ntend, mod_scalars::ntimes, mod_scalars::ntstart, mod_iounits::sourcefile, mod_iounits::stdout, mod_scalars::step_counter, mod_scalars::time, wclock_off(), wclock_on(), wrt_ini_mod::wrt_frc(), and mod_fourdvar::wrtobsscale.

Here is the call graph for this function:

background_initialize()

subroutine, public i4dvar_mod::background_initialize

(

integer, intent(in)

my_outer

)

Definition at line 189 of file i4dvar.F.

!
!=======================================================================
!                                                                      !
!  This routine initializes ROMS nonlinear model trajectory Xb_n-1(0)  !
!  for each (n-1) outer loops. It is separated from the 'background'   !
!  4D-Var phase in ESM coupling applications that use generic methods  !
!  for 'initialize', 'run', and 'finalize'.                            !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     my_outer        Outer-loop counter (integer)                     !
!                                                                      !
!=======================================================================
!
!  Imported variable declarations
!
      integer, intent(in) :: my_outer
!
!  Local variable declarations.
!
      integer :: lstr, ng, tile
# ifdef STD_MODEL
      integer :: Lstd
# endif
      integer :: Fcount, InpRec, Tindex
# ifdef PROFILE
      integer :: thread
# endif
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", background_initialize"
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  Initialize nonlinear model kernel.
!-----------------------------------------------------------------------
 
# ifdef PROFILE
!
!  Start profile clock.
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_on (ng, inlm, 86, __line__, myfile)
        END DO
      END DO
# endif
!
!  Clear nonlinear mixing arrays.
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_mixing (ng, tile, inlm)
        END DO
      END DO
 
# ifdef SPLIT_4DVAR
!
!-----------------------------------------------------------------------
!  If split 4D-Var algorithm, set several variables that computed or
!  assigned in other 4D-Var phase executable.
!-----------------------------------------------------------------------
!
!  If outer>1, set ERstr=Nrun to compute the open boundary conditions
!  (OBC_time) and surface forcing (SF_time) adjustment times, if needed.
!
      IF (my_outer.gt.1) THEN
        nrun=1+(my_outer-1)*(ninner+1)
        erstr=nrun
      END IF
 
#  if defined ADJUST_BOUNDARY || defined ADJUST_STFLUX || \
      defined adjust_wstress
!
!  If outer>1, reset reset surface forcing and lateral boundary output
!  time indices to LADJ2 since they are changed in the inner loops.
!
      IF (my_outer.gt.1) THEN
        DO ng=1,ngrids
          lfout(ng)=ladj2
#   ifdef ADJUST_BOUNDARY
          lbout(ng)=ladj2
#   endif
        END DO
      END IF
#  endif
!
!  If outer>1, open Nonlinear model initial conditions NetCDF file
!  (INI struc) and inquire about its variable IDs. Reset the value of
!  INI(ng)%Rindex, which is needed in "initial" to the 4D-Var analysis
!  record.
!
      IF (my_outer.gt.1) THEN
        DO ng=1,ngrids
          ldefini(ng)=.false.
          CALL def_ini (ng)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          ini(ng)%Rindex=lini
        END DO
      END IF
!
!  If outer>1, open 4D-Var NetCDF file (DAV struc) and inquire about its
!  variables.
!
      IF (my_outer.gt.1) THEN
        DO ng=1,ngrids
          ldefmod(ng)=.false.
          CALL def_mod (ng)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          havenlmod(ng)=.false.                   ! do not read NLmodVal
        END DO
      END IF
!
!  If outer>1, read in the global observation screening and quality
!  control scale ObsScaleGlobal ("obs_scale") that it is written in the
!  first outer loop. Such data is in memory in the unsplit algorithm.
!  Recall that in I4D-Var, observation variables are read and load into
!  the arrays elements 1:Nobs(ng) for each survey time.  That is, only
!  the values needed are read.
!
!  HGA: What to do in 4D-Var with nested grids?
!
      IF (my_outer.gt.1) THEN
        ng=1
        SELECT CASE (dav(ng)%IOtype)
          CASE (io_nf90)
            CALL netcdf_get_fvar (ng, itlm, dav(ng)%name,               &
     &                            vname(1,idobss), obsscaleglobal,      &
     &                            ncid = dav(ng)%ncid)
 
#  if defined PIO_LIB && defined DISTRIBUTE
          CASE (io_pio)
            CALL pio_netcdf_get_fvar (ng, itlm, dav(ng)%name,           &
     &                                vname(1,idobss), obsscaleglobal,  &
     &                                piofile = dav(ng)%pioFile)
#  endif
        END SELECT
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF
!
!  If outer>1, read in initial (outer=1) nonlinear cost function values
!  from DAV file and load it into "CostNorm", its values are used for
!  reporting normalized values.
!
      IF (my_outer.gt.1) THEN
        DO ng=1,ngrids
          SELECT CASE (dav(ng)%IOtype)
            CASE (io_nf90)
              CALL netcdf_get_fvar (ng, inlm, dav(ng)%name,             &
     &                              'NLcost_function',                  &
     &                              fourdvar(ng)%CostNorm(0:),          &
     &                              ncid = dav(ng)%ncid,                &
     &                              start = (/1,1/),                    &
     &                              total = (/nobsvar(ng)+1,1/))
 
#  if defined PIO_LIB && defined DISTRIBUTE
            CASE (io_pio)
              CALL pio_netcdf_get_fvar (ng, inlm, dav(ng)%name,         &
     &                                  'NLcost_function',              &
     &                                  fourdvar(ng)%CostNorm(0:),      &
     &                                  piofile = dav(ng)%pioFile,      &
     &                                  start = (/1,1/),                &
     &                                  total = (/nobsvar(ng)+1,1/))
#  endif
          END SELECT
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
      END IF
 
#  if defined ADJUST_STFLUX   || defined ADJUST_WSTRESS || \
      defined adjust_boundary
!
!  If outer>1, read in surface forcing and or lateral boundary
!  increments (X-space) from ITL file Rec5.
!
      IF (my_outer.gt.1) THEN
        DO ng=1,ngrids
          ldefitl(ng)=.false.
          CALL tl_def_ini (ng)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
          inprec=rec5
          CALL get_state (ng, itlm, 1, itl(ng), inprec, ltlm1)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
      END IF
#  endif
 
#  ifdef FORWARD_FLUXES
!
!  If outer>1, set structure to process nonlinear surface fluxes from
!  the initial (outer=1) NLM quicksave trajectory. Notice that 2 is
!  substracted since the counter starts at 'outer0'.
!
      IF (my_outer.gt.1) THEN
        DO ng=1,ngrids
          WRITE (qck(ng)%name,10) trim(qck(ng)%head), my_outer-2
          lstr=len_trim(qck(ng)%name)
          qck(ng)%base=qck(ng)%name(1:lstr-3)
        END DO
!
        CALL edit_multifile ('QCK2BLK')
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF
#  endif
# endif
!
!-----------------------------------------------------------------------
!  Initialize nonlinear model.
!-----------------------------------------------------------------------
!
!  Activate switch to write out initial misfit between model and
!  observations.
!
      DO ng=1,ngrids
        IF (my_outer.eq.1) THEN
          wrtmisfit(ng)=.true.
        ELSE
          wrtmisfit(ng)=.false.
        END IF
      END DO
!
!  Set nonlinear output history file name. Create a basic state file
!  for each outher loop.
!
      DO ng=1,ngrids
        idefhis(ng)=-1
        ldefhis(ng)=.true.
        lwrthis(ng)=.true.
        lreadfwd(ng)=.false.
        WRITE (his(ng)%name,10) trim(fwd(ng)%head), my_outer-1
        lstr=len_trim(his(ng)%name)
        his(ng)%base=his(ng)%name(1:lstr-3)
      END DO
!
!  Set the nonlinear model to output the quicksave history file as a
!  function of the outer loop. It may be used as the basic state
!  trajectory for the surface fluxes (wind stress, shortwave, heat
!  flux, and E-P) because they can be saved frequently to resolve
!  the daily cycle while avoiding large files.
!
      DO ng=1,ngrids
        ldefqck(ng)=.true.
        lwrtqck(ng)=.true.
# ifdef FORWARD_FLUXES
        lreadblk(ng)=.false.
# endif
        WRITE (qck(ng)%name,10) trim(qck(ng)%head), my_outer-1
        lstr=len_trim(qck(ng)%name)
        qck(ng)%base=qck(ng)%name(1:lstr-3)
      END DO
!
!  Initialize nonlinear model. If outer=1, the model is initialized
!  with the background or reference state. Otherwise, the model is
!  initialized with the estimated initial conditions from previous
!  iteration, X(0) = X(0) + deltaX(0).
!
      DO ng=1,ngrids
        wrtnlmod(ng)=.true.
        wrttlmod(ng)=.false.
        rst(ng)%Rindex=0
        fcount=rst(ng)%load
        rst(ng)%Nrec(fcount)=0
      END DO
!
      CALL initial
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  If first pass, save nonlinear initial conditions (currently in time
!  index 1, background) into next record (Lbck) of INI(ng)%name NetCDF
!  file. The record "Lbck" becomes the background state record and the
!  record "Lini" becomes current nonlinear initial conditions.  Both
!  records are used in the algorithm below.
!
      IF (my_outer.eq.1) THEN
        tindex=1
        DO ng=1,ngrids
          ini(ng)%Rindex=1
          fcount=ini(ng)%load
          ini(ng)%Nrec(fcount)=1
# ifdef DISTRIBUTE
          CALL wrt_ini (ng, myrank, tindex)
# else
          CALL wrt_ini (ng, -1, tindex)
# endif
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
      END IF
 
# ifdef STD_MODEL
!
!  Estimate initial conditions standard deviation fields for the
!  background error covariance using the method of Mogensen et al.
!  (2012), which assumes that the background errors are proportional
!  to the vertical derivatives of the state. The error have simmilar
!  shape as the prior profile but iwth a displacement over the water
!  column.
!
      IF (my_outer.eq.1) THEN
        lstd=1                          ! time index in error arrays
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL background_std (ng, tile, tindex, lstd)
          END DO
        END DO
!
!  Write out estimated background standard deviation fields.
!
        DO ng=1,ngrids
          IF (lwrtstd(ng)) THEN
            std(5,ng)%Rindex=0
            fcount=std(5,ng)%load
            std(5,ng)%Nrec(fcount)=1
#  ifdef DISTRIBUTE
            CALL wrt_std (ng, myrank, lstd)
#  else
            CALL wrt_std (ng, -1, lstd)
#  endif
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END DO
      END IF
# endif
 
# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
!
!  Compute the reference zeta and biconjugate gradient arrays
!  required for the balance of free surface.
!
      IF (balance(isfsur)) THEN
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL balance_ref (ng, tile, lini)
            CALL biconj (ng, tile, inlm, lini)
          END DO
          wrtzetaref(ng)=.true.
        END DO
      END IF
# endif
!
!  If first pass, define output 4DVAR NetCDF file containing all
!  processed data at observation locations.
!
      IF (my_outer.eq.1) THEN
        DO ng=1,ngrids
          ldefmod(ng)=.true.
          CALL def_mod (ng)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
      END IF
!
 10   FORMAT (a,'_outer',i0,'.nc')
!
      RETURN

References mod_scalars::balance, zeta_balance_mod::balance_ref(), zeta_balance_mod::biconj(), mod_iounits::dav, def_ini_mod::def_ini(), def_mod_mod::def_mod(), edit_multifile(), mod_scalars::erstr, mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_fourdvar::fourdvar, mod_iounits::fwd, get_state_mod::get_state(), mod_fourdvar::havenlmod, mod_iounits::his, mod_ncparam::idefhis, mod_ncparam::idobss, mod_iounits::ini, initial(), mod_mixing::initialize_mixing(), mod_param::inlm, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_ncparam::isfsur, mod_iounits::itl, mod_param::itlm, ladj2, mod_parallel::last_tile, mod_stepping::lbout, mod_scalars::ldefhis, mod_scalars::ldefini, mod_scalars::ldefitl, mod_scalars::ldefmod, mod_scalars::ldefqck, mod_stepping::lfout, lini, mod_scalars::lreadblk, mod_scalars::lreadfwd, ltlm1, mod_scalars::lwrthis, mod_scalars::lwrtqck, mod_parallel::myrank, mod_param::ngrids, mod_scalars::ninner, mod_fourdvar::nobsvar, mod_scalars::noerror, mod_scalars::nrun, mod_iounits::qck, rec5, mod_iounits::rst, mod_iounits::sourcefile, mod_iounits::std, tl_def_ini_mod::tl_def_ini(), mod_ncparam::vname, wclock_on(), wrt_ini_mod::wrt_ini(), mod_fourdvar::wrtmisfit, mod_fourdvar::wrtnlmod, mod_fourdvar::wrttlmod, and mod_fourdvar::wrtzetaref.

Referenced by background().

Here is the call graph for this function:

Here is the caller graph for this function:

increment()

subroutine, public i4dvar_mod::increment	(	integer, intent(in)	my_outer,
		real(dp), intent(in)	runinterval )

Definition at line 766 of file i4dvar.F.

!
!=======================================================================
!                                                                      !
!  This routine computes the 4D-Var data assimilation state increment, !
!  dXa, by iterating the inner loops and minimizing the cost function. !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     my_outer        Outer-loop counter (integer)                     !
!     RunInterval     TLM/ADM kernels time stepping window (seconds)   !
!                                                                      !
!=======================================================================
!
!  Imported variable declarations
!
      logical :: Lweak = .false.
!
      integer, intent(in) :: my_outer
!
      real(dp), intent(in) :: RunInterval
!
!  Local variable declarations.
!
      integer :: i, ifile, lstr, my_inner, ng, tile
      integer :: Fcount, InpRec, Lcon, Lsav
# ifdef PROFILE
      integer :: thread
# endif
!
      real(r8) :: rate
# ifdef SPLIT_4DVAR
      real(dp) :: stime
# endif
!
      character (len=10) :: suffix
 
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", increment"
!
      sourcefile=myfile
!
!=======================================================================
!  Compute 4D-Var increment.
!=======================================================================
 
# ifdef PROFILE
!
!  Start profile clock.
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_on (ng, itlm, 87, __line__, myfile)
        END DO
      END DO
# endif
 
# ifdef SPLIT_4DVAR
!
!-----------------------------------------------------------------------
!  If split 4D-Var algorithm, set several variables that are computed
!  or assigned in other 4D-Var phase executable.
!-----------------------------------------------------------------------
!
!  Reset Nrun counter to a value greater than one.
!
      IF (my_outer.gt.1) THEN
        nrun=1+(my_outer-1)*(ninner+1)
      END IF
!
!  Open 4D-Var NetCDF file (DAV struc) and inquire about its variables.
!  Activate "haveNLmod" to read its values in calls to "obs_read". Its
!  values were written in the "background" phase.
!
      DO ng=1,ngrids
        ldefmod(ng)=.false.
        CALL def_mod (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        havenlmod(ng)=.true.
      END DO
!
!  In the split 4D-Var algorithm, we need to read the global observation
!  screening and quality control scale ObsScaleGlobal ("obs_scale") that
!  it is written in the "background" phase. Such data is in memory in
!  the unsplit algorithm.  Recall that in I4D-Var, observation variables
!  are read and load into the arrays elements 1:Nobs(ng) for each survey
!  time.  That is, only the values needed are read.
!
!  HGA: What to do in 4D-Var with nested grids?
!
      ng=1
      SELECT CASE (dav(ng)%IOtype)
        CASE (io_nf90)
          CALL netcdf_get_fvar (ng, itlm, dav(ng)%name,                 &
     &                          vname(1,idobss), obsscaleglobal,        &
     &                          ncid = dav(ng)%ncid)
 
#  if defined PIO_LIB && defined DISTRIBUTE
        CASE (io_pio)
          CALL pio_netcdf_get_fvar (ng, itlm, dav(ng)%name,             &
     &                              vname(1,idobss), obsscaleglobal,    &
     &                              piofile = dav(ng)%pioFile)
#  endif
      END SELECT
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Read in first value of NLM cost function computed at outer=1, and
!  load it into "CostNorm" that is used in the reporting of normalized
!  values.
!
      sourcefile=myfile
      DO ng=1,ngrids
        SELECT CASE (dav(ng)%IOtype)
          CASE (io_nf90)
            CALL netcdf_get_fvar (ng, inlm, dav(ng)%name,               &
     &                            'NLcost_function',                    &
     &                            fourdvar(ng)%CostNorm(0:),            &
     &                            ncid = dav(ng)%ncid,                  &
     &                            start = (/1,1/),                      &
     &                            total = (/nobsvar(ng)+1,1/))
 
#  if defined PIO_LIB && defined DISTRIBUTE
          CASE (io_pio)
            CALL pio_netcdf_get_fvar (ng, inlm, dav(ng)%name,           &
     &                                'NLcost_function',                &
     &                                fourdvar(ng)%CostNorm(0:),        &
     &                                piofile = dav(ng)%pioFile,        &
     &                                start = (/1,1/),                  &
     &                                total = (/nobsvar(ng)+1,1/))
#  endif
        END SELECT
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!  Read in current outer loop NLM cost function.
!
      DO ng=1,ngrids
        SELECT CASE (dav(ng)%IOtype)
          CASE (io_nf90)
            CALL netcdf_get_fvar (ng, inlm, dav(ng)%name,               &
     &                            'NLcost_function',                    &
     &                            fourdvar(ng)%NLobsCost(0:),           &
     &                            ncid = dav(ng)%ncid,                  &
     &                            start = (/1,my_outer/),               &
     &                            total = (/nobsvar(ng)+1,1/))
 
#  if defined PIO_LIB && defined DISTRIBUTE
          CASE (io_pio)
            CALL pio_netcdf_get_fvar (ng, inlm, dav(ng)%name,           &
     &                                'NLcost_function',                &
     &                                fourdvar(ng)%NLobsCost(0:),       &
     &                                piofile = dav(ng)%pioFile,        &
     &                                start = (/1,my_outer/),           &
     &                                total = (/nobsvar(ng)+1,1/))
#  endif
         END SELECT
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!  If outer>1, read in previous background and TLM cost function to
!  compute FOURDVAR(ng)%CostFun(0).  Its value is in memory in the
!  unsplit driver.
!
      IF (my_outer.gt.1) THEN
        DO ng=1,ngrids
          SELECT CASE (dav(ng)%IOtype)
            CASE (io_nf90)
              CALL netcdf_get_fvar (ng, inlm, dav(ng)%name,             &
     &                              'TLcost_function',                  &
     &                              fourdvar(ng)%CostFunOld(0:),        &
     &                              ncid = dav(ng)%ncid,                &
     &                              start = (/nrun-1/),                 &
     &                              total = (/1/))
              IF (founderror(exit_flag, noerror, __line__,              &
     &                       myfile)) RETURN
!
              CALL netcdf_get_fvar (ng, inlm, dav(ng)%name,             &
     &                              'back_function',                    &
     &                              fourdvar(ng)%BackCost(0:),          &
     &                              ncid = dav(ng)%ncid,                &
     &                              start = (/nrun-1/),                 &
     &                              total = (/1/))
              IF (founderror(exit_flag, noerror, __line__,              &
     &                       myfile)) RETURN
 
#  if defined PIO_LIB && defined DISTRIBUTE
            CASE (io_pio)
              CALL pio_netcdf_get_fvar (ng, inlm, dav(ng)%name,         &
     &                                  'TLcost_function',              &
     &                                  fourdvar(ng)%CostFunOld(0:),    &
     &                                  piofile = dav(ng)%pioFile,      &
     &                                  start = (/nrun-1/),             &
     &                                  total = (/1/))
              IF (founderror(exit_flag, noerror, __line__,              &
     &                       myfile)) RETURN
!
              CALL pio_netcdf_get_fvar (ng, inlm, dav(ng)%name,         &
     &                                  'back_function',                &
     &                                  fourdvar(ng)%BackCost(0:),      &
     &                                  piofile = dav(ng)%pioFile,      &
     &                                  start = (/nrun-1/),             &
     &                                  total = (/1/))
              IF (founderror(exit_flag, noerror, __line__,              &
     &                       myfile)) RETURN
#  endif
          END SELECT
!
          fourdvar(ng)%CostFun(0)=fourdvar(ng)%CostFunOld(0)+           &
     &                            fourdvar(ng)%BackCost(0)
        END DO
      END IF
!
!  If outer>1, read several conjugate gradient variables from 4D-VAR
!  NetCDF (DAV struc) file.  In the unsplit case, such values are
!  available in memory.
!
      IF (my_outer.gt.1) THEN
        DO ng=1,ngrids
          CALL cg_read_cgradient (ng, itlm, my_outer)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
      END IF
!
!  If outer>1, open tangent linear initial conditions NetCDF file
!  (ITL struc) and inquire about its variables IDs.
!
      IF (my_outer.gt.1) THEN
        DO ng=1,ngrids
          ldefitl(ng)=.false.
          CALL tl_def_ini (ng)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
      END IF
!
!  If outer>1, open tangent linear history NetCDF file (TLM struc) and
!  inquire about its variables IDs.
!
      IF (my_outer.gt.1) THEN
        DO ng=1,ngrids
          ldeftlm(ng)=.false.
          CALL tl_def_his (ng, ldeftlm(ng))
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
      END IF
!
!  Set nonlinear output history file to be used as the basis state
!  trajectory. The 4D-Var increment phase is computed by a different
!  executable and needs to know some of the HIS structure information.
!
      DO ng=1,ngrids
        WRITE (his(ng)%name,10) trim(fwd(ng)%head), my_outer-1
        lstr=len_trim(his(ng)%name)
        his(ng)%base=his(ng)%name(1:lstr-3)
        IF (his(ng)%Nfiles.gt.1) THEN
          DO ifile=1,his(ng)%Nfiles
            WRITE (suffix,"('_',i4.4,'.nc')") ifile
            his(ng)%files(ifile)=trim(his(ng)%base)//trim(suffix)
          END DO
          his(ng)%name=trim(his(ng)%files(1))
        ELSE
          his(ng)%files(1)=trim(his(ng)%name)
        END IF
      END DO
!
!  Set the nonlinear model quicksave-history file as the basic state for
!  the surface fluxes computed in "bulk_flux", which may be available at
!  more frequent intervals while avoiding large files. Since the 4D-Var
!  increment phase is calculated by a different executable and needs to
!  know some of the QCK structure information.
!
      DO ng=1,ngrids
        WRITE (qck(ng)%name,10) trim(qck(ng)%head), my_outer-1
        lstr=len_trim(qck(ng)%name)
        qck(ng)%base=qck(ng)%name(1:lstr-3)
        IF (qck(ng)%Nfiles.gt.1) THEN
          DO ifile=1,qck(ng)%Nfiles
            WRITE (suffix,"('_',i4.4,'.nc')") ifile
            qck(ng)%files(ifile)=trim(qck(ng)%base)//trim(suffix)
          END DO
          qck(ng)%name=trim(qck(ng)%files(1))
        ELSE
          qck(ng)%files(1)=trim(qck(ng)%name)
        END IF
      END DO
!
!  Read in 4D-Var starting time (sec) from nonlinear trajectory.
!  Initialize "tday" which are needed to write the correct time in
!  the ITL NetCDF file.  It is alse need for boundary and surface
!  forcing adjustments, if any.
!
      inprec=1
      DO ng=1,ngrids
        SELECT CASE (his(ng)%IOtype)
          CASE (io_nf90)
            CALL netcdf_get_fvar (ng, itlm, his(ng)%name,               &
     &                            vname(1,idtime), stime,               &
     &                            start = (/inprec/),                   &
     &                            total = (/1/))
 
#  if defined PIO_LIB && defined DISTRIBUTE
          CASE (io_pio)
            CALL pio_netcdf_get_fvar (ng, itlm, his(ng)%name,           &
     &                                vname(1,idtime), stime,           &
     &                                start = (/inprec/),               &
     &                                total = (/1/))
#  endif
        END SELECT
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        initime(ng)=stime
 
#  ifdef ADJUST_BOUNDARY
!
!  Set time (sec) for the open boundary adjustment.
!
        obc_time(1,ng)=stime
        DO i=2,nbrec(ng)
          obc_time(i,ng)=obc_time(i-1,ng)+nobc(ng)*dt(ng)
        END DO
#  endif
 
#  if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
!
!  Set time (sec) for the surface forcing adjustment.
!
        sf_time(1,ng)=stime
        DO i=2,nfrec(ng)
          sf_time(i,ng)=sf_time(i-1,ng)+nsff(ng)*dt(ng)
        END DO
#  endif
      END DO
# endif
!
!-----------------------------------------------------------------------
!  Initialize.
!-----------------------------------------------------------------------
!
!  Set various switches.
!
      DO ng=1,ngrids
        lwrtcost(ng)=.true.
# ifdef AVERAGES
        ldefavg(ng)=.false.
        lwrtavg(ng)=.false.
# endif
# ifdef DIAGNOSTICS
        ldefdia(ng)=.false.
        lwrtdia(ng)=.false.
# endif
        wrtnlmod(ng)=.false.
        wrtobsscale(ng)=.false.
        wrttlmod(ng)=.true.
      END DO
!
!  Set structure for the nonlinear forward trajectory to be processed
!  by the tangent linear and adjoint models. Also, set switches to
!  process the FWD structure in routine "check_multifile". Notice that
!  it is possible to split solution into multiple NetCDF files to reduce
!  their size.
!
      CALL edit_multifile ('HIS2FWD')
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      DO ng=1,ngrids
        lreadfwd(ng)=.true.
      END DO
 
# ifdef FORWARD_FLUXES
!
!  Set the BLK structure to contain the nonlinear model surface fluxes
!  needed by the tangent linear and adjoint models. Also, set switches
!  to process that structure in routine "check_multifile". Notice that
!  it is possible to split the solution into multiple NetCDF files to
!  reduce their size.
!
!  The switch LreadFRC is deactivated because all the atmospheric
!  forcing, including shortwave radiation, is read from the NLM
!  surface fluxes or is assigned during ESM coupling.  Such fluxes
!  are available from the QCK structure. There is no need for reading
!  and processing from the FRC structure input forcing-files.
!
      CALL edit_multifile ('QCK2BLK')
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      DO ng=1,ngrids
        lreadblk(ng)=.true.
        lreadfrc(ng)=.false.
        lreadqck(ng)=.false.
      END DO
# endif
!
!  Clear the nonlinear state arrays to make sure that the RHS terms
!  rzeta, rubar, rvbar, ru, and rv are zero. Otherwise, those arrays
!  will have the last computed values when running the nonlinear model
!  if not processing the forward trajectory RHS terms. It needs to be
!  done to get identical solutions with the split schemes.
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, inlm)
        END DO
      END DO
!
!  The minimization algorithm requires to save all the gradient
!  solutions for each inner loop iteration.  They are used for
!  orthogonalization in the conjugate gradient algorithm.  Thus,
!  we need to reset adjoint file record indices.
!
      DO ng=1,ngrids
        adm(ng)%Rindex=0
        fcount=adm(ng)%load
        adm(ng)%Nrec(fcount)=0
      END DO
!
!  An adjoint NetCDF is created for each outer loop.
!
      DO ng=1,ngrids
        idefadj(ng)=-1
        ldefadj(ng)=.true.
        WRITE (adm(ng)%name,10) trim(adm(ng)%head), my_outer
        lstr=len_trim(adm(ng)%name)
        adm(ng)%base=adm(ng)%name(1:lstr-3)
      END DO
!
!  Define output Hessian NetCDF file containing the eigenvectors
!  approximation to the Hessian matrix computed from the Lanczos
!  algorithm. Notice that the file name is a function of the
!  outer loop. That is, a file is created for each outer loop.
!
      DO ng=1,ngrids
        ldefhss(ng)=.true.
        WRITE (hss(ng)%name,10) trim(hss(ng)%head), my_outer
        lstr=len_trim(hss(ng)%name)
        hss(ng)%base=hss(ng)%name(1:lstr-3)
        CALL def_hessian (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!  Notice that inner loop iteration start from zero. This is needed to
!  compute the minimization initial increment deltaX(0), its associated
!  gradient G(0), and descent direction d(0) used in the conjugate
!  gradient algorithm.
!
      inner_loop : DO my_inner=0,ninner
        inner=my_inner
!
!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
!  Time-step tangent linear model: compute cost function.
!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
!
!  If first pass inner=0, initialize tangent linear state (increments,
!  deltaX) from rest. Otherwise, use trial initial conditions estimated
!  by the conjugate gradient algorithm in previous inner loop. The TLM
!  initial conditions are read from ITL(ng)%name, record 1.
!
        DO ng=1,ngrids
          itl(ng)%Rindex=1
          CALL tl_initial (ng)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
!
!  On first pass, initialize records 2, 3 and 4 of the ITL file to zero.
!
        IF ((my_inner.eq.0).and.(my_outer.eq.1)) THEN
          DO ng=1,ngrids
# ifdef DISTRIBUTE
            CALL tl_wrt_ini (ng, myrank, ltlm1, rec2)
# else
            CALL tl_wrt_ini (ng, -1, ltlm1, rec2)
# endif
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# ifdef DISTRIBUTE
            CALL tl_wrt_ini (ng, myrank, ltlm1, rec3)
# else
            CALL tl_wrt_ini (ng, -1, ltlm1, rec3)
# endif
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# ifdef DISTRIBUTE
            CALL tl_wrt_ini (ng, myrank, ltlm1, rec4)
# else
            CALL tl_wrt_ini (ng, -1, ltlm1, rec4)
# endif
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END DO
        END IF
 
# ifdef MULTIPLE_TLM
!
!  If multiple TLM history NetCDF files, activate writing and determine
!  output filename. The multiple file option is used to perturb initial
!  state and create ensembles.  The TLM final trajectory is written for
!  each inner loop on separated NetCDF files.
!
        DO ng=1,ngrids
          ideftlm(ng)=-1
          ldeftlm(ng)=.true.
          lwrttlm(ng)=.true.
          WRITE (tlm(ng)%name,20) trim(tlm(ng)%head), nrun
          lstr=len_trim(tlm(ng)%name)
          tlm(ng)%base=tlm(ng)%name(1:lstr-3)
        END DO
# endif
!
!  Run tangent linear model. Compute misfit observation cost function,
!  Jo.
!
        DO ng=1,ngrids
          IF (master) THEN
            WRITE (stdout,30) 'TL', ng, my_outer, my_inner,             &
     &                        ntstart(ng), ntend(ng)
          END IF
        END DO
!
# ifdef SOLVE3D
        CALL tl_main3d (runinterval)
# else
        CALL tl_main2d (runinterval)
# endif
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef EVOLVED_LCZ
!
!  Write evolved tangent Lanczos vector into hessian netcdf file for use
!  later.
!
!  NOTE: When using this option, it is important to set LhessianEV and
!  Lprecond to FALSE in s4dvar.in, otherwise the evolved Lanczos vectors
!  with be overwritten by the Hessian eigenvectors. The fix to this
!  is to define a new NetCDF file that contains the evolved Lanczos
!  vectors.
!
        IF (my_inner.ne.0) THEN
          DO ng=1,ngrids
#  ifdef DISTRIBUTE
            CALL wrt_evolved (ng, myrank, kstp(ng), nrhs(ng))
#  else
            CALL wrt_evolved (ng, -1, kstp(ng), nrhs(ng))
#  endif
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END DO
        END IF
# endif
 
# ifdef MULTIPLE_TLM
!
!  If multiple TLM history NetCDF files, close current NetCDF file.
!
        sourcefile=myfile
        DO ng=1,ngrids
          CALL close_file (ng, itlm, tlm(ng))
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
# endif
!
!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
!  Time step adjoint model backwards: compute cost function gradient.
!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
!
!  Initialize the adjoint model always from rest.
!
        DO ng=1,ngrids
          CALL ad_initial (ng)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
!
!  Time-step adjoint model backwards. The adjoint model is forced with
!  the adjoint of the observation misfit (Jo) term.
!
        DO ng=1,ngrids
          IF (master) THEN
            WRITE (stdout,30) 'AD', ng, my_outer, my_inner,             &
     &                        ntstart(ng), ntend(ng)
          END IF
        END DO
!
# ifdef SOLVE3D
        CALL ad_main3d (runinterval)
# else
        CALL ad_main2d (runinterval)
# endif
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Clear adjoint arrays.
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL initialize_ocean (ng, tile, iadm)
# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
            CALL initialize_forces (ng, tile, iadm)
# endif
# ifdef ADJUST_BOUNDARY
            CALL initialize_boundary (ng, tile, iadm)
# endif
          END DO
        END DO
!
!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
!  Conjugate gradient algorithm.
!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
!
!  Read TLM v-space initial conditions, record 3 in ITL(ng)%name, and
!  load it into time index LTLM1. This is needed to compute background
!  cost function. Also read in new (x-space) gradient vector, GRADx(Jo),
!  from adjoint history file ADM(ng)%name.  Read in the sum of all the
!  previous outer-loop increments which are always in record 4 of
!  the ITL file.
!
        DO ng=1,ngrids
          IF (my_inner.eq.0) THEN
            inprec=rec1
            CALL get_state (ng, itlm, 8, itl(ng), inprec, ltlm1)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          ELSE
            inprec=rec3
            CALL get_state (ng, itlm, 8, itl(ng), inprec, ltlm1)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
 
          inprec=rec4
          CALL get_state (ng, itlm, 8, itl(ng), inprec, ltlm2)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
          inprec=adm(ng)%Rindex
          CALL get_state (ng, iadm, 4, adm(ng), inprec, ladj2)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef BALANCE_OPERATOR
          inprec=lini
          CALL get_state (ng, inlm, 2, ini(ng), inprec, lini)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          nrhs(ng)=lini
# endif
        END DO
!
!  Convert observation cost function gradient, GRADx(Jo), from model
!  space (x-space) to minimization space (v-space):
!
!     GRADv(Jo) = B^(T/2) GRADx(Jo),  operator: S G L^(T/2) W^(-1/2)
!
!  First, multiply the adjoint solution, GRADx(Jo), by the background-
!  error standard deviations, S.  Second, convolve result with the
!  adjoint diffusion operator, G L^(T/2) W^(-1/2). Then, backgound
!  cost function contribution (BackCost) and cost function gradient
!  (v-space) by adding background and observation contributions:
!
!     GRADv(J) = GRADv(Jb) + GRADv(Jo) = deltaV + GRADv(Jo)
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
# ifdef BALANCE_OPERATOR
            CALL ad_balance (ng, tile, lini, ladj2)
# endif
            CALL ad_variability (ng, tile, ladj2, lweak)
            CALL ad_convolution (ng, tile, ladj2, lweak, 2)
            CALL cost_grad (ng, tile, ltlm1, ltlm2, ladj2)
          END DO
        END DO
!
!  Compute current total cost function.
!
        DO ng=1,ngrids
          IF (nrun.eq.1) THEN
            DO i=0,nobsvar(ng)
              fourdvar(ng)%CostFunOld(i)=fourdvar(ng)%CostNorm(i)
              fourdvar(ng)%CostFun(i)=fourdvar(ng)%CostNorm(i)
            END DO
          ELSE
            DO i=0,nobsvar(ng)
              fourdvar(ng)%CostFunOld(i)=fourdvar(ng)%CostFun(i)
            END DO
          END IF
        END DO
!
!  Prepare for background cost function (Jb) calculation:
!
!  Read the convolved gradient from inner=0 (which is permanently
!  saved in record 1 of the adjoint file)  ALWAYS into record 1.
!
        IF (my_inner.gt.0) THEN
          DO ng=1,ngrids
            inprec=ladj1
            CALL get_state (ng, iadm, 3, adm(ng), inprec, ladj1)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END DO
        END IF
!
!  Compute background cost function (Jb) for inner=0:
!
!  If first pass of inner loop, read in the sum of previous v-space
!  gradients from record 4 of ITL file using the TLM model variables
!  as temporary storage. Also add background cost function to Cost0.
!
        IF (my_inner.eq.0) THEN
          DO ng=1,ngrids
            inprec=rec4
            CALL get_state (ng, itlm, 2, itl(ng), inprec, ltlm2)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
            DO tile=first_tile(ng),last_tile(ng),+1
              CALL back_cost (ng, tile, ltlm2)
            END DO
!
            fourdvar(ng)%Cost0(my_outer)=fourdvar(ng)%Cost0(my_outer)+  &
     &                                   fourdvar(ng)%BackCost(0)
          END DO
        END IF
!
!  Compute current total cost function.
!
        DO ng=1,ngrids
          IF (nrun.eq.1) THEN
            DO i=0,nobsvar(ng)
              fourdvar(ng)%CostNorm(i)=fourdvar(ng)%CostNorm(i)+        &
     &                                 fourdvar(ng)%BackCost(i)
              fourdvar(ng)%CostFunOld(i)=fourdvar(ng)%CostNorm(i)
              fourdvar(ng)%CostFun(i)=fourdvar(ng)%CostNorm(i)
            END DO
          ELSE
            DO i=0,nobsvar(ng)
              fourdvar(ng)%CostFunOld(i)=fourdvar(ng)%CostFun(i)
            END DO
          END IF
        END DO
!
!  Determine the descent direction in which the quadractic total cost
!  function decreases. Then, determine the TLM initial conditions,
!  deltaV(LTLM1), and its gradient, GRADv{J(Lnew)} at the new
!  direction.  Also, Compute TLM v-space trial initial conditions for
!  next inner loop, deltaV(LTLM2). The new gradient minimize the
!  quadratic cost function spanned by current and previous inner loop
!  iterations.  This is achieved by orthogonalizing (Gramm-Schmidt
!  algorithm) against all previous inner loop gradients.
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL cgradient (ng, tile, itlm, my_inner, my_outer)
          END DO
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
!
!  Report background (Jb) and observations (Jo) cost function values
!  normalized by their first minimization value. It also reports the
!  percentage change on total cost function value with respect to
!  previous iteration. Compute the optimality of the minimization to
!  check the statistical hypotheses between the background and
!  observations errors: the cost function value at the minimum, Jmin,
!  is ideally equal to half the number of observations assimilated
!  (Optimality=1=2*Jmin/Nobs), for a linear system.
!
        IF (master) THEN
          DO ng=1,ngrids
            IF (nrun.gt.1) THEN
              rate=100.0_r8*abs(fourdvar(ng)%CostFun(0)-                &
     &                          fourdvar(ng)%CostFunOld(0))/            &
     &                      fourdvar(ng)%CostFunOld(0)
            ELSE
              rate=0.0_r8
            END IF
            optimality(ng)=2.0_r8*fourdvar(ng)%CostFun(0)/              &
     &                     (fourdvar(ng)%ObsCount(0)-                   &
     &                      fourdvar(ng)%ObsReject(0))
            WRITE (stdout,40) my_outer, my_inner,                       &
     &                        fourdvar(ng)%BackCost(0)/                 &
     &                        fourdvar(ng)%CostNorm(0),                 &
     &                        fourdvar(ng)%ObsCost(0)/                  &
     &                        fourdvar(ng)%CostNorm(0),                 &
     &                        rate
            IF (my_inner.eq.0) THEN
              DO i=0,nobsvar(ng)
                IF (fourdvar(ng)%NLobsCost(i).ne.0.0_r8) THEN
                  IF (i.eq.0) THEN
                    WRITE (stdout,50) my_outer, my_inner,               &
     &                                fourdvar(ng)%NLobsCost(i)/        &
     &                                fourdvar(ng)%CostNorm(i)
                  ELSE
                    WRITE (stdout,60) my_outer, my_inner,               &
     &                                fourdvar(ng)%NLobsCost(i)/        &
     &                                fourdvar(ng)%CostNorm(i),         &
     &                                trim(obsname(i))
                  END IF
                END IF
                fourdvar(ng)%NLobsCost(i)=0.0
              END DO
            END IF
            WRITE (stdout,70) my_outer, my_inner, optimality(ng)
          END DO
        END IF
!
!  Save total v-space cost function gradient, GRADv{J(Lnew)}, into
!  ADM(ng)%name history NetCDF file. Noticed that the lastest adjoint
!  solution record is over-written in the NetCDF file for future use.
!  The switch "LwrtState2d" is activated to write out state arrays
!  instead ad_*_sol arrays (HGA).
!
        DO ng=1,ngrids
# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
          lfout(ng)=ladj2
# endif
# ifdef ADJUST_BOUNDARY
          lbout(ng)=ladj2
# endif
          kstp(ng)=ladj2
# ifdef SOLVE3D
          nstp(ng)=ladj2
# endif
          adm(ng)%Rindex=adm(ng)%Rindex-1
          lwrtstate2d(ng)=.true.
# ifdef DISTRIBUTE
          CALL ad_wrt_his (ng, myrank)
# else
          CALL ad_wrt_his (ng, -1)
# endif
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          lwrtstate2d(ng)=.false.
        END DO
!
!  Write out trial v-space TLM initial conditions, currently in time
!  index LTM2, into record 3 of ITL(ng)%name NetCDF file.
!
        DO ng=1,ngrids
# ifdef DISTRIBUTE
          CALL tl_wrt_ini (ng, myrank, ltlm2, rec3)
# else
          CALL tl_wrt_ini (ng, -1, ltlm2, rec3)
# endif
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
!
!  Read current outer loop nonlinear model initial conditions and
!  background state vectors.
!
        DO ng=1,ngrids
          inprec=lini
          CALL get_state (ng, inlm, 2, ini(ng), inprec, lini)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
          inprec=lbck
          CALL get_state (ng, inlm, 9, ini(ng), inprec, lbck)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
!
!  Convert increment vector, deltaV, from minimization space (v-space)
!  to model space (x-space):
!
!     deltaX = B^(1/2) deltaV
!  or
!     deltaX = W^(1/2) L^(1/2) G S
!
!  First, convolve estimated increment vector (v-space) by with the
!  tangent linear diffusion operator, W^(1/2) L^(1/2) G.  Second,
!  multiply result by the background-error standard deviation, S.
!
        lcon=ltlm2
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL tl_convolution (ng, tile, lcon, lweak, 2)
            CALL tl_variability (ng, tile, lcon, lweak)
# ifdef BALANCE_OPERATOR
            CALL tl_balance (ng, tile, lini, lcon)
# endif
          END DO
        END DO
!
!  Write out trial x-space (convolved) TLM initial conditions, currently
!  in time index Lcon, into record 1 of ITL(ng)%name NetCDF file.
!
        DO ng=1,ngrids
# ifdef DISTRIBUTE
          CALL tl_wrt_ini (ng, myrank, lcon, rec1)
# else
          CALL tl_wrt_ini (ng, -1, lcon, rec1)
# endif
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
!
!-----------------------------------------------------------------------
!  Update counters.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          lsav=lnew(ng)
          lnew(ng)=lold(ng)
          lold(ng)=lsav
          nrun=nrun+1
        END DO
!
      END DO inner_loop
!
!  Turn of switch to write cost functions in the DAV NetCDF file. They
!  are written in calls to "tl_wrt_ini" only inside the inner loops.
!
      DO ng=1,ngrids
        lwrtcost(ng)=.false.
      END DO
!
!  Close adjoint NetCDF file.
!
      sourcefile=myfile
      DO ng=1,ngrids
        CALL close_file (ng, iadm, adm(ng))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!  Close Hessian NetCDF file.
!
      DO ng=1,ngrids
        CALL close_file (ng, iadm, hss(ng))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
 
# ifdef PROFILE
!
!  Stop profile clock
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_off (ng, itlm, 87, __line__, myfile)
        END DO
      END DO
# endif
!
 10   FORMAT (a,'_outer',i0,'.nc')
 20   FORMAT (a,'_member',i3.3,'.nc')
 30   FORMAT (/,1x,a,1x,'ROMS: started time-stepping:',                 &
     &        ' (Grid: ',i0,', Outer: ',i2.2,', Inner: ',i3.3,          &
              ', TimeSteps: ',i0,' - ',i0,')',/)
 40   FORMAT (/,' (',i3.3,',',i3.3,'): TLM Cost Jb, J  = ',             &
     &        1p,e17.10,0p,1x,1p,e17.10,0p,t68,1p,e11.4,' %')
 50   FORMAT (/,'>(',i3.3,',',i3.3,'): NLM Cost     J  = ',             &
     &        18x,1p,e17.10,0p)
 60   FORMAT (' (',i3.3,',',i3.3,'): NLM Cost     J  = ',               &
     &        18x,1p,e17.10,0p,t69,a)
 70   FORMAT (/,1x,'(',i3.3,',',i3.3,'): Optimality (2*J/Nobs) = ',     &
     &        1p,e17.10,/)
!
      RETURN

References ad_balance_mod::ad_balance(), ad_convolution_mod::ad_convolution(), ad_initial(), ad_main2d(), ad_main3d(), ad_variability_mod::ad_variability(), ad_wrt_his_mod::ad_wrt_his(), mod_iounits::adm, back_cost_mod::back_cost(), cgradient_mod::cg_read_cgradient(), cgradient_mod::cgradient(), close_io_mod::close_file(), cost_grad_mod::cost_grad(), mod_iounits::dav, def_hessian_mod::def_hessian(), def_mod_mod::def_mod(), mod_scalars::dt, edit_multifile(), mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_fourdvar::fourdvar, mod_iounits::fwd, get_state_mod::get_state(), mod_fourdvar::havenlmod, mod_iounits::his, mod_iounits::hss, mod_param::iadm, mod_ncparam::idefadj, mod_ncparam::ideftlm, mod_ncparam::idobss, mod_ncparam::idtime, mod_iounits::ini, mod_boundary::initialize_boundary(), mod_forces::initialize_forces(), mod_ocean::initialize_ocean(), mod_scalars::initime, mod_param::inlm, mod_scalars::inner, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_iounits::itl, mod_param::itlm, mod_stepping::kstp, ladj1, ladj2, mod_parallel::last_tile, lbck, mod_stepping::lbout, mod_scalars::ldefadj, mod_scalars::ldefavg, mod_scalars::ldefdia, mod_scalars::ldefhss, mod_scalars::ldefitl, mod_scalars::ldefmod, mod_scalars::ldeftlm, mod_stepping::lfout, lini, mod_stepping::lnew, mod_stepping::lold, mod_scalars::lreadblk, mod_scalars::lreadfrc, mod_scalars::lreadfwd, mod_scalars::lreadqck, ltlm1, ltlm2, mod_scalars::lwrtavg, mod_scalars::lwrtcost, mod_scalars::lwrtdia, mod_scalars::lwrtstate2d, mod_scalars::lwrttlm, mod_parallel::master, mod_parallel::myrank, mod_scalars::nbrec, mod_scalars::nfrec, mod_param::ngrids, mod_scalars::ninner, mod_scalars::nobc, mod_fourdvar::nobsvar, mod_scalars::noerror, mod_stepping::nrhs, mod_scalars::nrun, mod_scalars::nsff, mod_stepping::nstp, mod_scalars::ntend, mod_scalars::ntstart, mod_scalars::obc_time, mod_fourdvar::obsname, mod_fourdvar::optimality, mod_iounits::qck, rec1, rec2, rec3, rec4, mod_scalars::sf_time, mod_iounits::sourcefile, mod_iounits::stdout, tl_balance_mod::tl_balance(), tl_convolution_mod::tl_convolution(), tl_def_his_mod::tl_def_his(), tl_def_ini_mod::tl_def_ini(), tl_initial(), tl_main2d(), tl_main3d(), tl_variability_mod::tl_variability(), tl_wrt_ini_mod::tl_wrt_ini(), mod_iounits::tlm, mod_ncparam::vname, wclock_off(), wclock_on(), wrt_evolved_mod::wrt_evolved(), mod_fourdvar::wrtnlmod, mod_fourdvar::wrtobsscale, and mod_fourdvar::wrttlmod.

Here is the call graph for this function:

posterior_analysis()

subroutine, public i4dvar_mod::posterior_analysis

(

real(dp), intent(in)

runinterval

)

Definition at line 2254 of file i4dvar.F.

!
!=======================================================================
!                                                                      !
!  This routine initialize the NLM with estimated 4D-Var state and     !
!  interpolates solution at observation locations for posterior        !
!  analysis.                                                           !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     RunInterval     NLM kernel time stepping window (seconds)        !
!                                                                      !
!=======================================================================
!
!  Imported variable declarations
!
      real(dp), intent(in) :: RunInterval
!
!  Local variable declarations.
!
      logical :: DoneStepping
!
      integer :: i, lstr, ng
# ifdef PROFILE
      integer :: thread
# endif
# if defined MODEL_COUPLING && !defined MCT_LIB
      integer :: NstrStep, NendStep, extra
!
      real(dp) :: ENDtime, NEXTtime
# endif
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", posterior_analysis"
!
      sourcefile=myfile
 
# if !(defined MODEL_COUPLING && defined ESMF_LIB)
!
!-----------------------------------------------------------------------
!  Set nonlinear model initial conditions.
!-----------------------------------------------------------------------
!
      CALL posterior_analysis_initialize
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
!
!-----------------------------------------------------------------------
!  Run nonlinear model. Interpolate nonlinear model to observation
!  locations.
# if defined MODEL_COUPLING && !defined MCT_LIB
!  Since the ROMS kernel has a delayed output and line diagnostics by
!  one timestep, subtact an extra value to the report of starting and
!  ending timestep for clarity. Usually, the model coupling interval
!  is of the same size as ROMS timestep.
# endif
!-----------------------------------------------------------------------
 
# ifdef PROFILE
!
!  Start profile clock.
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_on (ng, inlm, 88, __line__, myfile)
        END DO
      END DO
# endif
!
!  Initialize various parameters and switches.
!
      myruninterval=runinterval
!
      DO ng=1,ngrids
# ifdef AVERAGES
        idefavg(ng)=-1
        ldefavg(ng)=.true.
        lwrtavg(ng)=.true.
        WRITE (avg(ng)%name,10) trim(avg(ng)%head), outer
        lstr=len_trim(avg(ng)%name)
        avg(ng)%base=avg(ng)%name(1:lstr-3)
# endif
# ifdef DIAGNOSTICS
        idefdia(ng)=-1
        ldefdia(ng)=.true.
        lwrtdia(ng)=.true.
        WRITE (dia(ng)%name,10) trim(dia(ng)%head), outer
        lstr=len_trim(dia(ng)%name)
        dia(ng)%base=dia(ng)%name(1:lstr-3)
# endif
# if defined MODEL_COUPLING && !defined MCT_LIB
!
        nexttime=time(ng)+runinterval
        endtime=initime(ng)+(ntimes(ng)-1)*dt(ng)
        IF ((nexttime.eq.endtime).and.(ng.eq.1)) THEN
          extra=0                                   ! last time interval
        ELSE
          extra=1
        END IF
        step_counter(ng)=0
        nstrstep=iic(ng)
        nendstep=nstrstep+int((myruninterval)/dt(ng))-extra
        IF (master) WRITE (stdout,20) 'NL', ng, nstrstep, nendstep
# else
        IF (master) WRITE (stdout,20) 'NL', ng, ntstart(ng), ntend(ng)
# endif
      END DO
!
# ifdef SOLVE3D
      CALL main3d (runinterval)
# else
      CALL main2d (runinterval)
# endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  If completed stepping, write out and report cost function.
# if defined MODEL_COUPLING && !defined MCT_LIB
!  In coupled applications, RunInterval is much less than ntimes*dt,
!  so we need to wait until the last coupling interval is finished.
!  Otherwise, the control switches will be turned off prematurely.
# endif
!-----------------------------------------------------------------------
!
# if defined MODEL_COUPLING && !defined MCT_LIB
      IF (nendstep.eq.ntend(1)) THEN
        donestepping=.true.
      ELSE
        donestepping=.false.
      END IF
# else
      donestepping=.true.
# endif
!
      IF (donestepping) THEN
!
!  Write out nonlinear model final misfit cost function into
!  DAV(ng)%name NetCDF file. Notice that it is written in the
!  Nouter+1 record.
!
        sourcefile=myfile
        DO ng=1,ngrids
          SELECT CASE (dav(ng)%IOtype)
            CASE (io_nf90)
              CALL netcdf_put_fvar (ng, inlm, dav(ng)%name,             &
     &                              'NLcost_function',                  &
     &                              fourdvar(ng)%NLobsCost(0:),         &
     &                              (/1,nouter+1/),                     &
     &                              (/nobsvar(ng)+1,1/),                &
     &                              ncid = dav(ng)%ncid)
 
# if defined PIO_LIB && defined DISTRIBUTE
            CASE (io_pio)
              CALL pio_netcdf_put_fvar (ng, inlm, dav(ng)%name,         &
     &                                  'NLcost_function',              &
     &                                  fourdvar(ng)%NLobsCost(0:),     &
     &                                  (/1,nouter+1/),                 &
     &                                  (/nobsvar(ng)+1,1/),            &
     &                                  piofile = dav(ng)%pioFile)
# endif
          END SELECT
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
!
!  Report the final value of the nonlinear model misfit cost function.
!
        IF (master) THEN
          DO ng=1,ngrids
            DO i=0,nobsvar(ng)
              IF (fourdvar(ng)%NLobsCost(i).ne.0.0_r8) THEN
                IF (i.eq.0) THEN
                  WRITE (stdout,30) outer, inner,                       &
     &                              fourdvar(ng)%NLobsCost(i)/          &
     &                              fourdvar(ng)%CostNorm(i)
                ELSE
                  WRITE (stdout,40) outer, inner,                       &
     &                              fourdvar(ng)%NLobsCost(i)/          &
     &                              fourdvar(ng)%CostNorm(i),           &
     &                              trim(obsname(i))
                END IF
              END IF
            END DO
          END DO
        END IF
!
!  Done.  Set history file ID to closed state since we manipulated
!  its indices with the forward file ID which was closed above.
!
        DO ng=1,ngrids
          his(ng)%ncid=-1
        END DO
      END IF
 
# ifdef PROFILE
!
!  Stop profile clock
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_off (ng, inlm, 88, __line__, myfile)
        END DO
      END DO
# endif
!
 10   FORMAT (a,'_outer',i0,'.nc')
 20   FORMAT (/,1x,a,1x,'ROMS: started time-stepping:',                 &
     &        ' (Grid: ',i0,', TimeSteps: ',i0,' - ',i0,')',/)
 30   FORMAT (/,'>(',i3.3,',',i3.3,'): NLM Cost     J  = ',             &
     &        18x,1p,e17.10,0p)
 40   FORMAT (' (',i3.3,',',i3.3,'): NLM Cost     J  = ',               &
     &        18x,1p,e17.10,0p,t69,a)
!
      RETURN

References mod_iounits::avg, mod_iounits::dav, mod_iounits::dia, mod_scalars::dt, mod_scalars::exit_flag, strings_mod::founderror(), mod_fourdvar::fourdvar, mod_iounits::his, mod_ncparam::idefavg, mod_ncparam::idefdia, mod_scalars::iic, mod_scalars::initime, mod_param::inlm, mod_scalars::inner, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_scalars::ldefavg, mod_scalars::ldefdia, mod_scalars::lwrtavg, mod_scalars::lwrtdia, main2d(), main3d(), mod_parallel::master, mod_scalars::myruninterval, mod_param::ngrids, mod_fourdvar::nobsvar, mod_scalars::noerror, mod_scalars::nouter, mod_scalars::ntend, mod_scalars::ntimes, mod_scalars::ntstart, mod_fourdvar::obsname, mod_scalars::outer, posterior_analysis_initialize(), mod_iounits::sourcefile, mod_iounits::stdout, mod_scalars::step_counter, mod_scalars::time, wclock_off(), and wclock_on().

Here is the call graph for this function:

posterior_analysis_initialize()

subroutine, public i4dvar_mod::posterior_analysis_initialize

Definition at line 1984 of file i4dvar.F.

!
!=======================================================================
!                                                                      !
!  This routine initializes the nonlinear kernel with the 4D-Var new   !
!  state estimate Xa = Xb + dXa.  It is separated from the 'analysis'  !
!  4D-Var phase in ESM coupling applications that use generic methods  !
!  for 'initialize', 'run', and 'finalize'.                            !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     my_outer        Outer-loop counter (integer)                     !
!                                                                      !
!=======================================================================
!
!  Local variable declarations.
!
      integer :: i, ifile, lstr, ng, tile
      integer :: Fcount, InpRec
# ifdef PROFILE
      integer :: thread
# endif
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", posterior_analysis_initialize"
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  Initialize nonlinear model kernel with new 4D-Var state estimate.
!-----------------------------------------------------------------------
 
# ifdef PROFILE
!
!  Start profile clock.
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_on (ng, inlm, 88, __line__, myfile)
        END DO
      END DO
# endif
!
!  Clear nonlinear mixing arrays.
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_mixing (ng, tile, inlm)
        END DO
      END DO
 
# ifdef SPLIT_4DVAR
!
!-----------------------------------------------------------------------
!  If split 4D-Var algorithm, set several variables that computed or
!  assigned in other 4D-Var phase executable.
!-----------------------------------------------------------------------
!
      outer=nouter
      inner=ninner
!
!  Set Nrun>1, to read in surface forcing and open boundary conditions
!  increments in "initial", if appropriate.
!
      nrun=1+nouter*(ninner+1)
!
!  Set ERstr=Nrun, to set the open boundary condition (OBC_time) and
!  surface forcing (SF_time) adjustment times, if needed.
!
      erstr=nrun
!
!  Open Nonlinear model initial conditions NetCDF file (INI struc) and
!  inquire about its variable IDs.
!
      DO ng=1,ngrids
        ldefini(ng)=.false.
        CALL def_ini (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!  Open 4D-Var NetCDF file (DAV struc) and inquire about its variables.
!
      DO ng=1,ngrids
        ldefmod(ng)=.false.
        CALL def_mod (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        havenlmod(ng)=.false.                     ! do not read NLmodVal
      END DO
!
!  In the split 4D-Var algorithm, we need to read the global observation
!  screening and quality control scale ObsScaleGlobal ("obs_scale") that
!  it is written in the "background" phase. Such data is in memory in
!  the unsplit algorithm.  Recall that in I4D-Var, observation variables
!  are read and load into the arrays elements 1:Nobs(ng) for each survey
!  time.  That is, only the values needed are read.
!
!  HGA: What to do in 4D-Var with nested grids?
!
      ng=1
      SELECT CASE (dav(ng)%IOtype)
        CASE (io_nf90)
          CALL netcdf_get_fvar (ng, itlm, dav(ng)%name,                 &
     &                          vname(1,idobss), obsscaleglobal,        &
     &                          ncid = dav(ng)%ncid)
 
#  if defined PIO_LIB && defined DISTRIBUTE
        CASE (io_pio)
          CALL pio_netcdf_get_fvar (ng, itlm, dav(ng)%name,             &
     &                              vname(1,idobss), obsscaleglobal,    &
     &                              piofile = dav(ng)%pioFile)
#  endif
      END SELECT
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Read initial nonlinear cost function values from DAV file and load it
!  into CostNorm, its values are used for reporting normalized values.
!
      DO ng=1,ngrids
        SELECT CASE (dav(ng)%IOtype)
          CASE (io_nf90)
            CALL netcdf_get_fvar (ng, inlm, dav(ng)%name,               &
     &                            'NLcost_function',                    &
     &                            fourdvar(ng)%CostNorm(0:),            &
     &                            ncid = dav(ng)%ncid,                  &
     &                            start = (/1,1/),                      &
     &                            total = (/nobsvar(ng)+1,1/))
 
#  if defined PIO_LIB && defined DISTRIBUTE
          CASE (io_pio)
            CALL pio_netcdf_get_fvar (ng, inlm, dav(ng)%name,           &
     &                                'NLcost_function',                &
     &                                fourdvar(ng)%CostNorm(0:),        &
     &                                piofile = dav(ng)%pioFile,        &
     &                                start = (/1,1/),                  &
     &                                total = (/nobsvar(ng)+1,1/))
#  endif
        END SELECT
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
 
# if defined ADJUST_STFLUX   || defined ADJUST_WSTRESS || \
     defined adjust_boundary
!
!  If split 4D-Var, read in surface forcing and or lateral boundary
!  increments (X-space) from ITL file Rec5.
!
      DO ng=1,ngrids
        ldefitl(ng)=.false.
        CALL tl_def_ini (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        inprec=rec5
        CALL get_state (ng, itlm, 1, itl(ng), inprec, ltlm1)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!  If split 4D-Var, reset reset surface forcing and lateral boundary
!  output time indices to LADJ2 since they are changed in the inner
!  loops.
!
      DO ng=1,ngrids
        lfout(ng)=ladj2
#   ifdef ADJUST_BOUNDARY
        lbout(ng)=ladj2
#   endif
      END DO
#  endif
 
#  ifdef FORWARD_FLUXES
!
!  If not first NLM run, set BLK structure to the previous quicksave
!  trajectory.  There is a logic in "get_data" that reads from BLK.
!  (HGA: This probably legacy code that it is no longer needed)
!
      DO ng=1,ngrids
        WRITE (qck(ng)%name,10) trim(qck(ng)%head), nouter-1
        lstr=len_trim(qck(ng)%name)
        qck(ng)%base=qck(ng)%name(1:lstr-3)
      END DO
!
      CALL edit_multifile ('QCK2BLK')
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#  endif
# endif
!
!-----------------------------------------------------------------------
!  Initialize nonlinear model.
!-----------------------------------------------------------------------
!
!  Set nonlinear output history file name. Create a basic state file
!  for each outher loop. Notice that the LreadBLK and LreadFWD switches
!  are turned off to suppress processing of the structures when
!  "check_multifile" during nonlinear model execution.
!
      DO ng=1,ngrids
        idefhis(ng)=-1
        ldefhis(ng)=.true.
        lwrthis(ng)=.true.
# ifdef FORWARD_FLUXES
        lreadblk(ng)=.false.
# endif
        lreadfwd(ng)=.false.
        his(ng)%Rindex=0
        fcount=his(ng)%load
        his(ng)%Nrec(fcount)=0
        WRITE (his(ng)%name,10) trim(fwd(ng)%head), nouter
        lstr=len_trim(his(ng)%name)
        his(ng)%base=his(ng)%name(1:lstr-3)
      END DO
!
!  Set the nonlinear model output quicksave-history file for the
!  posterior analysis trajectory. Notice that the LreadBLK switch
!  is turned off to suppress processing of the structure in
!  "check_multifile" during nonlinear model execution.
!
      DO ng=1,ngrids
        idefqck(ng)=-1
        ldefqck(ng)=.true.
        lwrtqck(ng)=.true.
# ifdef FORWARD_FLUXES
        lreadblk(ng)=.false.
# endif
        WRITE (qck(ng)%name,10) trim(qck(ng)%head), nouter
        lstr=len_trim(qck(ng)%name)
        qck(ng)%base=qck(ng)%name(1:lstr-3)
      END DO
!
!  Initialize nonlinear model with estimated initial conditions.  Reset
!  the value of INI(ng)%Rindex, which is needed in "initial" to the
!  4D-Var analysis record.
!
      DO ng=1,ngrids
        wrtnlmod(ng)=.true.
        wrttlmod(ng)=.false.
        wrtmisfit(ng)=.false.
        rst(ng)%Rindex=0
        fcount=rst(ng)%load
        rst(ng)%Nrec(fcount)=0
        ini(ng)%Rindex=lini
      END DO
!
      CALL initial
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Clear NLobsCost. Activate switch to write out final misfit between
!  model and observations.
!
      DO ng=1,ngrids
        DO i=0,nobsvar(ng)
          fourdvar(ng)%NLobsCost(i)=0.0_r8
        END DO
        wrtmisfit(ng)=.true.
      END DO
 
# ifdef PROFILE
!
!  Stop profile clock
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_off (ng, inlm, 88, __line__, myfile)
        END DO
      END DO
# endif
!
 10   FORMAT (a,'_outer',i0,'.nc')
!
      RETURN

References mod_iounits::dav, def_ini_mod::def_ini(), def_mod_mod::def_mod(), edit_multifile(), mod_scalars::erstr, mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_fourdvar::fourdvar, mod_iounits::fwd, get_state_mod::get_state(), mod_fourdvar::havenlmod, mod_iounits::his, mod_ncparam::idefhis, mod_ncparam::idefqck, mod_ncparam::idobss, mod_iounits::ini, initial(), mod_mixing::initialize_mixing(), mod_param::inlm, mod_scalars::inner, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_iounits::itl, mod_param::itlm, ladj2, mod_parallel::last_tile, mod_stepping::lbout, mod_scalars::ldefhis, mod_scalars::ldefini, mod_scalars::ldefitl, mod_scalars::ldefmod, mod_scalars::ldefqck, mod_stepping::lfout, lini, mod_scalars::lreadblk, mod_scalars::lreadfwd, ltlm1, mod_scalars::lwrthis, mod_scalars::lwrtqck, mod_param::ngrids, mod_scalars::ninner, mod_fourdvar::nobsvar, mod_scalars::noerror, mod_scalars::nouter, mod_scalars::nrun, mod_scalars::outer, mod_iounits::qck, rec5, mod_iounits::rst, mod_iounits::sourcefile, tl_def_ini_mod::tl_def_ini(), mod_ncparam::vname, wclock_off(), wclock_on(), mod_fourdvar::wrtmisfit, mod_fourdvar::wrtnlmod, and mod_fourdvar::wrttlmod.

Referenced by posterior_analysis().

Here is the call graph for this function:

Here is the caller graph for this function:

prior_error()

subroutine, public i4dvar_mod::prior_error

(

integer, intent(in)

ng

)

Definition at line 2469 of file i4dvar.F.

!
!=======================================================================
!                                                                      !
!  This routine processes background prior error covariance standard   !
!  deviations and normalization coefficients.                          !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     ng              Nested grid number                               !
!                                                                      !
!=======================================================================
!
!  Imported variable declarations
!
      integer, intent(in) :: ng
!
!  Local variable declarations.
!
      integer :: tile
      integer :: NRMrec, STDrec, Tindex
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", prior_error"
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  Set application grid, metrics, and associated variables and
!  parameters.
!-----------------------------------------------------------------------
!
!  The ROMS application grid configuration is done once. It is usually
!  done in the "initial" kernel routine. However, since we are calling
!  the "normalization" routine here, we need several grid variables and
!  parameter.  Also, if reading only water points, we need to know the
!  land/sea mask arrays to unpack.
!
      IF (setgridconfig(ng)) THEN
        CALL set_grid (ng, inlm)
      END IF
!
!-----------------------------------------------------------------------
!  Read in standard deviation factors for error covariance.
!-----------------------------------------------------------------------
!
      IF (lgetstd) THEN
!
!  Initial conditions standard deviation. They are loaded in Tindex=1
!  of the e_var(...,Tindex) state variables.
!
        IF (lreadstd(ng)) THEN
          stdrec=1
          tindex=1
# ifdef STD_MODEL
          CALL get_state (ng, 10, 10, std(5,ng), stdrec, tindex)
# else
          CALL get_state (ng, 10, 10, std(1,ng), stdrec, tindex)
# endif
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
 
# ifdef ADJUST_BOUNDARY
!
!  Open boundary conditions standard deviation.
!
        stdrec=1
        tindex=1
        CALL get_state (ng, 12, 12, std(3,ng), stdrec, tindex)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
!
!  Surface forcing standard deviation.
!
        stdrec=1
        tindex=1
        CALL get_state (ng, 13, 13, std(4,ng), stdrec, tindex)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# ifdef STD_MODEL
!
!  If computing the standard deviation (STD) directly from the
!  background (prior) field as an alternative to climatological
!  read from the input NetCDF file, define the output STD NetCDF
!  file.
!
        IF (ldefstd(ng)) THEN
          CALL def_std (ng)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
# endif
      END IF
!
!-----------------------------------------------------------------------
!  Error covariance normalization coefficients.
!-----------------------------------------------------------------------
!
      IF (lgetnrm) THEN
!
!  Compute or read in background-error covariance normalization factors.
!  If computing, write out factors to NetCDF. This is an expensive
!  computation that needs to be computed only once for a particular
!  application grid.
!
        IF (any(lwrtnrm(:,ng))) THEN
          CALL def_norm (ng, inlm, 1)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef ADJUST_BOUNDARY
          CALL def_norm (ng, inlm, 3)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
          CALL def_norm (ng, inlm, 4)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
!
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL normalization (ng, tile, 2)
          END DO
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          ldefnrm(1:4,ng)=.false.
          lwrtnrm(1:4,ng)=.false.
 
        ELSE
 
          nrmrec=1
          CALL get_state (ng, 14, 14, nrm(1,ng), nrmrec, 1)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef ADJUST_BOUNDARY
          CALL get_state (ng, 16, 16, nrm(3,ng), nrmrec, 1)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
          CALL get_state (ng, 17, 17, nrm(4,ng), nrmrec, 1)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
        END IF
      END IF
!
      RETURN

References def_norm_mod::def_norm(), mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), get_state_mod::get_state(), mod_param::inlm, mod_parallel::last_tile, mod_scalars::ldefnrm, lgetnrm, lgetstd, mod_scalars::lreadstd, mod_scalars::lwrtnrm, mod_scalars::noerror, normalization_mod::normalization(), mod_iounits::nrm, set_grid(), mod_scalars::setgridconfig, mod_iounits::sourcefile, and mod_iounits::std.

Here is the call graph for this function:

Variable Documentation

ladj1

integer i4dvar_mod::ladj1 = 1

Definition at line 175 of file i4dvar.F.

      integer :: LADJ1 = 1      ! initial cost gradient

Referenced by increment().

ladj2

integer i4dvar_mod::ladj2 = 2

Definition at line 176 of file i4dvar.F.

      integer :: LADJ2 = 2      ! new cost gradient (not normalized)

Referenced by background_initialize(), increment(), and posterior_analysis_initialize().

lbck

integer i4dvar_mod::lbck = 2

Definition at line 178 of file i4dvar.F.

      integer :: Lbck  = 2      ! background record in INI

Referenced by background(), and increment().

ldone

logical i4dvar_mod::ldone

Definition at line 169 of file i4dvar.F.

      logical :: Ldone          ! 4D-Var cycle finish switch

lgetnrm

logical i4dvar_mod::lgetnrm

Definition at line 166 of file i4dvar.F.

      logical :: LgetNRM        ! process covariance normalization

Referenced by prior_error().

lgetstd

logical i4dvar_mod::lgetstd

Definition at line 167 of file i4dvar.F.

      logical :: LgetSTD        ! process covariance standard deviation

Referenced by prior_error().

lini

integer i4dvar_mod::lini = 1

Definition at line 177 of file i4dvar.F.

      integer :: Lini  = 1      ! NLM initial conditions record in INI

Referenced by analysis(), background(), background_initialize(), increment(), and posterior_analysis_initialize().

ltlm1

integer i4dvar_mod::ltlm1 = 1

Definition at line 172 of file i4dvar.F.

      integer :: LTLM1 = 1      ! trial x-space TLM IC record in ITL

Referenced by analysis(), background_initialize(), increment(), and posterior_analysis_initialize().

ltlm2

integer i4dvar_mod::ltlm2 = 2

Definition at line 173 of file i4dvar.F.

      integer :: LTLM2 = 2      ! previous v-space TLM IC record in ITL

Referenced by analysis(), and increment().

ltlm3

integer i4dvar_mod::ltlm3 = 3

Definition at line 174 of file i4dvar.F.

      integer :: LTLM3 = 3      ! trial v-space TLM IC record in ITL

rec1

integer i4dvar_mod::rec1 = 1

Definition at line 179 of file i4dvar.F.

      integer :: Rec1  = 1

Referenced by analysis(), and increment().

rec2

integer i4dvar_mod::rec2 = 2

Definition at line 180 of file i4dvar.F.

      integer :: Rec2  = 2

Referenced by increment().

rec3

integer i4dvar_mod::rec3 = 3

Definition at line 181 of file i4dvar.F.

      integer :: Rec3  = 3

Referenced by analysis(), and increment().

rec4

integer i4dvar_mod::rec4 = 4

Definition at line 182 of file i4dvar.F.

      integer :: Rec4  = 4

Referenced by analysis(), and increment().

rec5

integer i4dvar_mod::rec5 = 5

Definition at line 184 of file i4dvar.F.

      integer :: Rec5  = 5

Referenced by analysis(), background_initialize(), and posterior_analysis_initialize().