vwalk_floats.F

Go to the documentation of this file.

#include "cppdefs.h"
      MODULE vwalk_floats_mod
 
#if defined NONLINEAR && defined FLOATS && defined FLOAT_VWALK && \
    defined solve3d
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group              Mark Hadfield   !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  These routines compute nudging velocities for vertical random walk. !
!                                                                      !
!  Reference:                                                          !
!                                                                      !
!  Hunter, J.R, P.D. Craig, and H.E. Philips, 1993: On the use of      !
!    random walk models with spatially variable diffusivity,           !
!    Journal of Computational Physics, 106, 366-376.                   !
!                                                                      !
!=======================================================================
!
      implicit none
!
      PRIVATE
      PUBLIC  :: vwalk_floats
!
      CONTAINS
!
!***********************************************************************
      SUBROUTINE vwalk_floats (ng, Lstr, Lend, Predictor,               &
     &                         my_thread, nudg)
!***********************************************************************
!
      USE mod_param
      USE mod_floats
      USE mod_stepping
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, lstr, lend
 
      logical, intent(in) :: predictor
# ifdef ASSUMED_SHAPE
      logical, intent(in) :: my_thread(lstr:)
 
      real(r8), intent(inout) :: nudg(lstr:)
# else
      logical, intent(in) :: my_thread(lstr:lend)
 
      real(r8), intent(inout) :: nudg(lstr:lend)
# endif
!
!  Local variable declarations.
!
      character (len=*), parameter :: myfile =                          &
     &  __FILE__
!
# ifdef PROFILE
      CALL wclock_on (ng, inlm, 10, __line__, myfile)
# endif
      CALL vwalk_floats_tile (ng, lstr, lend,                           &
     &                        nfm3(ng), nfm2(ng), nfm1(ng), nf(ng),     &
     &                        nfp1(ng),                                 &
     &                        predictor, my_thread,                     &
     &                        drifter(ng) % bounded,                    &
     &                        drifter(ng) % Tinfo,                      &
     &                        drifter(ng) % rwalk,                      &
     &                        nudg,                                     &
     &                        drifter(ng) % track)
# ifdef PROFILE
      CALL wclock_off (ng, inlm, 10, __line__, myfile)
# endif
!
      RETURN
      END SUBROUTINE vwalk_floats
 
!
!***********************************************************************
      SUBROUTINE vwalk_floats_tile (ng, Lstr, Lend,                     &
     &                              nfm3, nfm2, nfm1, nf, nfp1,         &
     &                              Predictor, my_thread, bounded,      &
     &                              Tinfo, rwalk, nudg, track)
!***********************************************************************
!
      USE mod_param
      USE mod_parallel
      USE mod_floats
      USE mod_grid
      USE mod_mixing
      USE mod_ncparam
      USE mod_ocean
      USE mod_scalars
!
      USE interp_floats_mod
# ifdef DISTRIBUTE
      USE distribute_mod, ONLY : mp_bcastf
# endif
      USE nrutil, ONLY : gasdev
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, Lstr, Lend
      integer, intent(in) :: nfm3, nfm2, nfm1, nf, nfp1
      logical, intent(in) :: Predictor
!
# ifdef ASSUMED_SHAPE
      logical, intent(in) :: bounded(:)
      logical, intent(in) :: my_thread(Lstr:)
 
      real(r8), intent(in) :: Tinfo(0:,:)
 
      real(r8), intent(inout) :: rwalk(:)
      real(r8), intent(inout) :: nudg(Lstr:)
      real(r8), intent(inout) :: track(:,0:,:)
# else
      logical, intent(in) :: bounded(Nfloats(ng))
      logical, intent(in) :: my_thread(Lstr:Lend)
 
      real(r8), intent(in) :: Tinfo(0:izrhs,Nfloats(ng))
 
      real(r8), intent(inout) :: rwalk(Nfloats(ng))
      real(r8), intent(inout) :: nudg(Lstr:Lend)
      real(r8), intent(inout) :: track(NFV(ng),0:NFT,Nfloats(ng))
# endif
!
!  Local variable declarations.
!
# ifdef MASKING
      logical, parameter :: Lmask = .true.
# else
      logical, parameter :: Lmask = .false.
# endif
      integer :: LBi, UBi, LBj, UBj
      integer :: i, l, nfindx
      integer :: ierr
 
      real(r8) :: HalfDT, akt, dakt, zrhs
      real(r8) :: cff, cff1, cff2, cff3, cff4
!
! Set tile array bounds.
!
      lbi=lbound(grid(ng)%h,dim=1)
      ubi=ubound(grid(ng)%h,dim=1)
      lbj=lbound(grid(ng)%h,dim=2)
      ubj=ubound(grid(ng)%h,dim=2)
!
!-----------------------------------------------------------------------
!  Compute nudging vertical velocities for random walk.
!-----------------------------------------------------------------------
!
!  Set float time level index to process.
!
      IF (predictor) THEN
        nfindx=nf
      ELSE
        nfindx=nfp1
      END IF
!
!  If predictor step, generate random number sequence.
!
      IF (predictor) THEN
# ifdef DISTRIBUTE
        IF (master) THEN
          CALL gasdev (rwalk)
        END IF
        CALL mp_bcastf (ng, inlm, rwalk)
# else
!$OMP MASTER
        CALL gasdev (rwalk)
!$OMP END MASTER
!$OMP BARRIER
# endif
      END IF
!
!  Interpolate vertical diffusion (temperature) coefficient and its
!  gradient to float locations.
!
      DO l=lstr,lend
        nudg(l)=0.0_r8
      END DO
 
      CALL interp_floats (ng, lbi, ubi, lbj, ubj, 0, n(ng),             &
     &                    lstr, lend, nfindx, ifakt, isbw3d,            &
     &                    w3dvar, lmask, spval, nudg,                   &
     &                    grid(ng) % pm,                                &
     &                    grid(ng) % pn,                                &
     &                    grid(ng) % Hz,                                &
# ifdef MASKING
     &                    grid(ng) % rmask,                             &
# endif
     &                    mixing(ng) % Akt(:,:,:,itemp),                &
     &                    my_thread, bounded, track)
 
      CALL interp_floats (ng, lbi, ubi, lbj, ubj, 1, n(ng),             &
     &                    lstr, lend, nfindx, ifdak, isbr3d,            &
     &                    r3dvar, lmask, spval, nudg,                   &
     &                    grid(ng) % pm,                                &
     &                    grid(ng) % pn,                                &
     &                    grid(ng) % Hz,                                &
# ifdef MASKING
     &                    grid(ng) % rmask,                             &
# endif
     &                    mixing(ng) % dAktdz,                          &
     &                    my_thread, bounded, track)
!
!  Compute nudging velocity coefficients. Use normally distributed
!  random numbers.
!
      cff=2.0_r8/dt(ng)
      DO l=lstr,lend
        IF (my_thread(l).and.bounded(l)) THEN
          nudg(l)=sqrt(cff*max(0.0_r8,track(ifakt,nfindx,l)))*rwalk(l)+ &
     &            track(ifdak,nfindx,l)
        ELSE
          nudg(l)=0.0_r8
        END IF
      END DO
!
!  Interpolate vertical slopes using nudging velocity coefficients.
!
      CALL interp_floats (ng, lbi, ubi, lbj, ubj, 0, n(ng),             &
     &                    lstr, lend, nfindx, izrhs, isbw3d,            &
     &                    -w3dvar, lmask, spval, nudg,                  &
     &                    grid(ng) % pm,                                &
     &                    grid(ng) % pn,                                &
     &                    grid(ng) % Hz,                                &
# ifdef MASKING
     &                    grid(ng) % rmask,                             &
# endif
     &                    ocean(ng) % W,                                &
     &                    my_thread, bounded, track)
!
!  If newly relased float, initialize all time levels.
!
      halfdt=0.5_r8*dt(ng)
 
      DO l=lstr,lend
        IF (my_thread(l).and.bounded(l)) THEN
          IF (time(ng)-halfdt.le.tinfo(itstr,l).and.                    &
     &        time(ng)+halfdt.gt.tinfo(itstr,l)) THEN
            akt =track(ifakt,nfindx,l)
            dakt=track(ifdak,nfindx,l)
            zrhs=track(izrhs,nfindx,l)
            DO i=0,nft
              track(ifakt,i,l)=akt
              track(ifakt,i,l)=dakt
              track(izrhs,i,l)=zrhs
            END DO
          END IF
        END IF
      END DO
!
!-----------------------------------------------------------------------
!  Time step for vertical position.
!-----------------------------------------------------------------------
!
!  Assign predictor/corrector weights.
!
      IF (predictor) THEN
        cff1=8.0_r8/3.0_r8
        cff2=4.0_r8/3.0_r8
      ELSE
        cff1=9.0_r8/8.0_r8
        cff2=1.0_r8/8.0_r8
        cff3=3.0_r8/8.0_r8
        cff4=6.0_r8/8.0_r8
      END IF
!
!  Compute new float vertical position.
!
# ifdef VWALK_FORWARD
#  if defined FLOAT_BIOLOGY
      DO l=lstr,lend
        IF (my_thread(l).and.bounded(l)) THEN
          track(izgrd,nfp1,l)=track(izgrd,nf,l)+                        &
     &                        dt(ng)*(track(izrhs,nf,l)+                &
     &                                track(iwbio,nf,l)*                &
     &                                track(i1ohz,nf,l))
        END IF
      END DO
#  else
      DO l=lstr,lend
        IF (my_thread(l).and.bounded(l)) THEN
          track(izgrd,nfp1,l)=track(izgrd,nf,l)+                        &
     &                        dt(ng)*track(izrhs,nf,l)
        END IF
      END DO
#  endif
# else
#  if defined FLOAT_BIOLOGY
      IF (predictor) THEN
        DO l=lstr,lend
          IF (my_thread(l).and.bounded(l)) THEN
            track(izgrd,nfp1,l)=track(izgrd,nfm3,l)+                    &
     &                          dt(ng)*(cff1*track(izrhs,nf  ,l)-       &
     &                                  cff2*track(izrhs,nfm1,l)+       &
     &                                  cff1*track(izrhs,nfm2,l)+       &
     &                                  cff1*track(iwbio,nf  ,l)*       &
     &                                       track(i1ohz,nf  ,l)-       &
     &                                  cff2*track(iwbio,nfm1,l)*       &
     &                                       track(i1ohz,nfm1,l)+       &
     &                                  cff1*track(iwbio,nfm2,l)*       &
     &                                       track(i1ohz,nfm2,l))
          END IF
        END DO
      ELSE
        DO l=lstr,lend
          IF (my_thread(l).and.bounded(l)) THEN
            track(izgrd,nfp1,l)=cff1*track(izgrd,nf  ,l)-               &
     &                          cff2*track(izgrd,nfm2,l)+               &
     &                          dt(ng)*(cff3*track(izrhs,nfp1,l)+       &
     &                                  cff4*track(izrhs,nf  ,l)-       &
     &                                  cff3*track(izrhs,nfm1,l)+       &
     &                                  cff3*track(iwbio,nfp1,l)*       &
     &                                       track(i1ohz,nfp1,l)+       &
     &                                  cff4*track(iwbio,nf  ,l)*       &
     &                                       track(i1ohz,nf  ,l)-       &
     &                                  cff3*track(iwbio,nfm1,l)*       &
     &                                       track(i1ohz,nf  ,l))
          END IF
        END DO
      END IF
#  else
      IF (predictor) THEN
        DO l=lstr,lend
          IF (my_thread(l).and.bounded(l)) THEN
            track(izgrd,nfp1,l)=track(izgrd,nfm3,l)+                    &
     &                          dt(ng)*(cff1*track(izrhs,nf  ,l)-       &
     &                                  cff2*track(izrhs,nfm1,l)+       &
     &                                  cff1*track(izrhs,nfm2,l))
          END IF
        END DO
      ELSE
        DO l=lstr,lend
          IF (my_thread(l).and.bounded(l)) THEN
            track(izgrd,nfp1,l)=cff1*track(izgrd,nf  ,l)-               &
     &                          cff2*track(izgrd,nfm2,l)+               &
     &                          dt(ng)*(cff3*track(izrhs,nfp1,l)+       &
     &                                  cff4*track(izrhs,nf  ,l)-       &
     &                                  cff3*track(izrhs,nfm1,l))
          END IF
        END DO
      END IF
#  endif
# endif
!
!  Zeroth-out nudging velocities coefficients.
!
      DO l=lstr,lend
        nudg(l)=0.0_r8
      END DO
!
      RETURN
      END SUBROUTINE vwalk_floats_tile
#endif
      END MODULE vwalk_floats_mod