#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
      USE W3GDATMD, ONLY: DXYMAX  
!/T1      USE W3GDATMD, ONLY: SIG
!/RTD !!   Use rotated N-Pole lat/lon and conversion sub.  JGLi12Jun2012
!/RTD      USE W3GDATMD, ONLY: PoLat, PoLon, AnglD
!/RTD      USE W3SERVMD, ONLY: W3LLTOEQ, W3EQTOLL, W3ACTURN
      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
!/S      USE W3SERVMD, ONLY: STRACE
!
      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
!/T1      INTEGER               :: IK, ITH
!/S      INTEGER, SAVE           :: IENT = 0
!/T1      REAL                  :: HS, HS0
!/RTD  !!    Declare rotation angle and rotated lat/lon variables for
!/RTD  !!    boundary points.   JGLi12Jun2012
!/RTD      REAL, ALLOCATABLE      :: Anglbdy(:), ELatbdy(:), ELonbdy(:) 
!/RTD      REAL                   :: Spectr(NK*NTH)
!/RTD      REAL                   :: XRLIM, YRLIM
      REAL, ALLOCATABLE       :: TMPSPC(:,:)
      LOGICAL                 :: FLOK
      CHARACTER(LEN=18)       :: FILEN
      CHARACTER(LEN=10)       :: VERTST
      CHARACTER(LEN=32)       :: IDTST
!/
!/ ------------------------------------------------------------------- /
!/
!/S      CALL STRACE (IENT, 'W3IOBC')
!
      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
!
!/T      WRITE (NDST,9000) INXOUT, FILER, FILEW, FILED, NDSB
!
! open file ---------------------------------------------------------- *
!
      I      = LEN_TRIM(FILEXT)
      J      = LEN_TRIM(FNMPRE)
!
      IF ( INXOUT.EQ.'READ'  .AND. FILER ) THEN
          WRITE (FILEN,'(A5,A)') 'nest.', FILEXT(:I)
!/T          WRITE (NDST,9001) FILEN(:5+I), NDSB
          OPEN (NDSB,FILE=FNMPRE(:J)//FILEN(:5+I),FORM='UNFORMATTED', &
                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)
!/T            WRITE (NDST,9001) FILEN(:6+I), NDSL(IFILE)
            OPEN (NDSL(IFILE),FILE=FNMPRE(:J)//FILEN(:6+I),           &
                  FORM='UNFORMATTED',ERR=800,IOSTAT=IERR)
            END DO
        END IF
!
      IF ( INXOUT.EQ.'DUMP'  .AND. FILED ) THEN
          WRITE (FILEN,'(A5,A)') 'nest.', FILEXT(:I)
!/T          WRITE (NDST,9001) FILEN(:5+I), NDSB
          OPEN (NDSB,FILE=FNMPRE(:J)//FILEN(:5+I),FORM='UNFORMATTED', &
                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)
!
!/T                WRITE (NDST,9002) IFILE, NDSL(IFILE), IDSTRBC,       &
!/T                       VERBPTBC, NBO(IFILE)-NBO(IFILE-1)
!
!/RTD ! By running the ww3_grid program the arrays XBPO, YBPO have been
!/RTD ! remapped to standard lat-lon and stored in mod_def.*
!/RTD !
                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)
!
!/T0                WRITE (NDST,9003)
!/T0                DO I=NBO(IFILE-1)+1, NBO(IFILE)
!/T0                  WRITE (NDST,9004) I-NBO(IFILE-1), XBPO(I),      &
!/T0                         YBPO(I), (IPBPO(I,J),J=1,4),             &
!/T0                         (RDBPO(I,J),J=1,4)
!/T0                  END DO
!
                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
!
!/T              WRITE (NDST,9002) 1, NDSB, IDSTRBC, VERBPTBC, NBI
!
              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)
!
!/T0          WRITE (NDST,9003)
!/T0          DO I=1, NBI
!/T0            WRITE (NDST,9004) I, XBPI(I), YBPI(I),                &
!/T0                   (IPBPI(I,J),J=1,4), (RDBPI(I,J),J=1,4)
!/T0            END DO
!
            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
!
!/T          WRITE (NDST,9002) 1, NDSB, IDTST, VERTST, NBI
!
          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)
!
!/RTD ! All boundary conditions position arrays XBPI, YBPI are defined
!/RTD ! in standard lat/lon coordinates. If Polat = 90. (and Polon = -180.),
!/RTD ! the b.c. positions don't need to be remapped 
!/RTD        IF ( Polat < 90. ) THEN
!/RTD !!   Convert standard into rotated lat/lon. JGLi12Jun2012
!/RTD          ALLOCATE ( Anglbdy(NBI),  ELatbdy(NBI), ELonbdy(NBI) )
!/RTD
!/RTD          CALL W3LLTOEQ ( YBPI, XBPI, ELatbdy, ELonbdy,     &
!/RTD       &                 Anglbdy, PoLat, PoLon, NBI )
!/RTD
!/RTD          XBPI = ELonbdy
!/RTD          YBPI = ELatbdy
!/RTD !!    W3LLTOEQ outputs longitudes on 0->360 degree grid
!/RTD !!    Next section will revise to -180->180 convention if required
!/RTD !!    by nested model rotated grid; determined by X0 lon value
!/RTD          IF ( X0 .LT. 0.0 ) THEN
!/RTD            DO I=1, NBI
!/RTD              IF ( XBPI(I) .GT. 180.0) XBPI(I) = XBPI(I) - 360.0
!/RTD            ENDDO
!/RTD          END IF
!/RTD !!    The old (4.18) W3GFPT was very strict so this loop reassigns RTD 
!/RTD !!    values to within a tolerance of the boundary - possibly this is
!/RTD !!    no longer required after the 20-Jan-2017 change?
!/RTD          XRLIM = X0 + (NX-1) * SX
!/RTD          YRLIM = Y0 + (NY-1) * SY
!/RTD          DO I=1, NBI
!/RTD            IF ( ABS(XBPI(I) - X0) .LT. SX/4.0 ) XBPI(I) = X0
!/RTD            IF ( ABS(YBPI(I) - Y0) .LT. SY/4.0 ) YBPI(I) = Y0
!/RTD            IF ( ABS(XBPI(I) - XRLIM) .LT. SX/4.0 ) XBPI(I) = XRLIM
!/RTD            IF ( ABS(YBPI(I) - YRLIM) .LT. SY/4.0 ) YBPI(I) = YRLIM
!/RTD          ENDDO
!/RTD
!/RTD          DEALLOCATE ( Anglbdy,  ELatbdy, ELonbdy )
!/RTD
!/RTD        END IF ! ( Polat < 90. )
!/RTD
          FLOK   = .TRUE.
          IF (GTYPE .EQ. UNGTYPE) THEN
            CALL W3NESTUG(DXYMAX,FLOK) 
          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    
!
!/T0          WRITE (NDST,9003)
!/T0          DO I=1, NBI
!/T0            WRITE (NDST,9005) I, ISBPI(I), XBPI(I), YBPI(I),      &
!/T0                   (IPBPI(I,J),J=1,4), (RDBPI(I,J),J=1,4)
!/T0            END DO
!
          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)
!/T          WRITE (NDST,9012) NDSB, TIME2, NBI2
          CALL W3DMO5 ( IGRD, NDSE, NDST, 3 )
!
        END IF
!
! Save previous spectra on read -------------------------------------- *
!
      IF ( INXOUT.EQ.'READ' .AND. .NOT.FILER ) THEN
!/T          WRITE (NDST,9020)
          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
!/T            WRITE (NDST,9010) IFILE, NDSL(IFILE), TIME1, NPTS
            END DO
        END IF
!
      IF ( INXOUT .EQ. 'DUMP'  ) THEN
          WRITE (NDSB) TIME1, NBI2
!/T          WRITE (NDST,9011) NDSB, TIME1, NBI2
        END IF
!
      IF ( INXOUT .EQ. 'READ'  ) THEN
          READ (NDSB,ERR=810,END=810) TIME2, NBI2
!/T          WRITE (NDST,9011) NDSB, TIME2, NBI2
        END IF
!
! Spectra ------------------------------------------------------------ *
!
      IF ( INXOUT .EQ. 'WRITE' ) THEN
!
!/T1          WRITE (NDST,9040)
!
          DO IFILE=1, NFBPO
            DO ISOUT=NBO2(IFILE-1)+1, NBO2(IFILE)
!
              ISEA   = ISBPO(ISOUT)
!
! ... Shared memory version data gather
!
!/SHRD              DO IS=1, NSPEC
!/SHRD                ABPOS(IS,ISOUT) = VA(IS,ISEA) * SIG2(IS) /      &
!/SHRD                                    CG(1+(IS-1)/NTH,ISEA)
!/SHRD                END DO
!
! ... Distributed memory version data gather
!   ( Array pre-filled in W3WAVE )
!
!/DIST              DO IS=1, NSPEC
!/DIST                ABPOS(IS,ISOUT) = ABPOS(IS,ISOUT) * SIG2(IS) /  &
!/DIST                                    CG(1+(IS-1)/NTH,ISEA)
!/DIST                END DO
!
!/RTD ! Polat == 90. means the grid is standard lat-lon, and the spectra
!/RTD ! need not be rotated back 
!/RTD              IF ( Polat < 90. ) THEN
!/RTD                ! Added spectral turning for rotated grid
!/RTD                ! (rotate back to standard pole)
!/RTD                Spectr = ABPOS(:,ISOUT)
!/RTD                CALL W3ACTURN( NTH, NK, -AnglD(ISEA), Spectr )
!/RTD                ABPOS(:,ISOUT) = Spectr
!/RTD                END IF
!
              WRITE (NDSL(IFILE)) (ABPOS(IS,ISOUT),IS=1,NSPEC)
!
!/T1              HS     = 0.
!/T1              DO IK=1, NK
!/T1                DO ITH=1, NTH
!/T1                  IS = ITH + (IK-1)*NTH
!/T1                  HS = HS + ABPOS(IS,ISOUT)*SIG(IK)
!/T1                  END DO
!/T1                END DO
!/T1              HS     = 4. * SQRT ( HS * DTH * 0.5 * (XFR-1./XFR) )
!/T1              WRITE (NDST,9041) NDSL(IFILE), ISOUT, ISEA, HS
!
              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
!
!/T1          WRITE (NDST,9042)
!/T1          DO IP=1, NBI2
!/T1            HS     = 0.
!/T1            HS0    = 0.
!/T1            DO ISP=1, NSPEC
!/T1              HS     = HS + ABPIN(ISP,IP)*SIG2(ISP)
!/T1              IF ( .NOT.FILER ) HS0 = HS0 + ABPI0(ISP,IP)*SIG2(ISP)
!/T1              END DO
!/T1            HS     = 4. * SQRT ( HS * DTH * 0.5 * (XFR-1./XFR) )
!/T1            HS0    = 4. * SQRT ( HS0 * DTH * 0.5 * (XFR-1./XFR) )
!/T1            WRITE (NDST,9043) IP, HS0, HS
!/T1            END DO
!
        END IF
!
! Set first spectra on first read ------------------------------------ *
!
      IF ( INXOUT.EQ.'READ' .AND. FILER ) THEN
!/T          WRITE (NDST,9021)
          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
!
!/T      WRITE (NDST,9022)
      TIME1(1) = TIME2(1)
      TIME1(2) = TIME2(2)
      DO 812, IP=0, NBI2
        DO 811, ISP=1, NSPEC
          ABPI0(ISP,IP) = ABPIN(ISP,IP)
  811     CONTINUE
  812   CONTINUE
!
      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')
!
 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'/)
!
!/T 9000 FORMAT (' TEST W3IOBC : INXOUT  : ',A5/                      &
!/T              '               FLAGS   : ',3L2/                     &
!/T              '               UNIT    : ',I4)
!/T 9001 FORMAT (' TEST W3IOBC : OPENING FILE ',A,'  (',I2,')')
!/T 9002 FORMAT (' TEST W3IOBC : FILE #  : ',I4/                      &
!/T              '               UNIT    : ',I4/                      &
!/T              '               ID      : ',A/                       &
!/T              '               VERSION : ',A/                       &
!/T              '               POINTS  : ',I4)
!
!/T0 9003 FORMAT (' TEST W3IOBC : POINT DATA ')
!/T0 9004 FORMAT ('             ',I3,2E10.3,2X,4I4,2X,4F5.2)
!/T0 9005 FORMAT ('             ',I3,I4,2E10.3,2X,4I4,2X,4F5.2)
!
!/T 9010 FORMAT (' TEST W3IOBC : OUTPUT FILE ',I1,' UNIT',I3,' TIME', &
!/T                 I9.8,I7.6,',',I5,' SPECTRA')
!/T 9011 FORMAT (' TEST W3IOBC : INPUT FILE UNIT',I3,' TIME',         &
!/T                 I9.8,I7.6,',',I5,' SPECTRA')
!/T 9012 FORMAT (' TEST W3IOBC : INPUT FILE UNIT',I3,' TIME',         &
!/T                 I9.8,I7.6,',',I5,' SPECTRA (TEST READ)')
!
!/T 9020 FORMAT (' TEST W3IOBC : SAVING OLD DATA')
!/T 9021 FORMAT (' TEST W3IOBC : SAVING FIRST DATA')
!/T 9022 FORMAT (' TEST W3IOBC : EOF REACHED')
!
!/T1 9040 FORMAT (' TEST W3IOBC : UNIT, ISOUT, ISEA, HS(NO TAIL) ')
!/T1 9041 FORMAT ( '            ',I3,2I6,F8.2)
!/T1 9042 FORMAT (' TEST W3IOBC : IP, HS(NO TAIL) ')
!/T1 9043 FORMAT ( '         ',I6,2F8.2)
!/
!/ End of W3IOBC ----------------------------------------------------- /
!/
      END SUBROUTINE W3IOBC
!/
!/ End of module W3IOBCMD -------------------------------------------- /
!/
      END MODULE W3IOBCMD
