propagator_so_semi.h

Go to the documentation of this file.

      MODULE propagator_mod
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group            Andrew M. Moore   !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  Stochastic Optimals, Seminorm Estimation:                           !
!                                                                      !
!  This routine is used during the computation of the eigenvectors of  !
!  the stochastic optimals operator  with respect the seminorm of the  !
!  chosen functional.                                                  !
!                                                                      !
!   Reference:                                                         !
!                                                                      !
!     Moore, A.M. et al., 2004: A comprehensive ocean prediction and   !
!       analysis system based on the tangent linear and adjoint of a   !
!       regional ocean model, Ocean Modelling, 7, 227-258.             !
!                                                                      !
!=======================================================================
!
      USE mod_kinds
!
      implicit none
!
      PRIVATE
      PUBLIC  :: propagator_so_semi
!
      CONTAINS
!
!***********************************************************************
      SUBROUTINE propagator_so_semi (RunInterval, state, ad_state)
!***********************************************************************
!
      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
      END SUBROUTINE propagator_so_semi
 
      END MODULE propagator_mod