ana_scope.h

Go to the documentation of this file.

!!
      SUBROUTINE ana_scope (ng, tile, model)
!
!! git $Id$
!!======================================================================
!! Copyright (c) 2002-2025 The ROMS Group                              !
!!   Licensed under a MIT/X style license                              !
!!   See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This subroutine sets analytical adjoint sensitivity spatial scope   !
!  masking arrays.                                                     !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_grid
      USE mod_ncparam
!
! Imported variable declarations.
!
      integer, intent(in) :: ng, tile, model
!
!  Local variable declarations.
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
#include "tile.h"
!
      CALL ana_scope_tile (ng, tile, model,                             &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     imins, imaxs, jmins, jmaxs,                  &
#ifdef MASKING
     &                     grid(ng) % rmask,                            &
     &                     grid(ng) % umask,                            &
     &                     grid(ng) % vmask,                            &
#endif
     &                     grid(ng) % Rscope,                           &
     &                     grid(ng) % Uscope,                           &
     &                     grid(ng) % Vscope)
!
! Set analytical header file name used.
!
#ifdef DISTRIBUTE
      IF (lanafile) THEN
#else
      IF (lanafile.and.(tile.eq.0)) THEN
#endif
        ananame(22)=myfile
      END IF
!
      RETURN
      END SUBROUTINE ana_scope
!
!***********************************************************************
      SUBROUTINE ana_scope_tile (ng, tile, model,                       &
     &                           LBi, UBi, LBj, UBj,                    &
     &                           IminS, ImaxS, JminS, JmaxS,            &
#ifdef MASKING
     &                           rmask, umask, vmask,                   &
#endif
     &                           Rscope, Uscope, Vscope)
!***********************************************************************
!
      USE mod_param
      USE mod_scalars
!
      USE exchange_2d_mod
#ifdef DISTRIBUTE
      USE mp_exchange_mod, ONLY : mp_exchange2d
#endif
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile, model
      integer, intent(in) :: LBi, UBi, LBj, UBj
      integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
#ifdef ASSUMED_SHAPE
# ifdef MASKING
      real(r8), intent(in) :: rmask(LBi:,LBj:)
      real(r8), intent(in) :: umask(LBi:,LBj:)
      real(r8), intent(in) :: vmask(LBi:,LBj:)
# endif
      real(r8), intent(out) :: Rscope(LBi:,LBj:)
      real(r8), intent(out) :: Uscope(LBi:,LBj:)
      real(r8), intent(out) :: Vscope(LBi:,LBj:)
#else
# ifdef MASKING
      real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
      real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
      real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
# endif
      real(r8), intent(out) :: Rscope(LBi:UBi,LBj:UBj)
      real(r8), intent(out) :: Uscope(LBi:UBi,LBj:UBj)
      real(r8), intent(out) :: Vscope(LBi:UBi,LBj:UBj)
#endif
!
!  Local variable declarations.
!
      integer :: Imin, Imax, Jmin, Jmax, i, j
!
      real(r8) :: scope(IminS:ImaxS,JminS:JmaxS)
 
#include "set_bounds.h"
!
!-----------------------------------------------------------------------
!  Set Land/Sea mask of RHO-points: Land=0, Sea=1.
!-----------------------------------------------------------------------
!
!  Notice that private scratch array "mask" is used to allow
!  computation within a parallel loop.
!
#ifdef DOUBLE_GYRE
      imin=-5+(lm(ng)+1)/2
      imax=imin+10
      jmin=-5+(mm(ng)+1)/2
      jmax=jmin+10
 
      DO j=jstrm2,jendp2
        DO i=istrm2,iendp2
          scope(i,j)=0.0_r8
          IF (((imin.le.i).and.(i.le.imax)).and.                        &
     &        ((jmin.le.j).and.(j.le.jmax))) THEN
            scope(i,j)=1.0_r8
          END IF
        END DO
      END DO
#else
      ana_scope.h: no values provided for spatial scope masking.
#endif
!
      DO j=jstrt,jendt
        DO i=istrt,iendt
          rscope(i,j)=scope(i,j)
#ifdef MASKING
          rscope(i,j)=rscope(i,j)*rmask(i,j)
#endif
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Compute Land/Sea mask of U- and V-points.
!-----------------------------------------------------------------------
!
      DO j=jstrt,jendt
        DO i=istrp,iendt
          uscope(i,j)=scope(i-1,j)*scope(i,j)
#ifdef MASKING
          uscope(i,j)=uscope(i,j)*umask(i,j)
#endif
        END DO
      END DO
      DO j=jstrp,jendt
        DO i=istrt,iendt
          vscope(i,j)=scope(i,j-1)*scope(i,j)
#ifdef MASKING
          vscope(i,j)=vscope(i,j)*vmask(i,j)
#endif
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Exchange boundary edges.
!-----------------------------------------------------------------------
!
      IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
        CALL exchange_r2d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj,                     &
     &                          rscope)
        CALL exchange_u2d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj,                     &
     &                          uscope)
        CALL exchange_v2d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj,                     &
     &                          vscope)
      END IF
 
#ifdef DISTRIBUTE
      CALL mp_exchange2d (ng, tile, model, 3,                           &
     &                    lbi, ubi, lbj, ubj,                           &
     &                    nghostpoints,                                 &
     &                    ewperiodic(ng), nsperiodic(ng),               &
     &                    rscope, uscope, vscope)
#endif
!
      RETURN
      END SUBROUTINE ana_scope_tile