ww3_sbs1.F90

Go to the documentation of this file.

 
 
#include "w3macros.h"
!/------------------------------------------------------------------- /
PROGRAM w3sbs1
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH-III           NOAA/NCEP |
  !/                  |           H. L. Tolman            |
  !/                  |            A. Chawla              |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :         05-Dec-2012 |
  !/                  +-----------------------------------+
  !/
  !/    04-May-2005 : Origination.                        ( version 3.07 )
  !/    11-Aug-2010 : Upgrade for operations and inclusion in svn.
  !/                                                    ( version 3.14.4 )
  !/    05-Dec-2012 : Making sleep a system call.       ( version 4.11   )
  !/
  !/    Copyright 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 :
  !
  !     Program shell or driver to run the multi-grid wave model in
  !     'half-coupled' mode, that is running side-by-side with a weather
  !     model while waiting for wind field to become available.
  !
  !     This version is set up for running at NCEP with a single input
  !     wind file, and requires an additional input file.
  !       times.inp  Input file with time stamps. Add to this input file
  !                  a time stamp after the field has been properly
  !                  added to the wind.ww3 or equavalent file.
  !     This file should have the time stamps of fields available in
  !     the first auxiliary wind input file (grid).
  !
  !     Apart from management of the time stepping, this code is
  !     identical to ww3_multi.ftn, and reads the corresponding input
  !     file ww3_multi.inp
  !
  !     Note hardwired options and system dependent parts as identified
  !     in Section 7.
  !
  !  2. Method :
  !
  !     Calling WMWAVE in a loop as wind data become available, with
  !     test on wind file.
  !
  !     In order for this to work properly, the user needs to increment
  !     then main wind input file (wind.XXXX) as data become avalable
  !     while this program is running. After a new field is added to
  !     wind file, the corresponding time stamp in YYYYMMDD YYMMSS
  !     format is concatenated to the times.inp file. As the code
  !     reads the new time stamp (1X,I8,1Z,I6 format), a test read of
  !     the wind file is performed until the file is readable, after
  !     which the wave model is run until the new time stamp and the
  !     process is repeated. The test reading of the wind file proved
  !     essential on the NCEP IBM systems to deal with file system
  !     latencies and buffer flushing.
  !
  !  3. Parameters :
  !
  !     Local parameters.
  !     ----------------------------------------------------------------
  !       SLEEP1  I.P.   Sleep time for testing times file.
  !       SLEEP2  I.P.   Sleep time for testing winds file.
  !     ----------------------------------------------------------------
  !
  !  4. Subroutines used :
  !
  !      Name      Type  Module   Description
  !     ----------------------------------------------------------------
  !      WMINIT    Subr. WMINITMD Multi-grid model initialization.
  !      WMWAVE    Subr. WMWAVEMD Multi-grid model subroutine.
  !      WMFINL    Subr. WMFINLMD Multi-grid model finalization.
  !      EXTCDE    Subr. W3SERVMD Abort program as graceful as possible.
  !      W3SETG    Subr. W3GDATMD Point to Grid data data structure.
  !      W3SETI    Subr. W3IDATMD Point to input fields data structure.
  !      WMUGET    Subr. WMUNITMD Automatic unit number assignement.
  !      WMUSET    Subr.          Automatic unit number assignement.
  !
  !      MPI_INIT, MPI_COMM_SIZE, MPI_COMM_RANK, MPI_BARRIER,
  !         MPI_FINALIZE
  !                Subr.          Standard MPI routines.
  !
  !      RDTIME    Subr. W3MLT    Get next wind time.
  !      RDWIND    Subr. W3MLT    Test read next wind field.
  !     ----------------------------------------------------------------
  !
  !  5. Called by :
  !
  !     None, stand-alone program.
  !
  !  6. Error messages :
  !
  !  7. Remarks :
  !
  !     - Assumptions in this program:
  !        1) WNS or WND option with 3 or two data fields is set in the
  !           decaration and initialization of the C*3 TYPE.
  !        2) Single wind file to be tested, this is the first aux grid
  !           with wind defined.
  !        3) Needs system SLEEP command, now behind SBS switch.
  !/    05-Dec-2012 : Making sleep a system call.       ( version 4.11   )
 
  !
  !  8. Structure :
  !
  !     ----------------------------------------------------------------
  !      0.  Initialization necessary for driver
  !        a General I/O: (implicit in wmmdatmd)
  !        b MPI environment
  !        c Identifying output to "screen" unit
  !      1.  Initialization of all wave models / grids       ( WMINIT )
  !      2.  Open and prepare test files.
  !      3.  Run the multi-grid models
  !        a Preparations
  !        b Catch up with starting time of model            ( RDTIME )
  !        c Catch up with test reading of file              ( DWINDE )
  !        d Run wave model                                  ( WMWAVE )
  !      4.  Finalization of wave model                      ( WMFINL )
  !      5.  Finalization of driver
  !     ----------------------------------------------------------------
  !
  !  9. Switches :
  !
  !       !/MPI   Including MPI routines / environment.
  !
  ! 10. Source code :
  !
  !/ ------------------------------------------------------------------- /
  USE wminitmd, ONLY: wminit
  USE wmwavemd, ONLY: wmwave
  USE wmfinlmd, ONLY: wmfinl
  USE w3servmd, ONLY: extcde
  USE w3gdatmd, ONLY: w3setg
  USE w3gdatmd, ONLY: ngrids, nauxgr, nx, ny, gname, filext
  USE w3idatmd, ONLY: w3seti
  USE w3idatmd, ONLY: flwind
  USE wmmdatmd, ONLY: mdsf
  USE wmunitmd, ONLY: wmuget, wmuset
  USE w3timemd
  !/
  USE wmmdatmd, ONLY: mdse, mdst, mdss, nmproc, improc, nmpscr,   &
       nrgrd, stime, etime
  !/
  IMPLICIT NONE
  !
#ifdef W3_MPI
  include "mpif.h"
#endif
  !/
  !/ ------------------------------------------------------------------- /
  !/ Local parameters
  !/
  INTEGER              :: mpi_comm = -99, ierr, ndst1, ndst2 = -1,&
       nxw = -1, nyw = -1, tnext(2), told(2),  &
       i
#ifdef W3_MPI
  INTEGER              :: ierr_mpi
#endif
  INTEGER, PARAMETER   :: sleep1 = 10 , sleep2 = 10
  INTEGER, ALLOCATABLE :: tend(:,:)
  REAL                 :: dttst
  !      CHARACTER(LEN=3)     :: TSFLD, TYPE = 'WNS'
  CHARACTER(LEN=3)     :: tsfld, TYPE = 'WND'
  CHARACTER(LEN=13)    :: tsstr
  !/
  !/ ------------------------------------------------------------------- /
  ! 0.  Initialization necessary for driver
  ! 0.a General I/O: all can start with initialization in wmmdatmd
  !
  ! 0.b MPI environment: Here, we use MPI_COMM_WORLD
  !
#ifdef W3_MPI
  CALL mpi_init      ( ierr_mpi )
  mpi_comm = mpi_comm_world
  CALL mpi_comm_size ( mpi_comm, nmproc, ierr_mpi )
  CALL mpi_comm_rank ( mpi_comm, improc, ierr_mpi )
  improc = improc + 1
#endif
  !
  ! 0.c Identifying output to "screen" unit
  !
  IF ( improc .EQ. nmpscr ) WRITE (*,900)
  !
  !/ ------------------------------------------------------------------- /
  ! 1.  Initialization of all wave models / grids
  !     Use only one of the calls ....
  !
  ! ... Log and screen output, no separate test output file
  !
  !     CALL WMINIT ( 8, 9, 6, 6, 6, 'ww3_multi.inp', MPI_COMM )
  !
  ! ... Screen output disabled
  !
  !     CALL WMINIT ( 8, 9, 9, 6, 6, 'ww3_multi.inp', MPI_COMM )
  !
  ! ... Separate test output file and file preamble defined
  !
  !     CALL WMINIT ( 8, 9, 6, 10, 6, 'ww3_multi.inp', MPI_COMM,        &
  !                   './data/' )
  !
  ! ... Separate test output file
  !
  CALL wminit ( 8, 9, 6, 10, 6, 'ww3_multi.inp', mpi_comm )
  !
  !/ ------------------------------------------------------------------- /
  ! 2.  Setting up test files
  !
  CALL wmuget ( mdse, mdst, ndst1, 'INP' )
  CALL wmuset ( mdse, mdst, ndst1, .true., 'I/O',                 &
       name='times.inp',                                 &
       desc='times file for sbs driver' )
  OPEN (ndst1,file='times.inp',status='OLD',err=820,iostat=ierr)
#ifdef W3_T
  WRITE (mdst,9020)
#endif
  !
  DO i=-1, -nauxgr, -1
    CALL w3setg ( i, mdse, mdst )
    CALL w3seti ( i, mdse, mdst )
    IF ( flwind ) THEN
      IF ( improc .EQ. nmpscr ) WRITE (mdss,920) filext
      nxw    = nx
      nyw    = ny
      ndst2  = mdsf(i,3)
      EXIT
    END IF
  END DO
  !
  IF ( nxw .EQ. -1 ) GOTO 825
  IF ( ndst2 .EQ. -1 ) GOTO 825
  !
#ifdef W3_T
  WRITE (mdst,9021)
  WRITE (mdst,9022) nxw, nyw, ndst2, i
#endif
  !
  !/ ------------------------------------------------------------------- /
  ! 3.  Run the wave model
  ! 3.a Prepping, initial time stamp
  !
  ALLOCATE ( tend(2,nrgrd) )
  !
  CALL rdtime ( ndst1, tnext )
  IF ( improc .EQ. nmpscr ) WRITE (mdss,930) tnext
  !
  ! 3.b Catch up with starting time as needed
  !
  DO
    told   = tnext
    CALL rdtime ( ndst1, tnext )
    dttst  = dsec21( tnext , stime )
    IF ( dttst .GT. 0. ) THEN
      IF ( improc .EQ. nmpscr ) WRITE (mdss,930) tnext
    ELSE IF ( dttst .EQ. 0. ) THEN
      IF ( improc .EQ. nmpscr ) WRITE (mdss,930) tnext
      EXIT
    ELSE
      backspace ndst1
      tnext  = told
      EXIT
    END IF
  END DO
  !
  ! 3.c Test readig of initial fields
  !
  CALL rdwind ( ndst2, tnext, nxw, nyw, .false. )
  !
  ! 3.d Loop to run the model
  !
  DO
    !
    CALL rdtime ( ndst1, tnext )
    IF ( improc .EQ. nmpscr ) WRITE (mdss,930) tnext
    CALL rdwind ( ndst2, tnext, nxw, nyw, .true. )
    IF ( improc .EQ. nmpscr ) WRITE (mdss,931)
    !
    dttst  = dsec21( tnext , etime )
    IF ( dttst .LT. 0. ) THEN
      tnext  = etime
      dttst  = 0.
    END IF
    !
    DO i=1, nrgrd
      tend(:,i) = tnext(:)
    END DO
    !
#ifdef W3_MPI
    CALL mpi_barrier ( mpi_comm, ierr_mpi )
#endif
    CALL wmwave ( tend )
    !
    dttst  = dsec21( tnext , etime )
    IF ( dttst .LE. 0 ) EXIT
    !
  END DO
  !
  DEALLOCATE ( tend )
  !
  !/ ------------------------------------------------------------------- /
  ! 4.  Finalize the wave model
  !
  CALL wmfinl
  !
  !/ ------------------------------------------------------------------- /
  ! 5   Finalize the driver
  !
  IF ( improc .EQ. nmpscr ) WRITE (*,999)
  !
#ifdef W3_MPI
  CALL mpi_barrier ( mpi_comm, ierr_mpi )
  CALL mpi_finalize  ( ierr_mpi )
#endif
  !
  GO TO 888
  !
820 CONTINUE
  WRITE (mdss,1020) ierr
  CALL extcde ( 20 )
  !
825 CONTINUE
  WRITE (mdss,1025) ndst2
  CALL extcde ( 25 )
  !
888 CONTINUE
  !
  ! Formats
  !
900 FORMAT (/15x,'     *** WAVEWATCH III Multi-grid shell ***    '/ &
       15x,'================================================='/&
       15x,'                           side-by-side version'/)
  !
920 FORMAT ( '     WIND DATA FILE USED IS wind.',a)
930 FORMAT (/'     WIND DATA FOUND AT TIME : ',i8.8,1x,i6.6)
931 FORMAT (' ')
  !
999 FORMAT (//'  End of program '/                                  &
       ' ========================================'/           &
       '          WAVEWATCH III Multi-grid shell '/)
  !
1020 FORMAT (/' *** WAVEWATCH-III ERROR IN W3SBS1 : '/               &
       '     ERROR IN OPENING TIMES FILE'/                    &
       '     IOSTAT =',i5/)
  !
1025 FORMAT (/' *** WAVEWATCH-III ERROR IN W3SBS1 : '/               &
       '     WIND FILE NOT FOUND, NDST2 =  ',i8/)
  !
#ifdef W3_T
9020 FORMAT ( ' TEST W3SBS1: TIMES FILE SUCCESSFULLY OPENED')
9021 FORMAT ( ' TEST W3SBS1: WINDS FILE SUCCESSFULLY OPENED')
9022 FORMAT ( '              TEST DATA : ',2i8,2i4)
#endif
  !/
  !/ Internal subroutines RDTIME and RDWIND ---------------------------- /
  !/
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE rdtime ( NDS, TIME )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH-III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         05-Dec-2012 !
    !/                  +-----------------------------------+
    !/
    !/    10-Aug-2010 : Origination.                      ( version 3.14.4 )
    !/    05-Dec-2012 : Making sleep a system call.       ( version 4.11   )
    !/
    !  1. Purpose :
    !
    !     Internal subroutine to get next time in time file, including
    !     waiting until the file is there.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       NDS     Int.   I   Unit number for times file.
    !       TIME    I.A.   O   Next time in times file.
    !     ----------------------------------------------------------------
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: NDS
    INTEGER, INTENT(OUT)    :: TIME(2)
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_SBS
    CHARACTER(LEN=10)       :: COMMAND
#endif
    !/
    ! -------------------------------------------------------------------- /
    ! 1.  Reading loop
    !
    DO
      !
      READ (nds,910,END=110,ERR=810,IOSTAT=IERR) time
      EXIT
      !
110   CONTINUE
      IF ( improc .EQ. nmpscr ) WRITE (mdss, 911 )
      backspace nds
      !
#ifdef W3_SBS
      WRITE (command,'(A5,1X,I4)') 'sleep ', sleep1
      CALL system ( command )
#endif
      !
    END DO
    !
    RETURN
    !
    ! Escape locations read errors --------------------------------------- *
    !
810 CONTINUE
    WRITE (mdss,1010) ierr
    CALL extcde ( 10 )
    !
    ! Formats
    !
910 FORMAT (1x,i8,1x,i6)
    !
911 FORMAT (/'    END OF TIMES FILE REACHED FOR WIND DATA '/        &
         '       WAITING BEFORE CHECKING AGAIN')
    !
1010 FORMAT (/' *** WAVEWATCH-III ERROR IN W3SBS1/RDTIME : '/        &
         '     ERROR IN OPENING TIMES FILE'/                   &
         '     IOSTAT =',i5/)
    !/
    !/ End of RDTIME ----------------------------------------------------- /
    !/
  END SUBROUTINE rdtime
  !/ ------------------------------------------------------------------- /
  SUBROUTINE rdwind ( NDS, TIME, NX, NY, REWIND )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH-III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         05-Dec-2012 !
    !/                  +-----------------------------------+
    !/
    !/    10-Aug-2010 : Origination.                      ( version 3.14.4 )
    !/    05-Dec-2012 : Making sleep a system call.       ( version 4.11   )
    !/
    !  1. Purpose :
    !
    !     Internal subroutine to test readnext wind fields from the data
    !     file, including testing to see if file was read properly.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       NDS     Int.   I   Unit number for times file.
    !       TIME    I.A.   I   Next time in times file.
    !       NX,NY   Int.   I   Grid size.
    !       REWIND  Log.   I   Flag for wind file rewind.
    !     ----------------------------------------------------------------
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: NDS, TIME(2), NX, NY
    LOGICAL, INTENT(IN)     :: REWIND
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: TTIME(2), IX, IY
    INTEGER, SAVE           :: NREW  = 0
    REAL                    :: DTTST, XXX(NX,NY)
#ifdef W3_SBS
    CHARACTER(LEN=10)       :: COMMAND
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Loops
    !
    DO
      !
      ! ... Inner loop reading
      !
      DO
        !
        nrew   = nrew + 1
        READ (nds,END=140,ERR=140) ttime
#ifdef W3_T
        WRITE (mdst,9000) ttime
#endif
        !
        nrew   = nrew + 1
        READ (nds,END=130,ERR=130) ((XXX(IX,IY),IX=1,NX),IY=1,NY)
#ifdef W3_T
        WRITE (mdst,9001) 'U'
#endif
        !
        nrew   = nrew + 1
        READ (nds,END=120,ERR=120) ((XXX(IX,IY),IX=1,NX),IY=1,NY)
#ifdef W3_T
        WRITE (mdst,9001) 'V'
#endif
        !
        IF ( TYPE .EQ. 'WNS' ) then
          nrew   = nrew + 1
          READ (nds,END=110,ERR=110) ((XXX(IX,IY),IX=1,NX),IY=1,NY)
#ifdef W3_T
          WRITE (mdst,9001) 'DT'
#endif
        END IF
        !
        EXIT
        !
110     CONTINUE
        backspace nds
        nrew   = nrew - 1
120     CONTINUE
        backspace nds
        nrew   = nrew - 1
130     CONTINUE
        backspace nds
        nrew   = nrew - 1
140     CONTINUE
        backspace nds
        nrew   = nrew - 1
        !
        IF ( improc .EQ. nmpscr ) WRITE (mdss,900)
        !
#ifdef W3_SBS
        WRITE (command,'(A5,1X,I4)') 'sleep ', sleep2
        CALL system ( command )
#endif
        !
      END DO
      !
      ! ... Outer loop catching up
      !
      dttst  = dsec21( time , ttime )
      !
      IF ( dttst .LT. 0. ) THEN
        IF ( improc .EQ. nmpscr ) WRITE (mdss,901) ttime
      ELSE IF ( dttst .EQ. 0. ) THEN
        EXIT
      ELSE
        GOTO 800
      END IF
      !
    END DO
    !
    ! ... Rewind all
    !
    IF ( rewind ) THEN
      !
      IF ( improc.EQ.nmpscr .AND. nrew.GT.4 ) WRITE (mdss,902) nrew
      !
      DO i=1, nrew
        backspace nds
      END DO
      !
      nrew   = 0
      !
    END IF
    !
    RETURN
    !
    ! Escape locations read errors --------------------------------------- *
    !
800 CONTINUE
    WRITE (mdss,1010)
    CALL extcde ( 10 )
    !
    ! Formats
    !
900 FORMAT ('       FILE NOT YET COMPLETE ... ')
901 FORMAT ('         SKIPPING FILE FOR ',i8.8,i7.6)
902 FORMAT ('         REWINDING FILE BY ',i4,' RECORDS')
    !
1010 FORMAT (/' *** WAVEWATCH-III ERROR IN W3SBS1/RDWIND : '/        &
         '     FILE READ PAST EXPECTED TIME '/)
    !
#ifdef W3_T
9000 FORMAT ( ' TEST RDWIND: TIME READ ',i8.8,1x,i6.6)
9001 FORMAT ( '              FIELD READ ',a)
#endif
    !/
    !/ End of RDWIND ----------------------------------------------------- /
    !/
  END SUBROUTINE rdwind
  !/
  !/ End of W3SBS1 ----------------------------------------------------- /
  !/
END PROGRAM w3sbs1