w3iotrmd Module Reference

Generate track output. More...

Functions/Subroutines
subroutine	w3iotr (NDSINP, NDSOUT, A, IMOD)
	Perform output of spectral information along provided tracks. More...

Detailed Description

Generate track output.

Author

H. L. Tolman

Date

26-Dec-2012

Function/Subroutine Documentation

w3iotr()

subroutine w3iotrmd::w3iotr	(	integer, intent(in)	NDSINP,
		integer, intent(in)	NDSOUT,
		real, dimension(nth,nk,0:nseal), intent(in)	A,
		integer, intent(in)	IMOD
	)

Perform output of spectral information along provided tracks.

     Time and location data for the track is read from the file
     track_i.FILEXT, and output spectra additional information are
     written to track_o.FILEXT.

     The spectrum dumped is the frequency-direction spectrum in
     m**2/Hz/rad.

     The output spectra are energy density spectra in terms of the
     true frequency and a direction in radians. The corresponding
     band widths are part of the file header.

Parameters

[in,out]	NDSINP	Unit number of input file track_i.FILEXT.
[in,out]	NDSOUT	Unit number of output file track_o.FILEXT.
[in,out]	A	Spectra (shape conversion through par list).
[in,out]	IMOD	Model grid number.

Author

H. L. Tolman

Date

08-Jun-2018

Definition at line 105 of file w3iotrmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         08-Jun-2018 |
    !/                  +-----------------------------------+
    !/
    !/    22-Dec-1998 : Final FORTRAN 77                    ( version 1.18 )
    !/    27-Dec-1999 : Upgrade to FORTRAN 90               ( version 2.00 )
    !/    24-Jan-2001 : Flat grid version                   ( version 2.06 )
    !/    20-Aug-2003 : Output through NAPTRK, seq. file.   ( version 3.04 )
    !/    24-Nov-2004 : Multiple grid version.              ( version 3.06 )
    !/    04-May-2005 : Change to MPI_COMM_WAVE.            ( version 3.07 )
    !/    27-Jun-2005 : Adding MAPST2,                      ( version 3.07 )
    !/    27-Jun-2006 : Adding file name preamble.          ( version 3.09 )
    !/    17-May-2007 : Adding NTPROC/NAPROC separation.    ( version 3.11 )
    !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
    !/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
    !/                  (W. E. Rogers & T. J. Campbell, NRL)
    !/    30-Oct-2009 : Implement curvilinear grid type.    ( version 3.14 )
    !/                  (W. E. Rogers & T. J. Campbell, NRL)
    !/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
    !/                  specify index closure for a grid.   ( version 3.14 )
    !/                  (T. J. Campbell, NRL)
    !/    26-Dec-2012 : Initialize ASPTRK.                  ( version 4.11 )
    !/    12-Dec-2014 : Modify instanciation of NRQTR       ( version 5.04 )
    !/    08-Jun-2018 : use W3PARALL/INIT_GET_JSEA_ISPROC   ( version 6.04 )
    !/
    !/    Copyright 2009-2014 National Weather Service (NWS),
    !/       National Oceanic and Atmospheric Administration.  All rights
    !/       reserved.  WAVEWATCH III is a trademark of the NWS.
    !/       No unauthorized use without permission.
    !/
    !  1. Purpose :
    !
    !     Perform output of spectral information along provided tracks.
    !
    !  2. Method :
    !
    !     Time and location data for the track is read from the file
    !     track_i.FILEXT, and output spectra additional information are
    !     written to track_o.FILEXT.
    !
    !     The spectrum dumped is the frequency-direction spectrum in
    !     m**2/Hz/rad.
    !
    !     The output spectra are energy density spectra in terms of the
    !     true frequency and a direction in radians. The corresponding
    !     band widths are part of the file header.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       NDSINP  Int.   I   Unit number of input file track_i.FILEXT
    !                          If negative, file is unformatted and v.v.
    !       NDSOUT  Int.   I   Unit number of output file track_o.FILEXT
    !       A       R.A.   I   Spectra (shape conversion through par list).
    !       IMOD    Int.   I   Model grid number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     See module documentation.
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3WAVE    Subr. W3WAVEMD Actual wave model routine.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     - If input file not found, a warning is printed and output
    !       type is disabled.
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !     !/SHRD  Switch for shared / distributed memory architecture.
    !     !/DIST  Id.
    !     !/MPI   MPI interface routines.
    !
    !     !/S     Enable subroutine tracing.
    !     !/T     General test output.
    !     !/T1    Test output on track point status.
    !     !/T2    Test output of mask arrays.
    !     !/T3    Test output for writing of file.
    !
    ! 10. Remarks :
    !
    !     Regarding section 3.e.2 "Optimize: omit points that are not
    !       strictly required.". This optimization saves disk space but
    !       results in output files that are more difficult to use. For
    !       example, matlab built-in function "griddata" requires all four
    !       bounding points. This means that a post-processing code must
    !       have extra logic do deal with cases without all four bounding
    !       points (interpolation along a line, or nearest neighbor).
    !       A namelist variable has been add to make this feature optional.
    !       Default, original behavior: TRCKCMPR = T (in /MISC/ namelist).
    !       Save all points: TRCKCMPR =  F (in /MISC/ namelist).
    !       Within the present routine, the logical is named "CMPRTRCK".
    !
    ! 11. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE constants
    !/
    USE w3gdatmd, ONLY: w3setg, cmprtrck
    USE w3wdatmd, ONLY: w3setw
    USE w3adatmd, ONLY: w3seta
    USE w3odatmd, ONLY: w3seto, w3dmo3
    !/
    USE w3gdatmd, ONLY: nk, nth, nspec, nsea, nseal, nx, ny,        &
         flagll, iclose, xgrd, ygrd, gsu,            &
         dpdx, dpdy, dqdx, dqdy, mapsta, mapst2,     &
         mapfs, th, dth, sig, dsip, xfr, filext
    USE w3gsrumd, ONLY: w3gfcl
#ifdef W3_T
    USE w3gsrumd, ONLY: w3gsup
#endif
    USE w3gdatmd, ONLY: maxx, maxy, gtype, ungtype
    USE w3wdatmd, ONLY: time, ust
    USE w3adatmd, ONLY: cg, dw, cx, cy, ua, ud, as
#ifdef W3_MPI
    USE w3adatmd, ONLY: mpi_comm_wave
#endif
    USE w3odatmd, ONLY: ndst, ndse, iaproc, naproc, naptrk, naperr, &
         ipass => ipass3, atolast => tolast,         &
         adtout => dtout, o3init, stop, mask1,       &
         mask2, trckid, fnmpre
#ifdef W3_MPI
    USE w3odatmd, ONLY: it0trk, nrqtr, irqtr
#endif
    !/
    USE w3timemd
    USE w3parall, ONLY : init_get_jsea_isproc
    USE w3servmd, ONLY : strsplit
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: NDSINP, NDSOUT, IMOD
    REAL, INTENT(IN)        :: A(NTH,NK,0:NSEAL)
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER, PARAMETER      :: OTYPE = 3
    INTEGER                 :: NDSTI, NDSTO, ISPROC, IERR,          &
         IK, ITH, IX, IY, TIMEB(2), TIMEE(2), &
         TTIME(2), IX1, IX2, IY1, IY2,        &
         IXX(4), IYY(4), I, J, ISEA, JSEA,    &
         TOLAST(2)
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
#ifdef W3_T
    INTEGER                 :: NREAD, NTRACK, NSPECO, NLOCO
#endif
#ifdef W3_T3
    INTEGER                 :: ISPT
#endif
#ifdef W3_MPI
    INTEGER                 :: IT, IROOT, IFROM, IERR_MPI
    INTEGER, ALLOCATABLE    :: STATUS(:,:)
#endif
    REAL                    :: XN, YN, XT, YT, RD, X, Y, WX, WY,    &
         SPEC(NK,NTH), FACTOR, ASPTRK(NTH,NK),&
         DTOUT, XX(4), YY(4)
    REAL, SAVE              :: RDCHCK = 0.05, rtchck = 0.05
    LOGICAL                 :: FORMI, FLAG1, FLAG2, INGRID
    CHARACTER               :: TRCKT*32, LINE*1024, TSTSTR*3, IDTST*34
    CHARACTER(LEN=100)      :: LIST(5)
#ifdef W3_T1
    CHARACTER(LEN=17), SAVE :: TSTLOC = '                 '
#endif
#ifdef W3_T2
    CHARACTER(LEN=1)        :: MAPSTR(NX)
#endif
    !
    equivalence(ixx(1),ix1) , (ixx(2),ix2) ,        &
         (iyy(1),iy1) , (iyy(3),iy2)
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'W3IOTR')
#endif
    !
    CALL w3seto ( imod, ndse, ndst )
    CALL w3setg ( imod, ndse, ndst )
    CALL w3seta ( imod, ndse, ndst )
    CALL w3setw ( imod, ndse, ndst )
    !
    tolast = atolast(:,otype)
    dtout  = adtout(otype)
    !
    IF ( .NOT. o3init ) CALL w3dmo3 ( imod, ndse, ndst )
    !
    formi  = ndsinp .GT. 0
    ndsti  = abs(ndsinp)
    ndsto  = abs(ndsout)
 
    IF (gtype .EQ. ungtype) THEN
      xn     = maxx
      yn     = maxy
    ENDIF
    !
    isproc = iaproc
    ipass  = ipass + 1
    !
    IF ( flagll ) THEN
      factor = 1.
    ELSE
      factor = 1.e-3
    END IF
    !
    asptrk = 0.
    !
#ifdef W3_T
    WRITE (ndst,9000) time
#endif
    !
#ifdef W3_MPI
    IF ( nrqtr .NE. 0 ) THEN
      CALL mpi_startall ( nrqtr, irqtr, ierr_mpi )
      ALLOCATE ( status(mpi_status_size,nrqtr) )
      CALL mpi_waitall ( nrqtr, irqtr , status, ierr_mpi )
      DEALLOCATE ( status )
    END IF
#endif
    !
    ! 1.  First pass through routine ------------------------------------- *
    !
    IF ( ipass .EQ. 1 ) THEN
      !
#ifdef W3_T
      WRITE (ndst,9010) tolast, dtout, ndsti, ndsto, formi
#endif
      !   Removed by F.A. 2010/12/24  /T          CALL W3GSUP ( GSU, NDST )
      !
      i      = len_trim(filext)
      j      = len_trim(fnmpre)
      !
      ! 1.a Open input file
      !
      IF ( formi ) THEN
#ifdef W3_T
        WRITE (ndst,9011) fnmpre(:j)//'track_i.'//filext(:i), &
             'FORMATTED'
#endif
        OPEN (ndsti,file=fnmpre(:j)//'track_i.'//filext(:i),     &
             status='OLD',err=800,form='FORMATTED',iostat=ierr)
        READ (ndsti,'(A)',err=801,END=802,IOSTAT=IERR) idtst
      ELSE
#ifdef W3_T
        WRITE (ndst,9011) fnmpre(:j)//'track_i.'//filext(:i), &
             'UNFORMATTED'
#endif
        OPEN (ndsti,file=fnmpre(:j)//'track_i.'//filext(:i),     &
             status='OLD',err=800,form='UNFORMATTED', convert=file_endian,iostat=ierr)
        READ (ndsti,err=801,END=802,IOSTAT=IERR) idtst
      END IF
      !
      IF ( idtst .NE. idstri ) GOTO 803
      !
      ! 1.b Open output file
      !
      IF ( iaproc .EQ. naptrk ) THEN
#ifdef W3_T
        WRITE (ndst,9012) fnmpre(:j)//'track_o.'//filext(:i), &
             'UNFORMATTED'
#endif
        OPEN (ndsto,file=fnmpre(:j)//'track_o.'//filext(:i),     &
             form='UNFORMATTED', convert=file_endian,err=810,iostat=ierr)
        WRITE (ndsto,err=811,iostat=ierr) idstro, flagll, nk,    &
             nth, xfr
        WRITE (ndsto,err=811,iostat=ierr) 0.5*pi-th(1), -dth,    &
             (sig(ik)*tpiinv,ik=1,nk),                          &
             (dsip(ik)*tpiinv,ik=1,nk)
      END IF
      !
      ! 1.c Initialize maps
      !
#ifdef W3_T
      WRITE (ndst,9015)
#endif
      !
      mask2  = .false.
      trckid = ''
      !
    END IF
    !
    ! 2.  Preparations --------------------------------------------------- *
    ! 2.a Shift mask arrays
    !
#ifdef W3_T
    WRITE (ndst,9020)
#endif
    !
    mask1  = mask2
    mask2  = .false.
    !
    ! 2.b Set time frame
    !
    timeb  = time
    timee  = time
    CALL tick21 ( timee ,  dtout )
    !
    IF ( dsec21(timee,tolast) .LT. 0. ) THEN
      timee  = tolast
#ifdef W3_T
      WRITE (ndst,9022)
#endif
    END IF
    !
#ifdef W3_T
    WRITE (ndst,9021) timeb, timee
#endif
    !
    ! 3.  Loop over input points ----------------------------------------- *
    !
#ifdef W3_T
    nread  = 0
    ntrack = 0
#endif
    !
    ! 3.a Read new track point (infinite loop)
    !
    IF ( stop ) THEN
      tolast = time
#ifdef W3_T
      WRITE (ndst,9034)
#endif
      GOTO 399
    END IF
    !
#ifdef W3_T1
    WRITE (ndst,9030)
#endif
    !
    DO
      !
      IF ( formi ) THEN
        READ (ndsti,'(A)',err=801,END=390,IOSTAT=IERR) line
        list(:)=''
        CALL strsplit(line,list)
        READ(list(1),'(I8)') ttime(1)
        READ(list(2),'(I6)') ttime(2)
        READ(list(3),*) xt
        READ(list(4),*) yt
        IF(SIZE(list).GE.5) trckt=list(5)
      ELSE
        READ (ndsti, err=801,END=390,IOSTAT=IERR) TTIME, XT, YT, trckt
      END IF
#ifdef W3_T
      nread  = nread + 1
#endif
      !
      ! 3.b Point before time interval
      !
      IF ( dsec21(timeb,ttime) .LT. 0. ) THEN
#ifdef W3_T1
        WRITE (ndst,9031) ttime,factor*xt,factor*yt,'TOO EARLY'
#endif
        cycle
      END IF
      !
      ! 3.c Point after time interval
      !
      IF ( dsec21(timee,ttime) .GT. 0. ) THEN
        backspace(ndsti)
#ifdef W3_T
        nread  = nread - 1
#endif
#ifdef W3_T1
        WRITE (ndst,9031) ttime,factor*xt,factor*yt,'TOO LATE'
#endif
        GOTO 399
      END IF
      !
      ! 3.d Check time in interval
      !
      flag1  = dsec21(ttime,timee) .GT. rtchck*dtout
      flag2  = dsec21(timeb,ttime) .GT. rtchck*dtout
      !
      ! 3.e Check point coordinates
      !
 
      ! 3.e.1 Initial identification of computational grid points to include.
      !
      !       Find cell that encloses target point (note that the returned
      !       cell corner indices are adjusted for global wrapping and the
      !       coordinates are adjusted to avoid branch cut crossings)
      ingrid = w3gfcl( gsu, xt, yt, ixx, iyy, xx, yy )
      IF ( .NOT. ingrid ) THEN
#ifdef W3_T1
        WRITE (ndst,9031) ttime, factor*xt, factor*yt, &
             'OUT OF GRID'
#endif
        cycle
      END IF
      !
      !       Change cell-corners from counter-clockwise to column-major order
      ix     = ixx(4);  iy     = iyy(4);
      ixx(4) = ixx(3);  iyy(4) = iyy(3);
      ixx(3) = ix;      iyy(3) = iy;
      !
      ! 3.e.2 Optimize: omit points that are not strictly required.
      !       See "Remarks"
 
      IF(cmprtrck)THEN ! perform track compression
 
        !         Project onto I-axis
        rd = dpdx(iyy(1),ixx(1))*(xt-xx(1)) &
             + dpdy(iyy(1),ixx(1))*(yt-yy(1))
        !
        !         Collapse to left or right if within tolerance
        IF ( rd .LT. rdchck ) THEN
          ixx(2) = ixx(1)
          ixx(4) = ixx(3)
        ELSE IF ( rd .GT. 1.-rdchck ) THEN
          ixx(1) = ixx(2)
          ixx(3) = ixx(4)
        END IF
        !
        !         Project onto J-axis
        rd = dqdx(iyy(1),ixx(1))*(xt-xx(1)) &
             + dqdy(iyy(1),ixx(1))*(yt-yy(1))
        !
        !         Collapse to top or bottom if within tolerance
        IF ( rd .LT. rdchck ) THEN
          iyy(3) = iyy(1)
          iyy(4) = iyy(2)
        ELSE IF ( rd .GT. 1.-rdchck ) THEN
          iyy(1) = iyy(3)
          iyy(2) = iyy(4)
        END IF
 
      END IF ! IF(CMPRTRCK)THEN
      !
      ! 3.f Mark the four corner points
      !
      DO j=1, 4
        !
        ix     = ixx(j)
        iy     = iyy(j)
        IF(gtype .EQ. ungtype) THEN
          x = xgrd(1,ix)
          y = ygrd(1,ix)
        ENDIF
        mask1(iy,ix) = mask1(iy,ix) .OR. flag1
        mask2(iy,ix) = mask2(iy,ix) .OR. flag2
        trckid(iy,ix) = trckt
        !
#ifdef W3_T1
        IF ( mapsta(iy,ix) .EQ. 0 ) THEN
          IF ( mapst2(iy,ix) .EQ. 0 ) THEN
            tstloc(4*j-3:4*j-1) = 'LND'
          ELSE
            tstloc(4*j-3:4*j-1) = 'XCL'
          END IF
        ELSE IF ( mapsta(iy,ix) .LT. 0 ) THEN
          IF ( mapst2(iy,ix) .EQ. 1 ) THEN
            tstloc(4*j-3:4*j-1) = 'ICE'
          ELSE IF ( mapst2(iy,ix) .EQ. 2 ) THEN
            tstloc(4*j-3:4*j-1) = 'DRY'
          ELSE
            tstloc(4*j-3:4*j-1) = 'DIS'
          END IF
        ELSE IF ( mapsta(iy,ix) .GT. 0 ) THEN
          tstloc(4*j-3:4*j-1) = 'SEA'
        END IF
#endif
        !
      END DO
      !
#ifdef W3_T1
      WRITE (ndst,9031) ttime, factor*xt, factor*yt, tstloc,    &
           ixx(1), ixx(2), iyy(1), iyy(3), flag1, flag2
#endif
      !
#ifdef W3_T
      ntrack = ntrack + 1
#endif
      !
    END DO
    !
    ! 3.g End of input file escape location
    !
390 CONTINUE
#ifdef W3_T
    WRITE (ndst,9033)
#endif
    stop   = .true.
    !
    ! 3.h Read end escape location
    !
399 CONTINUE
    !
    ! 3.h Mask test output
    !
#ifdef W3_T2
    WRITE (ndst,9035)
    DO iy=ny,1,-1
      DO ix=1, nx
        IF ( mask1(iy,ix) ) THEN
          mapstr(ix) = 'X'
        ELSE IF ( mask2(iy,ix) ) THEN
          mapstr(ix) = 'x'
        ELSE
          mapstr(ix) = '.'
        END IF
      END DO
      WRITE (ndst,9036) mapstr
    END DO
#endif
    !
    ! 4.  Write data for flagged locations ------------------------------- *
    !
#ifdef W3_T
    nloco  = 0
    nspeco = 0
#endif
#ifdef W3_MPI
    it     = it0trk
    iroot  = naptrk - 1
    ALLOCATE ( status(mpi_status_size,1) )
#endif
    !
    DO iy=1, ny
      DO ix=1, nx
        IF ( mask1(iy,ix) ) THEN
          !
          IF(gtype .EQ. ungtype) THEN
            x = xgrd(1,ix)
            y = ygrd(1,ix)
          ELSE
            x = xgrd(iy,ix)
            y = ygrd(iy,ix)
          ENDIF
#ifdef W3_MPI
          it     = it + 1
#endif
#ifdef W3_T
          nloco  = nloco + 1
#endif
          !
          ! 4.a Status of point
          !
          IF ( mapsta(iy,ix) .EQ. 0 ) THEN
            IF ( mapst2(iy,ix) .EQ. 0 ) THEN
              tststr = 'LND'
            ELSE
              tststr = 'XCL'
            END IF
          ELSE IF ( mapsta(iy,ix) .LT. 0 ) THEN
            IF ( mapst2(iy,ix) .EQ. 1 ) THEN
              tststr = 'ICE'
            ELSE IF ( mapst2(iy,ix) .EQ. 2 ) THEN
              tststr = 'DRY'
            ELSE
              tststr = 'DIS'
            END IF
          ELSE
            tststr = 'SEA'
          END IF
          !
#ifdef W3_T
          IF ( tststr .EQ. 'SEA' ) nspeco = nspeco + 1
#endif
          !
          ! 4.b Determine where point is stored
          !     ( land point assumed stored on IAPROC = NAPTRK
          !       set to -99 in test output )
          !
          isea   = mapfs(iy,ix)
          IF ( isea .EQ. 0 ) THEN
            isproc = naptrk
#ifdef W3_T3
            ispt    = -99
#endif
          ELSE
            CALL init_get_jsea_isproc(isea, jsea, isproc)
#ifdef W3_T3
            ispt    = isproc
#endif
          END IF
#ifdef W3_MPI
          ifrom  = isproc - 1
#endif
          ! 4.c Spectrum is at local processor, but this is not the NAPTRK
          !     Send the spectrum to NAPTRK
 
          IF ( isproc.EQ.iaproc .AND. iaproc.NE.naptrk ) THEN
#ifdef W3_T3
            WRITE (ndst,9040) ix, iy, isea, ispt, 'SENDING'
#endif
#ifdef W3_MPI
            CALL mpi_send ( a(1,1,jsea), nspec, mpi_real,  &
                 iroot, it, mpi_comm_wave, ierr_mpi )
#endif
          END IF
          !
          ! 4.d This is NAPTRK, perform all output
          !
          IF ( iaproc .EQ. naptrk ) THEN
            !
            ! 4.e Sea point, prepare data
            !
            IF ( tststr .EQ. 'SEA' ) THEN
              !
              wx     = ua(isea) * cos(ud(isea))
              wy     = ua(isea) * sin(ud(isea))
              !
              ! ..... Local spectra
              !
              IF ( iaproc .EQ. isproc ) THEN
                DO ik=1, nk
                  DO ith=1, nth
                    spec(ik,ith) =                          &
                         tpi*a(ith,ik,jsea)*sig(ik)/cg(ik,isea)
                  END DO
                END DO
                !
                ! ..... Non-local spectra
                !
              ELSE
#ifdef W3_T3
                WRITE (ndst,9040) ix, iy, isea, ispt,   &
                     'RECEIVING'
#endif
#ifdef W3_MPI
                CALL mpi_recv (asptrk, nspec, mpi_real,&
                     ifrom, it, mpi_comm_wave,   &
                     status, ierr_mpi )
#endif
                !
                DO ik=1, nk
                  DO ith=1, nth
                    spec(ik,ith) =                          &
                         tpi*asptrk(ith,ik)*sig(ik)/cg(ik,isea)
                  END DO
                END DO
              END IF
              !
              ! 4.e Sea point, write general data + spectrum
              !
              WRITE (ndsto,err=811,iostat=ierr)               &
                   time, x, y, tststr, trckid(iy,ix)
              WRITE (ndsto,err=811,iostat=ierr)               &
                   dw(isea), cx(isea), cy(isea), wx, wy,        &
                   ust(isea), as(isea), spec
              !
              ! 4.f Non-sea point, write
              !
            ELSE
              WRITE (ndsto,err=811,iostat=ierr)               &
                   time, x, y, tststr, trckid(iy,ix)
              !
              ! ..... Sea and non-sea points processed
              !
            END IF
            !
            ! ..... End of action at NAPTRK
            !
#ifdef W3_T3
            WRITE (ndst,9040) ix, iy, isea, ispt, 'WRITTEN', time
#endif
          END IF
          !
          ! ..... Close IF for mask flag (top section 4)
          !
        END IF
        !
        ! ..... End of loop over map
        !
      END DO
    END DO
    !
#ifdef W3_MPI
    DEALLOCATE ( status )
#endif
    !
#ifdef W3_T
    WRITE (ndst,9090) ntrack, nread, nspeco, nloco
#endif
    !
    GOTO 888
    !
    !     Error Escape Locations
    !
800 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,1000) filext(:i), ierr
    GOTO 880
    !
801 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,1001) filext(:i), ierr
    GOTO 880
    !
802 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,1002) filext(:i)
    GOTO 880
    !
803 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,1003) filext(:i), idstri, idtst
    GOTO 880
    !
810 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,1010) filext(:i), ierr
    GOTO 880
    !
811 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,1011) filext(:i), ierr
    !
    !     Disabeling output
    !
880 CONTINUE
    atolast(:,3) = time
#ifdef W3_T
    WRITE (ndst,9080)
#endif
    !
888 CONTINUE
    !
    RETURN
    !
    ! Formats
    !
1000 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/             &
         '     INPUT FILE WITH TRACK DATA NOT FOUND ',          &
         '(FILE track_i.',a,' IOSTAT =',i6,')'/                 &
         '     TRACK OUTPUT DISABLED '/)
1001 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/             &
         '     ERROR IN READING FILE track_i.',a,' IOSTAT =',i6/&
         '     (ADITIONAL) TRACK OUTPUT DISABLED '/)
1002 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/             &
         '     PREMATURE END OF FILE track_i.',a/               &
         '     TRACK OUTPUT DISABLED '/)
1003 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/             &
         '     UNEXPECTED CONTENTS OF OF FILE track_i.',a/      &
         '       EXPECTED : ',a/                                &
         '       FOUND    : ',a/                                &
         '     TRACK OUTPUT DISABLED '/)
1010 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/             &
         '     ERROR IN OPENING OUTPUT FILE ',                  &
         '(FILE track_o.',a,' IOSTAT =',i6,')'/                 &
         '     TRACK OUTPUT DISABLED '/)
1011 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/             &
         '     ERROR IN WRITING TO FILE track_o.',a,' IOSTAT =',i6/ &
         '     (ADITIONAL) TRACK OUTPUT DISABLED '/)
    !
#ifdef W3_T
9000 FORMAT (' TEST W3IOTR : MODEL TIME       : ',i8.8,i7.6)
9010 FORMAT ('               LAST OUTPUT TIME : ',i8.8,i7.6/      &
         '               OUTPUT TIME INC, : ',f6.0/           &
         '               UNIT NUMBERS     : ',2i4/            &
         '               FORMAT FLAGS     : ',l4)
9011 FORMAT (' TEST W3IOTR : OPENING INPUT    : ',a,' [',a,']')
9012 FORMAT (' TEST W3IOTR : OPENING OUTPUT   : ',a,' [',a,']')
9015 FORMAT (' TEST W3IOTR : PREPARING MASKS')
9020 FORMAT (' TEST W3IOTR : SHIFTING MASKS')
9021 FORMAT (' TEST W3IOTR : OUTPUT TIME FRAME: ',i8.8,i7.6/      &
         '                                  ',i8.8,i7.6)
9022 FORMAT (' TEST W3IOTR : ENDING TIME REACHED')
9033 FORMAT (' TEST W3IOTR : END OF INPUT FILE')
9034 FORMAT (' TEST W3IOTR : OUTPUT TYPE DISABLED')
9090 FORMAT (' TEST W3IOTR : NUMBER OF TRACK P: ',i10,            &
         '  (OUT OF',i10,')'/                                 &
         '               NUMBER OF SPECTRA: ',i10,            &
         '  (OUT OF',i10,')')
9080 FORMAT (' TEST W3IOTR : OUTPUT TYPE DISABLED.')
#endif
    !
#ifdef W3_T1
9030 FORMAT (' TEST W3IOTR : POINT-BY-POINT STATUS')
9031 FORMAT ('      ',i8.8,i7.6,2f9.2,1x,a,1x,4i4,2l3)
#endif
#ifdef W3_T2
9035 FORMAT (' TEST W3IOTR : DUMP OF MAPS : ')
9036 FORMAT (132a1)
#endif
    !
#ifdef W3_T3
9040 FORMAT (' TEST W3IOTR : POINT',2i4,' (',i6,')',             &
         ' ON PROCESS',i4,2x,a,i10.8,i7.6)
#endif
    !/
    !/ End of W3IOTR ----------------------------------------------------- /
    !/

References w3adatmd::as, w3adatmd::cg, w3gdatmd::cmprtrck, w3adatmd::cx, w3adatmd::cy, w3gdatmd::dpdx, w3gdatmd::dpdy, w3gdatmd::dqdx, w3gdatmd::dqdy, w3gdatmd::dsip, w3gdatmd::dth, w3odatmd::dtout, w3adatmd::dw, file(), constants::file_endian, w3gdatmd::filext, w3gdatmd::flagll, w3odatmd::fnmpre, w3gdatmd::gsu, w3gdatmd::gtype, w3odatmd::iaproc, w3gdatmd::iclose, include(), w3parall::init_get_jsea_isproc(), w3odatmd::ipass3, w3odatmd::irqtr, w3odatmd::it0trk, w3gdatmd::mapfs, w3gdatmd::mapst2, w3gdatmd::mapsta, w3odatmd::mask1, w3odatmd::mask2, w3gdatmd::maxx, w3gdatmd::maxy, w3adatmd::mpi_comm_wave, w3odatmd::naperr, w3odatmd::naproc, w3odatmd::naptrk, w3odatmd::ndse, w3odatmd::ndst, w3gdatmd::nk, w3odatmd::nrqtr, w3gdatmd::nsea, w3gdatmd::nseal, w3gdatmd::nspec, w3gdatmd::nth, w3gdatmd::nx, w3gdatmd::ny, w3odatmd::o3init, w3gdatmd::sig, w3odatmd::stop, w3servmd::strace(), w3servmd::strsplit(), w3gdatmd::th, w3wdatmd::time, w3odatmd::tolast, w3odatmd::trckid, w3adatmd::ua, w3adatmd::ud, w3gdatmd::ungtype, w3wdatmd::ust, w3odatmd::w3dmo3(), w3gsrumd::w3gsup(), w3adatmd::w3seta(), w3gdatmd::w3setg(), w3odatmd::w3seto(), w3wdatmd::w3setw(), w3gdatmd::xfr, w3gdatmd::xgrd, and w3gdatmd::ygrd.

Referenced by w3wavemd::w3wave().