inp_par.F

Go to the documentation of this file.

#include "cppdefs.h"
      MODULE inp_par_mod
!
!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 in input model parameters from standard input.   !
!  It also writes out these parameters to standard output.             !
!                                                                      !
!=======================================================================
!
      USE mod_kinds
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_ncparam
#ifdef GRID_EXTRACT
      USE mod_netcdf
# if defined PIO_LIB && defined DISTRIBUTE
      USE mod_pio_netcdf
# endif
#endif
      USE mod_scalars
#ifdef DISTRIBUTE
      USE mod_strings
#endif
!
      USE dateclock_mod,    ONLY : get_date
#ifdef DISTRIBUTE
      USE distribute_mod,   ONLY : mp_bcasti, mp_bcasts
#endif
      USE lbc_mod,          ONLY : lbc_report
      USE ran_state,        ONLY : ran_seed
#ifdef NESTING
      USE set_contact_mod,  ONLY : set_contact
#endif
      USE stdinp_mod,       ONLY : stdinp_unit
      USE strings_mod,      ONLY : founderror
#ifdef SOLVE3D
      USE tadv_mod,         ONLY : tadv_report
#endif
      USE tile_indices_mod, ONLY : tile_indices, tile_obs_bounds
!
      implicit none
!
      PUBLIC  :: inp_par
!
      CONTAINS
!
!***********************************************************************
      SUBROUTINE inp_par (model)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: model
!
!  Local variable declarations.
!
      logical :: gotfile, lwrite
!
      integer :: nghost, tile
      integer :: imin, imax, jmin, jmax
#ifdef GRID_EXTRACT
      integer :: i_padd, j_padd
#endif
#ifdef DISTRIBUTE
      integer :: maxhaloleni, maxhalolenj
#endif
      integer :: ibry, inp, out, i, ic, ifield, itrc, j, ng, npts
      integer :: sequence, varid
!
      real(r8) :: cff
      real(r8), parameter :: spv = 0.0_r8
!
      character (len=*), parameter :: myfile =                          &
     &  __FILE__
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  Read in and report input model parameters.
!-----------------------------------------------------------------------
!
#ifdef DISTRIBUTE
!
!  Get in ROMS standard input script filename (Iname) and and open it
!  as a regular formatted file in distributed-memory configurations.
!
      inp=stdinp_unit(master, gotfile)
      out=stdout
      lwrite=master
!
      IF (.not.gotfile) THEN
        IF (master) WRITE (out,10)
 10     FORMAT (/,' INP_PAR - Unable to ROMS standard input file, ',   &
                'Iname')
        exit_flag=2
      END IF
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#else
!
!  Set standard inpur and output units.
!
      inp=stdinp
      out=stdout
      lwrite=master
#endif
#if defined SPLIT_4DVAR && SUPPRESS_REPORT
!
!  Supress reporting the information in the split 4D-Var algorithm when
!  appending into standard output.
!
      IF (lappend) THEN
        lwrite=.false.
      END IF
#endif
!
!  Get current date.
!
#ifdef DISTRIBUTE
      IF (master) CALL get_date (date_str)
      CALL mp_bcasts (1, model, date_str)
#else
      CALL get_date (date_str)
#endif
!
!-----------------------------------------------------------------------
!  Read in physical model input parameters.
!-----------------------------------------------------------------------
!
      IF (master.and.lwrite) WRITE (out,20) version, trim(date_str)
 20   FORMAT (80('-'),/,                                                &
              ' Model Input Parameters:  ROMS version ',a,/,            &
     &        26x,a,/,80('-'))
!
!  Process ROMS standard input Iname script.
!
      CALL read_phypar (model, inp, out, lwrite)
#ifdef DISTRIBUTE
      CALL mp_bcasti (1, model, exit_flag)
#endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#if defined SPLIT_4DVAR && SUPPRESS_REPORT
!
!  If appending into standard output file, supress the reporting of
!  information. Turn of "LwrtInfo" switch.
!
      IF (lappend) THEN
        DO ng=1,ngrids
          lwrtinfo(ng)=.false.
        END DO
      END IF
#endif
#ifdef SEAICE
!
!-----------------------------------------------------------------------
!  Read in sea-ice model input parameters.
!-----------------------------------------------------------------------
!
      OPEN (15, file=trim(iparnam), form='formatted', status='old')
 
      CALL read_icepar (model, 15, out, lwrite)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#endif
#ifdef BIOLOGY
!
!-----------------------------------------------------------------------
!  Read in biological model input parameters.
!-----------------------------------------------------------------------
!
      OPEN (25, file=trim(bparnam), form='formatted', status='old')
 
      CALL read_biopar (model, 25, out, lwrite)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#endif
#ifdef SEDIMENT
!
!-----------------------------------------------------------------------
!  Read in sediment model input parameters.
!-----------------------------------------------------------------------
!
      OPEN (35, file=trim(sparnam), form='formatted', status='old')
 
      CALL read_sedpar (model, 35, out, lwrite)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#endif
#ifdef NESTING
!
!-----------------------------------------------------------------------
!  Read in nesting contact points NetCDF file and allocate and
!  initialize several structures and variables.
!-----------------------------------------------------------------------
!
      CALL set_contact (1, model)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#endif
!
!-----------------------------------------------------------------------
!  Set application domain parameters and switches.
!-----------------------------------------------------------------------
!
!  Set switch for three ghost-points in the halo region.
!
#ifdef SOLVE3D
      threeghostpoints=any(hadvection(:,:)%MPDATA).or.                  &
     &                 any(hadvection(:,:)%HSIMT)
#endif
#ifdef UV_VIS4
      threeghostpoints=.true.
#endif
!
!  Determine the number of ghost-points in the halo region.
!
      IF (threeghostpoints) THEN
        nghostpoints=3
      ELSE
        nghostpoints=2
      END IF
      IF (any(compositegrid).or.any(refinedgrid)) THEN
        nghostpoints=max(3,nghostpoints)
      END IF
!
!  Determine the switch to process input open boundary conditions data.
!
!  In nesting applications, the lateral boundary conditions data is
!  is needed only by the main coarser grid (RefineScale(ng)=0).
!
      DO ng=1,ngrids
        IF (.not.(refinedgrid(ng).and.refinescale(ng).gt.0)) THEN
          lprocessobc(ng)=.true.
        END IF
      END DO
 
#if defined SSH_TIDES || defined UV_TIDES
!
!  Determine the switch to process input tidal forcing data.
!
!  In nesting applications, the tides are processed only by the main
!  coarser grid (RefineScale(ng)=0) and the other grids get tidal
!  forcing from the contact areas.
!
      DO ng=1,ngrids
        IF (.not.(refinedgrid(ng).and.refinescale(ng).gt.0)) THEN
          lprocesstides(ng)=.true.
        END IF
      END DO
#endif
      CALL tile_indices (model, im, jm, lm, mm,                         &
     &                   bounds, domain, iobounds)
 
#ifdef GRID_EXTRACT
!
!-----------------------------------------------------------------------
!  If extracting output solution, set application domain decomposition
!  bounds, indices, and switches per tile partition for all grids.
!-----------------------------------------------------------------------
!
!  Inquire about the extract grid dimensions.
!
     DO ng=1,ngrids
        SELECT CASE (grx(ng)%IOtype)
          CASE (io_nf90)
            CALL netcdf_get_dim (ng, inlm, trim(grx(ng)%name))
#  if defined PIO_LIB && defined DISTRIBUTE
          CASE (io_pio)
            CALL pio_netcdf_get_dim (ng, inlm, trim(grx(ng)%name))
#  endif
          CASE DEFAULT
            IF (master) WRITE (stdout,40) grx(ng)%IOtype
 40         FORMAT (/,' INP_PAR - Illegal output type,',                &
     &              ' io_type = ',i0)
            exit_flag=3
        END SELECT
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
        xtr_lm(ng)=0
        xtr_mm(ng)=0
        DO i=1,n_dim
          IF (trim(dim_name(i)).eq.'xi_rho') THEN
            xtr_lm(ng)=dim_size(i)-2            ! I-computational points
            i_padd=(lm(ng)+2)/2-(lm(ng)+1)/2
            xtr_im(ng)=xtr_lm(ng)+i_padd
          ELSE IF (trim(dim_name(i)).eq.'eta_rho') THEN
            xtr_mm(ng)=dim_size(i)-2            ! J-computational points
            j_padd=(mm(ng)+2)/2-(mm(ng)+1)/2
            xtr_jm(ng)=xtr_mm(ng)+j_padd
          END IF
        END DO
        IF (xtr_lm(ng).eq.0) THEN
          WRITE (stdout,20) 'xi_rho', trim(grx(ng)%name)
          exit_flag=2
          RETURN
        END IF
        IF (xtr_jm(ng).eq.0) THEN
          WRITE (stdout,20) 'eta_rho', trim(grx(ng)%name)
          exit_flag=2
          RETURN
        END IF
 45     FORMAT (/,' INP_PAR - error inquiring dimension: ',a,2x,        &
     &          'in input NetCDF file: ',a)
      END DO
!
!  Set decomposition bounds, indices, and switches per tile partition
!  for all grids.
!
      CALL tile_indices (model, xtr_im, xtr_jm, xtr_lm, xtr_mm,         &
     &                   xtr_bounds, xtr_domain, xtr_iobounds)
#endif
!
!-----------------------------------------------------------------------
!  Set minimum and maximum fractional coordinates for processing
!  observations.
!-----------------------------------------------------------------------
!
      CALL tile_obs_bounds (model, im, jm, lm, mm,                      &
     &                      domain)
!
!-----------------------------------------------------------------------
!  Check tile partition starting and ending (I,J) indices for illegal
!  domain decomposition parameters NtileI and NtileJ in standard input
!  file.
!-----------------------------------------------------------------------
!
      IF (master.and.lwrite) THEN
        DO ng=1,ngrids
#ifdef SOLVE3D
          WRITE (stdout,50) ng, lm(ng), mm(ng), n(ng),                  &
     &                      ntilei(ng), ntilej(ng)
#else
          WRITE (stdout,50) ng, lm(ng), mm(ng),                         &
     &                      ntilei(ng), ntilej(ng)
#endif
#if !defined DISTRIBUTE && defined ADJOINT
          IF ((ntilei(ng).ne.1).or.(ntilej(ng).ne.1)) THEN
            WRITE (stdout,60)
            exit_flag=6
            RETURN
          END IF
#endif
          DO tile=0,ntilei(ng)*ntilej(ng)-1
#ifdef SOLVE3D
            npts=(bounds(ng)%Iend(tile)-                                &
     &            bounds(ng)%Istr(tile)+1)*                             &
     &           (bounds(ng)%Jend(tile)-                                &
     &            bounds(ng)%Jstr(tile)+1)*n(ng)
#else
            npts=(bounds(ng)%Iend(tile)-                                &
     &            bounds(ng)%Istr(tile)+1)*                             &
     &           (bounds(ng)%Jend(tile)-                                &
     &            bounds(ng)%Jstr(tile)+1)
#endif
            WRITE (stdout,70) tile,                                     &
     &                        bounds(ng)%Istr(tile),                    &
     &                        bounds(ng)%Iend(tile),                    &
     &                        bounds(ng)%Jstr(tile),                    &
     &                        bounds(ng)%Jend(tile),                    &
     &                        npts
            IF ((bounds(ng)%Iend(tile)-                                 &
     &           bounds(ng)%Istr(tile)+1).lt.2) THEN
              WRITE (stdout,80) ng, 'NtileI = ', ntilei(ng),            &
     &                              'Lm = ', lm(ng),                    &
     &                              'Istr = ', bounds(ng)%Istr(tile),   &
     &                              '  Iend = ', bounds(ng)%Iend(tile), &
     &                              'NtileI'
              exit_flag=6
              RETURN
            END IF
            IF ((bounds(ng)%Jend(tile)-                                 &
     &           bounds(ng)%Jstr(tile)+1).lt.2) THEN
              WRITE (stdout,80) ng, 'NtileJ = ', ntilej(ng),            &
     &                              'Mm = ', mm(ng),                    &
     &                              'Jstr = ', bounds(ng)%Jstr(tile),   &
     &                              '  Jend = ', bounds(ng)%Jend(tile), &
     &                              'NtileJ'
              exit_flag=6
              RETURN
            END IF
          END DO
        END DO
#ifdef SOLVE3D
 50     FORMAT (/,' Tile partition information for Grid ',i2.2,':',2x,  &
     &          i0,'x',i0,'x',i0,2x,'tiling: ',i0,'x',i0,/,/,           &
     &          5x,'tile',5x,'Istr',5x,'Iend',5x,'Jstr',5x,'Jend',      &
     &          5x,'Npts',/)
#else
 50     FORMAT (/,' Tile partition information for Grid ',i2.2,':',2x,  &
     &          i0,'x',i0,2x,'tiling: ',i0,'x',i0,/,/,                  &
     &          5x,'tile',5x,'Istr',5x,'Iend',5x,'Jstr',5x,'Jend',      &
     &          5x,'Npts',/)
#endif
#if !defined DISTRIBUTE && defined ADJOINT
 60     FORMAT (/,' INP_PAR - illegal domain decomposition for the ',   &
     &                       'Adjoint model.',/,11x,'Partitions are ',  &
     &          'allowed in distributed-menory (MPI) applications.'/)
#endif
 70     FORMAT (5(4x,i5),1x,i8)
 80     FORMAT (/,' INP_PAR - domain decomposition error in input ',    &
     &                        'script file for grid: ',i2.2,/,          &
     &          /,11x,'The domain partition parameter, ',a,i0,          &
     &          /,11x,'is incompatible with grid size, ',a,i0,          &
     &          /,11x,'because it yields too small tile, ',a,i0,a,i0,   &
     &          /,11x,'Decrease partition parameter: ',a)
      END IF
#ifdef DISTRIBUTE
      CALL mp_bcasti (1, model, exit_flag)
#endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Report tile minimum and maximum fractional grid coordinates.
!
      DO ng=1,ngrids
        IF (master.and.lwrite) THEN
          WRITE (stdout,90) ng
          DO tile=0,ntilei(ng)*ntilej(ng)-1
            WRITE (stdout,100) tile,                                    &
     &                         domain(ng)%Xmin_rho(tile),               &
     &                         domain(ng)%Xmax_rho(tile),               &
     &                         domain(ng)%Ymin_rho(tile),               &
     &                         domain(ng)%Ymax_rho(tile), 'RHO-points'
          END DO
          WRITE (stdout,'(1x)')
          DO tile=0,ntilei(ng)*ntilej(ng)-1
            WRITE (stdout,100) tile,                                    &
     &                         domain(ng)%Xmin_u(tile),                 &
     &                         domain(ng)%Xmax_u(tile),                 &
     &                         domain(ng)%Ymin_u(tile),                 &
     &                         domain(ng)%Ymax_u(tile), '  U-points'
          END DO
          WRITE (stdout,'(1x)')
          DO tile=0,ntilei(ng)*ntilej(ng)-1
            WRITE (stdout,100) tile,                                    &
     &                         domain(ng)%Xmin_v(tile),                 &
     &                         domain(ng)%Xmax_v(tile),                 &
     &                         domain(ng)%Ymin_v(tile),                 &
     &                         domain(ng)%Ymax_v(tile), '  V-points'
          END DO
 90       FORMAT (/,' Tile minimum and maximum fractional coordinates', &
     &            ' for Grid ',i2.2,':'/,                               &
#ifdef FULL_GRID
     &            '   (interior and boundary points)',/,/,              &
#else
     &            '   (interior points only)',/,/,                      &
#endif
     &            5x,'tile',5x,'Xmin',5x,'Xmax',5x,'Ymin',5x,'Ymax',    &
     &            5x,'grid',/)
 100      FORMAT (5x,i4,4f9.2,2x,a)
        END IF
      END DO
 
#ifdef DISTRIBUTE
!
!-----------------------------------------------------------------------
!  Determine the maximum tile lengths in XI and ETA directions for
!  distributed-memory communications.  Notice that halo size are
!  increased by few points to allow exchanging of private arrays.
!-----------------------------------------------------------------------
!
      IF (any(ewperiodic).or.any(nsperiodic)) THEN
        nghost=nghostpoints+1
      ELSE
        nghost=nghostpoints
      END IF
 
      DO ng=1,ngrids
        maxhaloleni=0
        maxhalolenj=0
        halobry(ng)=nghost
        DO tile=0,ntilei(ng)*ntilej(ng)-1
          imin=bounds(ng)%LBi(tile)-1
          imax=bounds(ng)%UBi(tile)+1
          jmin=bounds(ng)%LBj(tile)-1
          jmax=bounds(ng)%UBj(tile)+1
          maxhaloleni=max(maxhaloleni,(imax-imin+1))
          maxhalolenj=max(maxhalolenj,(jmax-jmin+1))
        END DO
        halosizei(ng)=nghost*maxhaloleni+6*nghost
        halosizej(ng)=nghost*maxhalolenj+6*nghost
        tileside(ng)=max(maxhaloleni,maxhalolenj)
        tilesize(ng)=maxhaloleni*maxhalolenj
        IF (master.and.lwrite) THEN
          WRITE (stdout,110) ng, halosizei(ng), ng, halosizej(ng),      &
     &                       ng, tileside(ng),  ng, tilesize(ng)
 110      FORMAT (/,' Maximum halo size in XI and ETA directions:',/,   &
     &            /,'               HaloSizeI(',i1,') = ',i7,           &
     &            /,'               HaloSizeJ(',i1,') = ',i7,           &
     &            /,'                TileSide(',i1,') = ',i7,           &
     &            /,'                TileSize(',i1,') = ',i7,/)
        END IF
      END DO
#endif
 
#if defined FOUR_DVAR || defined VERIFICATION
!
!-----------------------------------------------------------------------
!  Read in input assimilation parameters.
!-----------------------------------------------------------------------
!
      OPEN (35, file=trim(aparnam), form='formatted', status='old')
 
      CALL read_asspar (model, 35, out, lwrite)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#endif
#ifdef FLOATS
!
!-----------------------------------------------------------------------
!  Read in floats input parameters.
!-----------------------------------------------------------------------
!
      OPEN (45, file=trim(fposnam), form='formatted', status='old')
 
      CALL read_fltpar (model, 45, out, lwrite)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#endif
#if defined FLOATS && defined FLOAT_BIOLOGY
!
!-----------------------------------------------------------------------
!  Read in biological float behavior model input parameters.
!-----------------------------------------------------------------------
!
      OPEN (50, file=trim(fbionam), form='formatted', status='old')
 
      CALL read_fltbiopar (model, 50, out, lwrite)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#endif
#ifdef STATIONS
!
!-----------------------------------------------------------------------
!  Read in stations input parameters.
!-----------------------------------------------------------------------
!
      OPEN (55, file=trim(sposnam), form='formatted', status='old')
 
      CALL read_stapar (model, 55, out, lwrite)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#endif
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Report tracer advection scheme.
!-----------------------------------------------------------------------
!
      IF (master.and.lwrite) THEN
        WRITE (out,120) 'NLM'
 120    FORMAT (/,1x,'Tracer Advection Scheme: ',a,/,1x,24('='),/,      &
     &          /,1x,'Variable',t25,'Grid',t31,'Horizontal',            &
     &          t50,'Vertical', /,1x,'---------',t25,'----',            &
     &          t31,2('------------',7x))
      END IF
      CALL tadv_report (out, inlm, hadvection, vadvection, lwrite)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# if defined ADJOINT || defined TANGENT || defined TL_IOMS
!
      IF (master.and.lwrite) THEN
        WRITE (out,120) 'TLM, RPM, and ADM'
      END IF
      CALL tadv_report (out, iadm, ad_hadvection, ad_vadvection, lwrite)
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
#endif
#if defined TANGENT || defined TL_IOMS
!
!  Set tracer advection scheme switches for the tangent linear models
!  (TLM and RPM) to the same values as the adjoint model.
!
      DO ng=1,ngrids
        DO i=1,nt(ng)
          tl_hadvection(i,ng)%AKIMA4    = ad_hadvection(i,ng)%AKIMA4
          tl_hadvection(i,ng)%CENTERED2 = ad_hadvection(i,ng)%CENTERED2
          tl_hadvection(i,ng)%CENTERED4 = ad_hadvection(i,ng)%CENTERED4
          tl_hadvection(i,ng)%HSIMT     = ad_hadvection(i,ng)%HSIMT
          tl_hadvection(i,ng)%MPDATA    = ad_hadvection(i,ng)%MPDATA
          tl_hadvection(i,ng)%SPLINES   = ad_hadvection(i,ng)%SPLINES
          tl_hadvection(i,ng)%SPLIT_U3  = ad_hadvection(i,ng)%SPLIT_U3
          tl_hadvection(i,ng)%UPSTREAM3 = ad_hadvection(i,ng)%UPSTREAM3
!
          tl_vadvection(i,ng)%AKIMA4    = ad_vadvection(i,ng)%AKIMA4
          tl_vadvection(i,ng)%CENTERED2 = ad_vadvection(i,ng)%CENTERED2
          tl_vadvection(i,ng)%CENTERED4 = ad_vadvection(i,ng)%CENTERED4
          tl_vadvection(i,ng)%HSIMT     = ad_vadvection(i,ng)%HSIMT
          tl_vadvection(i,ng)%MPDATA    = ad_vadvection(i,ng)%MPDATA
          tl_vadvection(i,ng)%SPLINES   = ad_vadvection(i,ng)%SPLINES
          tl_vadvection(i,ng)%SPLIT_U3  = ad_vadvection(i,ng)%SPLIT_U3
          tl_vadvection(i,ng)%UPSTREAM3 = ad_vadvection(i,ng)%UPSTREAM3
        END DO
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Report lateral boundary conditions.
!-----------------------------------------------------------------------
!
      IF (master.and.lwrite) THEN
        WRITE (out,130) 'NLM'
 130    FORMAT (/,1x,'Lateral Boundary Conditions: ',a,/,1x,28('='),/,  &
     &          /,1x,'Variable',t25,'Grid',t31,'West Edge',             &
     &          t44,'South Edge', t57,'East Edge',t70,'North Edge',     &
     &          /,1x,'---------',t25,'----',t31,4('----------',3x))
        DO ifield=1,nlbcvar
          IF (idbvar(ifield).gt.0) THEN
            CALL lbc_report (out, ifield, lbc)
          END IF
        END DO
 
#if defined ADJOINT || defined TANGENT || defined TL_IOMS
!
        WRITE (out,130) 'TLM, RPM, and ADM'
        DO ifield=1,nlbcvar
          IF (idbvar(ifield).gt.0) THEN
            CALL lbc_report (out, ifield, ad_lbc)
          END IF
        END DO
#endif
      END IF
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Compute various constants.
!-----------------------------------------------------------------------
!
      gorho0=g/rho0
      DO ng=1,ngrids
        dtfast(ng)=dt(ng)/real(ndtfast(ng),r8)
!
!  Take the square root of the biharmonic coefficients so it can
!  be applied to each harmonic operator.
!
        nl_visc4(ng)=sqrt(abs(nl_visc4(ng)))
#ifdef ADJOINT
        ad_visc4(ng)=sqrt(abs(ad_visc4(ng)))
#endif
#if defined TANGENT || defined TL_IOMS
        tl_visc4(ng)=sqrt(abs(tl_visc4(ng)))
#endif
        tkenu4(ng)=sqrt(abs(tkenu4(ng)))
!
!  Set internal switch for activating sponge areas.
!
#ifdef SOLVE3D
        IF (luvsponge(ng).or.                                           &
     &      any(ltracersponge(:,ng))) THEN
          lsponge(ng)=.true.
        END IF
#else
        IF (luvsponge(ng)) THEN
          lsponge(ng)=.true.
        END IF
#endif
!
!  Set switch to processing nudging coefficients for passive/active
!  boundary conditions.
!
        nudgingcoeff(ng)=any(lbc(:,:,ng)%nudging)
#if defined ADJOINT || defined TANGENT || defined TL_IOMS
        nudgingcoeff(ng)=nudgingcoeff(ng).or.any(ad_lbc(:,:,ng)%nudging)
#endif
!
!  Set internal switch for processing climatology data.
!
#ifdef SOLVE3D
# if defined TS_MIX_CLIMA && (defined TS_DIF2 || defined TS_DIF4)
        lclimatology(ng)=.true.
# endif
        IF (lsshclm(ng).or.                                             &
            lm2clm(ng).or.lnudgem2clm(ng).or.                          &
            lm3clm(ng).or.lnudgem3clm(ng).or.                          &
            any(ltracerclm(:,ng)).or.any(lnudgetclm(:,ng))) THEN
          lclimatology(ng)=.true.
        END IF
#else
        IF (lsshclm(ng).or.                                             &
            lm2clm(ng).or.lnudgem2clm(ng)) THEN
          lclimatology(ng)=.true.
        END IF
#endif
!
!  Set internal switch for nudging to climatology fields.
!
#ifdef SOLVE3D
        IF (lnudgem2clm(ng).or.                                         &
     &      lnudgem3clm(ng).or.                                         &
     &      any(lnudgetclm(:,ng))) THEN
          lnudging(ng)=.true.
        END IF
#else
        IF (lnudgem2clm(ng)) THEN
          lnudging(ng)=.true.
        END IF
#endif
!
!  Compute inverse nudging coefficients (1/s) used in various tasks.
!
        IF (znudg(ng).gt.0.0_r8) THEN
          znudg(ng)=1.0_r8/(znudg(ng)*86400.0_r8)
        ELSE
          znudg(ng)=0.0_r8
        END IF
!
        IF (m2nudg(ng).gt.0.0_r8) THEN
          m2nudg(ng)=1.0_r8/(m2nudg(ng)*86400.0_r8)
        ELSE
          m2nudg(ng)=0.0_r8
        END IF
#ifdef SOLVE3D
!
        IF (m3nudg(ng).gt.0.0_r8) THEN
          m3nudg(ng)=1.0_r8/(m3nudg(ng)*86400.0_r8)
        ELSE
          m3nudg(ng)=0.0_r8
        END IF
#endif
!
!  Set nudging coefficients (1/s) for passive/active (outflow/inflow)
!  open boundary conditions.  Weak nudging is expected in passive
!  outflow conditions and strong nudging is expected in active inflow
!  conditions. If nudging to climatology fields, these values are
!  replaced by spatial nudging coefficients distribution in the
!  open boundary condition routines.
!
        IF (nudgingcoeff(ng)) THEN
          DO ibry=1,4
            IF (lbc(ibry,isfsur,ng)%nudging) THEN
              fsobc_out(ng,ibry)=znudg(ng)
              fsobc_in(ng,ibry)=obcfac(ng)*znudg(ng)
            END IF
!
            IF (lbc(ibry,isubar,ng)%nudging.or.                         &
     &          lbc(ibry,isvbar,ng)%nudging) THEN
              m2obc_out(ng,ibry)=m2nudg(ng)
              m2obc_in(ng,ibry)=obcfac(ng)*m2nudg(ng)
            END IF
#ifdef SOLVE3D
!
            IF (lbc(ibry,isuvel,ng)%nudging.or.                         &
     &          lbc(ibry,isvvel,ng)%nudging) THEN
              m3obc_out(ng,ibry)=m3nudg(ng)
              m3obc_in(ng,ibry)=obcfac(ng)*m3nudg(ng)
            END IF
!
            DO itrc=1,nt(ng)
              IF (lbc(ibry,istvar(itrc),ng)%nudging) THEN
                tobc_out(itrc,ng,ibry)=tnudg(itrc,ng)
                tobc_in(itrc,ng,ibry)=obcfac(ng)*tnudg(itrc,ng)
              END IF
            END DO
#endif
          END DO
        END IF
 
#if defined SO_SEMI        || \
   (defined stochastic_opt && !defined STOCH_OPT_WHITE)
       so_decay(ng)=so_decay(ng)*86400.0_r8
#endif
!
!  Convert momentum stresses and tracer flux scales to kinematic
!  Values. Recall, that all the model fluxes are kinematic.
!
        cff=1.0_r8/rho0
        fscale(idusms,ng)=cff*fscale(idusms,ng)
        fscale(idvsms,ng)=cff*fscale(idvsms,ng)
        fscale(idubms,ng)=cff*fscale(idubms,ng)
        fscale(idvbms,ng)=cff*fscale(idvbms,ng)
        fscale(idubrs,ng)=cff*fscale(idubrs,ng)
        fscale(idvbrs,ng)=cff*fscale(idvbrs,ng)
        fscale(idubws,ng)=cff*fscale(idubws,ng)
        fscale(idvbws,ng)=cff*fscale(idvbws,ng)
        fscale(idubcs,ng)=cff*fscale(idubcs,ng)
        fscale(idvbcs,ng)=cff*fscale(idvbcs,ng)
        cff=1.0_r8/(rho0*cp)
        fscale(idtsur(itemp),ng)=cff*fscale(idtsur(itemp),ng)
        fscale(idtbot(itemp),ng)=cff*fscale(idtbot(itemp),ng)
        fscale(idsrad,ng)=cff*fscale(idsrad,ng)
        fscale(idldwn,ng)=cff*fscale(idldwn,ng)
        fscale(idlrad,ng)=cff*fscale(idlrad,ng)
        fscale(idlhea,ng)=cff*fscale(idlhea,ng)
        fscale(idshea,ng)=cff*fscale(idshea,ng)
        fscale(iddqdt,ng)=cff*fscale(iddqdt,ng)
 
#ifdef SOLVE3D
!
!  Determine the number of climatology tracers to process.
!
        IF (any(ltracerclm(:,ng)).or.any(lnudgetclm(:,ng))) THEN
          ic=0
          DO itrc=1,nt(ng)
            IF (ltracerclm(itrc,ng)) THEN
              ic=ic+1
            END IF
          END DO
          ntclm(ng)=ic
        END IF
#endif
 
#if defined TANGENT || defined TL_IOMS
!
!  Set lateral boundary condition switches for the tangent linear
!  models (TLM and RPM) to the same values as the adjoint model.
!
        DO j=1,nlbcvar
          DO i=1,4
            tl_lbc(i,j,ng)%acquire     = ad_lbc(i,j,ng)%acquire
            tl_lbc(i,j,ng)%Chapman_explicit =                           &
     &                                   ad_lbc(i,j,ng)%Chapman_explicit
            tl_lbc(i,j,ng)%Chapman_implicit =                           &
     &                                   ad_lbc(i,j,ng)%Chapman_implicit
            tl_lbc(i,j,ng)%clamped     = ad_lbc(i,j,ng)%clamped
            tl_lbc(i,j,ng)%closed      = ad_lbc(i,j,ng)%closed
            tl_lbc(i,j,ng)%Flather     = ad_lbc(i,j,ng)%Flather
            tl_lbc(i,j,ng)%gradient    = ad_lbc(i,j,ng)%gradient
            tl_lbc(i,j,ng)%nested      = ad_lbc(i,j,ng)%nested
            tl_lbc(i,j,ng)%nudging     = ad_lbc(i,j,ng)%nudging
            tl_lbc(i,j,ng)%periodic    = ad_lbc(i,j,ng)%periodic
            tl_lbc(i,j,ng)%radiation   = ad_lbc(i,j,ng)%radiation
            tl_lbc(i,j,ng)%reduced     = ad_lbc(i,j,ng)%reduced
            tl_lbc(i,j,ng)%Shchepetkin = ad_lbc(i,j,ng)%Shchepetkin
          END DO
        END DO
#endif
 
      END DO
 
#ifdef SOLVE3D
!
!-----------------------------------------------------------------------
!  Set climatology tracers (active and passive) metadata.  It needs to
!  be done here because information is needed from all input scripts.
!  The variable name and units are the same as the basic tracers. The
!  default time-variable name is the same as the variable name but with
!  the "_time" suffix.  Recall that other time-variables names are
!  allowed provided that the input NetCDF variable has the "time"
!  attribute with the appropriate value.
!-----------------------------------------------------------------------
!
      varid=last_varid
      IF (any(ltracerclm).or.any(lnudgetclm)) THEN
        DO i=1,mt
          varid=varid+1
          IF (varid.gt.mv) THEN
            WRITE (stdout,130) mv, varid
            stop
          END IF
          idtclm(i)=varid
          DO ng=1,ngrids
            fscale(varid,ng)=1.0_r8
            iinfo(1,varid,ng)=r3dvar
          END DO
          WRITE (vname(1,varid),'(a)')                                  &
     &          trim(adjustl(vname(1,idtvar(i))))
          WRITE (vname(2,varid),'(a,a)')                                &
     &          trim(adjustl(vname(2,idtvar(i)))), ' climatology'
          WRITE (vname(3,varid),'(a)')                                  &
     &          trim(adjustl(vname(3,idtvar(i))))
          WRITE (vname(4,varid),'(a,a)')                                &
     &          trim(vname(1,varid)), ', scalar, series'
          WRITE (vname(5,varid),'(a,a)')                                &
     &          trim(adjustl(vname(1,idtvar(i)))), '_time'
        END DO
      END IF
!
!-----------------------------------------------------------------------
!  Set tracers inverse nudging coeffcients metadata.  It needs to be
!  done here because information is needed from all input scripts.
!  The variable name is the same as the basic tracer but with the
!  "_NudgeCoef" suffix.
!-----------------------------------------------------------------------
!
      DO i=1,mt
        IF (any(lnudgetclm(i,:))) THEN
          varid=varid+1
          IF (varid.gt.mv) THEN
            WRITE (stdout,140) mv, varid
 140        FORMAT (/,' INP_PAR - too small dimension ',                &
     &              'parameter, MV = ',2i5,/,15x,                       &
     &              'change file  mod_ncparam.F  and recompile.')
            stop
          END IF
          idtnud(i)=varid
          DO ng=1,ngrids
            fscale(varid,ng)=1.0_r8/86400        ! default units: 1/day
            iinfo(1,varid,ng)=r3dvar
          END DO
          WRITE (vname(1,varid),'(a,a)')                                &
     &          trim(adjustl(vname(1,idtvar(i)))), '_NudgeCoef'
          WRITE (vname(2,varid),'(a,a)')                                &
     &          trim(adjustl(vname(2,idtvar(i)))),                      &
     &          ', inverse nudging coefficients'
          WRITE (vname(3,varid),'(a,1x,a)')                             &
     &          trim(adjustl(vname(3,idtvar(i)))), 'day-1'
          WRITE (vname(4,varid),'(a,a)')                                &
     &        trim(vname(1,varid)), ', scalar'
          WRITE (vname(5,varid),'(a)') 'nulvar'
        ELSE
          idtnud(i)=0
        END IF
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Check C-preprocessing options and definitions.
!-----------------------------------------------------------------------
!
      IF (master.and.lwrite) THEN
        CALL checkdefs
        FLUSH (out)
      END IF
#ifdef DISTRIBUTE
      CALL mp_bcasti (1, model, exit_flag)
      CALL mp_bcasts (1, model, coptions)
#endif
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Initialize random number sequence so we can get identical results
!  everytime that we run the same solution.
!-----------------------------------------------------------------------
!
      sequence=759
      CALL ran_seed (sequence)
!
      RETURN
      END SUBROUTINE inp_par
!
      END MODULE inp_par_mod