forcing.F

Go to the documentation of this file.

#include "cppdefs.h"
      MODULE forcing_mod
 
#if defined NLM_OUTER         || defined RBL4DVAR || \
    defined sensitivity_4dvar || defined sp4dvar  || \
    defined tl_rbl4dvar
 
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This routine is used to force the nonlinear state equations in      !
!  weak constraint variational data assimilation.                      !
!                                                                      !
!=======================================================================
!
      implicit none
!
      PRIVATE
      PUBLIC  :: forcing
!
      CONTAINS
!
!***********************************************************************
      SUBROUTINE forcing (ng, tile, Kfrc, Nfrc)
!***********************************************************************
!
      USE mod_param
      USE mod_ocean
# ifdef SOLVE3D
      USE mod_coupling
# endif
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile, kfrc, nfrc
!
!  Local variable declarations.
!
# include "tile.h"
!
      CALL forcing_tile (ng, tile,                                      &
     &                   lbi, ubi, lbj, ubj,                            &
     &                   imins, imaxs, jmins, jmaxs,                    &
     &                   kfrc, nfrc,                                    &
# ifdef SOLVE3D
     &                   ocean(ng) % f_t,                               &
     &                   ocean(ng) % f_u,                               &
     &                   ocean(ng) % f_v,                               &
# endif
     &                   ocean(ng) % f_ubar,                            &
     &                   ocean(ng) % f_vbar,                            &
     &                   ocean(ng) % f_zeta,                            &
# ifdef SOLVE3D
     &                   ocean(ng) % t,                                 &
     &                   ocean(ng) % u,                                 &
     &                   ocean(ng) % v,                                 &
# endif
     &                   ocean(ng) % ubar,                              &
     &                   ocean(ng) % vbar,                              &
# ifdef SOLVE3D
     &                   coupling(ng) % Zt_avg1,                        &
# endif
     &                   ocean(ng) % zeta)
!
      RETURN
      END SUBROUTINE forcing
!
!***********************************************************************
      SUBROUTINE forcing_tile (ng, tile,                                &
     &                         LBi, UBi, LBj, UBj,                      &
     &                         IminS, ImaxS, JminS, JmaxS,              &
     &                         Kfrc, Nfrc,                              &
# ifdef SOLVE3D
     &                         f_t, f_u, f_v,                           &
# endif
     &                         f_ubar, f_vbar,                          &
     &                         f_zeta,                                  &
# ifdef SOLVE3D
     &                         t, u, v,                                 &
# endif
     &                         ubar, vbar,                              &
# ifdef SOLVE3D
     &                         Zt_avg1,                                 &
# endif
     &                         zeta)
!***********************************************************************
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_scalars
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile
      integer, intent(in) :: LBi, UBi, LBj, UBj
      integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
      integer, intent(in) :: Kfrc
      integer, intent(in) :: Nfrc
!
# ifdef ASSUMED_SHAPE
#  ifdef SOLVE3D
      real(r8), intent(in) :: f_t(LBi:,LBj:,:,:)
      real(r8), intent(in) :: f_u(LBi:,LBj:,:)
      real(r8), intent(in) :: f_v(LBi:,LBj:,:)
#  endif
      real(r8), intent(in) :: f_ubar(LBi:,LBj:)
      real(r8), intent(in) :: f_vbar(LBi:,LBj:)
      real(r8), intent(in) :: f_zeta(LBi:,LBj:)
#  ifdef SOLVE3D
      real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
      real(r8), intent(inout) :: u(LBi:,LBj:,:,:)
      real(r8), intent(inout) :: v(LBi:,LBj:,:,:)
#  endif
      real(r8), intent(inout) :: ubar(LBi:,LBj:,:)
      real(r8), intent(inout) :: vbar(LBi:,LBj:,:)
#  ifdef SOLVE3D
      real(r8), intent(inout) :: Zt_avg1(LBi:,LBj:)
#  endif
      real(r8), intent(inout) :: zeta(LBi:,LBj:,:)
# else
#  ifdef SOLVE3D
      real(r8), intent(in) :: f_t(LBi:UBi,LBj:UBj,N(ng),NT(ng))
      real(r8), intent(in) :: f_u(LBi:UBi,LBj:UBj,N(ng))
      real(r8), intent(in) :: f_v(LBi:UBi,LBj:UBj,N(ng))
#  endif
      real(r8), intent(in) :: f_ubar(LBi:UBi,LBj:UBj)
      real(r8), intent(in) :: f_vbar(LBi:UBi,LBj:UBj)
      real(r8), intent(in) :: f_zeta(LBi:UBi,LBj:UBj)
#  ifdef SOLVE3D
      real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
      real(r8), intent(inout) :: u(LBi:UBi,LBj:UBj,N(ng),2)
      real(r8), intent(inout) :: v(LBi:UBi,LBj:UBj,N(ng),2)
#  endif
      real(r8), intent(inout) :: ubar(LBi:UBi,LBj:UBj,:)
      real(r8), intent(inout) :: vbar(LBi:UBi,LBj:UBj,:)
#  ifdef SOLVE3D
      real(r8), intent(inout) :: Zt_avg1(LBi:UBi,LBj:UBj)
#  endif
      real(r8), intent(inout) :: zeta(LBi:UBi,LBj:UBj,:)
# endif
!
!  Local variable declarations.
!
      integer :: i, j
# ifdef SOLVE3D
      integer :: itrc, k
# endif
 
# include "set_bounds.h"
!
!-----------------------------------------------------------------------
!  Add adjoint impulse forcing to nonlinear linear state.
!-----------------------------------------------------------------------
!
      IF (domain(ng)%SouthWest_Corner(tile)) THEN
        IF (frequentimpulse(ng)) THEN
          IF (master) WRITE (stdout,10) time_code(ng)
        END IF
# ifdef RPCG
        IF (iauswitch(ng)) THEN
          IF (master) WRITE (stdout,20) time_code(ng)
        END IF
# endif
      END IF
!
!  Free-surface.
!
# ifdef SOLVE3D
      IF (iic(ng).eq.ntstart(ng)) THEN
        DO j=jstrr,jendr
          DO i=istrr,iendr
            zeta(i,j,kfrc)=zeta(i,j,kfrc)+f_zeta(i,j)
          END DO
        END DO
      ELSE
        DO j=jstrr,jendr
          DO i=istrr,iendr
            zt_avg1(i,j)=zt_avg1(i,j)+f_zeta(i,j)
          END DO
        END DO
      END IF
# else
      DO j=jstrr,jendr
        DO i=istrr,iendr
          zeta(i,j,kfrc)=zeta(i,j,kfrc)+f_zeta(i,j)
        END DO
      END DO
# endif
 
# ifndef SOLVE3D
!
!  2D momentum.
!
      DO j=jstrr,jendr
        DO i=istr,iendr
          ubar(i,j,kfrc)=ubar(i,j,kfrc)+f_ubar(i,j)
        END DO
      END DO
!
      DO j=jstr,jendr
        DO i=istrr,iendr
          vbar(i,j,kfrc)=vbar(i,j,kfrc)+f_vbar(i,j)
        END DO
      END DO
 
# else
!
!  3D momentum.
!
      DO k=1,n(ng)
        DO j=jstrr,jendr
          DO i=istr,iendr
            u(i,j,k,nfrc)=u(i,j,k,nfrc)+f_u(i,j,k)
          END DO
        END DO
        DO j=jstr,jendr
          DO i=istrr,iendr
            v(i,j,k,nfrc)=v(i,j,k,nfrc)+f_v(i,j,k)
          END DO
        END DO
      END DO
!
!  Tracers.
!
      DO itrc=1,nt(ng)
        DO k=1,n(ng)
          DO j=jstrr,jendr
            DO i=istrr,iendr
              t(i,j,k,nfrc,itrc)=t(i,j,k,nfrc,itrc)+                    &
     &                           f_t(i,j,k,itrc)
            END DO
          END DO
        END DO
      END DO
# endif
!
 10   FORMAT (2x,'NL_FORCING       - added convolved adjoint impulse,', &
     &        t71,'t = ', a)
# ifdef RPCG
 20   FORMAT (2x,'NL_FORCING       - incremental analysis update,    ', &
     &        t71,'t = ', a)
# endif
!
      RETURN
      END SUBROUTINE forcing_tile
#endif
      END MODULE forcing_mod