w3iorsmd.F90

Go to the documentation of this file.

 
 
#include "w3macros.h"
!/ ------------------------------------------------------------------- /
MODULE w3iorsmd
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           H. L. Tolman            |
  !/                  |                      FORTRAN 2003 |
  !/                  | Last update :         22-Mar-2021 |
  !/                  +-----------------------------------+
  !/
  !/    See subroutine for update log.
  !/
  !  1. Purpose :
  !
  !     Read/write restart files.
  !
  !  2. Variables and types :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      VERINI    C*10  Private  Restart file version number.
  !      IDSTR     C*26  Private  Restart file UD string.
  !     ----------------------------------------------------------------
  !
  !  3. Subroutines and functions :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      W3IORS    Subr. Public   Read/write restart files.
  !     ----------------------------------------------------------------
  !
  !  4. Subroutines and functions used :
  !
  !      Name      Type  Module   Description
  !     ----------------------------------------------------------------
  !      W3SETO, W3SETG, W3SETW, W3DIMW
  !                Subr. W3xDATMD Manage data structures.
  !      STRACE    Subr. W3SERVMD Subroutine tracing.            (!/S)
  !      EXTCDE    Subr. W3SERVMD Abort program with exit code.
  !      MPI_STARTALL, MPI_WAITALL                              (!/MPI)
  !                Subr.          MPI persistent communication routines
  !     ----------------------------------------------------------------
  !
  !  5. Remarks :
  !
  !  6. Switches :
  !
  !     See also routine.
  !
  !  7. Source code :
  !
  !/ ------------------------------------------------------------------- /
  PUBLIC
  !/
  ! Add fields needed for OASIS coupling in restart
  LOGICAL :: oarst
  !/
  !/ Private parameter statements (ID strings)
  !/
  CHARACTER(LEN=10), PARAMETER, PRIVATE :: verini = '2024-04-26'
  CHARACTER(LEN=26), PARAMETER, PRIVATE ::                        &
       idstr = 'WAVEWATCH III RESTART FILE'
  !/
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3iors ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         22-Mar-2021 |
    !/                  +-----------------------------------+
    !/
    !/    12-Jan-1999 : Final FORTRAN 77                    ( version 1.18 )
    !/    27-Dec-1999 : Upgrade to FORTRAN 90               ( version 2.00 )
    !/    30-Apr-2002 : Add ice for transparencies.         ( version 2.20 )
    !/    13-Nov-2002 : Add stress as vector.               ( version 3.00 )
    !/    19-Aug-2003 : Output server options added.        ( version 3.04 )
    !/    09-Dec-2004 : Multiple grid version.              ( version 3.06 )
    !/    24-Jun-2005 : Adding MAPST2.                      ( version 3.07 )
    !/    27-Jun-2006 : Adding file name preamble.          ( version 3.09 )
    !/    05-Jul-2006 : Consolidate stress arrays.          ( version 3.09 )
    !/    08-May-2007 : Starting from calm as an option.    ( version 3.11 )
    !/    17-May-2007 : Adding NTPROC/NAPROC separation.    ( version 3.11 )
    !/    22-Jun-2007 : Dedicated output processes.         ( version 3.11 )
    !/    15-Apr-2008 : Clean up for distribution.          ( version 3.14 )
    !/    21-Apr-2008 : Remove PGI bug internal files.      ( version 3.14 )
    !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
    !/    30-Oct-2009 : Output file name with 3 digit id.   ( version 3.14 )
    !/                  (W. E. Rogers, NRL)
    !/    14-Nov-2013 : Remove cold start init. UST(DIR).   ( version 4.13 )
    !/    31-May-2016 : Optimize restart file size for un-  ( version 5.10 )
    !/                  structured grid and restart read.
    !/                  (M. Ward, NCI, S. Zieger, BOM)
    !/    10-Mar-2017 : File access mode changed to 'STREAM'( version 6.02 )
    !/                  (S. Zieger, BOM)
    !/    09-Aug-2017 : Bug fix for MPI restart read issue  ( version 6.02 )
    !/                  (T. Campbell, NRL)
    !/    05-Jun-2018 : Add PDLIB/TIMINGS/DEBUGIO           ( version 6.04 )
    !/                  DEBUGINIT/MPI
    !/    19-Dec-2019 : Optional second stream of           ( version 7.00 )
    !/                  restart files
    !/                  (Roberto Padilla-Hernandez & J.H. Alves)
    !/    25-Sep-2020 : Extra fields for coupled restart    ( version 7.10 )
    !/    22-Mar-2021 : Add new coupling fields in restart  ( version 7.13 )
    !/    18-May-2021 : Read by default all extra restart   ( version 7.13 )
    !/
    !/    Copyright 2009-2013 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 :
    !
    !     Reads/writes restart files.
    !
    !  2. Method :
    !
    !     The file is opened within the routine, the name is pre-defined
    !     and the unit number is given in the parameter list. The restart
    !     file is written using UNFORMATTED write statements. The routine
    !     generates new names when called more than once. File names are :
    !
    !                                 restart000.FILEXT
    !                                 restart001.FILEXT
    !                                 restart002.FILEXT etc.
    !
    !     Optionally, a second stream of restart files is generated given
    !     a secondary stride definad by an additional start/end time line
    !     triggered by an optional argument added to the end of the stan-
    !     dard restart request line (a sixth argument flag set to T). File
    !     names include a time-tag prefix:
    !
    !                                 YYYYMMDD.HHMMSS.restart.FILEXT
    !
    !     The file to be read thus always is unnumbered, whereas all
    !     written files are automatically numbered.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       INXOUT  C*(*)  I   Test string for read/write, valid are:
    !                          'READ' Reading of a restart file.
    !                          'HOT'  Writing a full restart from the model.
    !                          'COLD' Writing a cold start file.
    !                          'WIND' Initialize fields using first wind
    !                                 field.
    !                          'CALM' Starting from calm conditions.
    !       NDSR    Int.  I/O  File unit number.
    !       DUMFPI  Real   I   Dummy values for FPIS for cold start.
    !       RSTYPE  Int.   O   Type of input field,
    !                           0 : cold start,
    !                           1 : cold start with fetch-limited spectra,
    !                           2 : full restart,
    !                           3 : for writing file.
    !                           4 : starting from calm.
    !       IMOD    Int.   I   Optional grid number, defaults to 1.
    !       FLRSTRT LOGIC  I    OTIONAL TRUE: A second request for restart files
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     See module documentation.
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3INIT    Subr. W3INITMD Wave model initialization routine.
    !      W3WAVE    Subr. W3WAVEMD Actual wave model routine.
    !      WW3_STRT  Prog.   N/A    Initial conditions program.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !       Tests on INXOUT, file status and on array dimensions.
    !
    !  7. Remarks :
    !
    !     - MAPSTA is dumped as it contains information on inactive points.
    !       Note that the original MAPSTA is dumped in the model def. file
    !       for use in the initial conditions (and output) programs.
    !     - Note that MAPSTA and MAPST2 data is combinded in the file.
    !     - The depth is recalculated in a write to avoid floating point
    !       errors in W3STRT.
    !     - Fields and field info read by all, written by las processor
    !       only.
    !     - The MPP version of the model will perform a gather here to
    !       maximize hiding of communication with IO.
    !
    !  8. Structure :
    !
    !     +---------------------------------------------------------------+
    !     | initialisations                                               |
    !     | test INXOUT                                                   |
    !     | open file                                                     |
    !     +---------------------------------------------------------------|
    !     |                             WRITE ?                           |
    !     | Y                                                           N |
    !     |-------------------------------|-------------------------------|
    !     | Write identifiers and         | Write identifiers and         |
    !     |   dimensions.                 |   dimensions.                 |
    !     |                               | Check ident. and dimensions.  |
    !     +-------------------------------+-------------------------------|
    !     |                       Full restart ?                          |
    !     | Y                                                           N |
    !     |-------------------------------|-------------------------------|
    !     | read/write/test time          |                               |
    !     +-------------------------------+-------------------------------|
    !     |                             WRITE ?                           |
    !     | Y                                                           N |
    !     |-------------------------------|-------------------------------|
    !     |          TYPE = 'WIND' ?      |          TYPE = 'WIND' ?      |
    !     | Y                           N | Y                           N |
    !     |---------------|---------------|---------------|---------------|
    !     | close file    | write spectra | gen. fetch-l. | read spectra  |
    !     | RETURN        |               |   spectra.    |               |
    !     |---------------+---------------+---------------+---------------|
    !     |                             WRITE ?                           |
    !     | Y                                                           N |
    !     |-------------------------------|-------------------------------|
    !     |          TYPE = 'FULL' ?      |          TYPE = 'FULL' ?      |
    !     | Y                           N | Y                           N |
    !     |---------------|---------------|---------------|---------------|
    !     | write level & | ( prep. level | read level &  | initalize l.& |
    !     |   (ice) map & |   for test    |   (ice) map.& |   times       |
    !     |   times       |   output )    |   times       | ( no ice )    |
    !     +---------------+---------------+---------------+-------------- +
    !
    !  9. Switches :
    !
    !     !/SEED  Linear input / seeding option.
    !     !/LNx
    !
    !     !/SHRD  Switch for shared / distributed memory architecture.
    !     !/DIST  Id.
    !     !/MPI   Id.
    !
    !     !/S     Enable subroutine tracing.
    !     !/T     Enable test output
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE w3gdatmd, ONLY: w3setg, w3setref, rstype
    USE w3odatmd, ONLY: w3seto
    USE w3adatmd, ONLY: w3seta, w3xeta, nsealm
    USE w3adatmd, ONLY: cx, cy, hs, wlm, t0m1, t01, fp0, thm, charn,&
         tauwix, tauwiy, tws, tauox, tauoy, bhd,     &
         phioc, tusx, tusy, ussx, ussy, tauice,      &
         uba, ubd, phibbl, taubbl, tauocx, tauocy,   &
         wnmean
    !/
    USE w3gdatmd, ONLY: nx, ny, nsea, nseal, nspec, mapsta, mapst2, &
         gname, filext, gtype, ungtype
    USE w3triamd, ONLY: set_ug_iobp
    USE w3wdatmd
#ifdef W3_WRST
    USE w3idatmd, ONLY: wxn, wyn, w3seti
    USE w3idatmd, ONLY: wxnwrst, wynwrst
#endif
    USE w3odatmd, ONLY: ndse, ndst, iaproc, naproc, naperr, naprst, &
         ifile => ifile4, fnmpre, ntproc, iostyp,    &
         flogrr, nogrp, ngrpp, screen
#ifdef W3_MPI
    USE w3odatmd, ONLY: nrqrs, nblkrs, rsblks, irqrs, irqrss,  &
         vaaux
    USE w3adatmd, ONLY: mpi_comm_wcmp
#endif
    !/
    USE w3servmd, ONLY: extcde
    USE constants, only: lpdlib, file_endian
    USE w3parall, ONLY: init_get_isea, init_get_jsea_isproc
    USE w3gdatmd, ONLY: nk, nth
#ifdef W3_TIMINGS
    USE w3parall, ONLY: print_my_time
#endif
#ifdef W3_PDLIB
    USE pdlib_field_vec
#endif
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER                       :: NDSR
    !      INTEGER, INTENT(IN)           :: NDSR
    INTEGER, INTENT(IN), OPTIONAL :: IMOD
    REAL, INTENT(INOUT)           :: DUMFPI
    CHARACTER, INTENT(IN)         :: INXOUT*(*)
    LOGICAL, INTENT(IN),OPTIONAL  :: FLRSTRT
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER, PARAMETER      :: LRB = 4
    !
    INTEGER                 :: IGRD, I, J, LRECL, NSIZE, IERR,      &
         NSEAT, MSPEC, TTIME(2), ISEA, JSEA,  &
         NREC, NPART, IPART, IX, IY, IXL, IP, &
         NPRTX2, NPRTY2, IYL, ITMP
    INTEGER, ALLOCATABLE    :: MAPTMP(:,:)
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
#ifdef W3_MPI
    INTEGER                 :: IERR_MPI, IH, IB, ISEA0, ISEAN, &
         NRQ, NSEAL_MIN
#endif
    INTEGER(KIND=8)         :: RPOS
#ifdef W3_MPI
    INTEGER, ALLOCATABLE    :: STAT1(:,:), STAT2(:,:)
    REAL, ALLOCATABLE       :: VGBUFF(:), VLBUFF(:)
#endif
    REAL(KIND=lrb), ALLOCATABLE :: writebuff(:), tmp(:), tmp2(:)
 
    LOGICAL                 :: WRITE, IOSFLG
    LOGICAL                 :: FLOGOA(NOGRP,NGRPP)
    LOGICAL                 :: NDSROPN
    CHARACTER(LEN=4)        :: TYPE
    CHARACTER(LEN=10)       :: VERTST
    !      CHARACTER(LEN=21)       :: FNAME
    CHARACTER(LEN=40)       :: FNAME
    CHARACTER(LEN=26)       :: IDTST
    CHARACTER(LEN=30)       :: TNAME
    CHARACTER(LEN=15)       :: TIMETAG
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'W3IORS')
#endif
    !
    !
    ! Constant NDSR for using mpiifort in ZEUS ... paralell runs crashing
    !  because compiler doesn't accept reciclyng of UNIT for FORMATTED or
    !  UNFORMATTED files in OPEN
    !
    !     NDSR = 525
 
    iosflg = iostyp .GT. 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 )
#ifdef W3_WRST
    CALL w3seti ( igrd, ndse, ndst )
#endif
    !
    IF (inxout.NE.'READ' .AND. inxout.NE.'HOT'  .AND.               &
         inxout.NE.'COLD' .AND. inxout.NE.'WIND' .AND.               &
         inxout.NE.'CALM' ) THEN
      IF ( iaproc .EQ. naperr ) WRITE (ndse,900) inxout
      CALL extcde ( 1 )
    END IF
    !
    WRITE = inxout .NE. 'READ'
    IF ( inxout .EQ. 'HOT' ) THEN
      TYPE   = 'FULL'
    ELSE
      TYPE   = inxout
    END IF
    !
#ifdef W3_T
    WRITE (ndst,9000) inxout, WRITE, ntproc, naproc, iaproc, naprst
#endif
    !
    ! initializations ---------------------------------------------------- *
    !
    IF ( .NOT.dinit ) THEN
      IF ( iaproc .LE. naproc ) THEN
        CALL w3dimw ( imod, ndse, ndst )
      ELSE
        CALL w3dimw ( imod, ndse, ndst, .false. )
      END IF
    END IF
    !
    IF ( iaproc .LE. naproc ) va(:,0) = 0.
    !
    lrecl  = max( lrb*nspec ,                                      &
         lrb*(6+(25/lrb)+(9/lrb)+(29/lrb)+(3/lrb)) )
    nsize  = lrecl / lrb
    !     --- Allocate buffer array with zeros (used to
    !         fill bytes up to size LRECL). ---
    ALLOCATE(writebuff(nsize))
    writebuff(:) = 0.
    !
    !     Allocate memory to receive fields needed for coupling
    IF (oarst) THEN
      ALLOCATE(tmp(nsea))
      ALLOCATE(tmp2(nsea))
    ENDIF
    !
    ! open file ---------------------------------------------------------- *
    !
    i      = len_trim(filext)
    j      = len_trim(fnmpre)
    !
    !CHECKPOINT RESTART FILE
    itmp=0
    IF ( PRESENT(flrstrt) ) THEN
      IF (flrstrt) THEN
        WRITE(timetag,"(i8.8,'.'i6.6)")time(1),time(2)
        fname=timetag//'.restart.'//filext(:i)
        itmp=1
      END IF
    END IF
    IF(itmp.NE.1)THEN ! FNAME is not set above, so do it here
      IF ( ifile.EQ.0 ) THEN
        fname  = 'restart.'//filext(:i)
      ELSE
        fname  = 'restartNNN.'//filext(:i)
        IF ( WRITE .AND. iaproc.EQ.naprst )                         &
             WRITE (fname(8:10),'(I3.3)') ifile
      END IF
    END IF
 
    ifile  = ifile + 1
    !
#ifdef W3_T
    WRITE (ndst,9001) fname, lrecl
#endif
    !
 
    IF(ndst.EQ.ndsr)THEN
      IF ( iaproc .EQ. naperr )                                    &
           WRITE(ndse,'(A,I8)')'UNIT NUMBERS OF RESTART FILE AND '&
           //'TEST OUTPUT ARE THE SAME : ',ndst
      CALL extcde ( 15 )
    ENDIF
 
    IF ( WRITE ) THEN
      IF ( .NOT.iosflg .OR. iaproc.EQ.naprst )                    &
           OPEN (ndsr,file=fnmpre(:j)//fname,form='UNFORMATTED', convert=file_endian,       &
           access='STREAM',err=800,iostat=ierr)
    ELSE
      OPEN (ndsr,file=fnmpre(:j)//fname,form='UNFORMATTED', convert=file_endian,       &
           access='STREAM',err=800,iostat=ierr,                  &
           status='OLD',action='READ')
    END IF
    !
    ! test info ---------------------------------------------------------- *
    !
    IF ( WRITE ) THEN
      !
      IF ( iaproc .EQ. naprst ) THEN
        !           Because data has mixed data types we do not know how many
        !           bytes remain to fill up to LRECL. ---
        !           --- Make the entire record zero ---
        writebuff(:) = 0.
        WRITE (ndsr,pos=1) writebuff
        !           --- Replace zeros with data ---
        WRITE (ndsr,pos=1) idstr, verini, gname, TYPE, nsea,      &
             nspec, flogrr
      END IF
      rstype = 3
      !
    ELSE
      READ (ndsr,pos=1,err=802,iostat=ierr)                       &
           idtst, vertst, tname, TYPE, nseat, mspec, flogoa
      !
      IF ( idtst .NE. idstr ) THEN
        IF ( iaproc .EQ. naperr )                               &
             WRITE (ndse,901) idtst, idstr
        CALL extcde ( 10 )
      END IF
      IF ( vertst .NE. verini ) THEN
        IF ( iaproc .EQ. naperr )                               &
             WRITE (ndse,902) vertst, verini
        CALL extcde ( 11 )
      END IF
      IF ( tname .NE. gname ) THEN
        IF ( iaproc .EQ. naperr )                               &
             WRITE (ndse,903) tname, gname
      END IF
      IF (type.NE.'FULL' .AND. type.NE.'COLD' .AND.               &
           type.NE.'WIND' .AND. type.NE.'CALM' ) THEN
        IF ( iaproc .EQ. naperr )                               &
             WRITE (ndse,904) TYPE
        CALL extcde ( 12 )
      END IF
      IF (nseat.NE.nsea .OR. nspec.NE.mspec) THEN
        IF ( iaproc .EQ. naperr )                               &
             WRITE (ndse,905) mspec, nseat, nspec, nsea
        CALL extcde ( 13 )
      END IF
      IF (type.EQ.'FULL') THEN
        rstype = 2
      ELSE IF (type.EQ.'WIND') THEN
        rstype = 1
      ELSE IF (type.EQ.'CALM') THEN
        rstype = 4
      ELSE
        rstype = 0
      END IF
 
      IF (.NOT. WRITE .AND. oarst .AND. iaproc .EQ. naproc) THEN
        DO i=1, nogrp
          DO j=1, ngrpp
            IF (flogrr(i,j) .AND. .NOT. flogoa(i,j)) THEN
              WRITE(screen,1000) i, j
            ENDIF
          ENDDO
        ENDDO
      ENDIF
      !
    END IF
    !
100 CONTINUE
    !
#ifdef W3_T
    WRITE (ndst,9002) idstr, verini, gname, TYPE,                &
         nsea, nseal, nspec
#endif
    !
    ! TIME if required --------------------------------------------------- *
    !
    IF (type.EQ.'FULL') THEN
      rpos  = 1_8 + lrecl*(2-1_8)
      IF ( WRITE ) THEN
        IF ( iaproc .EQ. naprst ) THEN
          writebuff(:) = 0.
          WRITE (ndsr,pos=rpos) writebuff
          WRITE (ndsr,pos=rpos) time
        END IF
      ELSE
        READ (ndsr,pos=rpos,err=802,iostat=ierr) ttime
        IF (time(1).NE.ttime(1) .OR. time(2).NE.ttime(2)) THEN
          IF ( iaproc .EQ. naperr )                           &
               WRITE (ndse,906) ttime, time
          CALL extcde ( 20 )
        END IF
      END IF
      !
#ifdef W3_T
      WRITE (ndst,9003) time
    ELSE
      WRITE (ndst,9004)
#endif
      !
    END IF
    !
    ! Spectra ------------------------------------------------------------ *
    !          ( Bail out if write for TYPE.EQ.'WIND' )
    !
    IF ( WRITE ) THEN
      IF ( type.EQ.'WIND' .OR. type.EQ.'CALM' ) THEN
        IF ( .NOT.iosflg .OR. iaproc.EQ.naprst ) THEN
          CLOSE ( ndsr )
        END IF
#ifdef W3_T
        WRITE (ndst,9005) TYPE
#endif
        ! Clean up file handles and allocated arrays
        INQUIRE (unit=ndsr, opened=ndsropn)
        IF (ndsropn)              CLOSE(ndsr)
        IF (ALLOCATED(writebuff)) DEALLOCATE(writebuff)
        IF (ALLOCATED(tmp))       DEALLOCATE(tmp)
        IF (ALLOCATED(tmp2))      DEALLOCATE(tmp2)
 
        RETURN
      ELSE IF ( iaproc.LE.naproc .OR. iaproc.EQ. naprst ) THEN
        !
        ! Original non-server version writing of spectra
        !
        IF ( .NOT.iosflg .OR. (naproc.EQ.1.AND.naprst.EQ.1) ) THEN
#ifdef W3_MPI
          DO jsea=1, nseal
            CALL init_get_isea(isea, jsea)
            nrec   = isea + 2
            rpos  = 1_8 + lrecl*(nrec-1_8)
            writebuff(:) = 0.
            writebuff(1:nspec) = va(1:nspec,jsea)
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr) writebuff
          END DO
#else
          DO jsea=1, nsea
            isea = jsea
            nrec   = isea + 2
            rpos  = 1_8 + lrecl*(nrec-1_8)
            writebuff(:) = 0.
            writebuff(1:nspec) = va(1:nspec,jsea)
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr) writebuff
          END DO
#endif
          !
          ! I/O server version writing of spectra ( !/MPI )
          !
#ifdef W3_MPI
        ELSE
          !
          IF (lpdlib) THEN
#endif
#ifdef W3_TIMINGS
            CALL print_my_time("Before UNST_PDLIB_WRITE_TO_FILE")
#endif
#ifdef W3_PDLIB
            CALL unst_pdlib_write_to_file(ndsr)
#endif
#ifdef W3_TIMINGS
            CALL print_my_time("After UNST_PDLIB_WRITE_TO_FILE")
#endif
#ifdef W3_MPI
          ELSE
 
            IF ( iaproc .NE. naprst ) THEN
              nrq    = 1
            ELSE IF ( naprst .LE. naproc ) THEN
              nrq    = naproc - 1
            ELSE
              nrq    = naproc
            END IF
            !
            ALLOCATE ( stat1(mpi_status_size,nrq) )
            IF ( iaproc .EQ. naprst ) CALL mpi_startall    &
                 ( nrq, irqrss, ierr_mpi )
            !
            DO ib=1, nblkrs
              isea0  = 1 + (ib-1)*rsblks*naproc
              isean  = min( nsea , ib*rsblks*naproc )
              !
              IF ( iaproc .EQ. naprst ) THEN
                !
                ih     = 1 + nrq * (ib-1)
                CALL mpi_waitall                         &
                     ( nrq, irqrss(ih), stat1, ierr_mpi )
                IF ( ib .LT. nblkrs ) THEN
                  ih     = 1 + nrq * ib
                  CALL mpi_startall                    &
                       ( nrq, irqrss(ih), ierr_mpi )
                END IF
                !
                DO isea=isea0, isean
                  nrec   = isea + 2
                  CALL init_get_jsea_isproc(isea, jsea, ip)
                  rpos   = 1_8 + lrecl*(nrec-1_8)
                  writebuff(:) = 0.
                  IF ( ip .EQ. naprst ) THEN
                    writebuff(1:nspec) = va(1:nspec,jsea)
                  ELSE
                    jsea   = jsea - 2*((ib-1)/2)*rsblks
                    writebuff(1:nspec) = vaaux(1:nspec,jsea,ip)
                  END IF
                  WRITE (ndsr,pos=rpos,err=803,iostat=ierr) &
                       writebuff
                END DO
                !
              ELSE
                !
                CALL mpi_startall                        &
                     ( 1, irqrss(ib), ierr_mpi )
                CALL mpi_waitall                         &
                     ( 1, irqrss(ib), stat1, ierr_mpi )
                !
              END IF
            END DO
            !
            DEALLOCATE ( stat1 )
          END IF
#endif
          !
        END IF
        !
      END IF
    ELSE
      !
      ! Reading spectra
      !
      IF ( type.EQ.'WIND' .OR. type.EQ.'CALM' ) THEN
#ifdef W3_T
        WRITE (ndst,9020) TYPE
#endif
      ELSE
        IF (lpdlib) THEN
#ifdef W3_TIMINGS
          CALL print_my_time("Before UNST_PDLIB_READ_FROM_FILE")
#endif
#ifdef W3_PDLIB
          CALL unst_pdlib_read_from_file(ndsr)
#endif
#ifdef W3_TIMINGS
          CALL print_my_time("After UNST_PDLIB_READ_FROM_FILE")
#endif
        ELSE
#ifdef W3_MPI
          nseal_min = 1 + (nsea-naproc)/naproc
          IF ( naproc.GT.1 ) THEN
            !/ ----------- Large number of small-sized record reads will tend ---- *
            !/             to perform badly on most file systems. We read this part
            !/             using streams and scatter the results using MPI.
            !/                                                      ( M. WARD, NCI )
            !
            !              Begin computational proc. only section ---------------- *
            IF ( iaproc.LE.naproc ) THEN
              !
              !              Main loop --------------------------------------------- *
              ALLOCATE( vgbuff( nsize * naproc ) )
              ALLOCATE( vlbuff( nsize ) )
              !
              DO jsea = 1, nseal_min
                !                Read NAPROC records into buffer VGBUFF. ------------- *
                IF ( iaproc .EQ. naproc ) THEN
                  rpos = 1_8 + (2 + (jsea - 1_8) * naproc) * lrecl
                  READ(ndsr, pos=rpos,err=802,iostat=ierr) vgbuff(:)
                ELSE
                  vgbuff(:) = 0.
                END IF
                !                Distribute one record to each rank.
                CALL mpi_scatter(vgbuff, nsize, mpi_real,             &
                     vlbuff, nsize, mpi_real,             &
                     naproc-1, mpi_comm_wcmp, ierr        )
                !                Transfer the spectral content of VLBUFF to VA. ------ *
                va(1:nspec,jsea) = vlbuff(1:nspec)
              END DO
              !
              !              Include remainder values (switch to record format) ---- *
              jsea = nseal_min + 1
              IF ( jsea.EQ.nseal ) THEN
                CALL init_get_isea(isea, jsea)
                nrec = isea + 2
                rpos = 1_8 + lrecl*(nrec-1_8)
                READ (ndsr, pos=rpos, err=802, iostat=ierr)          &
                     (va(i,jsea), i=1,nspec)
              END IF
              !
              DEALLOCATE( vgbuff )
              DEALLOCATE( vlbuff )
              !
              !              End computational proc. only section ------------------ *
            END IF
            !
          ELSE
#endif
            va = 0.
            DO jsea=1, nsea
              CALL init_get_isea(isea, jsea)
              nrec   = isea + 2
              rpos   = 1_8 + lrecl*(nrec-1_8)
              READ (ndsr,pos=rpos,err=802,iostat=ierr)              &
                   (va(i,jsea),i=1,nspec)
            ENDDO
#ifdef W3_MPI
          END IF
#endif
        END IF
      END IF
    END IF
 
    va = max(0.,va)
    !
#ifdef W3_T
    WRITE (ndst,9006)
#endif
    !
    ! Water level etc. if required --------------------------------------- *
    !     ( For cold start write test output and cold start initialize
    !       water levels. Note that MAPSTA overwrites the one read from the
    !       model definition file, so that it need not be initialized. )
    !
    nrec   = nsea + 3
    npart  = 1 + (nsea-1)/nsize
    nprtx2 = 1 + (nx-1)/nsize
    nprty2 = 1 + (ny-1)/nsize
    !
    IF ( WRITE ) THEN
      !
      IF (type.EQ.'FULL') THEN
        !
        IF ( iaproc .EQ. naprst ) THEN
          !
#ifdef W3_MPI
          if (associated(irqrs)) then
            ALLOCATE ( stat2(mpi_status_size,nrqrs) )
            CALL mpi_waitall                               &
                 ( nrqrs, irqrs , stat2, ierr_mpi )
            DEALLOCATE ( stat2 )
          end if
#endif
          !
          rpos  = 1_8 + lrecl*(nrec-1_8)
          writebuff(:) = 0.
          WRITE (ndsr,pos=rpos,err=803,iostat=ierr) writebuff
          WRITE (ndsr,pos=rpos,err=803,iostat=ierr)           &
               tlev, tice, trho, tic1, tic5
          DO ipart=1,npart
            nrec  = nrec + 1
            rpos  = 1_8 + lrecl*(nrec-1_8)
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr) writebuff
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr)         &
                 (wlv(isea),isea=1+(ipart-1)*nsize,          &
                 min(nsea,ipart*nsize))
          END DO
          DO ipart=1,npart
            nrec  = nrec + 1
            rpos  = 1_8 + lrecl*(nrec-1_8)
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr) writebuff
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr)         &
                 (ice(isea),isea=1+(ipart-1)*nsize,          &
                 min(nsea,ipart*nsize))
          END DO
 
#ifdef W3_WRST
          ! The WRST switch saves the values of wind in the
          ! restart file and then uses the wind for the first
          ! time step here.  This is needed when coupling with
          ! an atm model that does not have 10m wind speeds at
          ! initialization.  If there is no restart, wind is zero
#endif
 
#ifdef W3_WRST
          DO ix=1, nx
            DO ipart=1,nprty2
              nrec  = nrec + 1
              rpos  = 1_8 + lrecl*(nrec-1_8)
              WRITE (ndsr,pos=rpos,err=803,iostat=ierr) writebuff
              WRITE (ndsr,pos=rpos,err=803,iostat=ierr)       &
                   (wxn(ix,iyl),iyl=1+(ipart-1)*nsize,         &
                   min(ny,ipart*nsize))
            END DO
          END DO
          DO ix=1, nx
            DO ipart=1,nprty2
              nrec  = nrec + 1
              rpos  = 1_8 + lrecl*(nrec-1_8)
              WRITE (ndsr,pos=rpos,err=803,iostat=ierr) writebuff
              WRITE (ndsr,pos=rpos,err=803,iostat=ierr)       &
                   (wyn(ix,iyl),iyl=1+(ipart-1)*nsize,         &
                   min(ny,ipart*nsize))
            END DO
          END DO
#endif
          ALLOCATE ( maptmp(ny,nx) )
          maptmp = mapsta + 8*mapst2
          DO iy=1, ny
            DO ipart=1,nprtx2
              nrec  = nrec + 1
              rpos  = 1_8 + lrecl*(nrec-1_8)
              WRITE (ndsr,pos=rpos,err=803,iostat=ierr)       &
                   writebuff
              WRITE (ndsr,pos=rpos,err=803,iostat=ierr)       &
                   (maptmp(iy,ixl),ixl=1+(ipart-1)*nsize,    &
                   min(nx,ipart*nsize))
            END DO
          END DO
          DEALLOCATE ( maptmp )
          DO ipart=1,npart
            nrec  = nrec + 1
            rpos  = 1_8 + lrecl*(nrec-1_8)
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr) writebuff
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr)         &
                 (ust(isea),isea=1+(ipart-1)*nsize,          &
                 min(nsea,ipart*nsize))
          END DO
          DO ipart=1,npart
            nrec  = nrec + 1
            rpos  = 1_8 + lrecl*(nrec-1_8)
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr) writebuff
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr)         &
                 (ustdir(isea),isea=1+(ipart-1)*nsize,       &
                 min(nsea,ipart*nsize))
          END DO
          DO ipart=1,npart
            nrec  = nrec + 1
            rpos  = 1_8 + lrecl*(nrec-1_8)
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr) writebuff
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr)         &
                 (asf(isea),isea=1+(ipart-1)*nsize,          &
                 min(nsea,ipart*nsize))
          END DO
          DO ipart=1,npart
            nrec  = nrec + 1
            rpos  = 1_8 + lrecl*(nrec-1_8)
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr) writebuff
            WRITE (ndsr,pos=rpos,err=803,iostat=ierr)         &
                 (fpis(isea),isea=1+(ipart-1)*nsize,         &
                 min(nsea,ipart*nsize))
          END DO
          IF (oarst) THEN
#ifdef W3_MPI
            CALL w3xeta ( igrd, ndse, ndst )
#endif
            !
            IF ( flogrr(1,2) ) THEN
              WRITE(ndsr,err=803,iostat=ierr) cx(1:nsea)
              WRITE(ndsr,err=803,iostat=ierr) cy(1:nsea)
            ENDIF
            IF ( flogrr(1,12) )                                 &
                 WRITE(ndsr,err=803,iostat=ierr) icef(1:nsea)
            IF ( flogrr(2,1) )                                  &
                 WRITE(ndsr,err=803,iostat=ierr) hs(1:nsea)
            IF ( flogrr(2,2) )                                  &
                 WRITE(ndsr,err=803,iostat=ierr) wlm(1:nsea)
            IF ( flogrr(2,4) )                                  &
                 WRITE(ndsr,err=803,iostat=ierr) t0m1(1:nsea)
            IF ( flogrr(2,5) )                                  &
                 WRITE(ndsr,err=803,iostat=ierr) t01(1:nsea)
            IF ( flogrr(2,6) )                                  &
                 WRITE(ndsr,err=803,iostat=ierr) fp0(1:nsea)
            IF ( flogrr(2,7) )                                  &
                 WRITE(ndsr,err=803,iostat=ierr) thm(1:nsea)
            IF ( flogrr(2,19) )                                 &
                 WRITE(ndsr,err=803,iostat=ierr) wnmean(1:nsea)
            IF ( flogrr(5,2) )                                  &
                 WRITE(ndsr,err=803,iostat=ierr) charn(1:nsea)
            IF ( flogrr(5,5) ) THEN
              WRITE(ndsr,err=803,iostat=ierr) tauwix(1:nsea)
              WRITE(ndsr,err=803,iostat=ierr) tauwiy(1:nsea)
            ENDIF
            IF ( flogrr(5,11) )                                 &
                 WRITE(ndsr,err=803,iostat=ierr) tws(1:nsea)
            IF ( flogrr(6,2) ) THEN
              WRITE(ndsr,err=803,iostat=ierr) tauox(1:nsea)
              WRITE(ndsr,err=803,iostat=ierr) tauoy(1:nsea)
            ENDIF
            IF ( flogrr(6,3) )                                  &
                 WRITE(ndsr,err=803,iostat=ierr) bhd(1:nsea)
            IF ( flogrr(6,4) )                                  &
                 WRITE(ndsr,err=803,iostat=ierr) phioc(1:nsea)
            IF ( flogrr(6,5) ) THEN
              WRITE(ndsr,err=803,iostat=ierr) tusx(1:nsea)
              WRITE(ndsr,err=803,iostat=ierr) tusy(1:nsea)
            ENDIF
            IF ( flogrr(6,6) ) THEN
              WRITE(ndsr,err=803,iostat=ierr) ussx(1:nsea)
              WRITE(ndsr,err=803,iostat=ierr) ussy(1:nsea)
            ENDIF
            IF ( flogrr(6,10) ) THEN
              WRITE(ndsr,err=803,iostat=ierr) tauice(1:nsea,1)
              WRITE(ndsr,err=803,iostat=ierr) tauice(1:nsea,2)
            ENDIF
            IF ( flogrr(6,13) ) THEN
              WRITE(ndsr,err=803,iostat=ierr) tauocx(1:nsea)
              WRITE(ndsr,err=803,iostat=ierr) tauocy(1:nsea)
            ENDIF
            IF ( flogrr(7,2) ) THEN
              WRITE(ndsr,err=803,iostat=ierr) uba(1:nsea)
              WRITE(ndsr,err=803,iostat=ierr) ubd(1:nsea)
            ENDIF
            IF ( flogrr(7,4) )                                  &
                 WRITE(ndsr,err=803,iostat=ierr) phibbl(1:nsea)
            IF ( flogrr(7,5) ) THEN
              WRITE(ndsr,err=803,iostat=ierr) taubbl(1:nsea,1)
              WRITE(ndsr,err=803,iostat=ierr) taubbl(1:nsea,2)
            ENDIF
            !
#ifdef W3_MPI
            CALL w3seta ( igrd, ndse, ndst )
#endif
          ENDIF
#ifdef W3_T
          WRITE (ndst,9007)
        ELSE
          DO isea=1, nsea
            wlv(isea) = 0.
            ice(isea) = 0.
          END DO
          WRITE (ndst,9008)
#endif
        END IF
      END IF
    ELSE
      IF (type.EQ.'FULL') THEN
        rpos = 1_8 + lrecl*(nrec-1_8)
        READ (ndsr,pos=rpos,err=802,iostat=ierr)                &
             tlev, tice, trho, tic1, tic5
        DO ipart=1,npart
          nrec  = nrec + 1
          rpos = 1_8 + lrecl*(nrec-1_8)
          READ (ndsr,pos=rpos,err=802,iostat=ierr)              &
               (wlv(isea),isea=1+(ipart-1)*nsize,              &
               min(nsea,ipart*nsize))
        END DO
        DO ipart=1,npart
          nrec  = nrec + 1
          rpos = 1_8 + lrecl*(nrec-1_8)
          READ (ndsr,pos=rpos,err=802,iostat=ierr)              &
               (ice(isea),isea=1+(ipart-1)*nsize,              &
               min(nsea,ipart*nsize))
        END DO
#ifdef W3_WRST
        DO ix=1, nx
          DO ipart=1,nprty2
            nrec  = nrec + 1
            rpos = 1_8 + lrecl*(nrec-1_8)
            READ (ndsr,pos=rpos,err=802,iostat=ierr)              &
                 (wxnwrst(ix,iyl),iyl=1+(ipart-1)*nsize,         &
                 min(ny,ipart*nsize))
          END DO
        END DO
        DO ix=1, nx
          DO ipart=1,nprty2
            nrec  = nrec + 1
            rpos = 1_8 + lrecl*(nrec-1_8)
            READ (ndsr,pos=rpos,err=802,iostat=ierr)              &
                 (wynwrst(ix,iyl),iyl=1+(ipart-1)*nsize,         &
                 min(ny,ipart*nsize))
          END DO
        END DO
#endif
        ALLOCATE ( maptmp(ny,nx) )
        DO iy=1, ny
          DO ipart=1,nprtx2
            nrec  = nrec + 1
            rpos  = 1_8 + lrecl*(nrec-1_8)
            READ (ndsr,pos=rpos,err=802,iostat=ierr)            &
                 (maptmp(iy,ixl),ixl=1+(ipart-1)*nsize,        &
                 min(nx,ipart*nsize))
          END DO
        END DO
        mapsta = mod(maptmp+2,8) - 2
        mapst2 = (maptmp-mapsta) / 8
        DEALLOCATE ( maptmp )
        !
        ! Updates reflections maps:
        !
        IF (gtype.EQ.ungtype) THEN
          !AR: not needed since already initialized on w3iogr                CALL SET_UG_IOBP
#ifdef W3_REF1
        ELSE
          CALL w3setref
#endif
        ENDIF
        !
        DO ipart=1,npart
          nrec  = nrec + 1
          rpos  = 1_8 + lrecl*(nrec-1_8)
          READ (ndsr,pos=rpos,err=802,iostat=ierr)              &
               (ust(isea),isea=1+(ipart-1)*nsize,              &
               min(nsea,ipart*nsize))
        END DO
        DO ipart=1,npart
          nrec  = nrec + 1
          rpos  = 1_8 + lrecl*(nrec-1_8)
          READ (ndsr,pos=rpos,err=802,iostat=ierr)              &
               (ustdir(isea),isea=1+(ipart-1)*nsize,           &
               min(nsea,ipart*nsize))
        END DO
        DO ipart=1,npart
          nrec  = nrec + 1
          rpos  = 1_8 + lrecl*(nrec-1_8)
          READ (ndsr,pos=rpos,err=802,iostat=ierr)              &
               (asf(isea),isea=1+(ipart-1)*nsize,              &
               min(nsea,ipart*nsize))
        END DO
        DO ipart=1,npart
          nrec  = nrec + 1
          rpos  = 1_8 + lrecl*(nrec-1_8)
          READ (ndsr,pos=rpos,err=802,iostat=ierr)              &
               (fpis(isea),isea=1+(ipart-1)*nsize,             &
               min(nsea,ipart*nsize))
        END DO
        IF (oarst) THEN
          IF ( flogoa(1,2) ) THEN
            READ (ndsr,err=802,iostat=ierr) cx(1:nsea)
            READ (ndsr,err=802,iostat=ierr) cy(1:nsea)
          ENDIF
          IF ( flogoa(1,12) ) THEN
            READ (ndsr,err=802,iostat=ierr) icef(1:nsea)
          ENDIF
          IF ( flogoa(2,1) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) hs(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(2,2) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) wlm(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(2,4) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) t0m1(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(2,5) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) t01(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(2,6) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) fp0(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(2,7) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) thm(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(2,19) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) wnmean(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(5,2) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) charn(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(5,5) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            READ (ndsr,err=802,iostat=ierr) tmp2(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) THEN
                tauwix(i) = tmp(j)
                tauwiy(i) = tmp2(j)
              ENDIF
            ENDDO
          ENDIF
          IF ( flogoa(5,11) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) tws(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(6,2) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            READ (ndsr,err=802,iostat=ierr) tmp2(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) THEN
                tauox(i) = tmp(j)
                tauoy(i) = tmp2(j)
              ENDIF
            ENDDO
          ENDIF
          IF ( flogoa(6,3) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) bhd(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(6,4) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) phioc(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(6,5) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            READ (ndsr,err=802,iostat=ierr) tmp2(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) THEN
                tusx(i) = tmp(j)
                tusy(i) = tmp2(j)
              ENDIF
            ENDDO
          ENDIF
          IF ( flogoa(6,6) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            READ (ndsr,err=802,iostat=ierr) tmp2(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) THEN
                ussx(i) = tmp(j)
                ussy(i) = tmp2(j)
              ENDIF
            ENDDO
          ENDIF
          IF ( flogoa(6,10) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            READ (ndsr,err=802,iostat=ierr) tmp2(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) THEN
                tauice(i,1) = tmp(j)
                tauice(i,2) = tmp2(j)
              ENDIF
            ENDDO
          ENDIF
          IF ( flogoa(6,13) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            READ (ndsr,err=802,iostat=ierr) tmp2(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) THEN
                tauocx(i) = tmp(j)
                tauocy(i) = tmp2(j)
              ENDIF
            ENDDO
          ENDIF
          IF ( flogoa(7,2) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            READ (ndsr,err=802,iostat=ierr) tmp2(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) THEN
                uba(i) = tmp(j)
                ubd(i) = tmp2(j)
              ENDIF
            ENDDO
          ENDIF
          IF ( flogoa(7,4) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) phibbl(i) = tmp(j)
            ENDDO
          ENDIF
          IF ( flogoa(7,5) ) THEN
            READ (ndsr,err=802,iostat=ierr) tmp(1:nsea)
            READ (ndsr,err=802,iostat=ierr) tmp2(1:nsea)
            DO i=1, nsealm
              j = iaproc + (i-1)*naproc
              IF (j .LE. nsea) THEN
                taubbl(i,1) = tmp(j)
                taubbl(i,2) = tmp2(j)
              ENDIF
            ENDDO
          ENDIF
        ENDIF
#ifdef W3_T
        WRITE (ndst,9007)
#endif
      ELSE
        tlev(1) = -1
        tlev(2) =  0
        tice(1) = -1
        tice(2) =  0
        trho(1) = -1
        tic1(1) = -1
        tic1(2) =  0
        tic5(1) = -1
        tic5(2) =  0
#ifdef W3_WRST
        wxnwrst =  0.
        wynwrst =  0.
#endif
        wlv     =  0.
        ice     =  0.
        asf     =  1.
        fpis    =  dumfpi
 
        ! Initialize coupled fields if no restart is present
        IF (oarst) THEN
          cx      = 0.
          cy      = 0.
          icef    = 0.
          hs      = 0.
          wlm     = 0.
          t0m1    = 0.
          t01     = 0.
          fp0     = 1.
          thm     = 0.
          wnmean  = 0.
          charn   = 0.0185
          tauwix  = 0.
          tauwiy  = 0.
          tws     = 0.
          tauox   = 0.
          tauoy   = 0.
          bhd     = 0.
          phioc   = 0.
          tusx    = 0.
          tusy    = 0.
          ussx    = 0.
          ussy    = 0.
          tauocx  = 0.
          tauocy  = 0.
          tauice  = 0.
          uba     = 0.
          ubd     = 0.
          phibbl  = 0.
          taubbl  = 0.
        ENDIF
#ifdef W3_T
        WRITE (ndst,9008)
#endif
      END IF
    END IF
    !
    ! Close file --------------------------------------------------------- *
    !
    IF (write) THEN
      IF ( .NOT.iosflg .OR. iaproc.EQ.naprst ) THEN
        CLOSE ( ndsr )
      END IF
    ELSE
      CLOSE ( ndsr )
    END IF
    !
    IF (ALLOCATED(writebuff)) DEALLOCATE(writebuff)
    IF (ALLOCATED(tmp))  DEALLOCATE(tmp)
    IF (ALLOCATED(tmp2)) DEALLOCATE(tmp2)
    !
    RETURN
    !
    ! Escape locations read errors :
    !
800 CONTINUE
#ifdef W3_LN0
    TYPE   = 'WIND'
    rstype = 1
#endif
#ifdef W3_SEED
    TYPE   = 'CALM'
    rstype = 4
#endif
#ifdef W3_LN1
    TYPE   = 'CALM'
    rstype = 4
#endif
    IF ( iaproc .EQ. naperr ) WRITE (ndse,990) TYPE, ierr
    GOTO 100
    !
801 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,991)
    CALL extcde ( 30 )
    !
802 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,992) ierr
    CALL extcde ( 31 )
    !
803 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,993) ierr, rpos
    CALL extcde ( 31 )
    !
    !
    ! Formats
    !
900 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/                &
         '     ILLEGAL INXOUT VALUE: ',a/)
901 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/                &
         '     ILLEGAL IDSTR, READ : ',a/                       &
         '                   CHECK : ',a/)
902 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/                &
         '     ILLEGAL VERINI, READ : ',a/                      &
         '                    CHECK : ',a/)
903 FORMAT (/' *** WAVEWATCH III WARNING IN W3IORS :'/              &
         '     ILLEGAL GNAME, READ : ',a/                       &
         '                   CHECK : ',a/)
904 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/                &
         '     ILLEGAL TYPE : ',a/)
905 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/                &
         '     CONFLICTING NSPEC, NSEA GRID : ',2i8/            &
         '                         EXPECTED : ',2i8/)
906 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/                &
         '     CONFLICTING TIMES: FILE : ',i10.8,i8.6/          &
         '                       MODEL : ',i10.8,i8.6/)
    !
990 FORMAT (/' *** WAVEWATCH III WARNING IN W3IORS : '/             &
         '     NO READABLE RESTART FILE, ',                     &
         'INITIALIZE WITH ''',a,''' INSTEAD'/              &
         '     IOSTAT =',i5/)
991 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS : '/               &
         '     PREMATURE END OF FILE'/)
992 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS : '/               &
         '     ERROR IN READING FROM FILE'/                     &
         '     IOSTAT =',i5/)
993 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS : '/               &
         '     ERROR IN WRITING TO FILE'/                       &
         '     IOSTAT =',i5,', POS =',i11 /)
1000 FORMAT (/' *** WAVEWATCH III WARNING IN W3IORS : '/             &
         '     REQUESTED EXTRA RESTART GROUP',i2,' FIELD',i2, / &
         '     IS NOT PRESENT IN THE RESTART FILE.'/            &
         '     THIS MAY CAUSE INSTABILITIES IN COUPLED CONFIGURATIONS')
    !
    !
#ifdef W3_T
9000 FORMAT (' TEST W3IORS : TEST PARAMETERS :'/                  &
         '      INXOUT : ',a,/                                &
         '       WRITE : ',l10/                               &
         '      NTPROC : ',i10/                               &
         '      NAPROC : ',i10/                               &
         '      IAPROC : ',i10/                               &
         '      NAPRST : ',i10)
9001 FORMAT ('      FNAME  : ',a/                                 &
         '       LRECL : ',i10)
9002 FORMAT ('       IDSTR : ',a/                                 &
         '      VERINI : ',a/                                 &
         '       GNAME : ',a/                                 &
         '        TYPE : ',a/                                 &
         '        NSEA : ',i10/                               &
         '       NSEAL : ',i10/                               &
         '       NSPEC : ',i10)
9003 FORMAT (' TEST W3IORS :',i10.8,i8.6,' UTC')
9004 FORMAT (' TEST W3IORS : TIME NOT AVAILABLE ')
9005 FORMAT (' TEST W3IORS : NO SPECTRA, TYPE=''',a,''' ')
9006 FORMAT (' TEST W3IORS : SPECTRA PROCESSED ')
9007 FORMAT (' TEST W3IORS : WATER LEVELS ETC. PROCESSED ')
9008 FORMAT (' TEST W3IORS : WATER LEVELS ETC. PROCESSED (DUMMY)')
    !
9020 FORMAT (' TEST W3IORS : RSTYPE = ',a,', PERFORMED BY W3INIT')
#endif
    !/
    !/ End of W3IORS ----------------------------------------------------- /
    !/
  END SUBROUTINE w3iors
  !/
  !/ End of module W3IORSMD -------------------------------------------- /
  !/
END MODULE w3iorsmd