set_data.F

Go to the documentation of this file.

#include "cppdefs.h"
#ifdef NONLINEAR
      SUBROUTINE set_data (ng, tile)
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This subroutine processes forcing, boundary, climatology, and       !
!  other input data. It time-interpolates between snapshots.           !
!                                                                      !
!=======================================================================
!
      USE mod_param
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile
!
!  Local variable declarations.
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
# include "tile.h"
!
# ifdef PROFILE
      CALL wclock_on (ng, inlm, 4, __line__, myfile)
# endif
      CALL set_data_tile (ng, tile,                                     &
     &                    lbi, ubi, lbj, ubj,                           &
     &                    imins, imaxs, jmins, jmaxs)
# ifdef PROFILE
      CALL wclock_off (ng, inlm, 4, __line__, myfile)
# endif
!
      RETURN
      END SUBROUTINE set_data
!
!***********************************************************************
      SUBROUTINE set_data_tile (ng, tile,                               &
     &                          LBi, UBi, LBj, UBj,                     &
     &                          IminS, ImaxS, JminS, JmaxS)
!***********************************************************************
!
      USE mod_param
# if defined HYPOXIA_SRM || defined RED_TIDE
      USE mod_biology
# endif
      USE mod_boundary
      USE mod_clima
      USE mod_forces
      USE mod_grid
      USE mod_mixing
      USE mod_ncparam
      USE mod_ocean
      USE mod_stepping
      USE mod_scalars
      USE mod_sources
!
# ifdef ANALYTICAL
      USE analytical_mod
# endif
      USE exchange_2d_mod
      USE set_2dfld_mod
# ifdef SOLVE3D
      USE set_3dfld_mod
# endif
# ifdef DISTRIBUTE
#  ifdef WET_DRY
      USE distribute_mod,  ONLY : mp_boundary
#  endif
      USE mp_exchange_mod, ONLY : mp_exchange2d
#  ifdef SOLVE3D
      USE mp_exchange_mod, ONLY : mp_exchange3d
#  endif
# endif
      USE strings_mod,     ONLY : founderror
!
      implicit none
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile
      integer, intent(in) :: LBi, UBi, LBj, UBj
      integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
!  Local variable declarations.
!
      logical :: Lprocess, SetBC
      logical :: update = .false.
# ifdef WET_DRY
      logical :: bry_update
# endif
!
      integer :: ILB, IUB, JLB, JUB
      integer :: i, ic, itrc, j, k, my_tile
!
      real(r8) :: cff, cff1, cff2
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", set_data_tile"
!
# include "set_bounds.h"
!
!  Lower and upper bounds for nontiled (global values) boundary arrays.
!
      my_tile=-1                           ! for global values
      ilb=bounds(ng)%LBi(my_tile)
      iub=bounds(ng)%UBi(my_tile)
      jlb=bounds(ng)%LBj(my_tile)
      jub=bounds(ng)%UBj(my_tile)
!
!=======================================================================
!  Set point Sources/Sinks (river runoff).
!=======================================================================
!
!  Point Source/Sink vertically integrated mass transport.
!
# ifdef ANA_PSOURCE
      IF (luvsrc(ng).or.lwsrc(ng).or.any(ltracersrc(:,ng))) THEN
        CALL ana_psource (ng, tile, inlm)
      END IF
# else
      IF (domain(ng)%SouthWest_Test(tile)) THEN
        IF (luvsrc(ng).or.lwsrc(ng)) THEN
          CALL set_ngfld (ng, inlm, idrtra, 1, nsrc(ng), 1,             &
     &                    1, nsrc(ng), 1,                               &
     &                    sources(ng) % QbarG,                          &
     &                    sources(ng) % Qbar,                           &
     &                    update)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#  ifdef SOLVE3D
          DO k=1,n(ng)
            DO i=1,nsrc(ng)
              sources(ng)%Qsrc(i,k)=sources(ng)%Qbar(i)*                &
     &                              sources(ng)%Qshape(i,k)
            END DO
          END DO
#  endif
        END IF
 
#  ifdef SOLVE3D
!
!  Tracer Sources/Sinks.
!
        DO itrc=1,nt(ng)
          IF (ltracersrc(itrc,ng)) THEN
            CALL set_ngfld (ng, inlm, idrtrc(itrc), 1, nsrc(ng), n(ng), &
     &                      1, nsrc(ng), n(ng),                         &
     &                      sources(ng) % TsrcG(:,:,:,itrc),            &
     &                      sources(ng) % Tsrc(:,:,itrc),               &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END DO
#  endif
      END IF
# endif
!
!=======================================================================
!  Set forcing data.
!=======================================================================
!
!  Set switch to process surface atmospheric fields.
!
# if defined FOUR_DVAR   && \
     defined bulk_fluxes && defined prior_bulk_fluxes
!  In 4D-Var data assimilation applications, the user have the option
!  to fix the prior (background phase) surface fluxes in the successive
!  outer loops (Nouter>1) or the final analysis phase. In such case, the
!  fluxes are read from the background trajectory.
!
      IF (nrun.eq.1) THEN
        lprocess=.true.
      ELSE
        lprocess=.false.
      END IF
# else
      lprocess=.true.
# endif
 
# ifdef SOLVE3D
 
#  ifdef CLOUDS
!
!  Set cloud fraction (nondimensional).  Notice that clouds are
!  processed first in case that they are used to adjust shortwave
!  radiation.
!
      IF (lprocess) THEN
#   ifdef ANA_CLOUD
        CALL ana_cloud (ng, tile, inlm)
#   elif (defined FRC_COUPLING && defined TIME_INTERP) || \
         !defined FRC_COUPLING
        CALL set_2dfld_tile (ng, tile, inlm, idcfra,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%cloudG,                         &
     &                       forces(ng)%cloud,                          &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
      END IF
#  endif
 
#  if defined BULK_FLUXES || defined ECOSIM  || \
    (defined shortwave && defined ana_srflux && defined albedo)
!
!  Set surface air temperature (degC).
!
      IF (lprocess) THEN
#   ifdef ANA_TAIR
        CALL ana_tair (ng, tile, inlm)
#   elif (defined FRC_COUPLING && defined TIME_INTERP) || \
         !defined FRC_COUPLING
        CALL set_2dfld_tile (ng, tile, inlm, idtair,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%TairG,                          &
     &                       forces(ng)%Tair,                           &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
      END IF
#  endif
 
#  if defined BULK_FLUXES || defined ECOSIM   || \
     (defined shortwave && defined ana_srflux && defined albedo)
!
!  Set surface air relative or specific humidity.
!
      IF (lprocess) THEN
#   ifdef ANA_HUMIDITY
        CALL ana_humid (ng, tile, inlm)
#   elif (defined FRC_COUPLING && defined TIME_INTERP) || \
         !defined FRC_COUPLING
        CALL set_2dfld_tile (ng, tile, inlm, idqair,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%HairG,                          &
     &                       forces(ng)%Hair,                           &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
      END IF
#  endif
 
#  ifdef SHORTWAVE
!
!  Set kinematic surface solar shortwave radiation flux (degC m/s).
!
#   ifdef ANA_SRFLUX
      CALL ana_srflux (ng, tile, inlm)
#   elif (defined FRC_COUPLING && defined TIME_INTERP) || \
         !defined FRC_COUPLING
      CALL set_2dfld_tile (ng, tile, inlm, idsrad,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%srflxG,                           &
     &                     forces(ng)%srflx,                            &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
 
#   ifdef DIURNAL_SRFLUX
!
!  Modulate the averaged shortwave radiation flux by the local diurnal
!  cycle.
!
      IF (lprocess) THEN
        CALL ana_srflux (ng, tile, inlm)
      END IF
#   endif
#  endif
 
#  if defined RED_TIDE && defined DAILY_SHORTWAVE
!
!  Set kinematic daily-averaged surface solar shortwave radiation flux
!  (degC m/s).
!
      CALL set_2dfld_tile (ng, tile, inlm, idasrf,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%srflxG_avg,                       &
     &                     forces(ng)%srflx_avg,                        &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#  endif
 
#  if defined BULK_FLUXES     && \
    !(defined LONGWAVE        || defined LONGWAVE_OUT) && \
     ( (defined frc_coupling  && defined time_interp)  || \
       !defined FRC_COUPLING )
!
!  Surface net longwave radiation (degC m/s).
!
      IF (lprocess) THEN
        CALL set_2dfld_tile (ng, tile, inlm, idlrad,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%lrflxG,                         &
     &                       forces(ng)%lrflx,                          &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF
#  endif
 
#  if defined LONGWAVE_OUT   && defined BULK_FLUXES  && \
     ( (defined frc_coupling && defined time_interp) || \
       !defined FRC_COUPLING )
!
!  Surface downwelling longwave radiation (degC m/s).
!
      IF (lprocess) THEN
        CALL set_2dfld_tile (ng, tile, inlm, idldwn,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%lrflxG,                         &
     &                       forces(ng)%lrflx,                          &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF
#  endif
 
#  if defined BULK_FLUXES || defined ECOSIM
!
!  Set surface winds (m/s).
!
      IF (lprocess) THEN
#   ifdef ANA_WINDS
        CALL ana_winds (ng, tile, inlm)
#   elif (defined FRC_COUPLING && defined TIME_INTERP) || \
         !defined FRC_COUPLING
        CALL set_2dfld_tile (ng, tile, inlm, iduair,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%UwindG,                         &
     &                       forces(ng)%Uwind,                          &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        CALL set_2dfld_tile (ng, tile, inlm, idvair,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%VwindG,                         &
     &                       forces(ng)%Vwind,                          &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#    ifdef CURVGRID
!
!  If input point surface winds or interpolated from coarse data, rotate
!  to curvilinear grid.
!
        IF (.not.linfo(1,iduair,ng).or.                                 &
     &      (iinfo(5,iduair,ng).ne.lm(ng)+2).or.                        &
     &      (iinfo(6,iduair,ng).ne.mm(ng)+2)) THEN
          DO j=jstrr,jendr
            DO i=istrr,iendr
              cff1=forces(ng)%Uwind(i,j)*grid(ng)%CosAngler(i,j)+       &
     &             forces(ng)%Vwind(i,j)*grid(ng)%SinAngler(i,j)
              cff2=forces(ng)%Vwind(i,j)*grid(ng)%CosAngler(i,j)-       &
     &             forces(ng)%Uwind(i,j)*grid(ng)%SinAngler(i,j)
              forces(ng)%Uwind(i,j)=cff1
              forces(ng)%Vwind(i,j)=cff2
            END DO
          END DO
 
          IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
            CALL exchange_r2d_tile (ng, tile,                           &
     &                              lbi, ubi, lbj, ubj,                 &
     &                              forces(ng)%UWind)
            CALL exchange_r2d_tile (ng, tile,                           &
     &                              lbi, ubi, lbj, ubj,                 &
     &                              forces(ng)%VWind)
          END IF
 
#     ifdef DISTRIBUTE
          CALL mp_exchange2d (ng, tile, inlm, 2,                        &
     &                        lbi, ubi, lbj, ubj,                       &
     &                        nghostpoints,                             &
     &                        ewperiodic(ng), nsperiodic(ng),           &
     &                        forces(ng)%UWind,                         &
     &                        forces(ng)%VWind)
#     endif
        END IF
#    endif
#   endif
      END IF
#  endif
 
#  ifdef BULK_FLUXES
!
!  Set rain fall rate (kg/m2/s).
!
      IF (lprocess) THEN
#   ifdef ANA_RAIN
        CALL ana_rain (ng, tile, inlm)
#   elif (defined FRC_COUPLING && defined TIME_INTERP) || \
         !defined FRC_COUPLING
        CALL set_2dfld_tile (ng, tile, inlm, idrain,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%rainG,                          &
     &                       forces(ng)%rain,                           &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
      END IF
#  endif
 
#  ifndef BULK_FLUXES
!
!  Set kinematic surface net heat flux (degC m/s).
!
#   ifdef ANA_STFLUX
      CALL ana_stflux (ng, tile, inlm, itemp)
#   elif (defined FRC_COUPLING && defined TIME_INTERP) || \
         !defined FRC_COUPLING
      CALL set_2dfld_tile (ng, tile, inlm, idtsur(itemp),               &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%stfluxG(:,:,:,itemp),             &
     &                     forces(ng)%stflux (:,:,itemp),               &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
#  endif
 
#  ifdef QCORRECTION
!
!  Set sea surface temperature (SST) and heat flux sensitivity to
!  SST (dQdSST) which are used for surface heat flux correction.
!
#   ifdef ANA_SST
      CALL ana_sst (ng, tile, inlm)
#   else
      CALL set_2dfld_tile (ng, tile, inlm, idsstc,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%sstG,                             &
     &                     forces(ng)%sst,                              &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
!
#   ifdef ANA_DQDSST
      CALL ana_dqdsst (ng, tile, inlm)
#   else
      CALL set_2dfld_tile (ng, tile, inlm, iddqdt,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%dqdtG,                            &
     &                     forces(ng)%dqdt,                             &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
#  endif
!
!  Set kinematic bottom net heat flux (degC m/s).
!
#  ifdef ANA_BTFLUX
      CALL ana_btflux (ng, tile, inlm, itemp)
#  else
      CALL set_2dfld_tile (ng, tile, inlm, idtbot(itemp),               &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%btfluxG(:,:,:,itemp),             &
     &                     forces(ng)%btflux (:,:,itemp),               &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#  endif
 
#  ifdef SALINITY
#   ifdef ANA_SSFLUX
!
!  Surface freshwater (E-P) flux (m/s) from analytical function.
!
      CALL ana_stflux (ng, tile, inlm, isalt)
#   else
 
#    if !(defined BULK_FLUXES  || defined EMINUSP      || \
          defined frc_coupling)
!
!  Surface freshwater (E-P) flux (m/s) from NetCDF variable "swflux".
!
      CALL set_2dfld_tile (ng, tile, inlm, idsfwf,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%stfluxG(:,:,:,isalt),             &
     &                     forces(ng)%stflux (:,:,isalt),               &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#    elif defined BULK_FLUXES  && !defined EMINUSP
!
!  Surface freshwater (E-P) flux (m/s) from NetCDF variable "EminusP".
!
      IF (lprocess) THEN
        CALL set_2dfld_tile (ng, tile, inlm, idempf,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%stfluxG(:,:,:,isalt),           &
     &                       forces(ng)%stflux (:,:,isalt),             &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF
#    endif
#   endif
 
#   if defined SCORRECTION || defined SRELAXATION
!
!  Set surface salinity for freshwater flux correction.
!
#    ifdef ANA_SSS
      CALL ana_sss (ng, tile, inlm)
#    else
      CALL set_2dfld_tile (ng, tile, inlm, idsssc,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%sssG,                             &
     &                     forces(ng)%sss,                              &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#    endif
#   endif
!
!  Set kinematic bottom salt flux (m/s).
!
#   ifdef ANA_BSFLUX
      CALL ana_btflux (ng, tile, inlm, isalt)
#   else
      CALL set_2dfld_tile (ng, tile, inlm, idtbot(isalt),               &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%btfluxG(:,:,:,isalt),             &
     &                     forces(ng)%btflux (:,:,isalt),               &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
#  endif
 
#  if defined BIOLOGY || defined SEDIMENT || defined T_PASSIVE
!
!  Set kinematic surface and bottom passive tracer fluxes (T m/s).
!
      DO itrc=nat+1,nt(ng)
#   ifdef ANA_SPFLUX
        CALL ana_stflux (ng, tile, inlm, itrc)
#   else
        CALL set_2dfld_tile (ng, tile, inlm, idtsur(itrc),              &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%stfluxG(:,:,:,itrc),            &
     &                       forces(ng)%stflux (:,:,itrc),              &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
#   ifdef ANA_BPFLUX
        CALL ana_btflux (ng, tile, inlm, itrc)
#   else
        CALL set_2dfld_tile (ng, tile, inlm, idtbot(itrc),              &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%btfluxG(:,:,:,itrc),            &
     &                       forces(ng)%btflux (:,:,itrc),              &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
      END DO
#  endif
# endif
 
# ifndef BULK_FLUXES
!
!  Set kinematic surface momentum flux (m2/s2).
!
#  ifdef ANA_SMFLUX
      CALL ana_smflux (ng, tile, inlm)
#  elif (defined FRC_COUPLING && defined TIME_INTERP) || \
        !defined FRC_COUPLING
      CALL set_2dfld_tile (ng, tile, inlm, idusms,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%sustrG,                           &
     &                     forces(ng)%sustr,                            &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
      CALL set_2dfld_tile (ng, tile, inlm, idvsms,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%svstrG,                           &
     &                     forces(ng)%svstr,                            &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#   ifdef CURVGRID
!
!  If input point wind stress, rotate to curvilinear grid.  Notice
!  that rotation is done at RHO-points. It does not matter.
!
      IF (.not.linfo(1,idusms,ng).or.                                   &
     &    (iinfo(5,idusms,ng).ne.lm(ng)+1).or.                          &
     &    (iinfo(6,idusms,ng).ne.mm(ng)+2)) THEN
        DO j=jstrr,jendr
          DO i=istrr,iendr
            cff1=forces(ng)%sustr(i,j)*grid(ng)%CosAngler(i,j)+         &
     &           forces(ng)%svstr(i,j)*grid(ng)%SinAngler(i,j)
            cff2=forces(ng)%svstr(i,j)*grid(ng)%CosAngler(i,j)-         &
     &           forces(ng)%sustr(i,j)*grid(ng)%SinAngler(i,j)
            forces(ng)%sustr(i,j)=cff1
            forces(ng)%svstr(i,j)=cff2
          END DO
        END DO
 
        IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
          CALL exchange_u2d_tile (ng, tile,                             &
     &                            lbi, ubi, lbj, ubj,                   &
     &                            forces(ng)%sustr)
          CALL exchange_v2d_tile (ng, tile,                             &
     &                            lbi, ubi, lbj, ubj,                   &
     &                            forces(ng)%svstr)
        END IF
 
#    ifdef DISTRIBUTE
        CALL mp_exchange2d (ng, tile, inlm, 2,                          &
     &                      lbi, ubi, lbj, ubj,                         &
     &                      nghostpoints,                               &
     &                      ewperiodic(ng), nsperiodic(ng),             &
     &                      forces(ng)%sustr,                           &
     &                      forces(ng)%svstr)
#    endif
      END IF
#   endif
#  endif
# endif
 
# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
!
!  Set surface air pressure (mb).
!
      IF (lprocess) THEN
#  ifdef ANA_PAIR
        CALL ana_pair (ng, tile, inlm)
#  elif (defined FRC_COUPLING && defined TIME_INTERP) || \
        !defined FRC_COUPLING
        setbc=.true.
!       SetBC=.FALSE.
        CALL set_2dfld_tile (ng, tile, inlm, idpair,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%PairG,                          &
     &                       forces(ng)%Pair,                           &
     &                       update, setbc)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#  endif
      END IF
# endif
 
# ifdef WAVE_DATA
!
!  Set surface wind-induced wave amplitude, direction and period.
!
#  ifdef ANA_WWAVE
      CALL ana_wwave (ng, tile, inlm)
#  else
#   ifdef WAVES_DIR
      CALL set_2dfld_tile (ng, tile, inlm, idwdir,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%DwaveG,                           &
     &                     forces(ng)%Dwave,                            &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
#   endif
 
#   ifdef WAVES_DIRP
      CALL set_2dfld_tile (ng, tile, inlm, idwdip,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%DwavepG,                           &
     &                     forces(ng)%Dwavep,                            &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
#   endif
 
#   ifdef WAVES_HEIGHT
      CALL set_2dfld_tile (ng, tile, inlm, idwamp,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%HwaveG,                           &
     &                     forces(ng)%Hwave,                            &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
#   endif
 
#   ifdef WAVES_LENGTH
      CALL set_2dfld_tile (ng, tile, inlm, idwlen,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%LwaveG,                           &
     &                     forces(ng)%Lwave,                            &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
#   endif
 
#   ifdef WAVES_LENGTHP
      CALL set_2dfld_tile (ng, tile, inlm, idwlep,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%LwavepG,                          &
     &                     forces(ng)%Lwavep,                           &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
#   endif
 
#   ifdef WAVES_TOP_PERIOD
      CALL set_2dfld_tile (ng, tile, inlm, idwptp,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%Pwave_topG,                       &
     &                     forces(ng)%Pwave_top,                        &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
#   endif
 
#   ifdef WAVES_BOT_PERIOD
      CALL set_2dfld_tile (ng, tile, inlm, idwpbt,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%Pwave_botG,                       &
     &                     forces(ng)%Pwave_bot,                        &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
#   endif
 
#   if defined WAVES_UB
      CALL set_2dfld_tile (ng, tile, inlm, idworb,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%Uwave_rmsG,                       &
     &                     forces(ng)%Uwave_rms,                        &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
#   endif
 
#   if defined WAVES_DISS
      CALL set_2dfld_tile (ng, tile, inlm, idwdib,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%Dissip_breakG,                    &
     &                     forces(ng)%Dissip_break,                     &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
      CALL set_2dfld_tile (ng, tile, inlm, idwdiw,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%Dissip_wcapG,                     &
     &                     forces(ng)%Dissip_wcap,                      &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
#   endif
 
#   if defined ROLLER_SVENDSEN
      CALL set_2dfld_tile (ng, tile, inlm, idwbrk,                      &
     &                     lbi, ubi, lbj, ubj,                          &
     &                     forces(ng)%Wave_breakG,                      &
     &                     forces(ng)%Wave_break,                       &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
#   endif
#  endif
# endif
 
# if defined ECOSIM && defined SOLVE3D
!
!  Compute spectral irradiance and cosine of average zenith angle of
!  downwelling spectral photons.
!
      CALL ana_specir (ng, tile, inlm)
# endif
 
# ifdef ANA_SPINNING
!
!  Set time-varying rotation force (centripetal accelerations) for
!  polar coordinate grids.
!
      CALL ana_spinning (ng, tile, inlm)
# endif
 
# ifdef HYPOXIA_SRM
!
!  Total respiration rate for hypoxia.
!
#  ifdef ANA_RESPIRATION
      CALL ana_respiration (ng, tile, inlm)
#  else
      CALL set_3dfld_tile (ng, tile, inlm, idresr,                      &
     &                     lbi, ubi, lbj, ubj, 1, n(ng),                &
     &                     ocean(ng)%respirationG,                      &
     &                     ocean(ng)%respiration,                       &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#  endif
# endif
 
# ifdef RED_TIDE
!
!  Red tide Observed Dissolved Inorganic Nutrient.
!
      CALL set_3dfld_tile (ng, tile, inlm, idodin,                      &
     &                     lbi, ubi, lbj, ubj, 1, n(ng),                &
     &                     ocean(ng)%DIN_obsG,                          &
     &                     ocean(ng)%DIN_obs,                           &
     &                     update)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
#if defined FOUR_DVAR   && \
    defined bulk_fluxes && defined prior_bulk_fluxes
!
!=======================================================================
!  In 4D-Var data assimilation algorithms, the user has the option to
!  impose the prior (background phase) surface fluxes in the successive
!  outer loops (Nouter>1) or the final analysis phase. Such fluxes were
!  computed by routine "bulk_fluxes" and stored in the NLM background
!  trajectory, BLK structure. Notice that "bulk_fluxes" is called in
!  "main3d" only during the prior trajectory computation.
!
!  Therefore, the fluxes are time interpolated from the pior snapshots.
!=======================================================================
!
      IF (.not.lprocess) THEN
!
!  Set prior surface wind stress components.
!
        CALL set_2dfld_tile (ng, tile, inlm, idusms,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%sustrG,                         &
     &                       forces(ng)%sustr,                          &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        CALL set_2dfld_tile (ng, tile, inlm, idvsms,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%svstrG,                         &
     &                       forces(ng)%svstr,                          &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef ATM_PRESS
!
!  Set prior surface air pressure.
!
        setbc=.true.
!!      SetBC=.FALSE.
        CALL set_2dfld_tile (ng, tile, inlm, idpair,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%PairG,                          &
     &                       forces(ng)%Pair,                           &
     &                       update, setbc)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# ifdef SOLVE3D
#  ifndef ANA_STFLUX
!
!  Set prior surface net heat flux.
!
        CALL set_2dfld_tile (ng, tile, inlm, idtsur(itemp),             &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%stfluxG(:,:,:,itemp),           &
     &                       forces(ng)%stflux (:,:,itemp),             &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#  endif
 
#  if defined SALINITY && !defined ANA_SSFLUX
!
!  Set prior surface freshwater flux.
!
        CALL set_2dfld_tile (ng, tile, inlm, idempf,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       forces(ng)%stfluxG(:,:,:,isalt),           &
     &                       forces(ng)%stflux (:,:,isalt),             &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#  endif
# endif
      END IF
#endif
!
!=======================================================================
!  Set open boundary conditions fields.
!=======================================================================
!
!  Set free-surface open boundary conditions.
!
      IF (lprocessobc(ng)) THEN
# ifdef ANA_FSOBC
        CALL ana_fsobc (ng, tile, inlm)
# else
        IF (domain(ng)%SouthWest_Test(tile)) THEN
          IF (lbc(iwest,isfsur,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idzbry(iwest), jlb, jub, 1,       &
     &                      0, mm(ng)+1, 1,                             &
     &                      boundary(ng) % zetaG_west,                  &
     &                      boundary(ng) % zeta_west,                   &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(ieast,isfsur,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idzbry(ieast), jlb, jub, 1,       &
     &                      0, mm(ng)+1, 1,                             &
     &                      boundary(ng) % zetaG_east,                  &
     &                      boundary(ng) % zeta_east,                   &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(isouth,isfsur,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idzbry(isouth), ilb, iub, 1,      &
     &                      0, lm(ng)+1 ,1,                             &
     &                      boundary(ng) % zetaG_south,                 &
     &                      boundary(ng) % zeta_south,                  &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(inorth,isfsur,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idzbry(inorth), ilb, iub, 1,      &
     &                      0, lm(ng)+1, 1,                             &
     &                      boundary(ng) % zetaG_north,                 &
     &                      boundary(ng) % zeta_north,                  &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END IF
# endif
 
# if defined WET_DRY
!
!  Ensure that water level on boundary cells is above bed elevation.
!
        IF (lbc(iwest,isfsur,ng)%acquire) THEN
          bry_update=.false.
          IF (domain(ng)%Western_Edge(tile)) THEN
            DO j=jstrr,jendr
              cff=dcrit(ng)-grid(ng)%h(0,j)
              IF (boundary(ng)%zeta_west(j).le.cff) THEN
                boundary(ng)%zeta_west(j)=cff
              END IF
            END DO
            bry_update=.true.
          END IF
#  ifdef DISTRIBUTE
          CALL mp_boundary (ng, inlm, jstrr, jendr, jlb, jub, 1, 1,     &
     &                      bry_update,                                 &
     &                      boundary(ng)%zeta_west)
#  endif
        END IF
!
        IF (lbc(ieast,isfsur,ng)%acquire) THEN
          bry_update=.false.
          IF (domain(ng)%Eastern_Edge(tile)) THEN
            DO j=jstrr,jendr
              cff=dcrit(ng)-grid(ng)%h(lm(ng)+1,j)
              IF (boundary(ng)%zeta_east(j).le.cff) THEN
                boundary(ng)%zeta_east(j)=cff
              END IF
            END DO
            bry_update=.true.
          END IF
#  ifdef DISTRIBUTE
          CALL mp_boundary (ng, inlm, jstrr, jendr, jlb, jub, 1, 1,     &
     &                      bry_update,                                 &
     &                      boundary(ng)%zeta_east)
#  endif
        END IF
!
        IF (lbc(isouth,isfsur,ng)%acquire) THEN
          bry_update=.false.
          IF (domain(ng)%Southern_Edge(tile)) THEN
            DO i=istrr,iendr
              cff=dcrit(ng)-grid(ng)%h(i,0)
              IF (boundary(ng)%zeta_south(i).le.cff) THEN
                boundary(ng)%zeta_south(i)=cff
              END IF
            END DO
            bry_update=.true.
          END IF
#  ifdef DISTRIBUTE
          CALL mp_boundary (ng, inlm, istrr, iendr, ilb, iub, 1, 1,     &
     &                      bry_update,                                 &
     &                      boundary(ng)%zeta_south)
#  endif
        END IF
!
        IF (lbc(inorth,isfsur,ng)%acquire) THEN
          bry_update=.false.
          IF (domain(ng)%Northern_Edge(tile)) THEN
            DO i=istrr,iendr
              cff=dcrit(ng)-grid(ng)%h(i,mm(ng)+1)
              IF (boundary(ng)%zeta_north(i).le.cff) THEN
                boundary(ng)%zeta_north(i)=cff
              END IF
            END DO
            bry_update=.true.
          END IF
#  ifdef DISTRIBUTE
          CALL mp_boundary (ng, inlm, istrr, iendr, ilb, iub, 1, 1,     &
     &                      bry_update,                                 &
     &                      boundary(ng)%zeta_north)
#  endif
        END IF
# endif
      END IF
!
!  Set 2D momentum component open boundary conditions.
!
      IF (lprocessobc(ng)) THEN
# ifdef ANA_M2OBC
        CALL ana_m2obc (ng, tile, inlm)
# else
        IF (domain(ng)%SouthWest_Test(tile)) THEN
          IF (lbc(iwest,isubar,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idu2bc(iwest), jlb, jub, 1,       &
     &                      0, mm(ng)+1, 1,                             &
     &                      boundary(ng) % ubarG_west,                  &
     &                      boundary(ng) % ubar_west,                   &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(iwest,isvbar,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idv2bc(iwest), jlb, jub, 1,       &
     &                      1, mm(ng)+1, 1,                             &
     &                      boundary(ng) % vbarG_west,                  &
     &                      boundary(ng) % vbar_west,                   &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(ieast,isubar,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idu2bc(ieast), jlb, jub, 1,       &
     &                      0, mm(ng)+1, 1,                             &
     &                      boundary(ng) % ubarG_east,                  &
     &                      boundary(ng) % ubar_east,                   &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(ieast,isvbar,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idv2bc(ieast), jlb, jub, 1,       &
     &                      1, mm(ng)+1, 1,                             &
     &                      boundary(ng) % vbarG_east,                  &
     &                      boundary(ng) % vbar_east,                   &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(isouth,isubar,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idu2bc(isouth), ilb, iub, 1,      &
     &                      1, lm(ng)+1, 1,                             &
     &                      boundary(ng) % ubarG_south,                 &
     &                      boundary(ng) % ubar_south,                  &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(isouth,isvbar,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idv2bc(isouth), ilb, iub, 1,      &
     &                      0, lm(ng)+1, 1,                             &
     &                      boundary(ng) % vbarG_south,                 &
     &                      boundary(ng) % vbar_south,                  &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(inorth,isubar,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idu2bc(inorth), ilb, iub, 1,      &
     &                      1, lm(ng)+1, 1,                             &
     &                      boundary(ng) % ubarG_north,                 &
     &                      boundary(ng) % ubar_north,                  &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(inorth,isvbar,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idv2bc(inorth), ilb, iub, 1,      &
     &                      0, lm(ng)+1, 1,                             &
     &                      boundary(ng) % vbarG_north,                 &
     &                      boundary(ng) % vbar_north,                  &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END IF
# endif
      END IF
 
# ifdef SOLVE3D
!
!  Set 3D momentum components open boundary conditions.
!
      IF (lprocessobc(ng)) THEN
#  ifdef ANA_M3OBC
        CALL ana_m3obc (ng, tile, inlm)
#  else
        IF (domain(ng)%SouthWest_Test(tile)) THEN
          IF (lbc(iwest,isuvel,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idu3bc(iwest), jlb, jub, n(ng),   &
     &                      0, mm(ng)+1, n(ng),                         &
     &                      boundary(ng) % uG_west,                     &
     &                      boundary(ng) % u_west,                      &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(iwest,isvvel,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idv3bc(iwest), jlb, jub, n(ng),   &
     &                      1, mm(ng)+1, n(ng),                         &
     &                      boundary(ng) % vG_west,                     &
     &                      boundary(ng) % v_west,                      &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(ieast,isuvel,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idu3bc(ieast), jlb, jub, n(ng),   &
     &                      0, mm(ng)+1, n(ng),                         &
     &                      boundary(ng) % uG_east,                     &
     &                      boundary(ng) % u_east,                      &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(ieast,isvvel,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idv3bc(ieast), jlb, jub, n(ng),   &
     &                      1, mm(ng)+1, n(ng),                         &
     &                      boundary(ng) % vG_east,                     &
     &                      boundary(ng) % v_east,                      &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(isouth,isuvel,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idu3bc(isouth), ilb, iub, n(ng),  &
     &                      1, lm(ng)+1, n(ng),                         &
     &                      boundary(ng) % uG_south,                    &
     &                      boundary(ng) % u_south,                     &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(isouth,isvvel,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idv3bc(isouth), ilb, iub, n(ng),  &
     &                      0, lm(ng)+1, n(ng),                         &
     &                      boundary(ng) % vG_south,                    &
     &                      boundary(ng) % v_south,                     &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(inorth,isuvel,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idu3bc(inorth), ilb, iub, n(ng),  &
     &                      1, lm(ng)+1, n(ng),                         &
     &                      boundary(ng) % uG_north,                    &
     &                      boundary(ng) % u_north,                     &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
!
          IF (lbc(inorth,isvvel,ng)%acquire) THEN
            CALL set_ngfld (ng, inlm, idv3bc(inorth), ilb, iub, n(ng),  &
     &                      0, lm(ng)+1, n(ng),                         &
     &                      boundary(ng) % vG_north,                    &
     &                      boundary(ng) % v_north,                     &
     &                      update)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END IF
#  endif
      END IF
!
!  Set tracer variables open boundary conditions.
!
      IF (lprocessobc(ng)) THEN
#  ifdef ANA_TOBC
        CALL ana_tobc (ng, tile, inlm)
#  else
        IF (domain(ng)%SouthWest_Test(tile)) THEN
           DO itrc=1,nt(ng)
            IF (lbc(iwest,istvar(itrc),ng)%acquire) THEN
              CALL set_ngfld (ng, inlm, idtbry(iwest,itrc),             &
     &                        jlb, jub, n(ng), 0, mm(ng)+1, n(ng),      &
     &                        boundary(ng) % tG_west(:,:,:,itrc),       &
     &                        boundary(ng) % t_west(:,:,itrc),          &
     &                        update)
              IF (founderror(exit_flag, noerror,                        &
     &                       __line__, myfile)) RETURN
            END IF
!
            IF (lbc(ieast,istvar(itrc),ng)%acquire) THEN
              CALL set_ngfld (ng, inlm, idtbry(ieast,itrc),             &
     &                        jlb, jub, n(ng), 0, mm(ng)+1, n(ng),      &
     &                        boundary(ng) % tG_east(:,:,:,itrc),       &
     &                        boundary(ng) % t_east(:,:,itrc),          &
     &                        update)
              IF (founderror(exit_flag, noerror,                        &
     &                       __line__, myfile)) RETURN
            END IF
!
            IF (lbc(isouth,istvar(itrc),ng)%acquire) THEN
              CALL set_ngfld (ng, inlm, idtbry(isouth,itrc),            &
     &                        ilb, iub, n(ng), 0, lm(ng)+1, n(ng),      &
     &                        boundary(ng) % tG_south(:,:,:,itrc),      &
     &                        boundary(ng) % t_south(:,:,itrc),         &
     &                        update)
              IF (founderror(exit_flag, noerror,                        &
     &                       __line__, myfile)) RETURN
            END IF
!
            IF (lbc(inorth,istvar(itrc),ng)%acquire) THEN
              CALL set_ngfld (ng, inlm, idtbry(inorth,itrc),            &
     &                        ilb, iub, n(ng), 0, lm(ng)+1, n(ng),      &
     &                        boundary(ng) % tG_north(:,:,:,itrc),      &
     &                        boundary(ng) % t_north(:,:,itrc),         &
     &                        update)
              IF (founderror(exit_flag, noerror,                        &
     &                       __line__, myfile)) RETURN
            END IF
          END DO
        END IF
#  endif
      END IF
# endif
!
!=======================================================================
!  Set climatology data.
!=====================================================================
!
!  Set sea surface height climatology (m).
!
      IF (lsshclm(ng)) THEN
# ifdef ANA_SSH
        CALL ana_ssh (ng, tile, inlm)
# else
        CALL set_2dfld_tile (ng, tile, inlm, idsshc,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       clima(ng)%sshG,                            &
     &                       clima(ng)%ssh,                             &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
      END IF
!
!  Set 2D momentum components climatology (m/s).
!
      IF (lm2clm(ng)) THEN
# ifdef ANA_M2CLIMA
        CALL ana_m2clima (ng, tile, inlm)
# else
        CALL set_2dfld_tile (ng, tile, inlm, idubcl,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       clima(ng)%ubarclmG,                        &
     &                       clima(ng)%ubarclm,                         &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        CALL set_2dfld_tile (ng, tile, inlm, idvbcl,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       clima(ng)%vbarclmG,                        &
     &                       clima(ng)%vbarclm,                         &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
      END IF
 
# ifdef SOLVE3D
!
!  Set 3D momentum components climatology (m/s).
!
      IF (lm3clm(ng)) THEN
#  ifdef ANA_M3CLIMA
        CALL ana_m3clima (ng, tile, inlm)
#  else
        CALL set_3dfld_tile (ng, tile, inlm, iduclm,                    &
     &                       lbi, ubi, lbj, ubj, 1, n(ng),              &
     &                       clima(ng)%uclmG,                           &
     &                       clima(ng)%uclm,                            &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        CALL set_3dfld_tile (ng, tile, inlm, idvclm,                    &
     &                       lbi, ubi, lbj, ubj, 1, n(ng),              &
     &                       clima(ng)%vclmG,                           &
     &                       clima(ng)%vclm,                            &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#  endif
      END IF
!
!  Set tracer variables climatology.
!
#  ifdef ANA_TCLIMA
      IF (any(ltracerclm(:,ng))) THEN
        CALL ana_tclima (ng, tile, inlm)
      END IF
#  else
      ic=0
      DO itrc=1,nt(ng)
        IF (ltracerclm(itrc,ng)) THEN
          ic=ic+1
          CALL set_3dfld_tile (ng, tile, inlm, idtclm(itrc),            &
     &                         lbi, ubi, lbj, ubj, 1, n(ng),            &
     &                         clima(ng)%tclmG(:,:,:,:,ic),             &
     &                         clima(ng)%tclm (:,:,:,ic),               &
     &                         update)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
      END DO
#  endif
# endif
 
# if defined NLM_OUTER                || \
     defined rbl4dvar                 || \
     defined rbl4dvar_ana_sensitivity || \
     defined rbl4dvar_fct_sensitivity || \
     defined sp4dvar
!
!=======================================================================
!  Set weak contraint forcing.
!=======================================================================
!
      IF (frequentimpulse(ng)) THEN
!
!  Set free-surface forcing.
!
        CALL set_2dfld_tile (ng, tile, inlm, idfsur,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       ocean(ng)%zetaG,                           &
     &                       ocean(ng)%f_zeta,                          &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#  ifndef SOLVE3D
!
!  Set 2D momentum forcing.
!
        CALL set_2dfld_tile (ng, tile, inlm, idubar,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       ocean(ng)%ubarG,                           &
     &                       ocean(ng)%f_ubar,                          &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL set_2dfld_tile (ng, tile, inlm, idvbar,                    &
     &                       lbi, ubi, lbj, ubj,                        &
     &                       ocean(ng)%vbarG,                           &
     &                       ocean(ng)%f_vbar,                          &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#  else
!
!  Set 3D momentum.
!
        CALL set_3dfld_tile (ng, tile, inlm, iduvel,                    &
     &                       lbi, ubi, lbj, ubj, 1, n(ng),              &
     &                       ocean(ng)%uG,                              &
     &                       ocean(ng)%f_u,                             &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        CALL set_3dfld_tile (ng, tile, inlm, idvvel,                    &
     &                       lbi, ubi, lbj, ubj, 1, n(ng),              &
     &                       ocean(ng)%vG,                              &
     &                       ocean(ng)%f_v,                             &
     &                       update)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Set 3D tracers.
!
        DO itrc=1,nt(ng)
          CALL set_3dfld_tile (ng, tile, inlm, idtvar(itrc),            &
     &                         lbi, ubi, lbj, ubj, 1, n(ng),            &
     &                         ocean(ng)%tG(:,:,:,:,itrc),              &
     &                         ocean(ng)%f_t(:,:,:,itrc),               &
     &                         update)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
#  endif
      END IF
# endif
!
      RETURN
      END SUBROUTINE set_data_tile
#else
      SUBROUTINE set_data
      RETURN
      END SUBROUTINE set_data
#endif