w3iosfmd.F90

Go to the documentation of this file.

 
 
#include "w3macros.h"
!/ ------------------------------------------------------------------- /
MODULE w3iosfmd
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           H. L. Tolman            |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :         25-Jul-2018 |
  !/                  +-----------------------------------+
  !/
  !/    27-Jun-2006 : Origination.                        ( version 3.09 )
  !/    02-Nov-2006 : Origination W3CPRT and W3IOSF.      ( version 3.10 )
  !/    24-Mar-2007 : Add pars for entire spectrum.       ( version 3.11 )
  !/    17-May-2007 : Adding NTPROC/NAPROC separation.    ( version 3.11 )
  !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
  !/    30-Oct-2009 : Fix unitialized dtsiz in w3iosf.    ( version 3.14 )
  !/                  (T. J. Campbell, NRL)
  !/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
  !/                  (W. E. Rogers & T. J. Campbell, NRL)
  !/    30-Oct-2009 : Implement curvilinear grid type.    ( version 3.14 )
  !/                  (W. E. Rogers & T. J. Campbell, NRL)
  !/    06-Mar-2012 : Reparing test output under MPI.     ( version 4.07 )
  !/    08-Jun-2018 : use W3ADATMD, W3PARALL, INIT_GET_ISEA and
  !/                            INIT_GET_JSEA_ISPROC      ( version 6.04 )
  !/    25-Jul-2018 : Changed DIMXP size for partitioning ( version 6.05 )
  !/                  methods 4 and 5. (C Bunney, UKMO)
  !/
  !/    Copyright 2009-2012 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 :
  !
  !     I/O and computational routines for the wave-field separation
  !     output.
  !
  !  2. Variables and types :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      VERPRT    C*10  Private  Partition file version number.
  !      IDSTR     C*35  Private  Partition file ID string.
  !     ----------------------------------------------------------------
  !
  !  3. Subroutines and functions :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      W3CPRT    Subr. Public   Partition all requested local spectra.
  !      W3IOSF    Subr. Public   Processing and output of partitioned
  !                               wave data.
  !     ----------------------------------------------------------------
  !
  !  4. Subroutines and functions used :
  !
  !      Name      Type  Module   Description
  !     ----------------------------------------------------------------
  !      W3PART    Subr. W3PARTMD Spectral partition for single spectrum.
  !      STRACE    Sur.  W3SERVMD Subroutine tracing.
  !      EXTCDE    Subr.   Id.    Program abort.
  !      MPI_SEND, MPI_RECV
  !                               MPI send and recieve routines
  !     ----------------------------------------------------------------
  !
  !  5. Remarks :
  !
  !  6. Switches :
  !
  !     !/S    Enable subroutine tracing.
  !     !/T    Enable test output
  !
  !  7. Source code :
  !
  !/ ------------------------------------------------------------------- /
  PUBLIC
  !/
  !/ Private parameter statements (ID strings)
  !/
  CHARACTER(LEN=10), PARAMETER, PRIVATE :: VERPRT = '2018-07-25'
  CHARACTER(LEN=35), PARAMETER, PRIVATE ::                        &
       IDSTR = 'WAVEWATCH III PARTITIONED DATA FILE'
  !/
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3cprt ( IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         25-Jul-2018 !
    !/                  +-----------------------------------+
    !/
    !/    30-Oct-2006 : Origination.                        ( version 3.10 )
    !/    24-Mar-2007 : Add pars for entire spectrum.       ( version 3.11 )
    !/    25-Jul-2018 : Changed DIMXP size for partitioning ( version 6.05 )
    !/                  methods 4 and 5. (C Bunney, UKMO)
    !/
    !  1. Purpose :
    !
    !     Partitioning of spectra into fields for all grid points that
    !     are locally stored.
    !
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Grid number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3PART    Subr. W3PARTMD Spectral partition for single spectrum.
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3WAVE    Subr. W3WAVEMD Actual wave model routine.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !     - Although a sparse (IX,IY) grid is looked for, th major loop
    !       is still over NSEAL to simplify storage.
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/S    Enable subroutine tracing.
    !     !/T    Enable test output
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !/
    USE constants
    !
    USE w3partmd, ONLY: w3part
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    USE w3gdatmd, ONLY: nsea, nseal, mapsf, mapsta, nk, nth, sig
    USE w3adatmd, ONLY: wn, cg, u10, u10d, dw
    USE w3odatmd, ONLY: iaproc, naproc, outpts, o6init,       &
         icprt, dtprt, dimp, ptmeth
    USE w3wdatmd, ONLY: va, asf
    USE w3adatmd, ONLY: nsealm
    USE w3parall, ONLY: init_get_isea, init_get_jsea_isproc
#ifdef W3_T
    USE w3odatmd, ONLY: ndst
#endif
    !
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: imod
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: dimxp, jsea, isea, ix, iy,     &
         ik, ith, np, tmpsiz, oldsiz, finsiz
    INTEGER, SAVE           :: tsfac = 7
#ifdef W3_S
    INTEGER, SAVE           :: ient = 0
#endif
    REAL                    :: uabs, udir, depth, fact, e2(nk,nth)
    REAL, ALLOCATABLE       :: XP(:,:), TMP(:,:), TMP2(:,:)
    !/
#ifdef W3_S
    CALL strace (ient, 'W3CPRT')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 0.  Initializations
    !
    IF(ptmeth .EQ. 4 .OR. ptmeth .EQ. 5) THEN
      ! Partitioning methods 4 and 5 only ever create 2 partitions
      ! C. Bunney, 25-Jul-18
      dimxp = 2
    ELSE
      dimxp  = ((nk+1)/2) * ((nth-1)/2)
    ENDIF
 
    ALLOCATE ( xp(dimp,0:dimxp) )
    !
    IF ( o6init ) THEN
      DEALLOCATE ( outpts(imod)%OUT6%DTPRT )
    ELSE
      ALLOCATE ( outpts(imod)%OUT6%ICPRT(nsealm+1,2) )
      icprt => outpts(imod)%OUT6%ICPRT
      o6init = .true.
    END IF
    icprt  = 0
    icprt(1,2) = 1
    !
    tmpsiz = tsfac * nseal
    ALLOCATE ( tmp(dimp,tmpsiz) )
    !
#ifdef W3_T
    WRITE (ndst,9000) dimp, dimxp, tmpsiz
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Loop over sea points
    !
    DO jsea=1, nseal
      !
      ! -------------------------------------------------------------------- /
      ! 2.  Check need for processing
      !
      CALL init_get_isea(isea, jsea)
      ix     = mapsf(isea,1)
      iy     = mapsf(isea,2)
      icprt(jsea+1,2) = icprt(jsea,2)
      !
      IF ( mapsta(iy,ix) .LT. 0 ) cycle
      !
      ! -------------------------------------------------------------------- /
      ! 3.  Prepare for partitioning
      !
      uabs   = u10(isea)*asf(isea)
      udir   = u10d(isea)*rade
      depth  = dw(isea)
      !
      DO ik=1, nk
        fact   = tpi * sig(ik) / cg(ik,isea)
        DO ith=1, nth
          e2(ik,ith) = va(ith+(ik-1)*nth,jsea) * fact
        END DO
      END DO
      !
      ! -------------------------------------------------------------------- /
      ! 4.  perform partitioning
      !
      !AR: NaN checks should results in immediate stop after trace ...
      IF (depth.NE.depth) THEN
        WRITE(6,*) 'IOSF:',isea,ix,iy,dw(isea),depth
        WRITE(*,*) 'FOUND NaN in depth'
        stop 'CRITICAL ERROR IN DEPTH ARRAY'
      END IF
      CALL w3part ( e2, uabs, udir, depth, wn(1:nk,isea),           &
           np, xp, dimxp )
      !
      ! -------------------------------------------------------------------- /
      ! 5.  Store results (temp)
      !
      IF ( np .GE. 0 ) THEN
        icprt( jsea ,1) = np + 1
        icprt(jsea+1,2) = icprt(jsea,2) + np + 1
        !
        IF ( icprt(jsea,2)+np .GT. tmpsiz ) THEN
          ALLOCATE ( tmp2(dimp,tmpsiz) )
          tmp2   = tmp
          DEALLOCATE ( tmp )
          oldsiz = tmpsiz
          tmpsiz = tmpsiz + max( tsfac*nseal , dimxp )
          ALLOCATE ( tmp(dimp,tmpsiz) )
          tmp(:,1:oldsiz) = tmp2(:,1:oldsiz)
          tmp(:,oldsiz+1:) = 0.
          DEALLOCATE ( tmp2 )
#ifdef W3_T
          WRITE (ndst,9050) jsea, oldsiz, tmpsiz
#endif
        END IF
        !
        tmp(:,icprt(jsea,2):icprt(jsea,2)+np) = xp(:,0:np)
        !
      END IF
      !
      ! -------------------------------------------------------------------- /
      ! 6.  End of loop and clean up
      !
    END DO
    !
    finsiz = icprt(nseal+1,2) - 1
    !
#ifdef W3_T
    WRITE (ndst,9060)
    WRITE (ndst,9061) (cmplx(jsea,icprt(jsea,:)),jsea=1,min(100,nseal))
    WRITE (ndst,9062) finsiz
#endif
    !
    ALLOCATE ( outpts(imod)%OUT6%DTPRT(dimp,max(1,finsiz)) )
    dtprt => outpts(imod)%OUT6%DTPRT
    IF ( finsiz .GT. 0 ) THEN
      dtprt = tmp(:,1:finsiz)
    ELSE
      dtprt = 0.
    END IF
    !
    DEALLOCATE ( xp, tmp )
    !
    RETURN
    !
    ! Formats
    !
#ifdef W3_T
9000 FORMAT (' TEST W3CPRT : DIMP, DIMXP, TMPSIZ    :',i2,2i6)
9050 FORMAT (' TEST W3CPRT : POINT',i4,', STORAGE',2i6)
9060 FORMAT (' TEST W3CPRT : COUNTERS FOR STORAGE (JSEA,NP,ST):')
9061 FORMAT (100('             ',5(2f9.0)/))
9062 FORMAT (' TEST W3CPRT : FINAL STORAGE SIZE :',i6)
#endif
    !/
    !/ End of W3CPRT ----------------------------------------------------- /
    !/
  END SUBROUTINE w3cprt
 
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3iosf ( NDSPT, IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         30-Oct-2009 |
    !/                  +-----------------------------------+
    !/
    !/    02-Nov-2006 : Origination.                        ( version 1.10 )
    !/    24-Mar-2007 : Add pars for entire spectrum.       ( version 3.11 )
    !/    17-May-2007 : Adding NTPROC/NAPROC separation.    ( version 3.11 )
    !/    30-Oct-2009 : Fix unitialized dtsiz error.        ( version 3.14 )
    !/                  (T. J. Campbell, NRL)
    !/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
    !/                  (W. E. Rogers & T. J. Campbell, NRL)
    !/    30-Oct-2009 : Implement curvilinear grid type.    ( version 3.14 )
    !/                  (W. E. Rogers & T. J. Campbell, NRL)
    !/
    !  1. Purpose :
    !
    !     Write partitioned spectrakl data to file. Unlike other
    !     WAVEWATCH III IO routines, this one writes only.
    !     First ad-hoc version.
    !
    !  2. Method :
    !
    !     Writing to formatted or unformatted file with ID headers.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       NDSPT   Int.   I   Unit number.
    !       IMOD    Int.   I   Grid number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !      EXTCDE    Subr.   Id.    Program abort.
    !      MPI_SEND, MPI_RECV
    !                               MPI send and recieve routines
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3WAVE    Subr. W3WAVEMD Actual wave model routine.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/S    Enable subroutine tracing.
    !     !/T    Enable test output
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !/
    USE constants
    USE w3servmd, ONLY: extcde
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    USE w3gdatmd, ONLY: filext, nsea, xgrd, ygrd, mapsf, flagll
#ifdef W3_MPI
    USE w3gdatmd, ONLY: nseal
#endif
    USE w3wdatmd, ONLY: time, asf
    USE w3odatmd, ONLY: ndse, iaproc, naproc, napprt, naperr, &
         ipass => ipass6, flform, fnmpre, outpts,    &
         ix0, ixn, ixs, iy0, iyn, iys, dimp
    USE w3adatmd, ONLY: dw, u10, u10d, cx, cy
    USE w3adatmd, ONLY: nsealm
    USE w3parall, ONLY: init_get_jsea_isproc
#ifdef W3_MPI
    USE w3adatmd, ONLY: mpi_comm_wave
    USE w3odatmd, ONLY: icprt, dtprt, it0prt
#endif
#ifdef W3_T
    USE w3odatmd, ONLY: ndst
#endif
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: NDSPT, IMOD
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: I, J, IERR, ISEA, JSEA, JAPROC,      &
         IX, IY, IP, IOFF, DTSIZ=0
#ifdef W3_MPI
    INTEGER                 :: ICSIZ, IERR_MPI, IT,            &
         STATUS(MPI_STATUS_SIZE,1), JSLM
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    INTEGER, POINTER        :: ICP(:,:)
    REAL                    :: X, Y, DEPTH, UABS, UDIR, CABS, CDIR
    REAL, POINTER           :: DTP(:,:)
    !
    TYPE procs
      INTEGER, POINTER      :: ICPRT(:,:)
      REAL, POINTER         :: DTPRT(:,:)
    END TYPE procs
    !
    TYPE(procs), TARGET, ALLOCATABLE :: PROC(:)
    !
    ! -------------------------------------------------------------------- /
    ! 0.  Initializations
    !
#ifdef W3_S
    CALL strace (ient, 'W3IOSF')
#endif
    !
    ipass  = ipass + 1
#ifdef W3_MPI
    icsiz  = 2 * ( nsealm + 1 )
#endif
    !
#ifdef W3_T
    WRITE (ndst,9000) ipass, flform, ndspt, imod, iaproc, napprt
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Set up file ( IPASS = 1 and proper processor )
    !
    IF ( ipass.EQ.1 .AND. iaproc.EQ.napprt ) THEN
      !
      ! 1.a Open file
      !
      i      = len_trim(filext)
      j      = len_trim(fnmpre)
      !
#ifdef W3_T
      WRITE (ndst,9010) fnmpre(:j)//'partition.'//filext(:i)
#endif
      !
      IF ( flform ) THEN
        OPEN (ndspt,file=fnmpre(:j)//'partition.'//filext(:i),   &
             err=800,iostat=ierr)
      ELSE
        OPEN (ndspt,file=fnmpre(:j)//'partition.'//filext(:i),   &
             form='UNFORMATTED',convert=file_endian,err=800,iostat=ierr)
      END IF
      !
      rewind(ndspt)
      !
      ! 1.b Header info
      !
      IF ( flform ) THEN
        WRITE (ndspt,910) idstr, verprt
        IF ( flagll ) THEN
          WRITE (ndspt,911) ' yyyymmdd hhmmss     '//         &
               'lat     lon   name       nprt'// &
               ' depth ubas  udir cabs  cdir'
        ELSE
          WRITE (ndspt,911) ' yyyymmdd hhmmss     '//         &
               'X       Y     name       nprt'// &
               ' depth ubas  udir cabs  cdir'
        END IF
        WRITE (ndspt,911) '        hs     tp     lp  '//    &
             '     theta     sp      wf'
      ELSE
        WRITE (  ndspt  ) idstr, verprt
        IF ( flagll ) THEN
          WRITE (  ndspt  ) ' yyyymmdd hhmmss     '//         &
               'lat     lon   name       nprt'// &
               ' depth ubas  udir cabs  cdir'
        ELSE
          WRITE (  ndspt  ) ' yyyymmdd hhmmss     '//         &
               'X       Y     name       nprt'// &
               ' depth ubas  udir cabs  cdir'
        END IF
        WRITE (  ndspt  ) '        hs     tp     lp  '//    &
             '     theta     sp      wf'
      END IF
      !
    END IF
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Send data if output is non-local ( MPI only )
    !     Leave routine after send
    !
    IF ( iaproc.NE.napprt .AND. iaproc.LE.naproc ) THEN
      !
#ifdef W3_T
      WRITE (ndst,9020)  iaproc, napprt, nsealm+1
#endif
      !
#ifdef W3_MPI
      it     = it0prt + iaproc - 1
      CALL mpi_send ( icprt, icsiz, mpi_real, napprt-1, it,  &
           mpi_comm_wave, ierr_mpi )
      dtsiz  = icprt(nseal+1,2) - 1
#endif
      !
#ifdef W3_T
      WRITE (ndst,9021)  iaproc, napprt, dtsiz
#endif
      !
#ifdef W3_MPI
      it     = it0prt + naproc + iaproc - 1
      IF ( dtsiz .GT. 0 ) CALL mpi_send                      &
           ( dtprt, 6*dtsiz, mpi_real, napprt-1,    &
           it, mpi_comm_wave, ierr_mpi )
#endif
      !
    END IF
    !
    IF ( iaproc .NE. napprt ) RETURN
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Point to and/or gather data
    ! 3.a Set up storage
    !
    ALLOCATE ( proc(naproc) )
    !
    ! 3.b Point to local data
    !
    IF ( iaproc .LE. naproc ) THEN
      proc(iaproc)%ICPRT => outpts(imod)%OUT6%ICPRT
      proc(iaproc)%DTPRT => outpts(imod)%OUT6%DTPRT
    END IF
    !
    ! 3.c Allocate and get counters and arrrays
    !
    DO japroc=1, naproc
      IF ( iaproc .EQ. japroc ) cycle
      !
#ifdef W3_T
      WRITE (ndst,9030)  japroc, nsealm+1
#endif
      !
#ifdef W3_MPI
      ALLOCATE ( proc(japroc)%ICPRT(nsealm+1,2) )
      icp   => proc(japroc)%ICPRT
      it     = it0prt + japroc - 1
      CALL mpi_recv ( icp, icsiz, mpi_real, japroc-1, it,  &
           mpi_comm_wave, status, ierr_mpi )
      jslm   = 1 + (nsea-japroc)/naproc
      dtsiz  = icp(jslm+1,2) - 1
#endif
      !
#ifdef W3_T
      WRITE (ndst,9031)  japroc, dtsiz
#endif
      !
#ifdef W3_MPI
      ALLOCATE ( proc(japroc)%DTPRT(dimp,max(1,dtsiz)) )
      dtp   => proc(japroc)%DTPRT
      it     = it0prt + naproc + japroc - 1
      IF ( dtsiz .GT. 0 ) CALL mpi_recv                    &
           ( dtp, dimp*dtsiz, mpi_real, japroc-1, &
           it, mpi_comm_wave, status, ierr_mpi )
#endif
      !
    END DO
    !
    ! -------------------------------------------------------------------- /
    ! 4.  Write all data for which partitions are found
    ! 4.a General loop over all sea points
    !
    DO isea=1, nsea
      !
      ! 4.b Check for partitioned data at sea point
      !
      CALL init_get_jsea_isproc(isea, jsea, japroc)
      !
      icp   => proc(japroc)%ICPRT
      dtp   => proc(japroc)%DTPRT
      !
      IF ( icp(jsea,1) .EQ. 0 ) cycle
      !
      ! 4.c Process point ID line
      !
      ix     = mapsf(isea,1)
      iy     = mapsf(isea,2)
      IF ( ix.LT.ix0 .OR. ix.GT.ixn .OR. mod(ix-ix0,ixs).NE.0 ) cycle
      IF ( iy.LT.iy0 .OR. iy.GT.iyn .OR. mod(iy-iy0,iys).NE.0 ) cycle
      x      = xgrd(iy,ix)
      y      = ygrd(iy,ix)
      depth   = dw(isea)
      uabs   = u10(isea)*asf(isea)
      udir   = mod( 270. - u10d(isea)*rade , 360. )
      cabs   = sqrt( cx(isea)**2 + cy(isea)**2 )
      IF ( cabs .LT. 1.e-3 ) THEN
        cdir   = 0.
      ELSE
        cdir   = atan2( cy(isea), cx(isea) ) * rade
        cdir   = mod( 270. - cdir , 360. )
      END IF
      !
      IF ( flform ) THEN
        IF ( flagll ) THEN
          WRITE (ndspt,940) time, y, x,                        &
               'grid_point', icp(jsea,1) - 1,      &
               depth, uabs, udir, cabs, cdir
        ELSE
          WRITE (ndspt,941) time, x*1.e-3, y*1.e-3,            &
               'grid_point', icp(jsea,1) - 1,      &
               depth, uabs, udir, cabs, cdir
        END IF
      ELSE
        IF ( flagll ) THEN
          WRITE (  ndspt  ) time, y, x,                        &
               'grid_point', icp(jsea,1) - 1,      &
               depth, uabs, udir, cabs, cdir
        ELSE
          WRITE (  ndspt  ) time, x*1.e-3, y*1.e-3,            &
               'grid_point', icp(jsea,1) - 1,      &
               depth, uabs, udir, cabs, cdir
        END IF
      END IF
      !
      ! 4.d Process partitions for this point
      !
      ioff   = icp(jsea,2)
      !
      IF ( flform ) THEN
        DO ip=0, icp(jsea,1) - 1
          WRITE (ndspt,942) ip, dtp(:,ip+ioff)
        END DO
      ELSE
        DO ip=0, icp(jsea,1) - 1
          WRITE (  ndspt  ) ip, dtp(:,ip+ioff)
        END DO
      END IF
      !
    END DO
    !
    ! -------------------------------------------------------------------- /
    ! 5.  Clean up data structure
    !
#ifdef W3_MPI
    DO japroc=1, naproc
      IF ( iaproc .EQ. japroc ) cycle
      DEALLOCATE ( proc(japroc)%ICPRT, proc(japroc)%DTPRT )
    END DO
#endif
    !
    DEALLOCATE ( proc )
    !
    RETURN
    !
    ! Escape locations read errors --------------------------------------- *
    !
800 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,1000) ierr
    CALL extcde ( 1 )
    !
    ! Formats
    !
910 FORMAT (a,1x,a)
911 FORMAT (a)
    !
940 FORMAT (1x,i8.8,1x,i6.6,2f8.3,2x,'''',a10,'''',            &
         1x,i2,f7.1,f5.1,f6.1,f5.2,f6.1)
941 FORMAT (1x,i8.8,1x,i6.6,2(f8.1,'E3'),2x,'''',a10,'''',     &
         1x,i2,f7.1,f5.1,f6.1,f5.2,f6.1)
942 FORMAT (i3,3f8.2,2f9.2,f7.2)
    !
1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOSF : '/               &
         '     ERROR IN OPENING FILE'/                          &
         '     IOSTAT =',i5/)
    !
#ifdef W3_T
9000 FORMAT (' TEST W3IOSF : IPASS =',i4,',  FLFROM = ',l1,        &
         ',  NDSPT =',i3,',  IMOD =',i3,','/                   &
         '               IAPROC, NAPPRT =',2i4)
9010 FORMAT (' TEST W3IOSF : OPENING NEW FILE [',a,']')
9020 FORMAT (' TEST W3IOSF : SENDING ICPRT FROM',i3,' TO',i3,     &
         ' WITH SIZE :',i6)
#endif
#ifdef W3_T
9021 FORMAT (' TEST W3IOSF : SENDING DTPRT FROM',i3,' TO',i3,     &
         ' WITH SIZE :',i6)
#endif
#ifdef W3_T
9030 FORMAT (' TEST W3IOSF : RECEIVING ICPRT FROM',i3,            &
         ' WITH SIZE :',i6)
#endif
#ifdef W3_T
9031 FORMAT (' TEST W3IOSF : RECEIVING DTPRT FROM',i3,            &
         ' WITH SIZE :',i6)
#endif
    !/
    !/ End of W3IOSF ----------------------------------------------------- /
    !/
  END SUBROUTINE w3iosf
  !/
  !/ End of module W3IOSFMD -------------------------------------------- /
  !/
END MODULE w3iosfmd