w3iobcmd.F90

Go to the documentation of this file.

 
 
#include "w3macros.h"
!/ ------------------------------------------------------------------- /
MODULE w3iobcmd
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           H. L. Tolman            |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :         01-Mar-2018 |
  !/                  +-----------------------------------+
  !/
  !/    See subroutine for update log.
  !/
  !/    Copyright 2009-2010 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 :
  !
  !     Processing of boundary data output.
  !
  !  2. Variables and types :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      VERBPTBC  C*10  Public   Nest file version number.
  !      IDSTRBC   C*32  Public   Restart file ID string.
  !     ----------------------------------------------------------------
  !
  !  3. Subroutines and functions :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      W3IOBC    Subr. Public   Boundary data IO.
  !     ----------------------------------------------------------------
  !
  !  4. Subroutines and functions used :
  !
  !      Name      Type  Module   Description
  !     ----------------------------------------------------------------
  !      W3SETO, W3SETG, W3SETW, W3SETA, W3DMO5
  !                Subr. W3xDATMD Manage data structures.
  !      W3CSPC    Subr. W3CSPCMD Spectral grid conversion.
  !      W3LLTOEQ  Subr. W3CSPCMD Standard to rotated lat/lon conversion.
  !      STRACE    Subr. W3SERVMD Subroutine tracing.
  !      EXTCDE    Subr. W3SERVMD Abort program with exit code.
  !     ----------------------------------------------------------------
  !
  !  5. Remarks :
  !
  !     None.
  !
  !  6. Switches :
  !
  !     See subroutine W3IOBC.
  !
  !  7. Source code :
  !
  !/ ------------------------------------------------------------------- /
  PUBLIC
  !/
  !/ Public variables  (ID strings)
  !/
  CHARACTER(LEN=10), PARAMETER :: verbptbc = '2018-03-01'
  CHARACTER(LEN=32), PARAMETER ::                        &
       idstrbc  = 'WAVEWATCH III BOUNDARY DATA FILE'
  !/
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3iobc ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         20-Jan-2017 |
    !/                  +-----------------------------------+
    !/
    !/    12-Jan-1999 : Distributed FORTRAN 77 version.     ( version 1.18 )
    !/    20-May-1999 : Remove read bug for IPBP and RDBP   ( see web page )
    !/    30-Dec-1999 : Upgrade to FORTRAN 90               ( version 2.00 )
    !/                  Major changes to logistics.
    !/    13-Dec-2004 : Multiple grid version.              ( version 3.06 )
    !/    19-Sep-2005 : Allow for change of spec. res.      ( version 3.08 )
    !/                  (on read only).
    !/    30-Sep-2005 : Add 'DUMP' option.                  ( version 3.08 )
    !/    27-Jun-2006 : Adding file name preamble.          ( version 3.09 )
    !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
    !/    30-Oct-2009 : Implement curvilinear grid type.    ( version 3.14 )
    !/                  (W. E. Rogers & T. J. Campbell, NRL)
    !/    28-Jul-2010 : Moving NKI, NTHI, XFRI, FR1I and
    !/                  TH1I to W3ODATMD.                   ( version 3.14.3 )
    !/    31-Oct-2010 : Implementing unstructured grid      ( version 3.14.3 )
    !/                  (A. Roland and F. Ardhuin)
    !/    05-Apr-2011 : Moved the W3CSPC call into loop     ( version 3.14.3 )
    !/    12-Jun-2012 : Add /RTD option or rotated grid option.
    !/                  (Jian-Guo Li)                       ( version 4.06 )
    !/    03-Jul-2013 : Corrected ABPIN indices             ( version 4.11 )
    !/    14-Jan-2014 : Corrected ABPIN indices for W3CSPC  ( version 4.18 )
    !/    20-Jan-2017 : Allow input boundary points to lie outside the grid
    !/                  within a distance of 0.1 times the grid cell size.
    !/                  (T.J. Campbell, NRL)                ( version 6.02 )
    !/    01-Mar-2018 : Rotate boundary points and directions
    !/                  of input spectra for rotated grids  ( version 6.02 )
    !/    07-Oct-2019 : RTD option with standard lat-lon
    !/                  grid when nesting to rotated grid   ( version 7.11 )
    !/
    !  1. Purpose :
    !
    !     Write/read boundary conditions file(s).
    !
    !  2. Method :
    !
    !     The file(s) are opened within the routine, the names are
    !     pre-defined as nest.FILEXT for the input file and nest1.FILEXT
    !     through nest9.FILEXT for up to 9 output files.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       INXOUT  C*(*)  I   Test string for read/write, valid are:
    !                          'READ', 'WRITE' or 'DUMP'.
    !       NDSB    Int.   I   Data set unit number.
    !       TIME1   I.A.  I/O  Present time.                          (w)
    !                          Time of first field.                   (r)
    !       TIME2   I.A.   O   Time of second field.                  (r)
    !       IOTST   Int.   O   Test indictor for reading.
    !                           1 : File not found.
    !                           0 : Fields read.
    !                          -1 : Past end of file.
    !       IMOD    Int.   I   Optional grid number, defaults to 1.
    !     ----------------------------------------------------------------
    !                                            (w) used for write only
    !                                            (r) used for write only
    !
    !  4. Subroutines used :
    !
    !     See module documentation.
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3WAVE    Subr. W3WAVEMD Actual wave model routine.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !       Tests on INXOUT, file status and data present in file.
    !
    !  7. Remarks :
    !
    !     - Array dimensions are tested in W3IOGR.
    !     - Spectra are stored as frequency (sigma) spectra to guarantee
    !       conservation under grid transformation.
    !     - At the moment it is mplicitly assumed that the number of
    !       spectral components is larger that the number of spectra
    !       per time step per file.
    !     - Dump option used in multi-grid model.
    !
    !  8. Structure :
    !
    !       See source code.
    !
    !  9. Switches :
    !
    !     !/SHRD  Switch for shared / distributed memory architecture.
    !     !/DIST  Id.
    !
    !     !/S     Enable subroutine tracing.
    !     !/T     General test output.
    !     !/T0    Point info test output.
    !     !/T1    Wave heights at input/output points.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE constants
    !
    USE w3gdatmd, ONLY: w3setg
    USE w3wdatmd, ONLY: w3setw
    USE w3adatmd, ONLY: w3seta
    USE w3odatmd, ONLY: w3seto, w3dmo5
    USE w3cspcmd, ONLY: w3cspc
    USE w3triamd, ONLY: w3nestug
    !
    USE w3gdatmd, ONLY: nk, nth, nspec, nsea, nseal, nx, ny,        &
         x0, y0, sx, sy, gsu, mapsta, mapfs, mapsf,  &
         xfr, fr1, sig2, th, dth, filext, fachfe,    &
         gtype, ungtype, smctype
    USE w3gdatmd, ONLY: dxymax
#ifdef W3_T1
    USE w3gdatmd, ONLY: sig
#endif
#ifdef W3_RTD
    !!   Use rotated N-Pole lat/lon and conversion sub.  JGLi12Jun2012
    USE w3gdatmd, ONLY: polat, polon, angld
    USE w3servmd, ONLY: w3lltoeq, w3eqtoll, w3acturn
#endif
    USE w3wdatmd, ONLY: va
    USE w3adatmd, ONLY: cg
    USE w3odatmd, ONLY: ndse, ndst, iaproc, naproc, naperr, napbpt, &
         nbi, nbi2, nfbpo, nbo, nbo2, ndsl,          &
         nki, nthi, xfri, fr1i, th1i,                &
         ipbpi, isbpi, xbpi, ybpi, rdbpi,            &
         ipbpo, isbpo, xbpo, ybpo, rdbpo,            &
         abpi0, abpin, abpos, flbpi, filer, filew,   &
         filed, spconv, fnmpre
    USE w3gsrumd
    !
    USE w3servmd, ONLY: extcde
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
#ifdef W3_SMC
    USE w3psmcmd, ONLY: w3smcgmp
#endif
    !
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)           :: NDSB
    INTEGER, INTENT(INOUT)        :: TIME1(2)
    INTEGER, INTENT(OUT)          :: TIME2(2), IOTST
    INTEGER, INTENT(IN), OPTIONAL :: IMOD
    CHARACTER, INTENT(IN)         :: INXOUT*(*)
    !/
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: IFILE, IERR, I, J, IX, IY, ISEA,     &
         IP, ISP, NPTS, ISOUT, IS, IGRD
#ifdef W3_T1
    INTEGER               :: IK, ITH
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
#ifdef W3_T1
    REAL                  :: HS, HS0
#endif
#ifdef W3_RTD
    !!    Declare rotation angle and rotated lat/lon variables for
    !!    boundary points.   JGLi12Jun2012
    REAL, ALLOCATABLE      :: Anglbdy(:), ELatbdy(:), ELonbdy(:)
    REAL                   :: Spectr(NK*NTH)
    REAL                   :: XRLIM, YRLIM
#endif
    REAL, ALLOCATABLE       :: TMPSPC(:,:)
    LOGICAL                 :: FLOK
    CHARACTER(LEN=18)       :: FILEN
    CHARACTER(LEN=10)       :: VERTST
    CHARACTER(LEN=32)       :: IDTST
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'W3IOBC')
#endif
    !
    iotst  = 0
    !
    ! test parameter list input ------------------------------------------ *
    !
    IF ( PRESENT(imod) ) THEN
      igrd   = imod
    ELSE
      igrd   = 1
    END IF
    !
    CALL w3seto ( igrd, ndse, ndst )
    CALL w3setg ( igrd, ndse, ndst )
    CALL w3setw ( igrd, ndse, ndst )
    CALL w3seta ( igrd, ndse, ndst )
    !
    IF (inxout.NE.'READ' .AND. inxout.NE.'WRITE' .AND.              &
         inxout.NE.'DUMP' ) THEN
      IF ( iaproc .EQ. naperr ) WRITE (ndse,900) inxout
      CALL extcde ( 1 )
    END IF
    !
#ifdef W3_T
    WRITE (ndst,9000) inxout, filer, filew, filed, ndsb
#endif
    !
    ! open file ---------------------------------------------------------- *
    !
    i      = len_trim(filext)
    j      = len_trim(fnmpre)
    !
    IF ( inxout.EQ.'READ'  .AND. filer ) THEN
      WRITE (filen,'(A5,A)') 'nest.', filext(:i)
#ifdef W3_T
      WRITE (ndst,9001) filen(:5+i), ndsb
#endif
      OPEN (ndsb,file=fnmpre(:j)//filen(:5+i),form='UNFORMATTED', convert=file_endian, &
           err=801,iostat=ierr,status='OLD')
    END IF
    !
    IF ( inxout.EQ.'WRITE' .AND. filew ) THEN
      DO ifile=1, nfbpo
        ndsl(ifile) = ndsb + ifile - 1
        WRITE (filen,'(A4,I1,A1,A)') 'nest', ifile, '.',          &
             filext(:i)
#ifdef W3_T
        WRITE (ndst,9001) filen(:6+i), ndsl(ifile)
#endif
        OPEN (ndsl(ifile),file=fnmpre(:j)//filen(:6+i),           &
             form='UNFORMATTED', convert=file_endian,err=800,iostat=ierr)
      END DO
    END IF
    !
    IF ( inxout.EQ.'DUMP'  .AND. filed ) THEN
      WRITE (filen,'(A5,A)') 'nest.', filext(:i)
#ifdef W3_T
      WRITE (ndst,9001) filen(:5+i), ndsb
#endif
      OPEN (ndsb,file=fnmpre(:j)//filen(:5+i),form='UNFORMATTED', convert=file_endian, &
           err=800,iostat=ierr)
    END IF
    !
    ! test info ---------------------------------------------------------- *
    ! ( new files only )
    ! ... writing
    !
    IF ( inxout.EQ.'WRITE' .AND. filew ) THEN
      IF ( iaproc .EQ. napbpt ) THEN
        DO ifile=1, nfbpo
          WRITE (ndsl(ifile))                                   &
               idstrbc, verbptbc, nk, nth, xfr, fr1, th(1),    &
               nbo(ifile)-nbo(ifile-1)
          !
#ifdef W3_T
          WRITE (ndst,9002) ifile, ndsl(ifile), idstrbc,       &
               verbptbc, nbo(ifile)-nbo(ifile-1)
#endif
          !
#ifdef W3_RTD
          ! By running the ww3_grid program the arrays XBPO, YBPO have been
          ! remapped to standard lat-lon and stored in mod_def.*
          !
#endif
          WRITE (ndsl(ifile))                                   &
               (xbpo(i),i=nbo(ifile-1)+1,nbo(ifile)),         &
               (ybpo(i),i=nbo(ifile-1)+1,nbo(ifile)),         &
               ((ipbpo(i,j),i=nbo(ifile-1)+1,nbo(ifile)),j=1,4),&
               ((rdbpo(i,j),i=nbo(ifile-1)+1,nbo(ifile)),j=1,4)
          !
#ifdef W3_T0
          WRITE (ndst,9003)
          DO i=nbo(ifile-1)+1, nbo(ifile)
            WRITE (ndst,9004) i-nbo(ifile-1), xbpo(i),      &
                 ybpo(i), (ipbpo(i,j),j=1,4),             &
                 (rdbpo(i,j),j=1,4)
          END DO
#endif
          !
        END DO
      END IF
    END IF
    !
    ! ... dumping
    !
    IF ( inxout.EQ.'DUMP' .AND. filed ) THEN
      IF ( iaproc .EQ. napbpt ) THEN
        WRITE (ndsb) idstrbc, verbptbc, nk, nth, xfr, fr1, th(1), nbi
        !
#ifdef W3_T
        WRITE (ndst,9002) 1, ndsb, idstrbc, verbptbc, nbi
#endif
        !
        WRITE (ndsb) (xbpi(i),i=1,nbi), (ybpi(i),i=1,nbi),      &
             ((ipbpi(i,j),i=1,nbi),j=1,4),              &
             ((rdbpi(i,j),i=1,nbi),j=1,4)
        !
#ifdef W3_T0
        WRITE (ndst,9003)
        DO i=1, nbi
          WRITE (ndst,9004) i, xbpi(i), ybpi(i),                &
               (ipbpi(i,j),j=1,4), (rdbpi(i,j),j=1,4)
        END DO
#endif
        !
      END IF
    END IF
    !
    ! ... reading
    !
    IF ( inxout.EQ.'READ' .AND. filer ) THEN
      !
      READ (ndsb,err=803,iostat=ierr)                             &
           idtst, vertst, nki, nthi, xfri, fr1i, th1i, nbi
      !
#ifdef W3_T
      WRITE (ndst,9002) 1, ndsb, idtst, vertst, nbi
#endif
      !
      IF ( idtst .NE. idstrbc ) THEN
        IF ( iaproc .EQ. naperr )                               &
             WRITE (ndse,901) idtst, idstrbc
        CALL extcde ( 10 )
      END IF
      IF ( vertst .NE. verbptbc ) THEN
        IF ( iaproc .EQ. naperr )                               &
             WRITE (ndse,902) vertst, verbptbc
        CALL extcde ( 11 )
      END IF
      !
      ! Determines if the spectrum in nest file needs to be converted
      !
      spconv = nki.NE.nk .OR. nthi.NE.nth .OR.                    &
           abs(xfri/xfr-1.).GT.0.01 .OR.                      &
           abs(fr1i/fr1-1.).GT.0.01 .OR.                      &
           abs(th1i-th(1)).GT.0.01*dth
      !
      CALL w3dmo5 ( igrd, ndse, ndst, 1 )
      !
      READ (ndsb,err=803,iostat=ierr)                             &
           (xbpi(i),i=1,nbi), (ybpi(i),i=1,nbi),                   &
           ((ipbpi(i,j),i=1,nbi),j=1,4),                           &
           ((rdbpi(i,j),i=1,nbi),j=1,4)
      !
#ifdef W3_RTD
      ! All boundary conditions position arrays XBPI, YBPI are defined
      ! in standard lat/lon coordinates. If Polat = 90. (and Polon = -180.),
      ! the b.c. positions don't need to be remapped
      IF ( polat < 90. ) THEN
        !!   Convert standard into rotated lat/lon. JGLi12Jun2012
        ALLOCATE ( anglbdy(nbi),  elatbdy(nbi), elonbdy(nbi) )
 
        CALL w3lltoeq ( ybpi, xbpi, elatbdy, elonbdy,     &
             &                 anglbdy, polat, polon, nbi )
 
        xbpi = elonbdy
        ybpi = elatbdy
        !!    W3LLTOEQ outputs longitudes on 0->360 degree grid
        !!    Next section will revise to -180->180 convention if required
        !!    by nested model rotated grid; determined by X0 lon value
        IF ( x0 .LT. 0.0 ) THEN
          DO i=1, nbi
            IF ( xbpi(i) .GT. 180.0) xbpi(i) = xbpi(i) - 360.0
          ENDDO
        END IF
        !!    The old (4.18) W3GFPT was very strict so this loop reassigns RTD
        !!    values to within a tolerance of the boundary - possibly this is
        !!    no longer required after the 20-Jan-2017 change?
        xrlim = x0 + (nx-1) * sx
        yrlim = y0 + (ny-1) * sy
        DO i=1, nbi
          IF ( abs(xbpi(i) - x0) .LT. sx/4.0 ) xbpi(i) = x0
          IF ( abs(ybpi(i) - y0) .LT. sy/4.0 ) ybpi(i) = y0
          IF ( abs(xbpi(i) - xrlim) .LT. sx/4.0 ) xbpi(i) = xrlim
          IF ( abs(ybpi(i) - yrlim) .LT. sy/4.0 ) ybpi(i) = yrlim
        ENDDO
 
        DEALLOCATE ( anglbdy,  elatbdy, elonbdy )
 
      END IF ! ( Polat < 90. )
 
#endif
      flok   = .true.
      IF (gtype .EQ. ungtype) THEN
        CALL w3nestug(dxymax,flok)
#ifdef W3_SMC
        !Li   For SMC grid check whether boundary points are within cell area.
      ELSE IF( gtype .EQ. smctype ) THEN
        CALL w3smcgmp( igrd, nbi, xbpi, ybpi, isbpi )
        IF ( iaproc .EQ. naperr ) WRITE (ndse,920)    &
             ( isbpi(i), xbpi(i), ybpi(i), i=1,nbi )
#endif
      ELSE
        DO i=1, nbi
          ! W3GFTP: find the nearest grid point to the input boundary point
          ! DCIN=0.1 is the distance outside of source grid in units of
          ! cell width to treat target point as inside the source grid.
          IF ( w3gfpt( gsu, xbpi(i), ybpi(i), ix, iy, dcin=0.1 ) ) THEN
            IF ( abs(mapsta(iy,ix)) .NE. 2 ) THEN
              IF ( iaproc .EQ. naperr )                         &
                   WRITE (ndse,909) ix, iy, abs(mapsta(iy,ix))
              flok   = .false.
            END IF
          ELSE
            IF ( iaproc .EQ. naperr )                             &
                 WRITE (ndse,910) i, xbpi(i), ybpi(i)
            CALL extcde ( 12 )
          END IF
          isbpi(i) = mapfs(iy,ix)
        END DO
      END IF
      !
#ifdef W3_T0
      WRITE (ndst,9003)
      DO i=1, nbi
        WRITE (ndst,9005) i, isbpi(i), xbpi(i), ybpi(i),      &
             (ipbpi(i,j),j=1,4), (rdbpi(i,j),j=1,4)
      END DO
#endif
      !
      IF ( .NOT.flok ) CALL extcde ( 20 )
      !
      DO isea=1, nsea
        ix     = mapsf(isea,1)
        iy     = mapsf(isea,2)
        IF ( abs(mapsta(iy,ix)) .EQ. 2 ) THEN
          flok   = .false.
          DO i=1, nbi
            IF ( isea .EQ. isbpi(i) ) flok = .true.
          END DO
          IF ( .NOT.flok .AND. iaproc.EQ.naperr )               &
               WRITE (ndse,911) ix, iy
        END IF
      END DO
      !
      !     Read first time and allocate ABPI0/N
      !
      READ (ndsb,END=810,ERR=810) TIME2, nbi2
      backspace(ndsb)
#ifdef W3_T
      WRITE (ndst,9012) ndsb, time2, nbi2
#endif
      CALL w3dmo5 ( igrd, ndse, ndst, 3 )
      !
    END IF
    !
    ! Save previous spectra on read -------------------------------------- *
    !
    IF ( inxout.EQ.'READ' .AND. .NOT.filer ) THEN
#ifdef W3_T
      WRITE (ndst,9020)
#endif
      time1  = time2
      abpi0(:,1:nbi2) = abpin(:,1:nbi2)
    END IF
    !
    ! TIME --------------------------------------------------------------- *
    !
    IF ( inxout .EQ. 'WRITE'  ) THEN
      DO ifile=1, nfbpo
        npts   = nbo2(ifile) - nbo2(ifile-1)
        WRITE (ndsl(ifile)) time1, npts
#ifdef W3_T
        WRITE (ndst,9010) ifile, ndsl(ifile), time1, npts
#endif
      END DO
    END IF
    !
    IF ( inxout .EQ. 'DUMP'  ) THEN
      WRITE (ndsb) time1, nbi2
#ifdef W3_T
      WRITE (ndst,9011) ndsb, time1, nbi2
#endif
    END IF
    !
    IF ( inxout .EQ. 'READ'  ) THEN
      READ (ndsb,err=810,END=810) TIME2, nbi2
#ifdef W3_T
      WRITE (ndst,9011) ndsb, time2, nbi2
#endif
    END IF
    !
    ! Spectra ------------------------------------------------------------ *
    !
    IF ( inxout .EQ. 'WRITE' ) THEN
      !
#ifdef W3_T1
      WRITE (ndst,9040)
#endif
      !
      DO ifile=1, nfbpo
        DO isout=nbo2(ifile-1)+1, nbo2(ifile)
          !
          isea   = isbpo(isout)
          !
          ! ... Shared memory version data gather
          !
#ifdef W3_SHRD
          DO is=1, nspec
            abpos(is,isout) = va(is,isea) * sig2(is) /      &
                 cg(1+(is-1)/nth,isea)
          END DO
#endif
          !
          ! ... Distributed memory version data gather
          !   ( Array pre-filled in W3WAVE )
          !
#ifdef W3_DIST
          DO is=1, nspec
            abpos(is,isout) = abpos(is,isout) * sig2(is) /  &
                 cg(1+(is-1)/nth,isea)
          END DO
#endif
          !
#ifdef W3_RTD
          ! Polat == 90. means the grid is standard lat-lon, and the spectra
          ! need not be rotated back
          IF ( polat < 90. ) THEN
            ! Added spectral turning for rotated grid
            ! (rotate back to standard pole)
            spectr = abpos(:,isout)
            CALL w3acturn( nth, nk, -angld(isea), spectr )
            abpos(:,isout) = spectr
          END IF
#endif
          !
          WRITE (ndsl(ifile)) (abpos(is,isout),is=1,nspec)
          !
#ifdef W3_T1
          hs     = 0.
          DO ik=1, nk
            DO ith=1, nth
              is = ith + (ik-1)*nth
              hs = hs + abpos(is,isout)*sig(ik)
            END DO
          END DO
          hs     = 4. * sqrt( hs * dth * 0.5 * (xfr-1./xfr) )
          WRITE (ndst,9041) ndsl(ifile), isout, isea, hs
#endif
          !
        END DO
      END DO
      !
    END IF
    !
    IF ( inxout .EQ. 'DUMP' ) THEN
      DO i=1, nbi2
        WRITE (ndsb) abpin(:,i)
      END DO
    END IF
    !
    IF ( inxout .EQ. 'READ' ) THEN
      !
      IF ( .NOT. spconv ) THEN
        DO ip=1, nbi2
          READ (ndsb,err=803,iostat=ierr) abpin(:,ip)
        END DO
      ELSE
        !
        ! In this case the spectral resolution is not compatible and
        ! the spectrum TMPSPC in nest file must be re-gridded into ABPIN to fit the model run
        ! spectral conversion is done by W3CSPC in w3cspcmd.ftn
        !
        ALLOCATE ( tmpspc(nki*nthi,nbi2) )
        DO ip=1, nbi2
          READ (ndsb,err=803,iostat=ierr) tmpspc(:,ip)
        END DO
        CALL w3cspc ( tmpspc     ,    nki, nthi, xfri, fr1i, th1i, &
             abpin(:,1:nbi2),nk,  nth,  xfr,  fr1,  th(1),&
             nbi2, ndst, ndse, fachfe )
        DEALLOCATE ( tmpspc )
      END IF
      !
#ifdef W3_T1
      WRITE (ndst,9042)
      DO ip=1, nbi2
        hs     = 0.
        hs0    = 0.
        DO isp=1, nspec
          hs     = hs + abpin(isp,ip)*sig2(isp)
          IF ( .NOT.filer ) hs0 = hs0 + abpi0(isp,ip)*sig2(isp)
        END DO
        hs     = 4. * sqrt( hs * dth * 0.5 * (xfr-1./xfr) )
        hs0    = 4. * sqrt( hs0 * dth * 0.5 * (xfr-1./xfr) )
        WRITE (ndst,9043) ip, hs0, hs
      END DO
#endif
      !
    END IF
    !
    ! Set first spectra on first read ------------------------------------ *
    !
    IF ( inxout.EQ.'READ' .AND. filer ) THEN
#ifdef W3_T
      WRITE (ndst,9021)
#endif
      time1 = time2
      DO ip=1, nbi2
        abpi0(:,ip) = abpin(:,ip)
      END DO
      abpi0(:,0) = 0.
      abpin(:,0) = 0.
    END IF
    !
    ! Reset flags -------------------------------------------------------- *
    !
    IF ( inxout .EQ. 'WRITE' ) filew  = .false.
    IF ( inxout .EQ. 'DUMP'  ) filed  = .false.
    IF ( inxout .EQ. 'READ'  ) filer  = .false.
    !
    RETURN
    !
    ! Escape locations IO errors
    !
800 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,1000) filen, ierr
    CALL extcde ( 40 )
    !
801 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,1001) imod
    iotst  = 1
    flbpi  = .false.
    RETURN
    !
802 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,1002)
    CALL extcde ( 41 )
    !
803 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,1003) ierr
    CALL extcde ( 42 )
    !
810 CONTINUE
    IF ( filer ) THEN
      IF ( iaproc .EQ. naperr ) WRITE (ndse,1010)
      CALL extcde ( 43 )
    END IF
    !
#ifdef W3_T
    WRITE (ndst,9022)
#endif
    time1(1) = time2(1)
    time1(2) = time2(2)
    DO ip=0, nbi2
      DO isp=1, nspec
        abpi0(isp,ip) = abpin(isp,ip)
      END DO
    END DO
    !
    iotst  = -1
    flbpi  = .false.
    RETURN
    !
    ! Formats
    !
900 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC :'/                &
         '     ILLEGAL INXOUT VALUE: ',a/)
901 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC :'/                &
         '     ILLEGAL IDSTRBC, READ : ',a/                     &
         '                  CHECK : ',a/)
902 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC :'/                &
         '     ILLEGAL VEROGR, READ : ',a/                      &
         '                   CHECK : ',a/)
    !
909 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC :'/                &
         '     POINT',2i4,' NOT ACTIVE SEA POINT (',i1,')')
910 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC :'/                &
         '     POINT',i4,2e14.6,' NOT LOCATED IN GRID')
911 FORMAT ( ' *** WAVEWATCH III WARNING : POINT',2i7,              &
         ' WILL NOT BE UPDATED')
920 FORMAT (/' *** SMCTYPE mapped boundary cells:'/ ((i8,2f9.3)) )
    !
1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC : '/               &
         '     ERROR IN OPENING FILE ',a/                       &
         '     IOSTAT =',i5/)
    !
    ! Note: This 1001 error can occur when multi-grid time steps are not
    !       compatible.
1001 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOBC : '/             &
         '     INPUT FILE WITH BOUNDARY CONDITIONS NOT FOUND'/  &
         '     BOUNDARY CONDITIONS WILL NOT BE UPDATED ',i5/)
1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC : '/               &
         '     PREMATURE END OF FILE'/)
1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC : '/               &
         '     ERROR IN READING FROM FILE'/                     &
         '     IOSTAT =',i5/)
    !
1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC : '/               &
         '     NO DATA IN INPUT FILE'/)
    !
#ifdef W3_T
9000 FORMAT (' TEST W3IOBC : INXOUT  : ',a5/                      &
         '               FLAGS   : ',3l2/                     &
         '               UNIT    : ',i4)
9001 FORMAT (' TEST W3IOBC : OPENING FILE ',a,'  (',i2,')')
9002 FORMAT (' TEST W3IOBC : FILE #  : ',i4/                      &
         '               UNIT    : ',i4/                      &
         '               ID      : ',a/                       &
         '               VERSION : ',a/                       &
         '               POINTS  : ',i4)
#endif
    !
#ifdef W3_T0
9003 FORMAT (' TEST W3IOBC : POINT DATA ')
9004 FORMAT ('             ',i3,2e10.3,2x,4i4,2x,4f5.2)
9005 FORMAT ('             ',i3,i4,2e10.3,2x,4i4,2x,4f5.2)
#endif
    !
#ifdef W3_T
9010 FORMAT (' TEST W3IOBC : OUTPUT FILE ',i1,' UNIT',i3,' TIME', &
         i9.8,i7.6,',',i5,' SPECTRA')
9011 FORMAT (' TEST W3IOBC : INPUT FILE UNIT',i3,' TIME',         &
         i9.8,i7.6,',',i5,' SPECTRA')
9012 FORMAT (' TEST W3IOBC : INPUT FILE UNIT',i3,' TIME',         &
         i9.8,i7.6,',',i5,' SPECTRA (TEST READ)')
    !
9020 FORMAT (' TEST W3IOBC : SAVING OLD DATA')
9021 FORMAT (' TEST W3IOBC : SAVING FIRST DATA')
9022 FORMAT (' TEST W3IOBC : EOF REACHED')
#endif
    !
#ifdef W3_T1
9040 FORMAT (' TEST W3IOBC : UNIT, ISOUT, ISEA, HS(NO TAIL) ')
9041 FORMAT ( '            ',i3,2i6,f8.2)
9042 FORMAT (' TEST W3IOBC : IP, HS(NO TAIL) ')
9043 FORMAT ( '         ',i6,2f8.2)
#endif
    !/
    !/ End of W3IOBC ----------------------------------------------------- /
    !/
  END SUBROUTINE w3iobc
  !/
  !/ End of module W3IOBCMD -------------------------------------------- /
  !/
END MODULE w3iobcmd