tl_def_ini.F

Go to the documentation of this file.

#include "cppdefs.h"
      MODULE tl_def_ini_mod
#if (defined TANGENT || defined TL_IOMS) && defined FOUR_DVAR
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This module updates tangent linear initial file used for 4DVAR      !
!  data assimilation using either the standard NetCDF library or       !
!  the Parallel-IO (PIO) library.                                      !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_parallel
      USE mod_fourdvar
      USE mod_iounits
      USE mod_ncparam
      USE mod_scalars
!
      USE def_dim_mod,  ONLY : def_dim
      USE def_info_mod, ONLY : def_info
      USE def_var_mod,  ONLY : def_var
      USE strings_mod,  ONLY : founderror
      USE wrt_info_mod, ONLY : wrt_info
!
      implicit none
!
      PUBLIC  :: tl_def_ini
      PRIVATE :: tl_def_ini_nf90
# if defined PIO_LIB && defined DISTRIBUTE
      PRIVATE :: tl_def_ini_pio
# endif
!
      CONTAINS
!
!***********************************************************************
      SUBROUTINE tl_def_ini (ng)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng
!
!  Local variable declarations.
!
      character (len=*), parameter :: myfile =                          &
     &  __FILE__
!
!-----------------------------------------------------------------------
!  Create a new history file according to IO type.
!-----------------------------------------------------------------------
!
      SELECT CASE (itl(ng)%IOtype)
        CASE (io_nf90)
          CALL tl_def_ini_nf90 (ng)
 
# if defined PIO_LIB && defined DISTRIBUTE
        CASE (io_pio)
          CALL tl_def_ini_pio (ng)
# endif
        CASE DEFAULT
          IF (master) WRITE (stdout,10) itl(ng)%IOtype
          exit_flag=3
      END SELECT
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
  10  FORMAT (' TL_DEF_INI - Illegal output file type, io_type = ',i0,  &
     &        /,14x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
!
      RETURN
      END SUBROUTINE tl_def_ini
!
!***********************************************************************
      SUBROUTINE tl_def_ini_nf90 (ng)
!***********************************************************************
!
      USE mod_netcdf
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng
!
!  Local variable declarations.
!
      logical :: got_var(nv)
!
      integer, parameter :: natt = 25
 
      integer :: i, j, ifield, itrc, nvd3, nvd4
      integer :: recdim, status, varid
      integer :: fcount
# ifdef ADJUST_BOUNDARY
      integer :: iorjdim, brecdim
# endif
# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
      integer :: frecdim
# endif
      integer :: dimids(ndimid)
      integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
# ifdef ADJUST_BOUNDARY
      integer :: t2dobc(4)
# endif
 
# ifdef SOLVE3D
      integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
#  ifdef ADJUST_BOUNDARY
      integer :: t3dobc(5)
#  endif
#  ifdef ADJUST_STFLUX
      integer :: t3dfrc(4)
#  endif
# endif
# ifdef ADJUST_WSTRESS
      integer :: u3dfrc(4), v3dfrc(4)
# endif
!
      real(r8) :: aval(6)
!
      character (len=256)    :: ncname
      character (len=MaxLen) :: vinfo(natt)
 
      character (len=*), parameter :: myfile =                          &
     &  __FILE__//", tl_def_ini_nf90"
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  Set and report file name.
!-----------------------------------------------------------------------
!
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      ncname=itl(ng)%name
!
      IF (master) THEN
        IF (ldefitl(ng)) THEN
          WRITE (stdout,10) ng, trim(ncname)
        ELSE
          WRITE (stdout,20) ng, trim(ncname)
        END IF
      END IF
!
!=======================================================================
!  Create a new tangent linear model initialization file.
!=======================================================================
!
      define : IF (ldefitl(ng)) THEN
        CALL netcdf_create (ng, itlm, trim(ncname), itl(ng)%ncid)
        IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
          IF (master) WRITE (stdout,30) trim(ncname)
          RETURN
        END IF
!
!-----------------------------------------------------------------------
!  Define the dimensions of staggered fields.
!-----------------------------------------------------------------------
!
        dimids=0
!
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xi_rho',        &
     &                 iobounds(ng)%xi_rho, dimids( 1))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xi_u',          &
     &                 iobounds(ng)%xi_u, dimids( 2))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xi_v',          &
     &                 iobounds(ng)%xi_v, dimids( 3))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xi_psi',        &
     &                 iobounds(ng)%xi_psi, dimids( 4))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'eta_rho',       &
     &                 iobounds(ng)%eta_rho, dimids( 5))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'eta_u',         &
     &                 iobounds(ng)%eta_u, dimids( 6))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'eta_v',         &
     &                 iobounds(ng)%eta_v, dimids( 7))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'eta_psi',       &
     &                 iobounds(ng)%eta_psi, dimids( 8))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef ADJUST_BOUNDARY
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'IorJ',          &
     &                 iobounds(ng)%IorJ, iorjdim)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# if defined WRITE_WATER && defined MASKING
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xy_rho',        &
     &                 iobounds(ng)%xy_rho, dimids(17))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xy_u',          &
     &                 iobounds(ng)%xy_u, dimids(18))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xy_v',          &
     &                 iobounds(ng)%xy_v, dimids(19))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# ifdef SOLVE3D
#  if defined WRITE_WATER && defined MASKING
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xyz_rho',       &
     &                 iobounds(ng)%xy_rho*n(ng), dimids(20))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xyz_u',         &
     &                 iobounds(ng)%xy_u*n(ng), dimids(21))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xyz_v',         &
     &                 iobounds(ng)%xy_v*n(ng), dimids(22))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xyz_w',         &
     &                 iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#  endif
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'N',             &
     &                 n(ng), dimids( 9))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 's_rho',         &
     &                 n(ng), dimids( 9))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 's_w',           &
     &                 n(ng)+1, dimids(10))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'tracer',        &
     &                 nt(ng), dimids(11))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#  ifdef SEDIMENT
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'NST',           &
     &                 nst, dimids(32))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'Nbed',          &
     &                 nbed, dimids(16))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#   if defined WRITE_WATER && defined MASKING
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xybed',         &
     &                 iobounds(ng)%xy_rho*nbed, dimids(24))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
#  endif
# endif
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'boundary',      &
     &                 4, dimids(14))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef FOUR_DVAR
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'Nstate',        &
     &                 nstatevar(ng), dimids(29))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'frc_adjust',    &
     &                 nfrec(ng), dimids(30))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# ifdef ADJUST_BOUNDARY
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'obc_adjust',    &
     &                 nbrec(ng), dimids(31))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
        status=def_dim(ng, itlm, itl(ng)%ncid, ncname,                  &
     &                 trim(adjustl(vname(5,idtime))),                  &
     &                 nf90_unlimited, dimids(12))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        recdim=dimids(12)
# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
        frecdim=dimids(30)
# endif
# ifdef ADJUST_BOUNDARY
        brecdim=dimids(31)
# endif
!
!  Set number of dimensions for output variables.
!
# if defined WRITE_WATER && defined MASKING
        nvd3=2
        nvd4=2
# else
        nvd3=3
        nvd4=4
# endif
!
!  Define dimension vectors for staggered tracer type variables.
!
# if defined WRITE_WATER && defined MASKING
        t2dgrd(1)=dimids(17)
        t2dgrd(2)=dimids(12)
#  ifdef SOLVE3D
        t3dgrd(1)=dimids(20)
        t3dgrd(2)=dimids(12)
#  endif
# else
        t2dgrd(1)=dimids( 1)
        t2dgrd(2)=dimids( 5)
        t2dgrd(3)=dimids(12)
#  ifdef SOLVE3D
        t3dgrd(1)=dimids( 1)
        t3dgrd(2)=dimids( 5)
        t3dgrd(3)=dimids( 9)
        t3dgrd(4)=dimids(12)
#  endif
#  ifdef ADJUST_STFLUX
        t3dfrc(1)=dimids( 1)
        t3dfrc(2)=dimids( 5)
        t3dfrc(3)=frecdim
        t3dfrc(4)=dimids(12)
#  endif
# endif
# ifdef ADJUST_BOUNDARY
        t2dobc(1)=iorjdim
        t2dobc(2)=dimids(14)
        t2dobc(3)=brecdim
        t2dobc(4)=dimids(12)
#  ifdef SOLVE3D
        t3dobc(1)=iorjdim
        t3dobc(2)=dimids( 9)
        t3dobc(3)=dimids(14)
        t3dobc(4)=brecdim
        t3dobc(5)=dimids(12)
#  endif
# endif
!
!  Define dimension vectors for staggered u-momentum type variables.
!
# if defined WRITE_WATER && defined MASKING
        u2dgrd(1)=dimids(18)
        u2dgrd(2)=dimids(12)
#  ifdef SOLVE3D
        u3dgrd(1)=dimids(21)
        u3dgrd(2)=dimids(12)
#  endif
# else
        u2dgrd(1)=dimids( 2)
        u2dgrd(2)=dimids( 6)
        u2dgrd(3)=dimids(12)
#  ifdef SOLVE3D
        u3dgrd(1)=dimids( 2)
        u3dgrd(2)=dimids( 6)
        u3dgrd(3)=dimids( 9)
        u3dgrd(4)=dimids(12)
#  endif
#  ifdef ADJUST_WSTRESS
        u3dfrc(1)=dimids( 2)
        u3dfrc(2)=dimids( 6)
        u3dfrc(3)=frecdim
        u3dfrc(4)=dimids(12)
#  endif
# endif
!
!  Define dimension vectors for staggered v-momentum type variables.
!
# if defined WRITE_WATER && defined MASKING
        v2dgrd(1)=dimids(19)
        v2dgrd(2)=dimids(12)
#  ifdef SOLVE3D
        v3dgrd(1)=dimids(22)
        v3dgrd(2)=dimids(12)
#  endif
# else
        v2dgrd(1)=dimids( 3)
        v2dgrd(2)=dimids( 7)
        v2dgrd(3)=dimids(12)
#  ifdef SOLVE3D
        v3dgrd(1)=dimids( 3)
        v3dgrd(2)=dimids( 7)
        v3dgrd(3)=dimids( 9)
        v3dgrd(4)=dimids(12)
#  endif
#  ifdef ADJUST_WSTRESS
        v3dfrc(1)=dimids( 3)
        v3dfrc(2)=dimids( 7)
        v3dfrc(3)=frecdim
        v3dfrc(4)=dimids(12)
#  endif
# endif
# ifdef SOLVE3D
!
!  Define dimension vector for staggered w-momentum type variables.
!
#  if defined WRITE_WATER && defined MASKING
        w3dgrd(1)=dimids(23)
        w3dgrd(2)=dimids(12)
#  else
        w3dgrd(1)=dimids( 1)
        w3dgrd(2)=dimids( 5)
        w3dgrd(3)=dimids(10)
        w3dgrd(4)=dimids(12)
#  endif
# endif
!
!  Initialize local information variable arrays.
!
        DO i=1,natt
          DO j=1,len(vinfo(1))
            vinfo(i)(j:j)=' '
          END DO
        END DO
        DO i=1,6
          aval(i)=0.0_r8
        END DO
!
!-----------------------------------------------------------------------
!  Define time-recordless information variables.
!-----------------------------------------------------------------------
!
        CALL def_info (ng, itlm, itl(ng)%ncid, ncname, dimids)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Define time-varying variables.
!-----------------------------------------------------------------------
!
!  Define model time.
!
        vinfo( 1)=vname(1,idtime)
        vinfo( 2)=vname(2,idtime)
        WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
        vinfo( 4)=trim(rclock%calendar)
        vinfo(14)=vname(4,idtime)
        vinfo(21)=vname(6,idtime)
        status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idtime),     &
     &                 nf_tout, 1, (/recdim/), aval, vinfo, ncname,     &
     &                 setparaccess = .false.)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Define free-surface.
!
        vinfo( 1)=vname(1,idfsur)
        WRITE (vinfo( 2),40) trim(vname(2,idfsur))
        vinfo( 3)=vname(3,idfsur)
        vinfo(14)=vname(4,idfsur)
        vinfo(16)=vname(1,idtime)
# if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_rho'
# endif
        vinfo(21)=vname(6,idfsur)
        vinfo(22)='coordinates'
        aval(5)=real(iinfo(1,idfsur,ng),r8)
        status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idfsur),     &
# ifdef WET_DRY
     &                 nf_fout, nvd3, t2dgrd, aval, vinfo, ncname,      &
     &                 setfillval = .false.)
# else
     &                 nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
# endif
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef ADJUST_BOUNDARY
!
!  Define free-surface open boundaries.
!
        IF (any(lobc(:,isfsur,ng))) THEN
          ifield=idsbry(isfsur)
          vinfo( 1)=vname(1,ifield)
          WRITE (vinfo( 2),40) trim(vname(2,ifield))
          vinfo( 3)=vname(3,ifield)
          vinfo(14)=vname(4,ifield)
          vinfo(16)=vname(1,idtime)
          vinfo(21)=vname(6,ifield)
          aval(5)=real(iinfo(1,ifield,ng),r8)
          status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield),   &
     &                   nf_fout, 4, t2dobc, aval, vinfo, ncname,       &
     &                   setfillval = .false.)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
# endif
!
!  Define 2D U-momentum component.
!
        vinfo( 1)=vname(1,idubar)
        WRITE (vinfo( 2),40) trim(vname(2,idubar))
        vinfo( 3)=vname(3,idubar)
        vinfo(14)=vname(4,idubar)
        vinfo(16)=vname(1,idtime)
# if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_u'
# endif
        vinfo(21)=vname(6,idubar)
        vinfo(22)='coordinates'
        aval(5)=real(iinfo(1,idubar,ng),r8)
        status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idubar),     &
     &                 nf_fout, nvd3, u2dgrd, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef ADJUST_BOUNDARY
!
!  Define 2D U-momentum component open boundaries.
!
        IF (any(lobc(:,isubar,ng))) THEN
          ifield=idsbry(isubar)
          vinfo( 1)=vname(1,ifield)
          WRITE (vinfo( 2),40) trim(vname(2,ifield))
          vinfo( 3)=vname(3,ifield)
          vinfo(14)=vname(4,ifield)
          vinfo(16)=vname(1,idtime)
          vinfo(21)=vname(6,ifield)
          aval(5)=real(iinfo(1,ifield,ng),r8)
          status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield),   &
     &                   nf_fout, 4, t2dobc, aval, vinfo, ncname,       &
     &                   setfillval = .false.)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
# endif
!
!  Define 2D V-momentum component.
!
        vinfo( 1)=vname(1,idvbar)
        WRITE (vinfo( 2),40) trim(vname(2,idvbar))
        vinfo( 3)=vname(3,idvbar)
        vinfo(14)=vname(4,idvbar)
        vinfo(16)=vname(1,idtime)
# if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_v'
# endif
        vinfo(21)=vname(6,idvbar)
        vinfo(22)='coordinates'
        aval(5)=real(iinfo(1,idvbar,ng),r8)
        status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idvbar),     &
     &                 nf_fout, nvd3, v2dgrd, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef ADJUST_BOUNDARY
!
!  Define 2D V-momentum component open boundaries.
!
        IF (any(lobc(:,isvbar,ng))) THEN
          ifield=idsbry(isvbar)
          vinfo( 1)=vname(1,ifield)
          WRITE (vinfo( 2),40) trim(vname(2,ifield))
          vinfo( 3)=vname(3,ifield)
          vinfo(14)=vname(4,ifield)
          vinfo(16)=vname(1,idtime)
          vinfo(21)=vname(6,ifield)
          aval(5)=real(iinfo(1,ifield,ng),r8)
          status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield),   &
     &                   nf_fout, 4, t2dobc, aval, vinfo, ncname,       &
     &                   setfillval = .false.)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
# endif
# ifdef ADJUST_WSTRESS
!
!  Define surface U-momentum stress.
!
        vinfo( 1)=vname(1,idusms)
        WRITE (vinfo( 2),40) trim(vname(2,idusms))
        vinfo( 3)=vname(3,idusms)
        vinfo(14)=vname(4,idusms)
        vinfo(16)=vname(1,idtime)
#  if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_u'
#  endif
        vinfo(21)=vname(6,idusms)
        vinfo(22)='coordinates'
        aval(5)=real(u2dvar,r8)
        status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idusms),     &
     &                 nf_fout, nvd4, u3dfrc, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Define surface V-momentum stress.
!
        vinfo( 1)=vname(1,idvsms)
        WRITE (vinfo( 2),40) trim(vname(2,idvsms))
        vinfo( 2)=vname(2,idvsms)
        vinfo( 3)=vname(3,idvsms)
        vinfo(14)=vname(4,idvsms)
        vinfo(16)=vname(1,idtime)
#  if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_v'
#  endif
        vinfo(21)=vname(6,idvsms)
        vinfo(22)='coordinates'
        aval(5)=real(v2dvar,r8)
        status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idvsms),     &
     &                 nf_fout, nvd4, v3dfrc, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
# ifdef SOLVE3D
!
!  Define 3D U-momentum component.
!
        vinfo( 1)=vname(1,iduvel)
        WRITE (vinfo( 2),40) trim(vname(2,iduvel))
        vinfo( 3)=vname(3,iduvel)
        vinfo(14)=vname(4,iduvel)
        vinfo(16)=vname(1,idtime)
#  if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_u'
#  endif
        vinfo(21)=vname(6,iduvel)
        vinfo(22)='coordinates'
        aval(5)=real(iinfo(1,iduvel,ng),r8)
        status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(iduvel),     &
     &                 nf_fout, nvd4, u3dgrd, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#  ifdef ADJUST_BOUNDARY
!
!  Define 3D U-momentum component open boundaries.
!
        IF (any(lobc(:,isuvel,ng))) THEN
          ifield=idsbry(isuvel)
          vinfo( 1)=vname(1,ifield)
          WRITE (vinfo( 2),40) trim(vname(2,ifield))
          vinfo( 3)=vname(3,ifield)
          vinfo(14)=vname(4,ifield)
          vinfo(16)=vname(1,idtime)
          vinfo(21)=vname(6,ifield)
          aval(5)=real(iinfo(1,ifield,ng),r8)
          status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield),   &
     &                   nf_fout, 5, t3dobc, aval, vinfo, ncname,       &
     &                   setfillval = .false.)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
#  endif
!
!  Define 3D V-momentum component.
!
        vinfo( 1)=vname(1,idvvel)
        WRITE (vinfo( 2),40) trim(vname(2,idvvel))
        vinfo( 3)=vname(3,idvvel)
        vinfo(14)=vname(4,idvvel)
        vinfo(16)=vname(1,idtime)
#  if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_v'
#  endif
        vinfo(21)=vname(6,idvvel)
        vinfo(22)='coordinates'
        aval(5)=real(iinfo(1,idvvel,ng),r8)
        status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idvvel),     &
     &                 nf_fout, nvd4, v3dgrd, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#  ifdef ADJUST_BOUNDARY
!
!  Define 3D V-momentum component open boundaries.
!
        IF (any(lobc(:,isvvel,ng))) THEN
          ifield=idsbry(isvvel)
          vinfo( 1)=vname(1,ifield)
          WRITE (vinfo( 2),40) trim(vname(2,ifield))
          vinfo( 3)=vname(3,ifield)
          vinfo(14)=vname(4,ifield)
          vinfo(16)=vname(1,idtime)
          vinfo(21)=vname(6,ifield)
          aval(5)=real(iinfo(1,ifield,ng),r8)
          status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield),   &
     &                   nf_fout, 5, t3dobc, aval, vinfo, ncname,       &
     &                   setfillval = .false.)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
#  endif
!
!  Define tracer type variables.
!
        DO itrc=1,nt(ng)
          vinfo( 1)=vname(1,idtvar(itrc))
          WRITE (vinfo( 2),40) trim(vname(2,idtvar(itrc)))
          vinfo( 3)=vname(3,idtvar(itrc))
          vinfo(14)=vname(4,idtvar(itrc))
          vinfo(16)=vname(1,idtime)
#  ifdef SEDIMENT
          DO i=1,nst
            IF (itrc.eq.idsed(i)) THEN
              WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
            END IF
          END DO
#  endif
#  if defined WRITE_WATER && defined MASKING
          vinfo(20)='mask_rho'
#  endif
          vinfo(21)=vname(6,idtvar(itrc))
          vinfo(22)='coordinates'
          aval(5)=real(r3dvar,r8)
          status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Tid(itrc),     &
     &                   nf_fout, nvd4, t3dgrd, aval, vinfo, ncname)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
 
#  ifdef ADJUST_BOUNDARY
!
!  Define tracer type variables open boundaries.
!
        DO itrc=1,nt(ng)
          IF (any(lobc(:,istvar(itrc),ng))) THEN
            ifield=idsbry(istvar(itrc))
            vinfo( 1)=vname(1,ifield)
            WRITE (vinfo( 2),40) trim(vname(2,ifield))
            vinfo( 3)=vname(3,ifield)
            vinfo(14)=vname(4,ifield)
            vinfo(16)=vname(1,idtime)
#   ifdef SEDIMENT
            DO i=1,nst
              IF (itrc.eq.idsed(i)) THEN
                WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
              END IF
            END DO
#   endif
            vinfo(21)=vname(6,ifield)
            aval(5)=real(iinfo(1,ifield,ng),r8)
            status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield), &
     &                     nf_fout, 5, t3dobc, aval, vinfo, ncname,     &
                           setfillval = .false.)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END DO
#  endif
#  ifdef ADJUST_STFLUX
!
!  Define surface tracer fluxes.
!
        DO itrc=1,nt(ng)
          IF (lstflux(itrc,ng)) THEN
            vinfo( 1)=vname(1,idtsur(itrc))
            WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
            vinfo( 3)=vname(3,idtsur(itrc))
            IF (itrc.eq.itemp) THEN
              vinfo(11)='upward flux, cooling'
              vinfo(12)='downward flux, heating'
            ELSE IF (itrc.eq.isalt) THEN
              vinfo(11)='upward flux, freshening (net precipitation)'
              vinfo(12)='downward flux, salting (net evaporation)'
            END IF
            vinfo(14)=vname(4,idtsur(itrc))
            vinfo(16)=vname(1,idtime)
#  if defined WRITE_WATER && defined MASKING
            vinfo(20)='mask_rho'
#  endif
            vinfo(21)=vname(6,idtsur(itrc))
            vinfo(22)='coordinates'
            aval(5)=real(r2dvar,r8)
            status=def_var(ng, itlm, itl(ng)%ncid,                      &
     &                     itl(ng)%Vid(idtsur(itrc)), nf_fout,          &
     &                     nvd4, t3dfrc, aval, vinfo, ncname)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END DO
#  endif
# endif
!
!-----------------------------------------------------------------------
!  Leave definition mode.
!-----------------------------------------------------------------------
!
        CALL netcdf_enddef (ng, itlm, ncname, itl(ng)%ncid)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Write out time-recordless, information variables.
!-----------------------------------------------------------------------
!
        CALL wrt_info (ng, itlm, itl(ng)%ncid, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF define
!
!=======================================================================
!  Open an existing initialization file, check its contents, and
!  prepare for appending data.
!=======================================================================
!
      query : IF (.not.ldefitl(ng)) THEN
        ncname=itl(ng)%name
!
!  Open tangent linear initialization file for read/write.
!
        CALL netcdf_open (ng, itlm, ncname, 1, itl(ng)%ncid)
        IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
          WRITE (stdout,60) trim(ncname)
          RETURN
        END IF
!
!  Inquire about the dimensions and check for consistency.
!
        CALL netcdf_check_dim (ng, itlm, ncname,                        &
     &                         ncid = itl(ng)%ncid)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Inquire about the variables.
!
        CALL netcdf_inq_var (ng, itlm, ncname,                          &
     &                       ncid = itl(ng)%ncid)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Initialize logical switches.
!
        DO i=1,nv
          got_var(i)=.false.
        END DO
!
!  Scan variable list from input NetCDF and activate switches for
!  initialization variables. Get variable IDs.
!
        DO i=1,n_var
          IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
            got_var(idtime)=.true.
            itl(ng)%Vid(idtime)=var_id(i)
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
            got_var(idfsur)=.true.
            itl(ng)%Vid(idfsur)=var_id(i)
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
            got_var(idubar)=.true.
            itl(ng)%Vid(idubar)=var_id(i)
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
            got_var(idvbar)=.true.
            itl(ng)%Vid(idvbar)=var_id(i)
# ifdef ADJUST_BOUNDARY
          ELSE IF (trim(var_name(i)).eq.                                &
     &             trim(vname(1,idsbry(isfsur)))) THEN
            got_var(idsbry(isfsur))=.true.
            itl(ng)%Vid(idsbry(isfsur))=var_id(i)
          ELSE IF (trim(var_name(i)).eq.                                &
     &             trim(vname(1,idsbry(isubar)))) THEN
            got_var(idsbry(isubar))=.true.
            itl(ng)%Vid(idsbry(isubar))=var_id(i)
          ELSE IF (trim(var_name(i)).eq.                                &
     &             trim(vname(1,idsbry(isvbar)))) THEN
            got_var(idsbry(isvbar))=.true.
            itl(ng)%Vid(idsbry(isvbar))=var_id(i)
# endif
# ifdef ADJUST_WSTRESS
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
            got_var(idusms)=.true.
            itl(ng)%Vid(idusms)=var_id(i)
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
            got_var(idvsms)=.true.
            itl(ng)%Vid(idvsms)=var_id(i)
# endif
# ifdef SOLVE3D
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
            got_var(iduvel)=.true.
            itl(ng)%Vid(iduvel)=var_id(i)
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
            got_var(idvvel)=.true.
            itl(ng)%Vid(idvvel)=var_id(i)
#  ifdef ADJUST_BOUNDARY
          ELSE IF (trim(var_name(i)).eq.                                &
     &             trim(vname(1,idsbry(isuvel)))) THEN
            got_var(idsbry(isuvel))=.true.
            itl(ng)%Vid(idsbry(isuvel))=var_id(i)
          ELSE IF (trim(var_name(i)).eq.                                &
     &             trim(vname(1,idsbry(isvvel)))) THEN
            got_var(idsbry(isvvel))=.true.
            itl(ng)%Vid(idsbry(isvvel))=var_id(i)
#  endif
# endif
          END IF
# ifdef SOLVE3D
          DO itrc=1,nt(ng)
            IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
              got_var(idtvar(itrc))=.true.
              itl(ng)%Tid(itrc)=var_id(i)
#  ifdef ADJUST_BOUNDARY
            ELSE IF (trim(var_name(i)).eq.                              &
     &               trim(vname(1,idsbry(istvar(itrc))))) THEN
              got_var(idsbry(istvar(itrc)))=.true.
              itl(ng)%Vid(idsbry(istvar(itrc)))=var_id(i)
#  endif
#  ifdef ADJUST_STFLUX
            ELSE IF (trim(var_name(i)).eq.                              &
     &               trim(vname(1,idtsur(itrc)))) THEN
              got_var(idtsur(itrc))=.true.
              itl(ng)%Vid(idtsur(itrc))=var_id(i)
#  endif
            END IF
          END DO
# endif
        END DO
!
!  Check if tangent linear mode initialization variables are available
!  in input NetCDF file.
!
        IF (.not.got_var(idtime)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idtime)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idfsur)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idfsur)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idubar)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idubar)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idvbar)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idvbar)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
# ifdef ADJUST_BOUNDARY
        IF (.not.got_var(idsbry(isfsur)).and.                           &
     &      any(lobc(:,isfsur,ng))) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isfsur))),  &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idsbry(isubar)).and.                           &
     &      any(lobc(:,isubar,ng))) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isubar))),  &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idsbry(isvbar)).and.                           &
     &      any(lobc(:,isvbar,ng))) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvbar))),  &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
# endif
# ifdef ADJUST_WSTRESS
        IF (.not.got_var(idusms)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idusms)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idvsms)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idvsms)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
# endif
# ifdef SOLVE3D
        IF (.not.got_var(iduvel)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,iduvel)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idvvel)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idvvel)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
#  ifdef ADJUST_BOUNDARY
        IF (.not.got_var(idsbry(isuvel)).and.                           &
     &      any(lobc(:,isuvel,ng))) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isuvel))),  &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idsbry(isvvel)).and.                           &
     &      any(lobc(:,isvvel,ng))) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvvel))),  &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
#  endif
# endif
# ifdef SOLVE3D
        DO itrc=1,nt(ng)
          IF (.not.got_var(idtvar(itrc))) THEN
            IF (master) WRITE (stdout,70) trim(vname(1,idtvar(itrc))),  &
     &                                    trim(ncname)
            exit_flag=3
            RETURN
          END IF
#  ifdef ADJUST_BOUNDARY
          IF (.not.got_var(idsbry(istvar(itrc))).and.                   &
     &        any(lobc(:,istvar(itrc),ng))) THEN
            IF (master) WRITE (stdout,70)                               &
     &                        trim(vname(1,idsbry(istvar(itrc)))),      &
     &                        trim(ncname)
            exit_flag=3
            RETURN
          END IF
#  endif
#  ifdef ADJUST_STFLUX
          IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
            IF (master) WRITE (stdout,70) trim(vname(1,idtsur(itrc))),  &
     &                                    trim(ncname)
            exit_flag=3
            RETURN
          END IF
#  endif
        END DO
# endif
!
!  Set unlimited time record dimension to the appropriate value.
!
        itl(ng)%Rindex=rec_size
        fcount=itl(ng)%Fcount
        itl(ng)%Nrec(fcount)=rec_size
      END IF query
!
  10  FORMAT (2x,'TL_DEF_INI_NF90  - creating initial file,',t56,       &
     &        'Grid ',i2.2,': ',a)
  20  FORMAT (2x,'TL_DEF_INI_NF90  - inquiring initial file,',t56,      &
     &        'Grid ',i2.2,': ',a)
  30  FORMAT (/,' TL_DEF_INI_NF90 - unable to create initial NetCDF',   &
     &        ' file:',1x,a)
  40  FORMAT ('tangent linear',1x,a)
  50  FORMAT (1pe11.4,1x,'millimeter')
  60  FORMAT (/,' TL_DEF_INI_NF90 - unable to open initial NetCDF',     &
     &        ' file: ',a)
  70  FORMAT (/,' TL_DEF_INI_NF90 - unable to find variable: ',a,2x,    &
     &        ' in file: ',a)
!
      RETURN
      END SUBROUTINE tl_def_ini_nf90
 
# if defined PIO_LIB && defined DISTRIBUTE
!
!***********************************************************************
      SUBROUTINE tl_def_ini_pio (ng)
!***********************************************************************
!
      USE mod_pio_netcdf
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng
!
!  Local variable declarations.
!
      logical :: got_var(nv)
!
      integer, parameter :: natt = 25
 
      integer :: i, j, ifield, itrc, nvd3, nvd4
      integer :: recdim, status
      integer :: fcount
# ifdef ADJUST_BOUNDARY
      integer :: iorjdim, brecdim
# endif
# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
      integer :: frecdim
# endif
      integer :: dimids(ndimid)
      integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
# ifdef ADJUST_BOUNDARY
      integer :: t2dobc(4)
# endif
 
# ifdef SOLVE3D
      integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
#  ifdef ADJUST_BOUNDARY
      integer :: t3dobc(5)
#  endif
#  ifdef ADJUST_STFLUX
      integer :: t3dfrc(4)
#  endif
# endif
# ifdef ADJUST_WSTRESS
      integer :: u3dfrc(4), v3dfrc(4)
# endif
!
      real(r8) :: aval(6)
!
      character (len=256)    :: ncname
      character (len=MaxLen) :: vinfo(natt)
 
      character (len=*), parameter :: myfile =                          &
     &  __FILE__//", tl_def_ini_pio"
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  Set and report file name.
!-----------------------------------------------------------------------
!
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      ncname=itl(ng)%name
!
      IF (master) THEN
        IF (ldefitl(ng)) THEN
          WRITE (stdout,10) ng, trim(ncname)
        ELSE
          WRITE (stdout,20) ng, trim(ncname)
        END IF
      END IF
!
!=======================================================================
!  Create a new tangent linear model initialization file.
!=======================================================================
!
      define : IF (ldefitl(ng)) THEN
        CALL pio_netcdf_create (ng, itlm, trim(ncname), itl(ng)%pioFile)
        IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
          IF (master) WRITE (stdout,30) trim(ncname)
          RETURN
        END IF
!
!-----------------------------------------------------------------------
!  Define the dimensions of staggered fields.
!-----------------------------------------------------------------------
!
        dimids=0
!
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xi_rho',     &
     &                 iobounds(ng)%xi_rho, dimids( 1))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xi_u',       &
     &                 iobounds(ng)%xi_u, dimids( 2))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xi_v',       &
     &                 iobounds(ng)%xi_v, dimids( 3))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xi_psi',     &
     &                 iobounds(ng)%xi_psi, dimids( 4))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'eta_rho',    &
     &                 iobounds(ng)%eta_rho, dimids( 5))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'eta_u',      &
     &                 iobounds(ng)%eta_u, dimids( 6))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'eta_v',      &
     &                 iobounds(ng)%eta_v, dimids( 7))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'eta_psi',    &
     &                 iobounds(ng)%eta_psi, dimids( 8))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef ADJUST_BOUNDARY
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'IorJ',       &
     &                 iobounds(ng)%IorJ, iorjdim)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# if defined WRITE_WATER && defined MASKING
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xy_rho',     &
     &                 iobounds(ng)%xy_rho, dimids(17))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xy_u',       &
     &                 iobounds(ng)%xy_u, dimids(18))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xy_v',       &
     &                 iobounds(ng)%xy_v, dimids(19))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# ifdef SOLVE3D
#  if defined WRITE_WATER && defined MASKING
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xyz_rho',    &
     &                 iobounds(ng)%xy_rho*n(ng), dimids(20))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xyz_u',      &
     &                 iobounds(ng)%xy_u*n(ng), dimids(21))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xyz_v',      &
     &                 iobounds(ng)%xy_v*n(ng), dimids(22))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xyz_w',      &
     &                 iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#  endif
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'N',          &
     &                 n(ng), dimids( 9))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 's_rho',      &
     &                 n(ng), dimids( 9))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 's_w',        &
     &                 n(ng)+1, dimids(10))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'tracer',     &
     &                 nt(ng), dimids(11))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#  ifdef SEDIMENT
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'NST',        &
     &                 nst, dimids(32))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'Nbed',       &
     &                 nbed, dimids(16))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#   if defined WRITE_WATER && defined MASKING
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xybed',      &
     &                 iobounds(ng)%xy_rho*nbed, dimids(24))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
#   endif
#  endif
# endif
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'boundary',   &
     &                 4, dimids(14))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef FOUR_DVAR
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'Nstate',     &
     &                 nstatevar(ng), dimids(29))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'frc_adjust', &
     &                 nfrec(ng), dimids(30))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
# ifdef ADJUST_BOUNDARY
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'obc_adjust', &
     &                 nbrec(ng), dimids(31))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
 
        status=def_dim(ng, itlm, itl(ng)%pioFile, ncname,               &
     &                 trim(adjustl(vname(5,idtime))),                  &
     &                 pio_unlimited, dimids(12))
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
        recdim=dimids(12)
# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
        frecdim=dimids(30)
# endif
# ifdef ADJUST_BOUNDARY
        brecdim=dimids(31)
# endif
!
!  Set number of dimensions for output variables.
!
# if defined WRITE_WATER && defined MASKING
        nvd3=2
        nvd4=2
# else
        nvd3=3
        nvd4=4
# endif
!
!  Define dimension vectors for staggered tracer type variables.
!
# if defined WRITE_WATER && defined MASKING
        t2dgrd(1)=dimids(17)
        t2dgrd(2)=dimids(12)
#  ifdef SOLVE3D
        t3dgrd(1)=dimids(20)
        t3dgrd(2)=dimids(12)
#  endif
# else
        t2dgrd(1)=dimids( 1)
        t2dgrd(2)=dimids( 5)
        t2dgrd(3)=dimids(12)
#  ifdef SOLVE3D
        t3dgrd(1)=dimids( 1)
        t3dgrd(2)=dimids( 5)
        t3dgrd(3)=dimids( 9)
        t3dgrd(4)=dimids(12)
#  endif
#  ifdef ADJUST_STFLUX
        t3dfrc(1)=dimids( 1)
        t3dfrc(2)=dimids( 5)
        t3dfrc(3)=frecdim
        t3dfrc(4)=dimids(12)
#  endif
# endif
# ifdef ADJUST_BOUNDARY
        t2dobc(1)=iorjdim
        t2dobc(2)=dimids(14)
        t2dobc(3)=brecdim
        t2dobc(4)=dimids(12)
#  ifdef SOLVE3D
        t3dobc(1)=iorjdim
        t3dobc(2)=dimids( 9)
        t3dobc(3)=dimids(14)
        t3dobc(4)=brecdim
        t3dobc(5)=dimids(12)
#  endif
# endif
!
!  Define dimension vectors for staggered u-momentum type variables.
!
# if defined WRITE_WATER && defined MASKING
        u2dgrd(1)=dimids(18)
        u2dgrd(2)=dimids(12)
#  ifdef SOLVE3D
        u3dgrd(1)=dimids(21)
        u3dgrd(2)=dimids(12)
#  endif
# else
        u2dgrd(1)=dimids( 2)
        u2dgrd(2)=dimids( 6)
        u2dgrd(3)=dimids(12)
#  ifdef SOLVE3D
        u3dgrd(1)=dimids( 2)
        u3dgrd(2)=dimids( 6)
        u3dgrd(3)=dimids( 9)
        u3dgrd(4)=dimids(12)
#  endif
#  ifdef ADJUST_WSTRESS
        u3dfrc(1)=dimids( 2)
        u3dfrc(2)=dimids( 6)
        u3dfrc(3)=frecdim
        u3dfrc(4)=dimids(12)
#  endif
# endif
!
!  Define dimension vectors for staggered v-momentum type variables.
!
# if defined WRITE_WATER && defined MASKING
        v2dgrd(1)=dimids(19)
        v2dgrd(2)=dimids(12)
#  ifdef SOLVE3D
        v3dgrd(1)=dimids(22)
        v3dgrd(2)=dimids(12)
#  endif
# else
        v2dgrd(1)=dimids( 3)
        v2dgrd(2)=dimids( 7)
        v2dgrd(3)=dimids(12)
#  ifdef SOLVE3D
        v3dgrd(1)=dimids( 3)
        v3dgrd(2)=dimids( 7)
        v3dgrd(3)=dimids( 9)
        v3dgrd(4)=dimids(12)
#  endif
#  ifdef ADJUST_WSTRESS
        v3dfrc(1)=dimids( 3)
        v3dfrc(2)=dimids( 7)
        v3dfrc(3)=frecdim
        v3dfrc(4)=dimids(12)
#  endif
# endif
# ifdef SOLVE3D
!
!  Define dimension vector for staggered w-momentum type variables.
!
#  if defined WRITE_WATER && defined MASKING
        w3dgrd(1)=dimids(23)
        w3dgrd(2)=dimids(12)
#  else
        w3dgrd(1)=dimids( 1)
        w3dgrd(2)=dimids( 5)
        w3dgrd(3)=dimids(10)
        w3dgrd(4)=dimids(12)
#  endif
# endif
!
!  Initialize local information variable arrays.
!
        DO i=1,natt
          DO j=1,len(vinfo(1))
            vinfo(i)(j:j)=' '
          END DO
        END DO
        DO i=1,6
          aval(i)=0.0_r8
        END DO
!
!-----------------------------------------------------------------------
!  Define time-recordless information variables.
!-----------------------------------------------------------------------
!
        CALL def_info (ng, itlm, itl(ng)%pioFile, ncname, dimids)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Define time-varying variables.
!-----------------------------------------------------------------------
!
!  Define model time.
!
        vinfo( 1)=vname(1,idtime)
        vinfo( 2)=vname(2,idtime)
        WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
        vinfo( 4)=trim(rclock%calendar)
        vinfo(14)=vname(4,idtime)
        vinfo(21)=vname(6,idtime)
        itl(ng)%pioVar(idtime)%dkind=pio_tout
        itl(ng)%pioVar(idtime)%gtype=0
!
        status=def_var(ng, itlm, itl(ng)%pioFile,                       &
     &                 itl(ng)%pioVar(idtime)%vd, pio_tout,             &
     &                 1, (/recdim/), aval, vinfo, ncname,              &
     &                 setparaccess = .false.)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Define free-surface.
!
        vinfo( 1)=vname(1,idfsur)
        WRITE (vinfo( 2),40) trim(vname(2,idfsur))
        vinfo( 3)=vname(3,idfsur)
        vinfo(14)=vname(4,idfsur)
        vinfo(16)=vname(1,idtime)
# if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_rho'
# endif
        vinfo(21)=vname(6,idfsur)
        vinfo(22)='coordinates'
        aval(5)=real(iinfo(1,idfsur,ng),r8)
        itl(ng)%pioVar(idfsur)%dkind=pio_fout
        itl(ng)%pioVar(idfsur)%gtype=r2dvar
!
        status=def_var(ng, itlm, itl(ng)%pioFile,                       &
     &                 itl(ng)%pioVar(idfsur)%vd, pio_fout,             &
# ifdef WET_DRY
     &                 nvd3, t2dgrd, aval, vinfo, ncname,      &
     &                 setfillval = .false.)
# else
     &                 nvd3, t2dgrd, aval, vinfo, ncname)
# endif
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef ADJUST_BOUNDARY
!
!  Define free-surface open boundaries.
!
        IF (any(lobc(:,isfsur,ng))) THEN
          ifield=idsbry(isfsur)
          vinfo( 1)=vname(1,ifield)
          WRITE (vinfo( 2),40) trim(vname(2,ifield))
          vinfo( 3)=vname(3,ifield)
          vinfo(14)=vname(4,ifield)
          vinfo(16)=vname(1,idtime)
          vinfo(21)=vname(6,ifield)
          aval(5)=real(iinfo(1,ifield,ng),r8)
          itl(ng)%pioVar(ifield)%dkind=pio_fout
          itl(ng)%pioVar(ifield)%gtype=r2dobc
!
          status=def_var(ng, itlm, itl(ng)%pioFile,                     &
     &                   itl(ng)%pioVar(ifield)%vd, pio_fout,           &
     &                   4, t2dobc, aval, vinfo, ncname,                &
     &                   setfillval = .false.)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
# endif
!
!  Define 2D U-momentum component.
!
        vinfo( 1)=vname(1,idubar)
        WRITE (vinfo( 2),40) trim(vname(2,idubar))
        vinfo( 3)=vname(3,idubar)
        vinfo(14)=vname(4,idubar)
        vinfo(16)=vname(1,idtime)
# if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_u'
# endif
        vinfo(21)=vname(6,idubar)
        vinfo(22)='coordinates'
        aval(5)=real(iinfo(1,idubar,ng),r8)
        itl(ng)%pioVar(idubar)%dkind=pio_fout
        itl(ng)%pioVar(idubar)%gtype=u2dvar
!
        status=def_var(ng, itlm, itl(ng)%pioFile,                       &
     &                 itl(ng)%pioVar(idubar)%vd, pio_fout,             &
     &                 nvd3, u2dgrd, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef ADJUST_BOUNDARY
!
!  Define 2D U-momentum component open boundaries.
!
        IF (any(lobc(:,isubar,ng))) THEN
          ifield=idsbry(isubar)
          vinfo( 1)=vname(1,ifield)
          WRITE (vinfo( 2),40) trim(vname(2,ifield))
          vinfo( 3)=vname(3,ifield)
          vinfo(14)=vname(4,ifield)
          vinfo(16)=vname(1,idtime)
          vinfo(21)=vname(6,ifield)
          aval(5)=real(iinfo(1,ifield,ng),r8)
          itl(ng)%pioVar(ifield)%dkind=pio_fout
          itl(ng)%pioVar(ifield)%gtype=u2dobc
!
          status=def_var(ng, itlm, itl(ng)%pioFile,                     &
     &                   itl(ng)%pioVar(ifield)%vd, pio_fout,           &
     &                   4, t2dobc, aval, vinfo, ncname,                &
     &                   setfillval = .false.)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
# endif
!
!  Define 2D V-momentum component.
!
        vinfo( 1)=vname(1,idvbar)
        WRITE (vinfo( 2),40) trim(vname(2,idvbar))
        vinfo( 3)=vname(3,idvbar)
        vinfo(14)=vname(4,idvbar)
        vinfo(16)=vname(1,idtime)
# if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_v'
# endif
        vinfo(21)=vname(6,idvbar)
        vinfo(22)='coordinates'
        aval(5)=real(iinfo(1,idvbar,ng),r8)
        itl(ng)%pioVar(idvbar)%dkind=pio_fout
        itl(ng)%pioVar(idvbar)%gtype=v2dvar
!
        status=def_var(ng, itlm, itl(ng)%pioFile,                       &
     &                 itl(ng)%pioVar(idvbar)%vd, pio_fout,             &
     &                 nvd3, v2dgrd, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
# ifdef ADJUST_BOUNDARY
!
!  Define 2D V-momentum component open boundaries.
!
        IF (any(lobc(:,isvbar,ng))) THEN
          ifield=idsbry(isvbar)
          vinfo( 1)=vname(1,ifield)
          WRITE (vinfo( 2),40) trim(vname(2,ifield))
          vinfo( 3)=vname(3,ifield)
          vinfo(14)=vname(4,ifield)
          vinfo(16)=vname(1,idtime)
          vinfo(21)=vname(6,ifield)
          aval(5)=real(iinfo(1,ifield,ng),r8)
          itl(ng)%pioVar(ifield)%dkind=pio_fout
          itl(ng)%pioVar(ifield)%gtype=v2dobc
!
          status=def_var(ng, itlm, itl(ng)%pioFile,                     &
     &                   itl(ng)%pioVar(ifield)%vd, pio_fout,           &
     &                   4, t2dobc, aval, vinfo, ncname,                &
     &                   setfillval = .false.)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
# endif
# ifdef ADJUST_WSTRESS
!
!  Define surface U-momentum stress.
!
        vinfo( 1)=vname(1,idusms)
        WRITE (vinfo( 2),40) trim(vname(2,idusms))
        vinfo( 3)=vname(3,idusms)
        vinfo(14)=vname(4,idusms)
        vinfo(16)=vname(1,idtime)
#  if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_u'
#  endif
        vinfo(21)=vname(6,idusms)
        vinfo(22)='coordinates'
        aval(5)=real(u2dvar,r8)
        itl(ng)%pioVar(idusms)%dkind=pio_fout
        itl(ng)%pioVar(idusms)%gtype=u2dvar
!
        status=def_var(ng, itlm, itl(ng)%pioFile,                       &
     &                 itl(ng)%pioVar(idusms)%vd, pio_fout,             &
     &                 nvd4, u3dfrc, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Define surface V-momentum stress.
!
        vinfo( 1)=vname(1,idvsms)
        WRITE (vinfo( 2),40) trim(vname(2,idvsms))
        vinfo( 2)=vname(2,idvsms)
        vinfo( 3)=vname(3,idvsms)
        vinfo(14)=vname(4,idvsms)
        vinfo(16)=vname(1,idtime)
#  if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_v'
#  endif
        vinfo(21)=vname(6,idvsms)
        vinfo(22)='coordinates'
        aval(5)=real(v2dvar,r8)
        itl(ng)%pioVar(idvsms)%dkind=pio_fout
        itl(ng)%pioVar(idvsms)%gtype=v2dvar
!
        status=def_var(ng, itlm, itl(ng)%pioFile,                       &
     &                 itl(ng)%pioVar(idvsms)%vd, pio_fout,             &
     &                 nvd4, v3dfrc, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
# endif
# ifdef SOLVE3D
!
!  Define 3D U-momentum component.
!
        vinfo( 1)=vname(1,iduvel)
        WRITE (vinfo( 2),40) trim(vname(2,iduvel))
        vinfo( 3)=vname(3,iduvel)
        vinfo(14)=vname(4,iduvel)
        vinfo(16)=vname(1,idtime)
#  if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_u'
#  endif
        vinfo(21)=vname(6,iduvel)
        vinfo(22)='coordinates'
        aval(5)=real(iinfo(1,iduvel,ng),r8)
        itl(ng)%pioVar(iduvel)%dkind=pio_fout
        itl(ng)%pioVar(iduvel)%gtype=u3dvar
!
        status=def_var(ng, itlm, itl(ng)%pioFile,                       &
     &                 itl(ng)%pioVar(iduvel)%vd, pio_fout,             &
     &                 nvd4, u3dgrd, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#  ifdef ADJUST_BOUNDARY
!
!  Define 3D U-momentum component open boundaries.
!
        IF (any(lobc(:,isuvel,ng))) THEN
          ifield=idsbry(isuvel)
          vinfo( 1)=vname(1,ifield)
          WRITE (vinfo( 2),40) trim(vname(2,ifield))
          vinfo( 3)=vname(3,ifield)
          vinfo(14)=vname(4,ifield)
          vinfo(16)=vname(1,idtime)
          vinfo(21)=vname(6,ifield)
          aval(5)=real(iinfo(1,ifield,ng),r8)
          itl(ng)%pioVar(ifield)%dkind=pio_fout
          itl(ng)%pioVar(ifield)%gtype=u3dobc
!
          status=def_var(ng, itlm, itl(ng)%pioFile,                     &
     &                   itl(ng)%pioVar(ifield)%vd, pio_fout,           &
     &                   5, t3dobc, aval, vinfo, ncname,                &
     &                   setfillval = .false.)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
#  endif
!
!  Define 3D V-momentum component.
!
        vinfo( 1)=vname(1,idvvel)
        WRITE (vinfo( 2),40) trim(vname(2,idvvel))
        vinfo( 3)=vname(3,idvvel)
        vinfo(14)=vname(4,idvvel)
        vinfo(16)=vname(1,idtime)
#  if defined WRITE_WATER && defined MASKING
        vinfo(20)='mask_v'
#  endif
        vinfo(21)=vname(6,idvvel)
        vinfo(22)='coordinates'
        aval(5)=real(iinfo(1,idvvel,ng),r8)
        itl(ng)%pioVar(idvvel)%dkind=pio_fout
        itl(ng)%pioVar(idvvel)%gtype=v3dvar
!
        status=def_var(ng, itlm, itl(ng)%pioFile,                       &
     &                 itl(ng)%pioVar(idvvel)%vd, pio_fout,             &
     &                 nvd4, v3dgrd, aval, vinfo, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
 
#  ifdef ADJUST_BOUNDARY
!
!  Define 3D V-momentum component open boundaries.
!
        IF (any(lobc(:,isvvel,ng))) THEN
          ifield=idsbry(isvvel)
          vinfo( 1)=vname(1,ifield)
          WRITE (vinfo( 2),40) trim(vname(2,ifield))
          vinfo( 3)=vname(3,ifield)
          vinfo(14)=vname(4,ifield)
          vinfo(16)=vname(1,idtime)
          vinfo(21)=vname(6,ifield)
          aval(5)=real(iinfo(1,ifield,ng),r8)
          itl(ng)%pioVar(ifield)%dkind=pio_fout
          itl(ng)%pioVar(ifield)%gtype=v3dobc
!
          status=def_var(ng, itlm, itl(ng)%pioFile,                     &
     &                   itl(ng)%pioVar(ifield)%vd, pio_fout,           &
     &                   5, t3dobc, aval, vinfo, ncname,                &
     &                   setfillval = .false.)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
#  endif
!
!  Define tracer type variables.
!
        DO itrc=1,nt(ng)
          vinfo( 1)=vname(1,idtvar(itrc))
          WRITE (vinfo( 2),40) trim(vname(2,idtvar(itrc)))
          vinfo( 3)=vname(3,idtvar(itrc))
          vinfo(14)=vname(4,idtvar(itrc))
          vinfo(16)=vname(1,idtime)
#  ifdef SEDIMENT
          DO i=1,nst
            IF (itrc.eq.idsed(i)) THEN
              WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
            END IF
          END DO
#  endif
#  if defined WRITE_WATER && defined MASKING
          vinfo(20)='mask_rho'
#  endif
          vinfo(21)=vname(6,idtvar(itrc))
          vinfo(22)='coordinates'
          aval(5)=real(r3dvar,r8)
          itl(ng)%pioTrc(itrc)%dkind=pio_fout
          itl(ng)%pioTrc(itrc)%gtype=r3dvar
!
          status=def_var(ng, itlm, itl(ng)%pioFile,                     &
     &                   itl(ng)%pioTrc(itrc)%vd, pio_fout,             &
     &                   nvd4, t3dgrd, aval, vinfo, ncname)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END DO
 
#  ifdef ADJUST_BOUNDARY
!
!  Define tracer type variables open boundaries.
!
        DO itrc=1,nt(ng)
          IF (any(lobc(:,istvar(itrc),ng))) THEN
            ifield=idsbry(istvar(itrc))
            vinfo( 1)=vname(1,ifield)
            WRITE (vinfo( 2),40) trim(vname(2,ifield))
            vinfo( 3)=vname(3,ifield)
            vinfo(14)=vname(4,ifield)
            vinfo(16)=vname(1,idtime)
#   ifdef SEDIMENT
            DO i=1,nst
              IF (itrc.eq.idsed(i)) THEN
                WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
              END IF
            END DO
#   endif
            vinfo(21)=vname(6,ifield)
            aval(5)=real(iinfo(1,ifield,ng),r8)
            itl(ng)%pioVar(ifield)%dkind=pio_fout
            itl(ng)%pioVar(ifield)%gtype=r3dobc
!
            status=def_var(ng, itlm, itl(ng)%pioFile,                   &
     &                     itl(ng)%pioVar(ifield)%vd, pio_fout,         &
     &                     5, t3dobc, aval, vinfo, ncname,              &
                           setfillval = .false.)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END DO
#  endif
#  ifdef ADJUST_STFLUX
!
!  Define surface tracer fluxes.
!
        DO itrc=1,nt(ng)
          IF (lstflux(itrc,ng)) THEN
            vinfo( 1)=vname(1,idtsur(itrc))
            WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
            vinfo( 3)=vname(3,idtsur(itrc))
            IF (itrc.eq.itemp) THEN
              vinfo(11)='upward flux, cooling'
              vinfo(12)='downward flux, heating'
            ELSE IF (itrc.eq.isalt) THEN
              vinfo(11)='upward flux, freshening (net precipitation)'
              vinfo(12)='downward flux, salting (net evaporation)'
            END IF
            vinfo(14)=vname(4,idtsur(itrc))
            vinfo(16)=vname(1,idtime)
#  if defined WRITE_WATER && defined MASKING
            vinfo(20)='mask_rho'
#  endif
            vinfo(21)=vname(6,idtsur(itrc))
            vinfo(22)='coordinates'
            aval(5)=real(r2dvar,r8)
            itl(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
            itl(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
!
            status=def_var(ng, itlm, itl(ng)%pioFile,                   &
     &                     itl(ng)%pioVar(idtsur(itrc))%vd, pio_fout,   &
     &                     nvd4, t3dfrc, aval, vinfo, ncname)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END DO
#  endif
# endif
!
!-----------------------------------------------------------------------
!  Leave definition mode.
!-----------------------------------------------------------------------
!
        CALL pio_netcdf_enddef (ng, itlm, ncname, itl(ng)%pioFile)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!-----------------------------------------------------------------------
!  Write out time-recordless, information variables.
!-----------------------------------------------------------------------
!
        CALL wrt_info (ng, itlm, itl(ng)%pioFile, ncname)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF define
!
!=======================================================================
!  Open an existing initialization file, check its contents, and
!  prepare for appending data.
!=======================================================================
!
      query : IF (.not.ldefitl(ng)) THEN
        ncname=itl(ng)%name
!
!  Open tangent linear initialization file for read/write.
!
        CALL pio_netcdf_open (ng, itlm, ncname, 1, itl(ng)%pioFile)
        IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
          WRITE (stdout,60) trim(ncname)
          RETURN
        END IF
!
!  Inquire about the dimensions and check for consistency.
!
        CALL pio_netcdf_check_dim (ng, itlm, ncname,                    &
     &                             piofile = itl(ng)%pioFile)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Inquire about the variables.
!
        CALL pio_netcdf_inq_var (ng, itlm, ncname,                      &
     &                           piofile = itl(ng)%pioFile)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Initialize logical switches.
!
        DO i=1,nv
          got_var(i)=.false.
        END DO
!
!  Scan variable list from input NetCDF and activate switches for
!  initialization variables. Get variable IDs.
!
        DO i=1,n_var
          IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
            got_var(idtime)=.true.
            itl(ng)%pioVar(idtime)%vd=var_desc(i)
            itl(ng)%pioVar(idtime)%dkind=pio_tout
            itl(ng)%pioVar(idtime)%gtype=0
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
            got_var(idfsur)=.true.
            itl(ng)%pioVar(idfsur)%vd=var_desc(i)
            itl(ng)%pioVar(idfsur)%dkind=pio_fout
            itl(ng)%pioVar(idfsur)%gtype=r2dvar
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
            got_var(idubar)=.true.
            itl(ng)%pioVar(idubar)%vd=var_desc(i)
            itl(ng)%pioVar(idubar)%dkind=pio_fout
            itl(ng)%pioVar(idubar)%gtype=u2dvar
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
            got_var(idvbar)=.true.
            itl(ng)%pioVar(idvbar)%vd=var_desc(i)
            itl(ng)%pioVar(idvbar)%dkind=pio_fout
            itl(ng)%pioVar(idvbar)%gtype=v2dvar
# ifdef ADJUST_BOUNDARY
          ELSE IF (trim(var_name(i)).eq.                                &
     &             trim(vname(1,idsbry(isfsur)))) THEN
            got_var(idsbry(isfsur))=.true.
            itl(ng)%pioVar(idsbry(isfsur))%vd=var_desc(i)
            itl(ng)%pioVar(idsbry(isfsur))%dkind=pio_fout
            itl(ng)%pioVar(idsbry(isfsur))%gtype=r2dobc
          ELSE IF (trim(var_name(i)).eq.                                &
     &             trim(vname(1,idsbry(isubar)))) THEN
            got_var(idsbry(isubar))=.true.
            itl(ng)%pioVar(idsbry(isubar))%vd=var_desc(i)
            itl(ng)%pioVar(idsbry(isubar))%dkind=pio_fout
            itl(ng)%pioVar(idsbry(isubar))%gtype=u2dobc
          ELSE IF (trim(var_name(i)).eq.                                &
     &             trim(vname(1,idsbry(isvbar)))) THEN
            got_var(idsbry(isvbar))=.true.
            itl(ng)%pioVar(idsbry(isvbar))%vd=var_desc(i)
            itl(ng)%pioVar(idsbry(isvbar))%dkind=pio_fout
            itl(ng)%pioVar(idsbry(isvbar))%gtype=v2dobc
# endif
# ifdef ADJUST_WSTRESS
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
            got_var(idusms)=.true.
            itl(ng)%pioVar(idusms)%vd=var_desc(i)
            itl(ng)%pioVar(idusms)%dkind=pio_fout
            itl(ng)%pioVar(idusms)%gtype=u2dvar
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
            got_var(idvsms)=.true.
            itl(ng)%pioVar(idvsms)%vd=var_desc(i)
            itl(ng)%pioVar(idvsms)%dkind=pio_fout
            itl(ng)%pioVar(idvsms)%gtype=v2dvar
# endif
# ifdef SOLVE3D
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
            got_var(iduvel)=.true.
            itl(ng)%pioVar(iduvel)%vd=var_desc(i)
            itl(ng)%pioVar(iduvel)%dkind=pio_fout
            itl(ng)%pioVar(iduvel)%gtype=u3dvar
          ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
            got_var(idvvel)=.true.
            itl(ng)%pioVar(idvvel)%vd=var_desc(i)
            itl(ng)%pioVar(idvvel)%dkind=pio_fout
            itl(ng)%pioVar(idvvel)%gtype=v3dvar
#  ifdef ADJUST_BOUNDARY
          ELSE IF (trim(var_name(i)).eq.                                &
     &             trim(vname(1,idsbry(isuvel)))) THEN
            got_var(idsbry(isuvel))=.true.
            itl(ng)%pioVar(idsbry(isuvel))%vd=var_desc(i)
            itl(ng)%pioVar(idsbry(isuvel))%dkind=pio_fout
            itl(ng)%pioVar(idsbry(isuvel))%gtype=u3dobc
          ELSE IF (trim(var_name(i)).eq.                                &
     &             trim(vname(1,idsbry(isvvel)))) THEN
            got_var(idsbry(isvvel))=.true.
            itl(ng)%pioVar(idsbry(isvvel))%vd=var_desc(i)
            itl(ng)%pioVar(idsbry(isvvel))%dkind=pio_fout
            itl(ng)%pioVar(idsbry(isvvel))%gtype=v3dobc
#  endif
# endif
          END IF
# ifdef SOLVE3D
          DO itrc=1,nt(ng)
            IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
              got_var(idtvar(itrc))=.true.
              itl(ng)%pioTrc(itrc)%vd=var_desc(i)
              itl(ng)%pioTrc(itrc)%dkind=pio_fout
              itl(ng)%pioTrc(itrc)%gtype=r3dvar
#  ifdef ADJUST_BOUNDARY
            ELSE IF (trim(var_name(i)).eq.                              &
     &               trim(vname(1,idsbry(istvar(itrc))))) THEN
              got_var(idsbry(istvar(itrc)))=.true.
              itl(ng)%pioVar(idsbry(istvar(itrc)))%vd=var_desc(i)
              itl(ng)%pioVar(idsbry(istvar(itrc)))%dkind=pio_fout
              itl(ng)%pioVar(idsbry(istvar(itrc)))%gtype=r3dobc
#  endif
#  ifdef ADJUST_STFLUX
            ELSE IF (trim(var_name(i)).eq.                              &
     &               trim(vname(1,idtsur(itrc)))) THEN
              got_var(idtsur(itrc))=.true.
              itl(ng)%pioVar(idtsur(itrc))%vd=var_desc(i)
              itl(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
              itl(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
#  endif
            END IF
          END DO
# endif
        END DO
!
!  Check if tangent linear mode initialization variables are available
!  in input NetCDF file.
!
        IF (.not.got_var(idtime)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idtime)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idfsur)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idfsur)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idubar)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idubar)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idvbar)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idvbar)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
# ifdef ADJUST_BOUNDARY
        IF (.not.got_var(idsbry(isfsur)).and.                           &
     &      any(lobc(:,isfsur,ng))) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isfsur))),  &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idsbry(isubar)).and.                           &
     &      any(lobc(:,isubar,ng))) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isubar))),  &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idsbry(isvbar)).and.                           &
     &      any(lobc(:,isvbar,ng))) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvbar))),  &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
# endif
# ifdef ADJUST_WSTRESS
        IF (.not.got_var(idusms)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idusms)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idvsms)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idvsms)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
# endif
# ifdef SOLVE3D
        IF (.not.got_var(iduvel)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,iduvel)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idvvel)) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idvvel)),          &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
#  ifdef ADJUST_BOUNDARY
        IF (.not.got_var(idsbry(isuvel)).and.                           &
     &      any(lobc(:,isuvel,ng))) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isuvel))),  &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
        IF (.not.got_var(idsbry(isvvel)).and.                           &
     &      any(lobc(:,isvvel,ng))) THEN
          IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvvel))),  &
     &                                  trim(ncname)
          exit_flag=3
          RETURN
        END IF
#  endif
# endif
# ifdef SOLVE3D
        DO itrc=1,nt(ng)
          IF (.not.got_var(idtvar(itrc))) THEN
            IF (master) WRITE (stdout,70) trim(vname(1,idtvar(itrc))),  &
     &                                    trim(ncname)
            exit_flag=3
            RETURN
          END IF
#  ifdef ADJUST_BOUNDARY
          IF (.not.got_var(idsbry(istvar(itrc))).and.                   &
     &        any(lobc(:,istvar(itrc),ng))) THEN
            IF (master) WRITE (stdout,70)                               &
     &                        trim(vname(1,idsbry(istvar(itrc)))),      &
     &                        trim(ncname)
            exit_flag=3
            RETURN
          END IF
#  endif
#  ifdef ADJUST_STFLUX
          IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
            IF (master) WRITE (stdout,70) trim(vname(1,idtsur(itrc))),  &
     &                                    trim(ncname)
            exit_flag=3
            RETURN
          END IF
#  endif
        END DO
# endif
!
!  Set unlimited time record dimension to the appropriate value.
!
        itl(ng)%Rindex=rec_size
        fcount=itl(ng)%Fcount
        itl(ng)%Nrec(fcount)=rec_size
      END IF query
!
  10  FORMAT (2x,'TL_DEF_INI_PIO   - creating initial file,',t56,       &
     &        'Grid ',i2.2,': ',a)
  20  FORMAT (2x,'TL_DEF_INI_PIO   - inquiring initial file,',t56,      &
     &        'Grid ',i2.2,': ',a)
  30  FORMAT (/,' TL_DEF_INI_PIO - unable to create initial NetCDF',    &
     &        ' file:',1x,a)
  40  FORMAT ('tangent linear',1x,a)
  50  FORMAT (1pe11.4,1x,'millimeter')
  60  FORMAT (/,' TL_DEF_INI_PIO - unable to open initial NetCDF',      &
     &        ' file: ',a)
  70  FORMAT (/,' TL_DEF_INI_PIO - unable to find variable: ',a,2x,     &
     &        ' in file: ',a)
!
      RETURN
      END SUBROUTINE tl_def_ini_pio
# endif
#endif
      END MODULE tl_def_ini_mod