Processing of boundary data output. More...

Functions/Subroutines
subroutine	w3iobc (INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD)
	Write/read boundary conditions file(s). More...

Variables
character(len=10), parameter	verbptbc = '2018-03-01'

character(len=32), parameter	idstrbc = 'WAVEWATCH III BOUNDARY DATA FILE'

Detailed Description

Processing of boundary data output.

Author: H. L. Tolman

Date: 01-Mar-2018

Function/Subroutine Documentation

◆ w3iobc()

subroutine w3iobcmd::w3iobc	(	character, dimension(*), intent(in)	INXOUT,
		integer, intent(in)	NDSB,
		integer, dimension(2), intent(inout)	TIME1,
		integer, dimension(2), intent(out)	TIME2,
		integer, intent(out)	IOTST,
		integer, intent(in), optional	IMOD
	)

Write/read boundary conditions file(s).

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.

Parameters

[in,out]	INXOUT	Test string for read/write.
[in,out]	NDSB	Data set unit number.
[in,out]	TIME1	Present time (w), time of first field (r).
[in,out]	TIME2	Time of second field.
[in,out]	IOTST	Test indictor for reading.
[in,out]	IMOD	Optional grid number, defaults to 1.

Author: H. L. Tolman

Date: 20-Jan-2017

Definition at line 99 of file w3iobcmd.F90.

     !/
     !/                  +-----------------------------------+
     !/                  | 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 ----------------------------------------------------- /
     !/