ana_mask.h

Go to the documentation of this file.

!!
      SUBROUTINE ana_mask (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 Land/Sea masking.                   !
!                                                                      !
!=======================================================================
!
      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_mask_tile (ng, tile, model,                              &
     &                    lbi, ubi, lbj, ubj,                           &
     &                    imins, imaxs, jmins, jmaxs,                   &
     &                    grid(ng) % pmask,                             &
     &                    grid(ng) % rmask,                             &
     &                    grid(ng) % umask,                             &
     &                    grid(ng) % vmask)
!
! Set analytical header file name used.
!
#ifdef DISTRIBUTE
      IF (lanafile) THEN
#else
      IF (lanafile.and.(tile.eq.0)) THEN
#endif
        ananame(15)=myfile
      END IF
!
      RETURN
      END SUBROUTINE ana_mask
!
!***********************************************************************
      SUBROUTINE ana_mask_tile (ng, tile, model,                        &
     &                          LBi, UBi, LBj, UBj,                     &
     &                          IminS, ImaxS, JminS, JmaxS,             &
     &                          pmask, rmask, umask, vmask)
!***********************************************************************
!
      USE mod_param
      USE mod_parallel
      USE mod_ncparam
      USE mod_iounits
      USE mod_scalars
!
      USE exchange_2d_mod
#ifdef DISTRIBUTE
      USE mp_exchange_mod, ONLY : mp_exchange2d
#endif
      USE stats_mod, ONLY : stats_2dfld
!
!  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
      real(r8), intent(out) :: pmask(LBi:,LBj:)
      real(r8), intent(out) :: rmask(LBi:,LBj:)
      real(r8), intent(out) :: umask(LBi:,LBj:)
      real(r8), intent(out) :: vmask(LBi:,LBj:)
#else
      real(r8), intent(out) :: pmask(LBi:UBi,LBj:UBj)
      real(r8), intent(out) :: rmask(LBi:UBi,LBj:UBj)
      real(r8), intent(out) :: umask(LBi:UBi,LBj:UBj)
      real(r8), intent(out) :: vmask(LBi:UBi,LBj:UBj)
#endif
!
!  Local variable declarations.
!
      logical, save :: first = .true.
!
      integer :: Imin, Imax, Jmin, Jmax
      integer :: i, j
!
      real(r8) :: mask(IminS:ImaxS,JminS:JmaxS)
!
      TYPE (T_STATS), save :: Stats(4)
 
#include "set_bounds.h"
!
!-----------------------------------------------------------------------
!  Initialize field statictics structure.
!-----------------------------------------------------------------------
!
      IF (first) THEN
        first=.false.
        DO i=1,SIZE(stats,1)
          stats(i) % checksum=0_i8b
          stats(i) % count=0
          stats(i) % min=large
          stats(i) % max=-large
          stats(i) % avg=0.0_r8
          stats(i) % rms=0.0_r8
        END DO
      END IF
!
!-----------------------------------------------------------------------
!  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=-2+(lm(ng)+1)/2
      imax=imin+2
      jmin=-2+(mm(ng)+1)/2
      jmax=jmin+2
      DO j=jstrm2,jendp2
        DO i=istrm2,iendp2
          mask(i,j)=1.0_r8
          IF (((imin.le.i).and.(i.le.imax)).and.                        &
     &        ((jmin.le.j).and.(j.le.jmax))) THEN
            mask(i,j)=0.0_r8
          END IF
        END DO
      END DO
#elif defined FLT_TEST
      DO j=jstrm2,jendp2
        DO i=istrm2,iendp2
          mask(i,j)=1.0_r8
          IF (j.eq.1 ) mask(i,j)=0.0_r8
          IF (j.eq.mm(ng)) mask(i,j)=0.0_r8
          IF ((i.ge.((lm(ng)+1)/2)).and.                                &
     &        (i.le.((lm(ng)+1)/2+1)).and.                              &
     &        (j.ge.((mm(ng)+1)/2)).and.                                &
     &        (j.le.((mm(ng)+1)/2+1))) mask(i,j)=0.0_r8
        END DO
      END DO
#elif defined LAKE_SIGNELL
      DO j=jstrm2,jendp2
        DO i=istrm2,iendp2
          mask(i,j)=1.0_r8
        END DO
      END DO
      IF (domain(ng)%Western_Edge(tile)) THEN
        DO j=jstrm1,jendp1
          mask(istr-1,j)=0.0_r8
        END DO
      END IF
      IF (domain(ng)%Eastern_Edge(tile)) THEN
        DO j=jstrm1,jendp1
          mask(iend+1,j)=0.0_r8
        END DO
      END IF
      IF (domain(ng)%Southern_Edge(tile)) THEN
        DO i=istrm1,iendp1
          mask(i,jstr-1)=0.0_r8
        END DO
      END IF
      IF (domain(ng)%Northern_Edge(tile)) THEN
        DO i=istrm1,iendp1
          mask(i,jend+1)=0.0_r8
        END DO
      END IF
#elif defined RIVERPLUME1
      DO j=jstrm2,jendp2
        DO i=istrm2,iendp2
          mask(i,j)=1.0_r8
        END DO
      END DO
      DO i=istrm2,min(5,iendp2)
        DO j=jstrm2,min(mm(ng)-18,jendp2)
          mask(i,j)=0.0_r8
        END DO
        DO j=max(jstrm2,mm(ng)-16),jendp2
          mask(i,j)=0.0_r8
        END DO
      END DO
#elif defined RIVERPLUME2
      DO j=jstrm2,jendp2
        DO i=istrm2,iendp2
          mask(i,j)=1.0_r8
        END DO
      END DO
      DO i=istrm2,min(5,iendp2)
        DO j=jstrm2,min(mm(ng)-11,jendp2)
          mask(i,j)=0.0_r8
        END DO
        DO j=max(jstrm2,mm(ng)-9),jendp2
          mask(i,j)=0.0_r8
        END DO
      END DO
#elif defined SHOREFACE
      DO j=jstrm2,jendp2
        DO i=istrm2,iendp2
          mask(i,j)=1.0_r8
        END DO
      END DO
#else
      ana_mask.h: no values provided for mask.
#endif
!
      DO j=jstrt,jendt
        DO i=istrt,iendt
          rmask(i,j)=mask(i,j)
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Compute Land/Sea mask of U- and V-points.
!-----------------------------------------------------------------------
!
      DO j=jstrt,jendt
        DO i=istrp,iendt
          umask(i,j)=mask(i-1,j)*mask(i,j)
        END DO
      END DO
      DO j=jstrp,jendt
        DO i=istrt,iendt
          vmask(i,j)=mask(i,j-1)*mask(i,j)
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Compute Land/Sea mask of PSI-points.
!-----------------------------------------------------------------------
!
      DO j=jstrp,jendt
        DO i=istrp,iendt
          pmask(i,j)=mask(i-1,j-1)*mask(i,j-1)*                         &
     &               mask(i-1,j  )*mask(i,j  )
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Report statitics.
!-----------------------------------------------------------------------
!
      CALL stats_2dfld (ng, tile, inlm, p2dvar, stats(1), 0,            &
     &                  lbi, ubi, lbj, ubj, pmask)
      IF (domain(ng)%NorthEast_Corner(tile)) THEN
        WRITE (stdout,10) 'mask on PSI-points: mask_psi',               &
     &                    ng, stats(1)%min, stats(1)%max
      END IF
      CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(2), 0,            &
     &                  lbi, ubi, lbj, ubj, rmask)
      IF (domain(ng)%NorthEast_Corner(tile)) THEN
        WRITE (stdout,10) 'mask on RHO-points: mask_rho',               &
     &                    ng, stats(2)%min, stats(2)%max
      END IF
      CALL stats_2dfld (ng, tile, inlm, u2dvar, stats(3), 0,            &
     &                  lbi, ubi, lbj, ubj, umask)
      IF (domain(ng)%NorthEast_Corner(tile)) THEN
        WRITE (stdout,10) 'mask on U-points: mask_u',                   &
     &                    ng, stats(3)%min, stats(3)%max
      END IF
      CALL stats_2dfld (ng, tile, inlm, v2dvar, stats(4), 0,            &
     &                  lbi, ubi, lbj, ubj, vmask)
      IF (domain(ng)%NorthEast_Corner(tile)) THEN
        WRITE (stdout,10) 'mask on V-points: mask_v',                   &
     &                    ng, stats(4)%min, stats(4)%max
      END IF
!
!-----------------------------------------------------------------------
!  Exchange boundary data.
!-----------------------------------------------------------------------
!
      IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
        CALL exchange_r2d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj,                     &
     &                          rmask)
        CALL exchange_p2d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj,                     &
     &                          pmask)
        CALL exchange_u2d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj,                     &
     &                          umask)
        CALL exchange_v2d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj,                     &
     &                          vmask)
      END IF
 
#ifdef DISTRIBUTE
      CALL mp_exchange2d (ng, tile, model, 4,                           &
     &                    lbi, ubi, lbj, ubj,                           &
     &                    nghostpoints,                                 &
     &                    ewperiodic(ng), nsperiodic(ng),               &
     &                    rmask, pmask, umask, vmask)
#endif
!
  10  FORMAT (3x,' ANA_MASK    - ',a,/,19x,                             &
     &        '(Grid = ',i2.2,', Min = ',1p,e15.8,0p,                   &
     &                         ' Max = ',1p,e15.8,0p,')')
!
      RETURN
      END SUBROUTINE ana_mask_tile