propagator_mod Module Reference

Functions/Subroutines
subroutine, public	propagator_afte (runinterval, state, ad_state)
subroutine, public	propagator_fsv (runinterval, state, ad_state)
subroutine, public	propagator_fte (runinterval, state, tl_state)
subroutine, public	propagator_hop (runinterval, state, ad_state)
subroutine, public	propagator_hso (runinterval, iter, state, ad_state)
subroutine, public	propagator_op (runinterval, state, ad_state)
subroutine, public	propagator_so (runinterval, iter, state, ad_state)
subroutine, public	propagator_so_semi (runinterval, state, ad_state)

Function/Subroutine Documentation

propagator_afte()

subroutine, public propagator_mod::propagator_afte	(	real(dp), intent(in)	runinterval,
		type (t_gst), dimension(ngrids), intent(in)	state,
		type (t_gst), dimension(ngrids), intent(inout)	ad_state )

Definition at line 36 of file propagator_afte.h.

!***********************************************************************
!
      USE mod_param
      USE mod_parallel
#ifdef SOLVE3D
      USE mod_coupling
#endif
      USE mod_iounits
      USE mod_ocean
      USE mod_scalars
      USE mod_stepping
!
      USE close_io_mod,   ONLY : close_inp
      USE dotproduct_mod, ONLY : ad_statenorm
      USE packing_mod,    ONLY : ad_unpack, ad_pack
#ifdef SOLVE3D
      USE set_depth_mod,  ONLY : set_depth
#endif
      USE strings_mod,    ONLY : founderror
!
!  Imported variable declarations.
!
      real(dp), intent(in) :: RunInterval
!
      TYPE (T_GST), intent(in) :: state(Ngrids)
      TYPE (T_GST), intent(inout) :: ad_state(Ngrids)
!
!  Local variable declarations.
!
#ifdef SOLVE3D
      logical :: FirstPass = .true.
#endif
!
      integer :: ng, tile
!
      real(r8) :: StateNorm(Ngrids)
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
!=======================================================================
!  Forward integration of the tangent linear model.
!=======================================================================
!
      nrun=nrun+1
      IF (master) THEN
        DO ng=1,ngrids
          WRITE (stdout,10) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Iteration: ', nrun,                     &
     &                      ',  number converged RITZ values: ',        &
     &                      nconv(ng)
        END DO
      END IF
!
!  Initialize time stepping indices and counters.
!
      DO ng=1,ngrids
        iif(ng)=1
        indx1(ng)=1
        kstp(ng)=1
        krhs(ng)=3
        knew(ng)=2
        predictor_2d_step(ng)=.false.
!
        iic(ng)=0
        nstp(ng)=1
        nrhs(ng)=1
        nnew(ng)=2
!
        synchro_flag(ng)=.true.
        tdays(ng)=dstart+dt(ng)*real(ntimes(ng),r8)*sec2day
        time(ng)=tdays(ng)*day2sec
        ntstart(ng)=ntimes(ng)+1
        ntend(ng)=1
        ntfirst(ng)=ntend(ng)
      END DO
!
!-----------------------------------------------------------------------
!  Clear adjoint state variables.  There is not need to clean the basic
!  state arrays since they were zeroth out at initialization and bottom
!  of previous iteration.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, iadm)
        END DO
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero time averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, iadm)
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Unpack adjoint initial conditions from state vector.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL ad_unpack (ng, tile, nstr(ng), nend(ng),                 &
     &                    state(ng)%vector)
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Compute initial adjoint state dot product norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL ad_statenorm (ng, tile, knew(ng), nstp(ng),              &
     &                       statenorm(ng))
        END DO
        IF (master) THEN
          WRITE (stdout,20) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Adjoint Initial Norm: ', statenorm(ng)
        END IF
      END DO
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        CALL close_inp (ng, iadm)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL ad_get_idata (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL ad_get_data (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!-----------------------------------------------------------------------
!  Time-step the adjoint model backwards.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        IF (master) THEN
          WRITE (stdout,30) 'AD', ng, ntstart(ng), ntend(ng)
        END IF
        time(ng)=time(ng)+dt(ng)
        iic(ng)=ntstart(ng)+1
      END DO
 
#ifdef SOLVE3D
      CALL ad_main3d (runinterval)
#else
      CALL ad_main2d (runinterval)
#endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Clear nonlinear state (basic state) variables and insure that the
!  time averaged free-surface is zero for scaling below and next
!  iteration.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, inlm)
#ifdef SOLVE3D
          CALL initialize_coupling (ng, tile, 0)
#endif
        END DO
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state final level thicknesses used for state norm
!  scaling. It uses zero time averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, iadm)
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Compute final adjoint state dot product norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL ad_statenorm (ng, tile, knew(ng), nstp(ng),              &
     &                       statenorm(ng))
        END DO
        IF (master) THEN
          WRITE (stdout,20) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Adjoint   Final Norm: ', statenorm(ng)
        END IF
      END DO
!
!-----------------------------------------------------------------------
!  Pack final adjoint solution into adjoint state vector.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL ad_pack (ng, tile, nstr(ng), nend(ng),                   &
     &                  ad_state(ng)%vector)
        END DO
      END DO
!
 10   FORMAT (/,a,i2.2,a,i3.3,a,i3.3/)
 20   FORMAT (/,a,i2.2,a,1p,e15.6,/)
 30   FORMAT (/,1x,a,1x,'ROMS: started time-stepping:',                 &
     &        ' (Grid: ',i2.2,' TimeSteps: ',i8.8,' - ',i8.8,')')
!
      RETURN

References ad_get_data(), ad_get_idata(), ad_main2d(), ad_main3d(), ad_pack(), dotproduct_mod::ad_statenorm(), ad_unpack(), close_io_mod::close_inp(), mod_scalars::day2sec, mod_scalars::dstart, mod_scalars::dt, mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_param::iadm, mod_scalars::iic, mod_scalars::iif, mod_scalars::indx1, mod_coupling::initialize_coupling(), mod_ocean::initialize_ocean(), mod_param::inlm, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_parallel::last_tile, mod_parallel::master, mod_scalars::nconv, mod_param::nend, mod_param::ngrids, mod_stepping::nnew, mod_scalars::noerror, mod_stepping::nrhs, mod_scalars::nrun, mod_stepping::nstp, mod_param::nstr, mod_scalars::ntend, mod_scalars::ntfirst, mod_scalars::ntimes, mod_scalars::ntstart, mod_scalars::predictor_2d_step, mod_kinds::r8, mod_scalars::sec2day, set_depth_mod::set_depth(), mod_iounits::stdout, mod_scalars::synchro_flag, mod_scalars::tdays, and mod_scalars::time.

Here is the call graph for this function:

propagator_fsv()

subroutine, public propagator_mod::propagator_fsv	(	real(dp), intent(in)	runinterval,
		type (t_gst), dimension(ngrids), intent(in)	state,
		type (t_gst), dimension(ngrids), intent(inout)	ad_state )

Definition at line 37 of file propagator_fsv.h.

!***********************************************************************
!
      USE mod_param
      USE mod_parallel
#ifdef SOLVE3D
      USE mod_coupling
#endif
      USE mod_iounits
      USE mod_ocean
      USE mod_scalars
      USE mod_stepping
!
      USE close_io_mod,   ONLY : close_inp
      USE dotproduct_mod, ONLY : tl_statenorm
      USE ini_adjust_mod, ONLY : ad_ini_perturb
      USE packing_mod,    ONLY : tl_unpack, ad_pack
      USE mod_forces,     ONLY : initialize_forces
#ifdef SOLVE3D
      USE set_depth_mod,  ONLY : set_depth
#endif
      USE strings_mod,    ONLY : founderror
!
!  Imported variable declarations.
!
      real(dp), intent(in) :: RunInterval
!
      TYPE (T_GST), intent(in) :: state(Ngrids)
      TYPE (T_GST), intent(inout) :: ad_state(Ngrids)
!
!  Local variable declarations.
!
      integer :: ng, tile
      integer :: ktmp, ntmp
!
      real(r8) :: StateNorm(Ngrids)
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
!=======================================================================
!  Forward integration of the tangent linear model.
!=======================================================================
!
      nrun=nrun+1
      IF (master) THEN
        DO ng=1,ngrids
          WRITE (stdout,10) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Iteration: ', nrun,                     &
     &                      ',  number converged RITZ values: ',        &
     &                      nconv(ng)
        END DO
      END IF
!
!  Initialize time stepping indices and counters.
!
      DO ng=1,ngrids
        iif(ng)=1
        indx1(ng)=1
        kstp(ng)=1
        krhs(ng)=1
        knew(ng)=1
        predictor_2d_step(ng)=.false.
!
        iic(ng)=0
        nstp(ng)=1
        nrhs(ng)=1
        nnew(ng)=1
!
        synchro_flag(ng)=.true.
        tdays(ng)=dstart
        time(ng)=tdays(ng)*day2sec
        ntstart(ng)=int((time(ng)-dstart*day2sec)/dt(ng))+1
        ntend(ng)=ntimes(ng)
        ntfirst(ng)=ntstart(ng)
      END DO
!
!-----------------------------------------------------------------------
!  Clear tangent linear state variables. There is not need to clean
!  the basic state arrays since they were zeroth out at initialization
!  and bottom of previous iteration.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, itlm)
        END DO
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero time-averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, itlm)
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Unpack tangent linear initial conditions from state vector.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL tl_unpack (ng, tile, nstr(ng), nend(ng),                 &
     &                    state(ng)%vector)
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Compute initial tangent linear state dot product norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL tl_statenorm (ng, tile, kstp(ng), nstp(ng),              &
     &                       statenorm(ng))
        END DO
        IF (master) THEN
          WRITE (stdout,20) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Tangent Initial Norm: ', statenorm(ng)
        END IF
      END DO
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        CALL close_inp (ng, itlm)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL tl_get_idata (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL tl_get_data (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!-----------------------------------------------------------------------
!  Time-step the tangent linear model.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        IF (master) THEN
          WRITE (stdout,30) 'TL', ng, ntstart(ng), ntend(ng)
        END IF
        time(ng)=time(ng)-dt(ng)
        iic(ng)=ntstart(ng)-1
      END DO
 
#ifdef SOLVE3D
      CALL tl_main3d (runinterval)
#else
      CALL tl_main2d (runinterval)
#endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Clear nonlinear (basic state) and adjoint state variables.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, inlm)
          CALL initialize_ocean (ng, tile, iadm)
#ifdef SOLVE3D
          CALL initialize_coupling (ng, tile, 0)
#endif
        END DO
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state final level thicknesses used for state norm
!  scaling. It uses zero time-averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, iadm)
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Compute final tangent linear state dot product norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL tl_statenorm (ng, tile, knew(ng), nstp(ng),              &
     &                       statenorm(ng))
        END DO
        IF (master) THEN
          WRITE (stdout,20) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Tangent   Final Norm: ', statenorm(ng)
        END IF
      END DO
!
!=======================================================================
!  Backward integration with the adjoint model.
!=======================================================================
!
!  Initialize time stepping indices and counters.
!
      DO ng=1,ngrids
        iif(ng)=1
        indx1(ng)=1
        ktmp=knew(ng)
        kstp(ng)=1
        krhs(ng)=3
        knew(ng)=2
        predictor_2d_step(ng)=.false.
!
        iic(ng)=0
        ntmp=nstp(ng)
        nstp(ng)=1
        nrhs(ng)=1
        nnew(ng)=2
!
        synchro_flag(ng)=.true.
        tdays(ng)=dstart+dt(ng)*real(ntimes(ng),r8)*sec2day
        time(ng)=tdays(ng)*day2sec
        ntstart(ng)=ntimes(ng)+1
        ntend(ng)=1
        ntfirst(ng)=ntend(ng)
      END DO
!
!-----------------------------------------------------------------------
!  Initialize adjoint model with the final tangent linear solution
!  scaled by the energy norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL ad_ini_perturb (ng, tile,                                &
     &                         ktmp, knew(ng), ntmp, nstp(ng))
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        CALL close_inp (ng, iadm)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL ad_get_idata (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL ad_get_data (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!-----------------------------------------------------------------------
!  Time-step the adjoint model backwards.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        IF (master) THEN
          WRITE (stdout,30) 'AD', ng, ntstart(ng), ntend(ng)
        END IF
        time(ng)=time(ng)+dt(ng)
        iic(ng)=ntstart(ng)+1
      END DO
 
#ifdef SOLVE3D
      CALL ad_main3d (runinterval)
#else
      CALL ad_main2d (runinterval)
#endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Clear nonlinear state (basic state) variables for next iteration
!  and to insure a rest state time averaged free-surface before adjoint
!  state norm scaling.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, inlm)
#ifdef SOLVE3D
          CALL initialize_coupling (ng, tile, 0)
#endif
        END DO
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero free-surface (rest state).  Therefore, the
!  norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, iadm)
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Pack final adjoint solution into adjoint state vector.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL ad_pack (ng, tile, nstr(ng), nend(ng),                   &
     &                  ad_state(ng)%vector)
        END DO
      END DO
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Clear forcing variables for next iteration.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_forces (ng, tile, itlm)
          CALL initialize_forces (ng, tile, iadm)
        END DO
      END DO
!
 10   FORMAT (/,a,i2.2,a,i3.3,a,i3.3/)
 20   FORMAT (/,a,i2.2,a,1p,e15.6,/)
 30   FORMAT (/,1x,a,1x,'ROMS: started time-stepping:',                 &
     &        ' (Grid: ',i2.2,' TimeSteps: ',i8.8,' - ',i8.8,')')
!
      RETURN

References ad_get_data(), ad_get_idata(), ini_adjust_mod::ad_ini_perturb(), ad_main2d(), ad_main3d(), ad_pack(), close_io_mod::close_inp(), mod_scalars::day2sec, mod_scalars::dstart, mod_scalars::dt, mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_param::iadm, mod_scalars::iic, mod_scalars::iif, mod_scalars::indx1, mod_coupling::initialize_coupling(), mod_forces::initialize_forces(), mod_ocean::initialize_ocean(), mod_param::inlm, mod_param::itlm, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_parallel::last_tile, mod_parallel::master, mod_scalars::nconv, mod_param::nend, mod_param::ngrids, mod_stepping::nnew, mod_scalars::noerror, mod_stepping::nrhs, mod_scalars::nrun, mod_stepping::nstp, mod_param::nstr, mod_scalars::ntend, mod_scalars::ntfirst, mod_scalars::ntimes, mod_scalars::ntstart, mod_scalars::predictor_2d_step, mod_kinds::r8, mod_scalars::sec2day, set_depth_mod::set_depth(), mod_iounits::stdout, mod_scalars::synchro_flag, mod_scalars::tdays, mod_scalars::time, tl_get_data(), tl_get_idata(), tl_main2d(), tl_main3d(), dotproduct_mod::tl_statenorm(), and tl_unpack().

Here is the call graph for this function:

propagator_fte()

subroutine, public propagator_mod::propagator_fte	(	real(dp), intent(in)	runinterval,
		type (t_gst), dimension(ngrids), intent(in)	state,
		type (t_gst), dimension(ngrids), intent(inout)	tl_state )

Definition at line 36 of file propagator_fte.h.

!***********************************************************************
!
      USE mod_param
      USE mod_parallel
#ifdef SOLVE3D
      USE mod_coupling
#endif
      USE mod_iounits
      USE mod_ocean
      USE mod_scalars
      USE mod_stepping
!
      USE close_io_mod,   ONLY : close_inp
      USE dotproduct_mod, ONLY : tl_statenorm
      USE packing_mod,    ONLY : tl_unpack, tl_pack
#ifdef SOLVE3D
      USE set_depth_mod,  ONLY : set_depth
#endif
      USE strings_mod,    ONLY : founderror
!
!  Imported variable declarations.
!
      real(dp), intent(in) :: RunInterval
!
      TYPE (T_GST), intent(in) :: state(Ngrids)
      TYPE (T_GST), intent(inout) :: tl_state(Ngrids)
!
!  Local variable declarations.
!
#ifdef SOLVE3D
      logical :: FirstPass = .true.
!
#endif
      integer :: ng, tile
!
      real(r8) :: StateNorm(Ngrids)
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
!=======================================================================
!  Forward integration of the tangent linear model.
!=======================================================================
!
!$OMP MASTER
      nrun=nrun+1
      IF (master) THEN
        DO ng=1,ngrids
          WRITE (stdout,10) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Iteration: ', nrun,                     &
     &                      ',  number converged RITZ values: ',        &
     &                      nconv(ng)
        END DO
      END IF
!$OMP END MASTER
!
!  Initialize time stepping indices and counters.
!
      DO ng=1,ngrids
        iif(ng)=1
        indx1(ng)=1
        kstp(ng)=1
        krhs(ng)=1
        knew(ng)=1
        predictor_2d_step(ng)=.false.
!
        iic(ng)=0
        nstp(ng)=1
        nrhs(ng)=1
        nnew(ng)=1
!
        synchro_flag(ng)=.true.
        tdays(ng)=dstart
        time(ng)=tdays(ng)*day2sec
!$OMP MASTER
        ntstart(ng)=int((time(ng)-dstart*day2sec)/dt(ng))+1
        ntend(ng)=ntimes(ng)
        ntfirst(ng)=ntstart(ng)
!$OMP END MASTER
      END DO
!$OMP BARRIER
!
!-----------------------------------------------------------------------
!  Clear tangent linear state variables. There is not need to clean
!  the basic state arrays since they were zeroth out at initialization
!  and bottom of previous iteration.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, itlm)
        END DO
!$OMP BARRIER
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero time averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, itlm)
        END DO
!$OMP BARRIER
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Unpack tangent linear initial conditions from state vector.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL tl_unpack (ng, tile, nstr(ng), nend(ng),                 &
     &                    state(ng)%vector)
        END DO
!$OMP BARRIER
      END DO
!
!-----------------------------------------------------------------------
!  Compute initial tangent linear state dot product norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL tl_statenorm (ng, tile, kstp(ng), nstp(ng),              &
     &                       statenorm(ng))
        END DO
!$OMP BARRIER
 
!$OMP MASTER
        IF (master) THEN
          WRITE (stdout,20) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Tangent Initial Norm: ', statenorm(ng)
        END IF
!$OMP END MASTER
      END DO
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
!$OMP MASTER
        CALL close_inp (ng, itlm)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL tl_get_idata (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL tl_get_data (ng)
!$OMP END MASTER
!$OMP BARRIER
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!-----------------------------------------------------------------------
!  Time-step the tangent linear model.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
!$OMP MASTER
        IF (master) THEN
          WRITE (stdout,30) 'TL', ng, ntstart(ng), ntend(ng)
        END IF
        time(ng)=time(ng)-dt(ng)
!$OMP END MASTER
        iic(ng)=ntstart(ng)-1
      END DO
!$OMP BARRIER
 
#ifdef SOLVE3D
      CALL tl_main3d (runinterval)
#else
      CALL tl_main2d (runinterval)
#endif
!$OMP BARRIER
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Clear nonlinear state (basic state) variables and insure that the
!  time averaged free-surface is zero for scaling below and next
!  iteration.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, inlm)
#ifdef SOLVE3D
          CALL initialize_coupling (ng, tile, 0)
#endif
        END DO
!$OMP BARRIER
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state final level thicknesses used for state norm
!  scaling. It uses zero time averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, itlm)
        END DO
!$OMP BARRIER
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Compute final tangent linear state dot product norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL tl_statenorm (ng, tile, knew(ng), nstp(ng),              &
     &                       statenorm(ng))
        END DO
!$OMP BARRIER
 
!$OMP MASTER
        IF (master) THEN
          WRITE (stdout,20) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Tangent   Final Norm: ', statenorm(ng)
        END IF
!$OMP END MASTER
      END DO
!
!-----------------------------------------------------------------------
!  Pack final tangent linear solution into tangent state vector.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL tl_pack (ng, tile, nstr(ng), nend(ng),                   &
     &                  tl_state(ng)%vector)
        END DO
!$OMP BARRIER
      END DO
!
 10   FORMAT (/,a,i2.2,a,i3.3,a,i3.3/)
 20   FORMAT (/,a,i2.2,a,1p,e15.6,/)
 30   FORMAT (/,1x,a,1x,'ROMS: started time-stepping:',                 &
     &        ' (Grid: ',i2.2,' TimeSteps: ',i8.8,' - ',i8.8,')')
 
      RETURN

References close_io_mod::close_inp(), mod_scalars::day2sec, mod_scalars::dstart, mod_scalars::dt, mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_scalars::iic, mod_scalars::iif, mod_scalars::indx1, mod_coupling::initialize_coupling(), mod_ocean::initialize_ocean(), mod_param::inlm, mod_param::itlm, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_parallel::last_tile, mod_parallel::master, mod_scalars::nconv, mod_param::nend, mod_param::ngrids, mod_stepping::nnew, mod_scalars::noerror, mod_stepping::nrhs, mod_scalars::nrun, mod_stepping::nstp, mod_param::nstr, mod_scalars::ntend, mod_scalars::ntfirst, mod_scalars::ntimes, mod_scalars::ntstart, mod_scalars::predictor_2d_step, set_depth_mod::set_depth(), mod_iounits::stdout, mod_scalars::synchro_flag, mod_scalars::tdays, mod_scalars::time, tl_get_data(), tl_get_idata(), tl_main2d(), tl_main3d(), tl_pack(), dotproduct_mod::tl_statenorm(), and tl_unpack().

Here is the call graph for this function:

propagator_hop()

subroutine, public propagator_mod::propagator_hop	(	real(dp), intent(in)	runinterval,
		type (t_gst), dimension(ngrids), intent(in)	state,
		type (t_gst), dimension(ngrids), intent(inout)	ad_state )

Definition at line 42 of file propagator_hop.h.

!***********************************************************************
!
      USE mod_param
      USE mod_parallel
#ifdef SOLVE3D
      USE mod_coupling
#endif
      USE mod_iounits
      USE mod_ocean
      USE mod_scalars
      USE mod_stepping
!
      USE close_io_mod,    ONLY : close_inp
      USE dotproduct_mod,  ONLY : tl_statenorm
      USE ini_adjust_mod,  ONLY : ad_ini_perturb
      USE inner2state_mod, ONLY : ad_inner2state, tl_inner2state
      USE inner2state_mod, ONLY : ini_c_norm
#ifdef SOLVE3D
      USE set_depth_mod,   ONLY : set_depth
#endif
      USE strings_mod,     ONLY : founderror
!
!  Imported variable declarations.
!
      real(dp), intent(in) :: RunInterval
!
      TYPE (T_GST), intent(in) :: state(Ngrids)
      TYPE (T_GST), intent(inout) :: ad_state(Ngrids)
!
!  Local variable declarations.
!
      integer :: ng, tile
      integer :: ktmp, ntmp, Lini
!
      real(r8) :: StateNorm(Ngrids)
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
!=======================================================================
!  Forward integration of the tangent linear model.
!=======================================================================
!
      nrun=nrun+1
      IF (master) THEN
        DO ng=1,ngrids
          WRITE (stdout,10) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Iteration: ', nrun,                     &
     &                      ',  number converged RITZ values: ',        &
     &                      nconv(ng)
        END DO
      END IF
!
!  Initialize time stepping indices and counters.
!
      DO ng=1,ngrids
        iif(ng)=1
        indx1(ng)=1
        kstp(ng)=1
        krhs(ng)=1
        knew(ng)=1
        predictor_2d_step(ng)=.false.
!
        iic(ng)=0
        nstp(ng)=1
        nrhs(ng)=1
        nnew(ng)=1
!
        synchro_flag(ng)=.true.
        tdays(ng)=dstart
        time(ng)=tdays(ng)*day2sec
        ntstart(ng)=int((time(ng)-dstart*day2sec)/dt(ng))+1
        ntend(ng)=ntimes(ng)
        ntfirst(ng)=ntstart(ng)
      END DO
!
      lini=1
!
!-----------------------------------------------------------------------
!  Clear tangent linear state variables. There is not need to clean
!  the basic state arrays since they were zeroth out at initialization
!  and bottom of previous iteration.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, itlm)
        END DO
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero time-averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, itlm)
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Compute tangent linear initial conditions from state vector.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL tl_inner2state (ng, tile, lini, state(ng)%vector)
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Compute initial tangent linear state analysis error norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL ini_c_norm (ng, tile, kstp(ng), nstp(ng),                &
     &                     statenorm(ng))
        END DO
        IF (master) THEN
          WRITE (stdout,20) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Tangent Initial Norm: ', statenorm(ng)
        END IF
      END DO
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        CALL close_inp (ng, itlm)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL tl_get_idata (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL tl_get_data (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!-----------------------------------------------------------------------
!  Time-step the tangent linear model.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        IF (master) THEN
          WRITE (stdout,30) 'TL', ng, ntstart(ng), ntend(ng)
        END IF
        time(ng)=time(ng)-dt(ng)
        iic(ng)=ntstart(ng)-1
      END DO
 
#ifdef SOLVE3D
      CALL tl_main3d (runinterval)
#else
      CALL tl_main2d (runinterval)
#endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Clear nonlinear (basic state) and adjoint state variables.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, inlm)
          CALL initialize_ocean (ng, tile, iadm)
#ifdef SOLVE3D
          CALL initialize_coupling (ng, tile, 0)
#endif
        END DO
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state final level thicknesses used for state norm
!  scaling. It uses zero time-averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, itlm)
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Compute final tangent linear energy norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL tl_statenorm (ng, tile, knew(ng), nstp(ng),              &
     &                       statenorm(ng))
        END DO
        IF (master) THEN
          WRITE (stdout,20) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Tangent   Final Norm: ', statenorm(ng)
        END IF
      END DO
!
!=======================================================================
!  Backward integration with the adjoint model.
!=======================================================================
!
!  Initialize time stepping indices and counters.
!
      DO ng=1,ngrids
        iif(ng)=1
        indx1(ng)=1
        ktmp=knew(ng)
        kstp(ng)=1
        krhs(ng)=3
        knew(ng)=2
        predictor_2d_step(ng)=.false.
!
        iic(ng)=0
        ntmp=nstp(ng)
        nstp(ng)=1
        nrhs(ng)=1
        nnew(ng)=2
!
        synchro_flag(ng)=.true.
        tdays(ng)=dstart+dt(ng)*real(ntimes(ng),r8)*sec2day
        time(ng)=tdays(ng)*day2sec
        ntstart(ng)=ntimes(ng)+1
        ntend(ng)=1
        ntfirst(ng)=ntend(ng)
      END DO
!
!-----------------------------------------------------------------------
!  Initialize adjoint model with the final tangent linear solution
!  scaled by the energy norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL ad_ini_perturb (ng, tile,                                &
     &                         ktmp, knew(ng), ntmp, nstp(ng))
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        CALL close_inp (ng, iadm)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL ad_get_idata (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL ad_get_data (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!-----------------------------------------------------------------------
!  Time-step the adjoint model backwards.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        IF (master) THEN
          WRITE (stdout,30) 'AD', ng, ntstart(ng), ntend(ng)
        END IF
        time(ng)=time(ng)+dt(ng)
        iic(ng)=ntstart(ng)+1
      END DO
 
#ifdef SOLVE3D
      CALL ad_main3d (runinterval)
#else
      CALL ad_main2d (runinterval)
#endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Clear nonlinear state (basic state) variables for next iteration
!  and to insure a rest state time averaged free-surface before adjoint
!  state norm scaling.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, inlm)
#ifdef SOLVE3D
          CALL initialize_coupling (ng, tile, 0)
#endif
        END DO
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero free-surface (rest state).  Therefore, the
!  norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, iadm)
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Compute adjoint state vector.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL ad_inner2state (ng, tile, lini, ad_state(ng)%vector)
        END DO
      END DO
!
 10   FORMAT (/,a,i2.2,a,i3.3,a,i3.3/)
 20   FORMAT (/,a,i2.2,a,1p,e15.6,/)
 30   FORMAT (/,1x,a,1x,'ROMS: started time-stepping:',                 &
     &        ' (Grid: ',i2.2,' TimeSteps: ',i8.8,' - ',i8.8,')')
!
      RETURN

References ad_get_data(), ad_get_idata(), ini_adjust_mod::ad_ini_perturb(), inner2state_mod::ad_inner2state(), ad_main2d(), ad_main3d(), close_io_mod::close_inp(), mod_scalars::day2sec, mod_scalars::dstart, mod_scalars::dt, mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_param::iadm, mod_scalars::iic, mod_scalars::iif, mod_scalars::indx1, inner2state_mod::ini_c_norm(), mod_coupling::initialize_coupling(), mod_ocean::initialize_ocean(), mod_param::inlm, mod_param::itlm, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_parallel::last_tile, mod_parallel::master, mod_scalars::nconv, mod_param::ngrids, mod_stepping::nnew, mod_scalars::noerror, mod_stepping::nrhs, mod_scalars::nrun, mod_stepping::nstp, mod_scalars::ntend, mod_scalars::ntfirst, mod_scalars::ntimes, mod_scalars::ntstart, mod_scalars::predictor_2d_step, mod_kinds::r8, mod_scalars::sec2day, set_depth_mod::set_depth(), mod_iounits::stdout, mod_scalars::synchro_flag, mod_scalars::tdays, mod_scalars::time, tl_get_data(), tl_get_idata(), inner2state_mod::tl_inner2state(), tl_main2d(), tl_main3d(), and dotproduct_mod::tl_statenorm().

Here is the call graph for this function:

propagator_hso()

subroutine, public propagator_mod::propagator_hso	(	real(dp), intent(in)	runinterval,
		integer	iter,
		type (t_gst), dimension(ngrids), intent(in)	state,
		type (t_gst), dimension(ngrids), intent(inout)	ad_state )

Definition at line 35 of file propagator_hso.h.

!***********************************************************************
!
      USE mod_param
      USE mod_parallel
      USE mod_netcdf
#ifdef SOLVE3D
      USE mod_coupling
#endif
      USE mod_iounits
      USE mod_ocean
      USE mod_scalars
      USE mod_stepping
      USE mod_storage
!
      USE close_io_mod,    ONLY : close_inp
      USE dotproduct_mod,  ONLY : tl_statenorm
      USE ini_adjust_mod,  ONLY : ad_ini_perturb
      USE mod_forces,      ONLY : initialize_forces
      USE inner2state_mod, ONLY : ad_inner2state, tl_inner2state
      USE inner2state_mod, ONLY : ini_c_norm
#ifdef STOCH_OPT_WHITE
      USE packing_mod,     ONLY : ad_so_pack, ad_unpack, tl_unpack
#else
      USE packing_mod,     ONLY : ad_so_pack_red, ad_unpack, tl_unpack
#endif
#ifdef SOLVE3D
      USE set_depth_mod,   ONLY : set_depth
#endif
      USE strings_mod,     ONLY : founderror
!
!  Imported variable declarations.
!
      integer :: Iter
!
      real(dp), intent(in) :: RunInterval
!
      TYPE (T_GST), intent(in) :: state(Ngrids)
      TYPE (T_GST), intent(inout) :: ad_state(Ngrids)
!
!  Local variable declarations.
!
      logical :: SOrunTL
#ifdef STOCH_OPT_WHITE
      logical :: SOrunAD
#endif
!
      integer :: ng, tile
      integer :: ktmp, ntmp, Lini
      integer :: kout, nout
      integer :: Fcount, Interval, IntTrap
!
      real(r8) :: StateNorm(Ngrids)
      real(r8) :: so_run_time
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
!=======================================================================
!  Forward integration of the tangent linear model.
!=======================================================================
!
      nrun=nrun+1
      IF (master) THEN
        DO ng=1,ngrids
          WRITE (stdout,10) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Iteration: ', nrun,                     &
     &                      ',  number converged RITZ values: ',        &
     &                      nconv(ng)
        END DO
      END IF
!
!  Loop over the required numger if trapezoidal intervals in time.
!
      interval_loop : DO interval=1,nintervals+1
 
        soruntl=.true.
#ifdef STOCH_OPT_WHITE
        sorunad=.true.
#endif
        IF (interval.eq.nintervals+1) THEN
          soruntl=.false.
#ifdef STOCH_OPT_WHITE
          sorunad=.false.
#endif
        END IF
        inttrap=interval
!
        IF (master) THEN
          WRITE (stdout,20) ' Stochastic Optimals Time Interval = ',    &
     &                      interval
        END IF
!
!  Initialize time stepping indices and counters.
!
        lini=1
        DO ng=1,ngrids
#ifndef STOCH_OPT_WHITE
          IF (interval.eq.1) THEN
            soinitial(ng)=.true.
          ELSE
            soinitial(ng)=.false.
          END IF
#endif
          IF (interval.eq.1) THEN
            lwrttlm(ng)=.true.
          ELSE
            lwrttlm(ng)=.false.
          END IF
          iif(ng)=1
          indx1(ng)=1
          kstp(ng)=1
          krhs(ng)=1
          knew(ng)=1
          predictor_2d_step(ng)=.false.
!
          iic(ng)=0
          nstp(ng)=1
          nrhs(ng)=1
          nnew(ng)=1
!
          synchro_flag(ng)=.true.
          tdays(ng)=dstart+real(ntimes(ng),r8)*real(interval-1,r8)*     &
     &                     dt(ng)*sec2day/real(nintervals,r8)
          time(ng)=tdays(ng)*day2sec
          ntstart(ng)=int((time(ng)-dstart*day2sec)/dt(ng))+1
          ntend(ng)=ntimes(ng)
          ntfirst(ng)=ntstart(ng)
          so_run_time=dt(ng)*real(ntend(ng)-ntstart(ng)+1,r8)
        END DO
!
!  Set switches and counters to manage output adjoint and tangent linear
!  history NetCDF files.
!
        DO ng=1,ngrids
          IF (iter.gt.0) THEN                ! Arnoldi iteration loop
            IF ((iter.eq.1).and.(interval.eq.1)) THEN
              ldefadj(ng)=.true.
              ldeftlm(ng)=.true.             ! NetCDF files are created
            ELSE                             ! on the first pass
              ldefadj(ng)=.false.
              ldeftlm(ng)=.false.
            END IF
            fcount=adm(ng)%load
            adm(ng)%Nrec(fcount)=0
            adm(ng)%Rindex=0
            fcount=tlm(ng)%load
            tlm(ng)%Nrec(fcount)=0
            tlm(ng)%Rindex=0
          ELSE                               ! Computing eigenvectors
            IF (lmultigst.and.(interval.eq.1)) THEN
              ldeftlm(ng)=.true.
            ELSE
              ldeftlm(ng)=.false.
            END IF
#ifdef STOCH_OPT_WHITE
            IF (interval.le.nintervals) THEN
              fcount=adm(ng)%load
              adm(ng)%Nrec(fcount)=0
              adm(ng)%Rindex=0
            END IF
#else
            fcount=adm(ng)%load
            adm(ng)%Nrec(fcount)=0
            adm(ng)%Rindex=0
#endif
            IF ((lmultigst.or.(abs(iter).eq.1)).and.                    &
     &          (interval.eq.1)) THEN
              fcount=tlm(ng)%load
              tlm(ng)%Nrec(fcount)=0
              tlm(ng)%Rindex=0
            END IF
          END IF
        END DO
!
!-----------------------------------------------------------------------
!  Clear tangent linear state variables. There is not need to clean
!  the basic state arrays since they were zeroth out at initialization
!  and bottom of previous iteration.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL initialize_ocean (ng, tile, itlm)
          END DO
        END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero time-averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=last_tile(ng),first_tile(ng),-1
            CALL set_depth (ng, tile, itlm)
          END DO
        END DO
#endif
!
!-----------------------------------------------------------------------
!  Compute tangent linear initial conditions from state vector.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL tl_inner2state (ng, tile, lini, state(ng)%vector)
          END DO
        END DO
!
!-----------------------------------------------------------------------
!  Compute initial tangent linear state analysis error norm.
!-----------------------------------------------------------------------
!
        IF (interval.eq.1) THEN
          DO ng=1,ngrids
            DO tile=last_tile(ng),first_tile(ng),-1
              CALL ini_c_norm (ng, tile, kstp(ng), nstp(ng),            &
     &                         statenorm(ng))
            END DO
            IF (master) THEN
              WRITE (stdout,30) ' PROPAGATOR - Grid: ', ng,             &
     &                          ',  Tangent Initial Norm: ',            &
     &                          statenorm(ng)
            END IF
          END DO
        END IF
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
        IF (soruntl) THEN              ! do not run TLM on last interval
          DO ng=1,ngrids
            CALL close_inp (ng, itlm)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
            CALL tl_get_idata (ng)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
            CALL tl_get_data (ng)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END DO
!
!-----------------------------------------------------------------------
!  Time-step the tangent linear model.
!-----------------------------------------------------------------------
!
          DO ng=1,ngrids
            IF (master) THEN
              WRITE (stdout,40) 'TL', ng, ntstart(ng), ntend(ng)
            END IF
            time(ng)=time(ng)-dt(ng)
            iic(ng)=ntstart(ng)-1
          END DO
 
#ifdef SOLVE3D
          CALL tl_main3d (so_run_time)
#else
          CALL tl_main2d (so_run_time)
#endif
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
!
!-----------------------------------------------------------------------
!  Clear nonlinear (basic state) and adjoint state variables.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL initialize_ocean (ng, tile, inlm)
            CALL initialize_ocean (ng, tile, iadm)
#ifdef SOLVE3D
            CALL initialize_coupling (ng, tile, 0)
#endif
          END DO
        END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state final level thicknesses used for state norm
!  scaling. It uses zero time-averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=last_tile(ng),first_tile(ng),-1
            CALL set_depth (ng, tile, itlm)
          END DO
        END DO
#endif
!
!-----------------------------------------------------------------------
!  Compute final tangent linear energy norm.
!-----------------------------------------------------------------------
!
        IF (interval.eq.nintervals+1) THEN
          DO ng=1,ngrids
            DO tile=first_tile(ng),last_tile(ng),+1
              CALL tl_statenorm (ng, tile, kstp(ng), nstp(ng),          &
     &                           statenorm(ng))
            END DO
            IF (master) THEN
              WRITE (stdout,30) ' PROPAGATOR - Grid: ', ng,             &
     &                          ',  Tangent   Final Norm: ',            &
     &                          statenorm(ng)
            END IF
          END DO
        END IF
!
!=======================================================================
!  Backward integration with the adjoint model.
!=======================================================================
!
!  Initialize time stepping indices and counters.
!
        DO ng=1,ngrids
#ifndef STOCH_OPT_WHITE
          lwrtstate2d(ng)=.false.
          lwrtstate3d(ng)=.false.
#endif
          iif(ng)=1
          indx1(ng)=1
          ktmp=knew(ng)
          IF (inttrap.eq.nintervals+1) THEN
            ktmp=kstp(ng)
          END IF
          kstp(ng)=1
          krhs(ng)=3
          knew(ng)=2
          kout=knew(ng)
#ifdef STOCH_OPT_WHITE
          IF (inttrap.eq.nintervals+1) THEN
            kout=kstp(ng)
          END IF
#endif
          predictor_2d_step(ng)=.false.
!
          iic(ng)=0
          ntmp=nstp(ng)
          nstp(ng)=1
          nrhs(ng)=1
          nnew(ng)=2
!
          synchro_flag(ng)=.true.
          tdays(ng)=dstart+dt(ng)*real(ntimes(ng),r8)*sec2day
          time(ng)=tdays(ng)*day2sec
          ntstart(ng)=ntimes(ng)+1
# ifdef STOCH_OPT_WHITE
          ntend(ng)=1+(interval-1)*ntimes(ng)/nintervals
# else
          ntend(ng)=1
# endif
          ntfirst(ng)=ntend(ng)
        END DO
!
!-----------------------------------------------------------------------
!  Initialize adjoint model with the final tangent linear solution
!  scaled by the energy norm.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=last_tile(ng),first_tile(ng),-1
            CALL ad_ini_perturb (ng, tile,                              &
     &                           ktmp, kout, ntmp, nstp(ng))
          END DO
        END DO
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
#ifdef STOCH_OPT_WHITE
        IF (sorunad) THEN              ! do not run ADM on last interval
#endif
          DO ng=1,ngrids
            CALL close_inp (ng, iadm)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
            CALL ad_get_idata (ng)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
            CALL ad_get_data (ng)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END DO
!
!-----------------------------------------------------------------------
!  Time-step the adjoint model backwards.
!-----------------------------------------------------------------------
!
          DO ng=1,ngrids
            IF (master) THEN
              WRITE (stdout,40) 'AD', ng, ntstart(ng), ntend(ng)
            END IF
            time(ng)=time(ng)+dt(ng)
            iic(ng)=ntstart(ng)+1
          END DO
 
#ifdef SOLVE3D
# ifdef STOCH_OPT_WHITE
          CALL ad_main3d (so_run_time)
# else
          CALL ad_main3d (runinterval)
# endif
#else
# ifdef STOCH_OPT_WHITE
          CALL ad_main2d (so_run_time)
# else
          CALL ad_main2d (runinterval)
# endif
#endif
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#ifdef STOCH_OPT_WHITE
        END IF
#endif
!
!-----------------------------------------------------------------------
!  Clear nonlinear state (basic state) variables for next iteration
!  and to insure a rest state time averaged free-surface before adjoint
!  state norm scaling.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL initialize_ocean (ng, tile, inlm)
#ifdef SOLVE3D
            CALL initialize_coupling (ng, tile, 0)
#endif
          END DO
        END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero free-surface (rest state).  Therefore, the
!  norm scaling is time invariant.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=last_tile(ng),first_tile(ng),-1
            CALL set_depth (ng, tile, iadm)
          END DO
        END DO
#endif
!
!-----------------------------------------------------------------------
!  Pack final adjoint solution into adjoint state vector.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
# ifdef STOCH_OPT_WHITE
            CALL ad_so_pack (ng, tile, nstr(ng), nend(ng), inttrap,     &
     &                       storage(ng)%my_state)
# else
            CALL ad_so_pack_red (ng, tile, nstr(ng), nend(ng),          &
     &                           inttrap, storage(ng)%my_state)
# endif
          END DO
        END DO
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Clear forcing variables for next iteration.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=last_tile(ng),first_tile(ng),-1
            CALL initialize_forces (ng, tile, itlm)
            CALL initialize_forces (ng, tile, iadm)
          END DO
        END DO
 
      END DO interval_loop
!
!-----------------------------------------------------------------------
!  Finally, unpack "my_state", and compute the adjoint state vector.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
            CALL ad_unpack (ng, tile, nstr(ng), nend(ng),               &
     &                      storage(ng)%my_state)
        END DO
      END DO
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
            CALL ad_inner2state (ng, tile, lini, ad_state(ng)%vector)
        END DO
      END DO
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
 10   FORMAT (/,a,i2.2,a,i3.3,a,i3.3/)
 20   FORMAT (/,a,i2.2)
 30   FORMAT (/,a,i2.2,a,1p,e15.6,/)
 40   FORMAT (/,1x,a,1x,'ROMS: started time-stepping:',                 &
     &        ' (Grid: ',i2.2,' TimeSteps: ',i8.8,' - ',i8.8,')')
!
      RETURN

References ad_get_data(), ad_get_idata(), ini_adjust_mod::ad_ini_perturb(), inner2state_mod::ad_inner2state(), ad_main2d(), ad_main3d(), ad_unpack(), mod_iounits::adm, close_io_mod::close_inp(), mod_scalars::day2sec, mod_scalars::dstart, mod_scalars::dt, mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_param::iadm, mod_scalars::iic, mod_scalars::iif, mod_scalars::indx1, inner2state_mod::ini_c_norm(), mod_coupling::initialize_coupling(), mod_forces::initialize_forces(), mod_ocean::initialize_ocean(), mod_param::inlm, mod_param::itlm, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_parallel::last_tile, mod_scalars::ldefadj, mod_scalars::ldeftlm, mod_scalars::lmultigst, mod_scalars::lwrtstate2d, mod_scalars::lwrttlm, mod_parallel::master, mod_scalars::nconv, mod_param::nend, mod_param::ngrids, mod_scalars::nintervals, mod_stepping::nnew, mod_scalars::noerror, mod_stepping::nrhs, mod_scalars::nrun, mod_stepping::nstp, mod_param::nstr, mod_scalars::ntend, mod_scalars::ntfirst, mod_scalars::ntimes, mod_scalars::ntstart, mod_scalars::predictor_2d_step, mod_kinds::r8, mod_scalars::sec2day, set_depth_mod::set_depth(), mod_iounits::stdout, mod_storage::storage, mod_scalars::synchro_flag, mod_scalars::tdays, mod_scalars::time, tl_get_data(), tl_get_idata(), inner2state_mod::tl_inner2state(), tl_main2d(), tl_main3d(), dotproduct_mod::tl_statenorm(), tl_unpack(), and mod_iounits::tlm.

Here is the call graph for this function:

propagator_op()

subroutine, public propagator_mod::propagator_op	(	real(dp), intent(in)	runinterval,
		type (t_gst), dimension(ngrids), intent(in)	state,
		type (t_gst), dimension(ngrids), intent(inout)	ad_state )

Definition at line 37 of file propagator_op.h.

!***********************************************************************
!
      USE mod_param
      USE mod_parallel
#ifdef SOLVE3D
      USE mod_coupling
#endif
      USE mod_iounits
      USE mod_ocean
      USE mod_scalars
      USE mod_stepping
!
      USE close_io_mod,   ONLY : close_inp
      USE dotproduct_mod, ONLY : tl_statenorm
      USE ini_adjust_mod, ONLY : ad_ini_perturb
      USE packing_mod,    ONLY : tl_unpack, ad_pack
#ifdef SOLVE3D
      USE set_depth_mod,  ONLY : set_depth
#endif
      USE strings_mod,    ONLY : founderror
!
!  Imported variable declarations.
!
      real(dp), intent(in) :: RunInterval
!
      TYPE (T_GST), intent(in) :: state(Ngrids)
      TYPE (T_GST), intent(inout) :: ad_state(Ngrids)
!
!  Local variable declarations.
!
      integer :: ng, tile
      integer :: ktmp, ntmp
!
      real(r8) :: StateNorm(Ngrids)
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
!=======================================================================
!  Forward integration of the tangent linear model.
!=======================================================================
!
      nrun=nrun+1
      IF (master) THEN
        DO ng=1,ngrids
          WRITE (stdout,10) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Iteration: ', nrun,                     &
     &                      ',  number converged RITZ values: ',        &
     &                      nconv(ng)
        END DO
      END IF
!
!  Initialize time stepping indices and counters.
!
      DO ng=1,ngrids
        iif(ng)=1
        indx1(ng)=1
        kstp(ng)=1
        krhs(ng)=1
        knew(ng)=1
        predictor_2d_step(ng)=.false.
!
        iic(ng)=0
        nstp(ng)=1
        nrhs(ng)=1
        nnew(ng)=1
!
        synchro_flag(ng)=.true.
        tdays(ng)=dstart
        time(ng)=tdays(ng)*day2sec
        ntstart(ng)=int((time(ng)-dstart*day2sec)/dt(ng))+1
        ntend(ng)=ntimes(ng)
        ntfirst(ng)=ntstart(ng)
      END DO
!
!-----------------------------------------------------------------------
!  Clear tangent linear state variables. There is not need to clean
!  the basic state arrays since they were zeroth out at initialization
!  and bottom of previous iteration.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, itlm)
        END DO
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero time-averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, itlm)
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Unpack tangent linear initial conditions from state vector.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL tl_unpack (ng, tile, nstr(ng), nend(ng),                 &
     &                    state(ng)%vector)
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Compute initial tangent linear state dot product norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL tl_statenorm (ng, tile, kstp(ng), nstp(ng),              &
     &                       statenorm(ng))
        END DO
        IF (master) THEN
          WRITE (stdout,20) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Tangent Initial Norm: ', statenorm(ng)
        END IF
      END DO
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        CALL close_inp (ng, itlm)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL tl_get_idata (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL tl_get_data (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!-----------------------------------------------------------------------
!  Time-step the tangent linear model.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        IF (master) THEN
          WRITE (stdout,30) 'TL', ng, ntstart(ng), ntend(ng)
        END IF
        time(ng)=time(ng)-dt(ng)
        iic(ng)=ntstart(ng)-1
      END DO
 
#ifdef SOLVE3D
      CALL tl_main3d (runinterval)
#else
      CALL tl_main2d (runinterval)
#endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Clear nonlinear (basic state) and adjoint state variables.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, inlm)
          CALL initialize_ocean (ng, tile, iadm)
#ifdef SOLVE3D
          CALL initialize_coupling (ng, tile, 0)
#endif
        END DO
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state final level thicknesses used for state norm
!  scaling. It uses zero time-averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, itlm)
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Compute final tangent linear state dot product norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL tl_statenorm (ng, tile, knew(ng), nstp(ng),              &
     &                       statenorm(ng))
        END DO
        IF (master) THEN
          WRITE (stdout,20) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Tangent   Final Norm: ', statenorm(ng)
        END IF
      END DO
!
!=======================================================================
!  Backward integration with the adjoint model.
!=======================================================================
!
!  Initialize time stepping indices and counters.
!
      DO ng=1,ngrids
        iif(ng)=1
        indx1(ng)=1
        ktmp=knew(ng)
        kstp(ng)=1
        krhs(ng)=3
        knew(ng)=2
        predictor_2d_step(ng)=.false.
!
        iic(ng)=0
        ntmp=nstp(ng)
        nstp(ng)=1
        nrhs(ng)=1
        nnew(ng)=2
!
        synchro_flag(ng)=.true.
        tdays(ng)=dstart+dt(ng)*real(ntimes(ng),r8)*sec2day
        time(ng)=tdays(ng)*day2sec
        ntstart(ng)=ntimes(ng)+1
        ntend(ng)=1
        ntfirst(ng)=ntend(ng)
      END DO
!
!-----------------------------------------------------------------------
!  Initialize adjoint model with the final tangent linear solution
!  scaled by the energy norm.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL ad_ini_perturb (ng, tile,                                &
     &                         ktmp, knew(ng), ntmp, nstp(ng))
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        CALL close_inp (ng, iadm)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL ad_get_idata (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL ad_get_data (ng)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END DO
!
!-----------------------------------------------------------------------
!  Time-step the adjoint model backwards.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        IF (master) THEN
          WRITE (stdout,30) 'AD', ng, ntstart(ng), ntend(ng)
        END IF
        time(ng)=time(ng)+dt(ng)
        iic(ng)=ntstart(ng)+1
      END DO
 
#ifdef SOLVE3D
      CALL ad_main3d (runinterval)
#else
      CALL ad_main2d (runinterval)
#endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Clear nonlinear state (basic state) variables for next iteration
!  and to insure a rest state time averaged free-surface before adjoint
!  state norm scaling.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL initialize_ocean (ng, tile, inlm)
#ifdef SOLVE3D
          CALL initialize_coupling (ng, tile, 0)
#endif
        END DO
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero free-surface (rest state).  Therefore, the
!  norm scaling is time invariant.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=last_tile(ng),first_tile(ng),-1
          CALL set_depth (ng, tile, iadm)
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Pack final adjoint solution into adjoint state vector.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
          CALL ad_pack (ng, tile, nstr(ng), nend(ng),                   &
     &                  ad_state(ng)%vector)
        END DO
      END DO
!
 10   FORMAT (/,a,i2.2,a,i3.3,a,i3.3/)
 20   FORMAT (/,a,i2.2,a,1p,e15.6,/)
 30   FORMAT (/,1x,a,1x,'ROMS: started time-stepping:',                 &
     &        ' (Grid: ',i2.2,' TimeSteps: ',i8.8,' - ',i8.8,')')
!
      RETURN

References ad_get_data(), ad_get_idata(), ini_adjust_mod::ad_ini_perturb(), ad_main2d(), ad_main3d(), ad_pack(), close_io_mod::close_inp(), mod_scalars::day2sec, mod_scalars::dstart, mod_scalars::dt, mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_param::iadm, mod_scalars::iic, mod_scalars::iif, mod_scalars::indx1, mod_coupling::initialize_coupling(), mod_ocean::initialize_ocean(), mod_param::inlm, mod_param::itlm, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_parallel::last_tile, mod_parallel::master, mod_scalars::nconv, mod_param::nend, mod_param::ngrids, mod_stepping::nnew, mod_scalars::noerror, mod_stepping::nrhs, mod_scalars::nrun, mod_stepping::nstp, mod_param::nstr, mod_scalars::ntend, mod_scalars::ntfirst, mod_scalars::ntimes, mod_scalars::ntstart, mod_scalars::predictor_2d_step, mod_kinds::r8, mod_scalars::sec2day, set_depth_mod::set_depth(), mod_iounits::stdout, mod_scalars::synchro_flag, mod_scalars::tdays, mod_scalars::time, tl_get_data(), tl_get_idata(), tl_main2d(), tl_main3d(), dotproduct_mod::tl_statenorm(), and tl_unpack().

Here is the call graph for this function:

propagator_so()

subroutine, public propagator_mod::propagator_so	(	real(dp), intent(in)	runinterval,
		integer	iter,
		type (t_gst), dimension(ngrids), intent(in)	state,
		type (t_gst), dimension(ngrids), intent(inout)	ad_state )

Definition at line 30 of file propagator_so.h.

!***********************************************************************
!
      USE mod_param
      USE mod_parallel
      USE mod_netcdf
#ifdef SOLVE3D
      USE mod_coupling
#endif
      USE mod_iounits
      USE mod_ocean
      USE mod_scalars
      USE mod_stepping
!
      USE close_io_mod,   ONLY : close_inp
      USE dotproduct_mod, ONLY : tl_statenorm
      USE ini_adjust_mod, ONLY : ad_ini_perturb
      USE mod_forces,     ONLY : initialize_forces
#ifdef STOCH_OPT_WHITE
      USE packing_mod,    ONLY : ad_so_pack, tl_unpack
#else
      USE packing_mod,    ONLY : ad_so_pack_red, tl_unpack
#endif
#ifdef SOLVE3D
      USE set_depth_mod,  ONLY : set_depth
#endif
      USE strings_mod,    ONLY : founderror
!
!  Imported variable declarations.
!
      integer :: Iter
!
      real(dp), intent(in) :: RunInterval
!
      TYPE (T_GST), intent(in) :: state(Ngrids)
      TYPE (T_GST), intent(inout) :: ad_state(Ngrids)
!
!  Local variable declarations.
!
      logical :: SOrunTL
#ifdef STOCH_OPT_WHITE
      logical :: SOrunAD
#endif
!
      integer :: ng, tile
      integer :: ktmp, ntmp
      integer :: kout, nout
      integer :: Fcount, Interval, IntTrap
!
      real(r8) :: StateNorm(Ngrids)
      real(r8) :: so_run_time
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
!=======================================================================
!  Forward integration of the tangent linear model.
!=======================================================================
!
      nrun=nrun+1
      IF (master) THEN
        DO ng=1,ngrids
          WRITE (stdout,10) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Iteration: ', nrun,                     &
     &                      ',  number converged RITZ values: ',        &
     &                      nconv(ng)
        END DO
      END IF
!
!  Loop over the required numger if trapezoidal intervals in time.
!
      interval_loop : DO interval=1,nintervals+1
 
        soruntl=.true.
#ifdef STOCH_OPT_WHITE
        sorunad=.true.
#endif
        IF (interval.eq.nintervals+1) THEN
          soruntl=.false.
#ifdef STOCH_OPT_WHITE
          sorunad=.false.
#endif
        END IF
        inttrap=interval
!
        IF (master) THEN
          WRITE (stdout,20) ' Stochastic Optimals Time Interval = ',    &
     &                      interval
        END IF
!
!  Initialize time stepping indices and counters.
!
        DO ng=1,ngrids
#ifndef STOCH_OPT_WHITE
          IF (interval.eq.1) THEN
            soinitial(ng)=.true.
          ELSE
            soinitial(ng)=.false.
          END IF
#endif
          IF (interval.eq.1) THEN
            lwrttlm(ng)=.true.
          ELSE
            lwrttlm(ng)=.false.
          END IF
          iif(ng)=1
          indx1(ng)=1
          kstp(ng)=1
          krhs(ng)=1
          knew(ng)=1
          predictor_2d_step(ng)=.false.
!
          iic(ng)=0
          nstp(ng)=1
          nrhs(ng)=1
          nnew(ng)=1
!
          synchro_flag(ng)=.true.
          tdays(ng)=dstart+real(ntimes(ng),r8)*real(interval-1,r8)*     &
     &                     dt(ng)*sec2day/real(nintervals,r8)
          time(ng)=tdays(ng)*day2sec
          ntstart(ng)=int((time(ng)-dstart*day2sec)/dt(ng))+1
          ntend(ng)=ntimes(ng)
          ntfirst(ng)=ntstart(ng)
          so_run_time=dt(ng)*real(ntend(ng)-ntstart(ng)+1,r8)
        END DO
!
!  Set switches and counters to manage output adjoint and tangent linear
!  history NetCDF files.
!
        DO ng=1,ngrids
          IF (iter.gt.0) THEN                ! Arnoldi iteration loop
            IF ((iter.eq.1).and.(interval.eq.1)) THEN
              ldefadj(ng)=.true.
              ldeftlm(ng)=.true.             ! NetCDF files are created
            ELSE                             ! on the first pass
              ldefadj(ng)=.false.
              ldeftlm(ng)=.false.
            END IF
            fcount=adm(ng)%load
            adm(ng)%Nrec(fcount)=0
            adm(ng)%Rindex=0
            fcount=tlm(ng)%load
            tlm(ng)%Nrec(fcount)=0
            tlm(ng)%Rindex=0
          ELSE                               ! Computing eigenvectors
            IF (lmultigst.and.(interval.eq.1)) THEN
              ldeftlm(ng)=.true.
            ELSE
              ldeftlm(ng)=.false.
            END IF
#ifdef STOCH_OPT_WHITE
            IF (interval.le.nintervals) THEN
              fcount=adm(ng)%load
              adm(ng)%Nrec(fcount)=0
              adm(ng)%Rindex=0
            END IF
#else
            fcount=adm(ng)%load
            adm(ng)%Nrec(fcount)=0
            adm(ng)%Rindex=0
#endif
            IF ((lmultigst.or.(abs(iter).eq.1)).and.                    &
     &          (interval.eq.1)) THEN
              fcount=tlm(ng)%load
              tlm(ng)%Nrec(fcount)=0
              tlm(ng)%Rindex=0
            END IF
          END IF
        END DO
!
!-----------------------------------------------------------------------
!  Clear tangent linear state variables. There is not need to clean
!  the basic state arrays since they were zeroth out at initialization
!  and bottom of previous iteration.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL initialize_ocean (ng, tile, itlm)
          END DO
        END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero time-averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=last_tile(ng),first_tile(ng),-1
            CALL set_depth (ng, tile, itlm)
          END DO
        END DO
#endif
!
!-----------------------------------------------------------------------
!  Unpack tangent linear initial conditions from state vector.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL tl_unpack (ng, tile, nstr(ng), nend(ng),               &
     &                      state(ng)%vector)
          END DO
        END DO
!
!-----------------------------------------------------------------------
!  Compute initial tangent linear state dot product norm.
!-----------------------------------------------------------------------
!
        IF (interval.eq.nintervals+1) THEN
          DO ng=1,ngrids
            DO tile=last_tile(ng),first_tile(ng),-1
              CALL tl_statenorm (ng, tile, kstp(ng), nstp(ng),          &
     &                           statenorm(ng))
            END DO
            IF (master) THEN
              WRITE (stdout,30) ' PROPAGATOR - Grid: ', ng,             &
     &                          ',  Tangent Initial Norm: ',            &
     &                          statenorm(ng)
            END IF
          END DO
        END IF
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
        IF (soruntl) THEN              ! do not run TLM on last interval
          DO ng=1,ngrids
            CALL close_inp (ng, itlm)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
            CALL tl_get_idata (ng)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
            CALL tl_get_data (ng)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END DO
!
!-----------------------------------------------------------------------
!  Time-step the tangent linear model.
!-----------------------------------------------------------------------
!
          DO ng=1,ngrids
            IF (master) THEN
              WRITE (stdout,40) 'TL', ng, ntstart(ng), ntend(ng)
            END IF
            time(ng)=time(ng)-dt(ng)
            iic(ng)=ntstart(ng)-1
          END DO
 
#ifdef SOLVE3D
          CALL tl_main3d (so_run_time)
#else
          CALL tl_main2d (so_run_time)
#endif
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
!
!-----------------------------------------------------------------------
!  Clear nonlinear (basic state) and adjoint state variables.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL initialize_ocean (ng, tile, inlm)
            CALL initialize_ocean (ng, tile, iadm)
#ifdef SOLVE3D
            CALL initialize_coupling (ng, tile, 0)
#endif
          END DO
        END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state final level thicknesses used for state norm
!  scaling. It uses zero time-averaged free-surface (rest state).
!  Therefore, the norm scaling is time invariant.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=last_tile(ng),first_tile(ng),-1
            CALL set_depth (ng, tile, itlm)
          END DO
        END DO
#endif
!
!-----------------------------------------------------------------------
!  Compute final tangent linear state dot product norm.
!-----------------------------------------------------------------------
!
        IF (interval.eq.nintervals+1) THEN
          DO ng=1,ngrids
            DO tile=first_tile(ng),last_tile(ng),+1
              CALL tl_statenorm (ng, tile, kstp(ng), nstp(ng),          &
     &                           statenorm(ng))
            END DO
            IF (master) THEN
              WRITE (stdout,30) ' PROPAGATOR - Grid: ', ng,             &
     &                          ',  Tangent   Final Norm: ',            &
     &                          statenorm(ng)
            END IF
          END DO
        END IF
!
!=======================================================================
!  Backward integration with the adjoint model.
!=======================================================================
!
!  Initialize time stepping indices and counters.
!
        DO ng=1,ngrids
#ifndef STOCH_OPT_WHITE
          lwrtstate2d(ng)=.false.
          lwrtstate3d(ng)=.false.
#endif
          iif(ng)=1
          indx1(ng)=1
          ktmp=knew(ng)
          IF (inttrap.eq.nintervals+1) THEN
            ktmp=kstp(ng)
          END IF
          kstp(ng)=1
          krhs(ng)=3
          knew(ng)=2
          kout=knew(ng)
#ifdef STOCH_OPT_WHITE
          IF (inttrap.eq.nintervals+1) THEN
            kout=kstp(ng)
          END IF
#endif
          predictor_2d_step(ng)=.false.
!
          iic(ng)=0
          ntmp=nstp(ng)
          nstp(ng)=1
          nrhs(ng)=1
          nnew(ng)=2
!
          synchro_flag(ng)=.true.
          tdays(ng)=dstart+dt(ng)*real(ntimes(ng),r8)*sec2day
          time(ng)=tdays(ng)*day2sec
          ntstart(ng)=ntimes(ng)+1
# ifdef STOCH_OPT_WHITE
          ntend(ng)=1+(interval-1)*ntimes(ng)/nintervals
# else
          ntend(ng)=1
# endif
          ntfirst(ng)=ntend(ng)
        END DO
!
!-----------------------------------------------------------------------
!  Initialize adjoint model with the final tangent linear solution
!  scaled by the energy norm.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=last_tile(ng),first_tile(ng),-1
            CALL ad_ini_perturb (ng, tile,                              &
     &                           ktmp, kout, ntmp, nstp(ng))
          END DO
        END DO
!
!-----------------------------------------------------------------------
!  Read in initial forcing, climatology and assimilation data from
!  input NetCDF files.  It loads the first relevant data record for
!  the time-interpolation between snapshots.
!-----------------------------------------------------------------------
!
#ifdef STOCH_OPT_WHITE
        IF (sorunad) THEN              ! do not run ADM on last interval
#endif
          DO ng=1,ngrids
            CALL close_inp (ng, iadm)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
            CALL ad_get_idata (ng)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
            CALL ad_get_data (ng)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END DO
!
!-----------------------------------------------------------------------
!  Time-step the adjoint model backwards.
!-----------------------------------------------------------------------
!
          DO ng=1,ngrids
            IF (master) THEN
              WRITE (stdout,40) 'AD', ng, ntstart(ng), ntend(ng)
            END IF
            time(ng)=time(ng)+dt(ng)
            iic(ng)=ntstart(ng)+1
          END DO
 
#ifdef SOLVE3D
# ifdef STOCH_OPT_WHITE
          CALL ad_main3d (so_run_time)
# else
          CALL ad_main3d (runinterval)
# endif
#else
# ifdef STOCH_OPT_WHITE
          CALL ad_main2d (so_run_time)
# else
          CALL ad_main2d (runinterval)
# endif
#endif
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#ifdef STOCH_OPT_WHITE
        END IF
#endif
!
!-----------------------------------------------------------------------
!  Clear nonlinear state (basic state) variables for next iteration
!  and to insure a rest state time averaged free-surface before adjoint
!  state norm scaling.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL initialize_ocean (ng, tile, inlm)
#ifdef SOLVE3D
            CALL initialize_coupling (ng, tile, 0)
#endif
          END DO
        END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Compute basic state initial level thicknesses used for state norm
!  scaling. It uses zero free-surface (rest state).  Therefore, the
!  norm scaling is time invariant.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=last_tile(ng),first_tile(ng),-1
            CALL set_depth (ng, tile, iadm)
          END DO
        END DO
#endif
!
!-----------------------------------------------------------------------
!  Pack final adjoint solution into adjoint state vector.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
# ifdef STOCH_OPT_WHITE
            CALL ad_so_pack (ng, tile, nstr(ng), nend(ng), inttrap,     &
     &                       ad_state(ng)%vector)
# else
            CALL ad_so_pack_red (ng, tile, nstr(ng), nend(ng),          &
     &                           inttrap, ad_state(ng)%vector)
# endif
          END DO
        END DO
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Clear forcing variables for next iteration.
!-----------------------------------------------------------------------
!
        DO ng=1,ngrids
          DO tile=first_tile(ng),last_tile(ng),+1
            CALL initialize_forces (ng, tile, itlm)
            CALL initialize_forces (ng, tile, iadm)
          END DO
        END DO
 
      END DO interval_loop
!
 10   FORMAT (/,a,i2.2,a,i3.3,a,i3.3/)
 20   FORMAT (/,a,i2.2)
 30   FORMAT (/,a,i2.2,a,1p,e15.6,/)
 40   FORMAT (/,1x,a,1x,'ROMS: started time-stepping:',                 &
     &        ' (Grid: ',i2.2,' TimeSteps: ',i8.8,' - ',i8.8,')')
!
      RETURN

References ad_get_data(), ad_get_idata(), ini_adjust_mod::ad_ini_perturb(), ad_main2d(), ad_main3d(), mod_iounits::adm, close_io_mod::close_inp(), mod_scalars::day2sec, mod_scalars::dstart, mod_scalars::dt, mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_param::iadm, mod_scalars::iic, mod_scalars::iif, mod_scalars::indx1, mod_coupling::initialize_coupling(), mod_forces::initialize_forces(), mod_ocean::initialize_ocean(), mod_param::inlm, mod_param::itlm, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_parallel::last_tile, mod_scalars::ldefadj, mod_scalars::ldeftlm, mod_scalars::lmultigst, mod_scalars::lwrtstate2d, mod_scalars::lwrttlm, mod_parallel::master, mod_scalars::nconv, mod_param::nend, mod_param::ngrids, mod_scalars::nintervals, mod_stepping::nnew, mod_scalars::noerror, mod_stepping::nrhs, mod_scalars::nrun, mod_stepping::nstp, mod_param::nstr, mod_scalars::ntend, mod_scalars::ntfirst, mod_scalars::ntimes, mod_scalars::ntstart, mod_scalars::predictor_2d_step, mod_kinds::r8, mod_scalars::sec2day, set_depth_mod::set_depth(), mod_iounits::stdout, mod_scalars::synchro_flag, mod_scalars::tdays, mod_scalars::time, tl_get_data(), tl_get_idata(), tl_main2d(), tl_main3d(), dotproduct_mod::tl_statenorm(), tl_unpack(), and mod_iounits::tlm.

Here is the call graph for this function:

propagator_so_semi()

subroutine, public propagator_mod::propagator_so_semi	(	real(dp), intent(in)	runinterval,
		type (t_gst), dimension(ngrids), intent(in)	state,
		type (t_gst), dimension(ngrids), intent(inout)	ad_state )

Definition at line 34 of file propagator_so_semi.h.

!***********************************************************************
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_ocean
      USE mod_scalars
      USE mod_stepping
!
#ifdef SO_SEMI_WHITE
      USE packing_mod, ONLY : so_semi_white
#else
      USE packing_mod, ONLY : so_semi_red
#endif
      USE strings_mod, ONLY : founderror
!
!  Imported variable declarations.
!
      real(dp), intent(in) :: RunInterval
!
      TYPE (T_GST), intent(in) :: state(Ngrids)
      TYPE (T_GST), intent(inout) :: ad_state(Ngrids)
!
!  Local variable declarations.
!
      logical, save :: FirstPass = .true.
!
      integer :: ng, tile
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
!=======================================================================
!  Backward integration of adjoint model forced with the seminorm of
!  the chosen functional. The adjoint model is run only only once in
!  the first iteration.
!=======================================================================
!
      nrun=nrun+1
      DO ng=1,ngrids
        sorec(ng)=0
      END DO
!
      first_pass : IF (firstpass) THEN
        firstpass=.false.
!
!  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
!
!  Activate adjoint output.
!
        DO ng=1,ngrids
          ldefadj(ng)=.true.
          lwrtadj(ng)=.true.
          lcycleadj(ng)=.false.
        END DO
!
!  Time-step adjoint model forced with chosen functional at initial
!  time only.
!
        DO ng=1,ngrids
          IF (master) THEN
            WRITE (stdout,10) 'AD', ng, ntstart(ng), ntend(ng)
          END IF
          dstrs(ng)=tdays(ng)
          dends(ng)=dstrs(ng)
        END DO
 
#ifdef SOLVE3D
        CALL ad_main3d (runinterval)
#else
        CALL ad_main2d (runinterval)
#endif
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
      END IF first_pass
!
!-----------------------------------------------------------------------
!  Compute new packed adjoint state vector containing surface forcing
!  variables.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO tile=first_tile(ng),last_tile(ng),+1
# ifdef SO_SEMI_WHITE
          CALL so_semi_white (ng, tile, nstr(ng), nend(ng),             &
     &                        state(ng)%vector,                         &
     &                        ad_state(ng)%vector)
# else
          CALL so_semi_red (ng, tile, nstr(ng), nend(ng),               &
     &                      state(ng)%vector,                           &
     &                      ad_state(ng)%vector)
# endif
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Report iteration and trace or stochastic optimals matrix.
!-----------------------------------------------------------------------
!
      IF (master) THEN
        DO ng=1,ngrids
          WRITE (stdout,20) ' PROPAGATOR - Grid: ', ng,                 &
     &                      ',  Iteration: ', nrun,                     &
     &                      ',  number converged RITZ values: ',        &
     &                      nconv(ng), 'TRnorm = ', trnorm(ng)
        END DO
      END IF
!
 10   FORMAT (/,1x,a,1x,'ROMS: started time-stepping:',                 &
     &        ' (Grid: ',i2.2,' TimeSteps: ',i8.8,' - ',i8.8,')')
 20   FORMAT (/,a,i2.2,a,i3.3,a,i3.3,/,42x,a,1p,e15.8)
!
      RETURN

References ad_initial(), ad_main2d(), ad_main3d(), mod_scalars::dends, mod_scalars::dstrs, mod_scalars::exit_flag, mod_parallel::first_tile, strings_mod::founderror(), mod_parallel::last_tile, mod_scalars::lcycleadj, mod_scalars::ldefadj, mod_scalars::lwrtadj, mod_parallel::master, mod_scalars::nconv, mod_param::nend, mod_param::ngrids, mod_scalars::noerror, mod_scalars::nrun, mod_param::nstr, mod_scalars::ntend, mod_scalars::ntstart, so_semi_red(), so_semi_white(), mod_scalars::sorec, mod_iounits::stdout, mod_scalars::tdays, and mod_scalars::trnorm.

Here is the call graph for this function: