tl_get_idata.F

Go to the documentation of this file.

#include "cppdefs.h"
#ifdef TANGENT
      SUBROUTINE tl_get_idata (ng)
!
!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 reads input data that needs to be obtained only once.  !
!                                                                      !
!  Currently,  this routine is only executed in serial mode by the     !
!  main thread.                                                        !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_grid
      USE mod_iounits
      USE mod_ncparam
      USE mod_parallel
      USE mod_scalars
      USE mod_sources
      USE mod_stepping
# if defined SSH_TIDES_NOT_YET || defined UV_TIDES_NOT_YET
      USE mod_tides
# endif
!
      USE strings_mod, ONLY : founderror
!
      implicit none
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng
!
!  Local variable declarations.
!
      logical, save :: recordless = .true.
 
      logical, dimension(3) :: update =                                 &
     &         (/ .FALSE., .FALSE., .FALSE. /)
!
      integer :: LBi, UBi, LBj, UBj
      integer :: itrc, is
!
      real(r8) :: time_save = 0.0_r8
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
      sourcefile=myfile
!
!  Lower and upper bounds for tiled arrays.
!
      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)
 
# ifdef PROFILE
!
!-----------------------------------------------------------------------
!  Turn on input data time wall clock.
!-----------------------------------------------------------------------
!
      CALL wclock_on (ng, itlm, 3, __line__, myfile)
# endif
 
# if defined SSH_TIDES_NOT_YET || defined UV_TIDES_NOT_YET
!
!-----------------------------------------------------------------------
!  Tide period, amplitude, phase, and currents.
!-----------------------------------------------------------------------
!
!  Tidal Period.
!
      IF (lprocesstides(ng)) THEN
        IF (iic(ng).eq.0) THEN
          CALL get_ngfld (ng, itlm, idtper, tide(ng)%ncid,              &
#  if defined PIO_LIB && defined DISTRIBUTE
     &                    tide(ng)%pioFile,                             &
#  endif
     &                    1, tide(ng), recordless, update(1),           &
     &                    1, mtc, 1, 1, 1, ntc(ng), 1,                  &
     &                    tides(ng) % Tperiod)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
      END IF
# endif
 
# ifdef SSH_TIDES_NOT_YET
!
!  Tidal elevation amplitude and phase. In order to read data as a
!  function of tidal period, we need to reset the model time variables
!  temporarily.
!
      IF (lprocesstides(ng)) THEN
        IF (iic(ng).eq.0) THEN
          time_save=time(ng)
          time(ng)=8640000.0_r8
          tdays(ng)=time(ng)*sec2day
!
          CALL get_2dfld (ng, itlm, idtzam, tide(ng)%ncid,              &
#  if defined PIO_LIB && defined DISTRIBUTE
     &                    tide(ng)%pioFile,                             &
#  endif
     &                    1, tide(ng), update(1),                       &
     &                    lbi, ubi, lbj, ubj, mtc, ntc(ng),             &
#  ifdef MASKING
     &                    grid(ng) % rmask,                             &
#  endif
     &                    tides(ng) % SSH_Tamp)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
          CALL get_2dfld (ng, itlm, idtzph, tide(ng)%ncid,              &
#  if defined PIO_LIB && defined DISTRIBUTE
     &                    tide(ng)%pioFile,                             &
#  endif
     &                    1, tide(ng), update(1),                       &
     &                    lbi, ubi, lbj, ubj, mtc, ntc(ng),             &
#  ifdef MASKING
     &                    grid(ng) % rmask,                             &
#  endif
     &                    tides(ng) % SSH_Tphase)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
          time(ng)=time_save
          tdays(ng)=time(ng)*sec2day
        END IF
      END IF
# endif
 
# ifdef UV_TIDES_NOT_YET
!
!  Tidal currents angle, phase, major and minor ellipse axis.
!
      IF (lprocesstides(ng)) THEN
        IF (iic(ng).eq.0) THEN
          time_save=time(ng)
          time(ng)=8640000.0_r8
          tdays(ng)=time(ng)*sec2day
!
          CALL get_2dfld (ng, itlm, idtvan, tide(ng)%ncid,              &
#  if defined PIO_LIB && defined DISTRIBUTE
     &                    tide(ng)%pioFile,                             &
#  endif
     &                    1, tide(ng), update(1),                       &
     &                    lbi, ubi, lbj, ubj, mtc, ntc(ng),             &
#  ifdef MASKING
     &                    grid(ng) % rmask,                             &
#  endif
     &                    tides(ng) % UV_Tangle)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
          CALL get_2dfld (ng, itlm, idtvph, tide(ng)%ncid,              &
#  if defined PIO_LIB && defined DISTRIBUTE
     &                    tide(ng)%pioFile,                             &
#  endif
     &                    1, tide(ng), update(1),                       &
     &                    lbi, ubi, lbj, ubj, mtc, ntc(ng),             &
#  ifdef MASKING
     &                    grid(ng) % rmask,                             &
#  endif
     &                    tides(ng) % UV_Tphase)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
          CALL get_2dfld (ng, itlm, idtvma, tide(ng)%ncid,              &
#  if defined PIO_LIB && defined DISTRIBUTE
     &                    tide(ng)%pioFile,                             &
#  endif
     &                    1, tide(ng), update(1),                       &
     &                    lbi, ubi, lbj, ubj, mtc, ntc(ng),             &
#  ifdef MASKING
     &                    grid(ng) % rmask,                             &
#  endif
     &                    tides(ng) % UV_Tmajor)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
          CALL get_2dfld (ng, itlm, idtvmi, tide(ng)%ncid,              &
#  if defined PIO_LIB && defined DISTRIBUTE
     &                    tide(ng)%pioFile,                             &
#  endif
     &                    1, tide(ng), update(1),                       &
     &                    lbi, ubi, lbj, ubj, mtc, ntc(ng),             &
#  ifdef MASKING
     &                    grid(ng) % rmask,                             &
#  endif
     &                    tides(ng) % UV_Tminor)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
          time(ng)=time_save
          tdays(ng)=time(ng)*sec2day
        END IF
      END IF
# endif
 
# ifndef ANA_PSOURCE
!
!-----------------------------------------------------------------------
!  Read in point Sources/Sinks position, direction, special flag, and
!  mass transport nondimensional shape profile.  Point sources are at
!  U- and V-points.
!-----------------------------------------------------------------------
!
      IF ((iic(ng).eq.0).and.                                           &
     &    (luvsrc(ng).or.lwsrc(ng).or.any(ltracersrc(:,ng)))) THEN
        CALL get_ngfld (ng, itlm, idrxpo, ssf(ng)%ncid,                 &
#  if defined PIO_LIB && defined DISTRIBUTE
     &                  ssf(ng)%pioFile,                                &
#  endif
     &                  1, ssf(ng), recordless, update(1),              &
     &                  1, nsrc(ng), 1, 1, 1, nsrc(ng), 1,              &
     &                  sources(ng) % Xsrc)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        CALL get_ngfld (ng, itlm, idrepo, ssf(ng)%ncid,                 &
#  if defined PIO_LIB && defined DISTRIBUTE
     &                  ssf(ng)%pioFile,                                &
#  endif
     &                  1, ssf(ng), recordless, update(1),              &
     &                  1, nsrc(ng), 1, 1, 1, nsrc(ng), 1,              &
     &                  sources(ng) % Ysrc)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        CALL get_ngfld (ng, itlm, idrdir, ssf(ng)%ncid,                 &
#  if defined PIO_LIB && defined DISTRIBUTE
     &                  ssf(ng)%pioFile,                                &
#  endif
     &                  1, ssf(ng), recordless, update(1),              &
     &                  1, nsrc(ng), 1, 1, 1, nsrc(ng), 1,              &
     &                  sources(ng) % Dsrc)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#  ifdef SOLVE3D
!
        CALL get_ngfld (ng, itlm, idrvsh, ssf(ng)%ncid,                 &
#   if defined PIO_LIB && defined DISTRIBUTE
     &                  ssf(ng)%pioFile,                                &
#   endif
     &                  1, ssf(ng), recordless, update(1),              &
     &                  1, nsrc(ng), n(ng), 1, 1, nsrc(ng), n(ng),      &
     &                  sources(ng) % Qshape)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#  endif
!
        DO is=1,nsrc(ng)
          sources(ng)%Isrc(is)=                                         &
     &                max(1,min(nint(sources(ng)%Xsrc(is)),lm(ng)+1))
          sources(ng)%Jsrc(is)=                                         &
     &                max(1,min(nint(sources(ng)%Ysrc(is)),mm(ng)+1))
        END DO
      END IF
# endif
 
# ifdef PROFILE
!
!-----------------------------------------------------------------------
!  Turn off input data time wall clock.
!-----------------------------------------------------------------------
!
      CALL wclock_off (ng, itlm, 3, __line__, myfile)
# endif
!
      RETURN
      END SUBROUTINE tl_get_idata
#else
      SUBROUTINE tl_get_idata
      RETURN
      END SUBROUTINE tl_get_idata
#endif