ww3_shel.F90

Go to the documentation of this file.

 
!
#include "w3macros.h"
 
!/ ------------------------------------------------------------------- /
!
PROGRAM w3shel
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           H. L. Tolman            |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :         22-Mar-2021 |
  !/                  +-----------------------------------+
  !/
  !/    19-Jan-1999 : Final FORTRAN 77                    ( version 1.18 )
  !/    19-Jan-2000 : Upgrade to FORTRAN 90               ( version 2.00 )
  !/    08-Mar-2000 : Fix time managament bug.            ( version 2.04 )
  !/    09-Jan-2001 : Fix FOUT allocation bug.            ( version 2.05 )
  !/    24-Jan-2001 : Flat grid version.                  ( version 2.06 )
  !/    25-Jan-2002 : Data assimilation set up.           ( version 2.17 )
  !/    08-May-2002 : Clean up for timers.                ( version 2.21 )
  !/    26-Aug-2002 : Generalizing timer.                 ( version 2.22 )
  !/    26-Dec-2002 : Continuously moving grid.           ( version 3.02 )
  !/    01-Aug-2003 : Continuously moving grid, input.    ( version 3.03 )
  !/    07-Oct-2003 : Fixed NHMAX test.                   ( version 3.05 )
  !/    05-Jan-2005 : Multiple grid version.              ( version 3.06 )
  !/    04-May-2005 : Change to MPI_COMM[_WAVE.           ( version 3.07 )
  !/    26-Jun-2006 : Add wiring for output type 6.       ( version 3.07 )
  !/    28-Jun-2006 : Adding file name preamble.          ( version 3.09 )
  !/    28-Oct-2006 : Adding partitioning options.        ( version 3.10 )
  !/    21-Jun-2007 : Dedicated output processes.         ( version 3.11 )
  !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
  !/    30-Oct-2009 : Fix format statement 2945.          ( 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)
  !/    13-Sep-2009 : Add coupling option                 ( version 3.14_SHOM )
  !/    30-Oct-2009 : Implement curvilinear grid type.    ( version 3.14 )
  !/                  (W. E. Rogers & T. J. Campbell, NRL)
  !/    29-Oct-2010 : Implement unstructured grids        ( version 3.14.4 )
  !/                  (A. Roland and F. Ardhuin)
  !/    23-Nov-2011 : Comments clean up                   ( version 4.04 )
  !/    06-Mar-2012 : Repairing test output.              ( version 4.07 )
  !/    03-Sep-2012 : Output initialization time.         ( version 4.10 )
  !/    27-Sep-2012 : Implement use of tidal constituents ( version 4.08 )
  !/    04-Feb-2014 : Switched clock to DATE_AND_TIME     ( version 4.18 )
  !/                  (A. Chawla and Mark Szyszka)
  !/    23-Apr-2015 : Adding NCEP Coupler                 ( version 5.06 )
  !/                  (A. Chawla and Dmitry Sheinin)
  !/    24-Apr-2015 : Adding OASIS coupling calls         ( version 5.07 )
  !/                  (M. Accensi & F. Ardhuin, IFREMER)
  !/    11-May-2015 : Checks dates for output types       ( version 5.08 )
  !/    26-Mar-2018 : Sea-point only Wnd/Cur input. JGLi  ( version 6.02 )
  !/    15-May-2018 : Update namelist                     ( version 6.05 )
  !/    06-Jun-2018 : Add PDLIB/MEMCHECK/NETCDF_QAD/DEBUGINIT ( version 6.04 )
  !/    14-Sep-2018 : Remove PALM implementation          ( version 6.06 )
  !/    04-Oct-2019 : Inline Output implementation        ( version 6.07 )
  !/                  (Roberto Padilla-Hernandez)
  !/    16-Jul-2020 : Variable coupling time step         ( version 7.08 )
  !/    25-Sep-2020 : Oasis coupling at T+0               ( version 7.10 )
  !/    22-Mar-2021 : Add new coupling fields             ( version 7.13 )
  !/    07-Jun-2021 : S_{nl} GKE NL5 (Q. Liu)             ( version 7.13 )
  !/    02-Feb-2022 : Scalability local                   ( version 7.14 )
  !/
  !/    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 :
  !
  !     A generic shell for WAVEWATCH III, using preformatted
  !     input fields.
  !
  !  2. Method :
  !
  !     Driver for the actual wave model (W3WAVE).
  !
  !     Files : ww3_shel.inp  Input commands for shell.
  !             level.ww3     Water level fields (optional).
  !             current.ww3   Current fields (optional).
  !             wind.ww3      Wind fields (optional).
  !             muddens.ww3   Mud parameter (optional)
  !             mudthk.ww3    Mud parameter (optional)
  !             mudvisc.ww3   Mud parameter (optional)
  !             ice(n).ww3    Ice parameters (n=1 to 5) (optional)
  !             ice.ww3       ice concentration fields (optional).
  !             data0.ww3     Files with assimilation data (optional).
  !             data1.ww3
  !             data2.ww3
  !
  !     The file names of the input files are set in W3FLDO
  !
  !  3. Parameters :
  !
  !     Local parameters.
  !     ----------------------------------------------------------------
  !       NHMAX   I.P.  Maximum number of homogeneous fields.
  !
  !       NDSI    Int.  General input unit number (shell only).
  !       NDSS    Int.  Scratch file.
  !       NDSO    Int.  General output unit number (shell only).
  !       NDSE    Int.  Error output unit number (shell only).
  !       NDST    Int.  Test output unit number (shell only).
  !       NDSF    I.A.  Field files unit numbers (shell only).
  !       FLH     L.A.  Flags for homogeneous fields.
  !       FLAGSC  L.A.  Flags for coupling fields
  !       FLAGSCI Log.  Flags for ice ic1 ic5 coupling
  !       NH      I.A.  Number of times for homogeneous fields.
  !       THO     I.A.  Times of homogeneous fields.
  !       TIME0   I.A.  Starting time.
  !       TIMEN   I.A.  Ending time.
  !     ----------------------------------------------------------------
  !
  !       NDS, NTRACE, ..., see W3WAVE
  !
  !  4. Subroutines used :
  !
  !      Name      Type  Module   Description
  !     ----------------------------------------------------------------
  !      W3NMOD    Subr. W3GDATMD Set nummber of data structures
  !      W3SETG    Subr.   Id.    Point to data structure.
  !      W3NDAT    Subr. W3WDATMD Set nummber of data structures
  !      W3SETW    Subr.   Id.    Point to data structure.
  !      W3NMOD    Subr. W3ADATMD Set nummber of data structures
  !      W3NAUX    Subr.   Id.    Point to data structure.
  !      W3NOUT    Subr. W3ODATMD Set nummber of data structures
  !      W3SETO    Subr.   Id.    Point to data structure.
  !      W3NINP    Subr. W3IDATMD Set nummber of data structures
  !      W3SETI    Subr.   Id.    Point to data structure.
  !
  !      NEXTLN    Subr. W3SERVMD Skip to next input line.
  !      STME21    Subr. W3TIMEMD Print date and time readable.
  !      DSEC21    Func.   Id.    Difference between times.
  !      TICK21    Subr.   Id.    Increment time.
  !
  !      W3FLDO    Subr. W3FLDSMD Opens and checks input files.
  !      W3FLDG    Subr.   Id.    Reads from input files.
  !      W3FLDD    Subr.   Id.    Reads from data files.
  !      W3FLDH    Subr.   Id.    Udates homogeneous fields.
  !
  !      W3INIT    Subr. W3INITMD Wave model initialization.
  !      W3READFLGRD Subr. W3IOGOMD Reading output fields flags.
  !      W3WAVE    Subr. W3WAVEMD Wave model.
  !      W3WDAS    Subr. W3WDASMD Data assimilation interface.
  !
  !      MPI_INIT, MPI_COMM_SIZE, MPI_COMM_RANK, MPI_BARRIER,
  !         MPI_FINALIZE
  !                Subr.          Standard MPI routines.
  !     ----------------------------------------------------------------
  !
  !  5. Called by :
  !
  !     None, stand-alone program.
  !
  !  6. Error messages :
  !
  !     - Checks on I-O.
  !     - Check on time interval.
  !
  !  7. Remarks :
  !
  !     - A rigourous input check is made in W3INIT.
  !     - See W3WDAS for documentation on the set-up of the data
  !       assimilation.
  !     - in "7.a.2 Check if update is needed"
  !       Field is updated when compute time is past old input time, and
  !       (in case of homogeneous input field),  grabs field value at next
  !       input time, which may in fact be far in the future from current
  !       compute time. Example: user says
  !       field=1   on 19680101 000000 and
  !       field=100 on 20160101 000000
  !       then on if 7.a.2 is reached on 19680101 010000, WW3 will set
  !       field to 100.
  !
  !  8. Structure :
  !
  !     ----------------------------------------------------------------
  !        0.   Set up data structures.                ( W3NMOD, etc. )
  !        1.   I-O setup.
  !          a  For shell.
  !          b  For WAVEWATCH III.
  !          c  Local parameters.
  !        2.   Define input fields
  !        3.   Set time frame.
  !        4.   Define output
  !          a  Loop over types, do
  !        +--------------------------------------------------------+
  !        | b    Process standard line                             |
  !        | c    If type 1: fields of mean wave parameters         |
  !        | d    If type 2: point output                           |
  !        | e    If type 3: track output                           |
  !        | f    If type 4: restart files                          |
  !        | g    If type 5: boundary output                        |
  !        | h    If type 6: separated wave fields                  |
  !        | i    If type 7: coupling fields                        |
  !        +--------------------------------------------------------+
  !        5.   Initialzations
  !          a  Wave model.                              ( W3INIT )
  !          b  Read homogeneous field data.
  !          c  Prepare input files.                     ( W3FLDO )
  !          d  Set field times.
  !        6.   If no input fields required, run model in a single
  !             sweep and exit.                          ( W3WAVE )
  !        7.   Run model with input
  !             Do until end time is reached
  !        +--------------------------------------------------------+
  !        | a  Determine next time interval and input fields.      |
  !        |   1  Preparation                                       |
  !        |      Loop over input fields                            |
  !        | +------------------------------------------------------|
  !        | | 2  Check if update is needed                         |
  !        | | 3  Update time and fields                 ( W3FLDG ) |
  !        | |                                           ( W3FLDH ) |
  !        | | 4  Update next ending time                           |
  !        | +------------------------------------------------------|
  !        | b  Run wave model.                          ( W3WAVE ) |
  !        | c  If requested, data assimilation.         ( W3WDAS ) |
  !        | d  Final output if needed.                  ( W3WAVE ) |
  !        | e  Check time                                          |
  !        +--------------------------------------------------------+
  !     ----------------------------------------------------------------
  !
  !  9. Switches :
  !
  !       !/SHRD  Switch for shared / distributed memory architecture.
  !       !/DIST  Id.
  !       !/MPI   Id.
  !
  !       !/MGW   Moving grid wind correction.
  !       !/MGP   Moving grid propagation correction.
  !
  !       !/T     Enable test output.
  !       !/O7    Echo input homogeneous fields.
  !
  !       !/NCO   NCEP NCO modifications for operational implementation.
  !
  !
  ! 10. Source code :
  !
  !/ ------------------------------------------------------------------- /
 
  use w3servmd, only : print_memcheck
#ifdef W3_PDLIB
  USE constants, ONLY: lpdlib
#endif
  USE w3gdatmd
  USE w3wdatmd, ONLY: time, va, w3ndat, w3dimw, w3setw
#ifdef W3_OASIS
  USE w3wdatmd, ONLY: time00, timeend
#endif
#ifdef W3_NL5
  USE w3wdatmd, ONLY: qi5tbeg
#endif
  USE w3adatmd, ONLY: w3naux, w3dima, w3seta
  USE w3idatmd
#ifdef W3_OASIS
  USE w3odatmd, ONLY: dtout, flout
#endif
  USE w3odatmd, ONLY: w3nout, w3seto
  USE w3odatmd, ONLY: naproc, iaproc, napout, naperr, nogrp,      &
       ngrpp, idout, fnmpre, iostyp, notype
  USE w3odatmd, ONLY: flogrr, flogr, ofiles
  !/
  USE w3fldsmd
  USE w3initmd
  USE w3wavemd
  USE w3wdasmd
  !/
  USE w3iogrmd, ONLY: w3iogr
  USE w3iogomd, ONLY: w3readflgrd, fldout, w3flgrdflag
  USE w3iorsmd, ONLY: oarst
  USE w3iopomd
  USE w3servmd, ONLY : nextln, extcde
  USE w3timemd
 
#ifdef W3_OASIS
  USE w3oacpmd, ONLY: cpl_oasis_init, cpl_oasis_grid,            &
       cpl_oasis_define, cpl_oasis_finalize,      &
       id_oasis_time, cplt0
#endif
#ifdef W3_OASOCM
  USE w3ogcmmd, ONLY: snd_fields_to_ocean
#endif
#ifdef W3_OASACM
  USE w3agcmmd, ONLY: snd_fields_to_atmos
#endif
#ifdef W3_OASICM
  USE w3igcmmd, ONLY: snd_fields_to_ice
#endif
 
#ifdef W3_TIDE
  USE w3tidemd
#endif
  !
  USE w3nmlshelmd
 
#ifdef W3_OMPG
  USE omp_lib
#endif
  IMPLICIT NONE
  !
#ifdef W3_MPI
  include "mpif.h"
#endif
  !/
  !/ ------------------------------------------------------------------- /
  !/ Local PARAMETER statements
  !/
  INTEGER, PARAMETER  :: nhmax =    200
  !/
  !/ ------------------------------------------------------------------- /
  !/ Local parameters
  !/
  TYPE(nml_domain_t)       :: nml_domain
  TYPE(nml_input_t)        :: nml_input
  TYPE(nml_output_type_t)  :: nml_output_type
  TYPE(nml_output_date_t)  :: nml_output_date
  TYPE(nml_homog_count_t)  :: nml_homog_count
  TYPE(nml_homog_input_t), ALLOCATABLE  :: nml_homog_input(:)
  !
  INTEGER             :: ndsi, ndsi2, ndss, ndso, ndse, ndst, ndsl,&
       ndsen, ierr, j, i, iloop, ipts, npts,     &
       ndtnew, mpi_comm = -99,                   &
       flagtide, coupl_comm, ih, n_tot
  INTEGER             :: ndsf(-7:9), nds(15), ntrace(2), ndt(7:9), &
       time0(2), timen(2), ttime(2), ttt(2),     &
       nh(-7:10), tho(2,-7:10,nhmax), rcld(7:9), &
       nodata(7:9), odat(40), iprt(6) = 0,       &
       startdate(8), stopdate(8), ihh(-7:10)
  !
#ifdef W3_OASIS
  INTEGER             :: oasised
#endif
#ifdef W3_COU
  INTEGER             :: ofl
#endif
  INTEGER             :: clkdt1(8), clkdt2(8), clkdt3(8)
#ifdef W3_MPI
  INTEGER             :: ierr_mpi
#endif
  !
  REAL                :: factor, dttst, xx, yy,                    &
       ha(nhmax,-7:10), hd(nhmax,-7:10),         &
       hs(nhmax,-7:10)
  REAL                :: clkfin, clkfel
  REAL, ALLOCATABLE   :: x(:), y(:), xxx(:,:), data0(:,:),         &
       data1(:,:), data2(:,:)
  !
  DOUBLE PRECISION    :: startjulday, stopjulday
  !
  CHARACTER(LEN=1)    :: comstr, flagtfc(-7:10)
  CHARACTER(LEN=3)    :: idstr(-7:10), idtst
  CHARACTER(LEN=6)    :: yesxno
  CHARACTER(LEN=40)   :: pn
  CHARACTER(LEN=40),                                               &
       ALLOCATABLE :: pnames(:)
  CHARACTER(LEN=13)   :: idflds(-7:10)
  CHARACTER(LEN=20)   :: strng
  CHARACTER(LEN=23)   :: dtme21
  CHARACTER(LEN=30)   :: idotyp(8)
  CHARACTER(LEN=80)   :: line
  CHARACTER(LEN=256)  :: tmpline, test
  CHARACTER(LEN=1024) :: fldin
  CHARACTER(LEN=1024) :: fldrst=''
  CHARACTER(LEN=80)   :: linein
  CHARACTER(LEN=8)    :: words(7)=''
 
#ifdef W3_COU
  CHARACTER(LEN=30)   :: ofile
#endif
  !
  LOGICAL             :: fllstl, fllsti, fllstr, flflg, flhom,     &
       tflagi, prtfrm, flagsci, flgnml
  LOGICAL             :: flgrd(nogrp,ngrpp), flgd(nogrp),          &
       flgr2(nogrp,ngrpp), flg2(nogrp),          &
       flagstide(4), flh(-7:10), flgdas(3),      &
       fllst_all(-7:10)
#ifdef W3_MPI
  LOGICAL             :: flhybr = .false.
#endif
#ifdef W3_OMPH
  INTEGER             :: thrlev
#endif
#ifdef W3_OASIS
  LOGICAL             :: l_master
  LOGICAL             :: first_step = .true.
#endif
  character(len=10)   :: jchar
  integer             :: memunit
  !
  !/
  !/ ------------------------------------------------------------------- /
  !/
  DATA idflds / 'ice param. 1 ' , 'ice param. 2 ' ,               &
       'ice param. 3 ' , 'ice param. 4 ' ,               &
       'ice param. 5 ' ,                                 &
       'mud density  ' , 'mud thkness  ' ,               &
       'mud viscos.  ' ,                                 &
       'water levels ' , 'currents     ' ,               &
       'winds        ' , 'ice fields   ' ,               &
       'momentum     ' , 'air density  ' ,               &
       'mean param.  ' , '1D spectra   ' ,               &
       '2D spectra   ' , 'moving grid  ' /
  DATA idotyp / 'Fields of mean wave parameters' ,                &
       'Point output                  ' ,                &
       'Track point output            ' ,                &
       'Restart files                 ' ,                &
       'Nesting data                  ' ,                &
       'Partitioned wave field data   ' ,                &
       'Fields for coupling           ' ,                &
       'Restart files second request  '/
  DATA idstr  / 'IC1', 'IC2', 'IC3', 'IC4', 'IC5', 'MDN', 'MTH',  &
       'MVS', 'LEV', 'CUR', 'WND', 'ICE', 'TAU', 'RHO',  &
       'DT0', 'DT1', 'DT2', 'MOV' /
  !
  flgr2 = .false.
  flagstide(:) = .false.
  flh(:)       = .false.
  !
#ifdef W3_T
  prtfrm = .true.
#endif
  !
  CALL date_and_time ( values=clkdt1 )
  !
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 0.  Set up data structures
  !
#ifdef W3_OASIS
  oasised=1
#endif
#ifdef W3_PDLIB
  lpdlib = .true.
#endif
  !
  CALL w3nmod ( 1, 6, 6 )
  CALL w3ndat (    6, 6 )
  CALL w3naux (    6, 6 )
  CALL w3nout (    6, 6 )
  CALL w3ninp (    6, 6 )
  !
  CALL w3setg ( 1, 6, 6 )
  CALL w3setw ( 1, 6, 6 )
  CALL w3seta ( 1, 6, 6 )
  CALL w3seto ( 1, 6, 6 )
  CALL w3seti ( 1, 6, 6 )
 
  memunit = 740+iaproc
  call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 1')
  !
#ifdef W3_SHRD
  naproc = 1
  iaproc = 1
#endif
  !
#ifdef W3_OMPH
  flhybr = .true.
#endif
 
#ifdef W3_OASIS
  IF (oasised.EQ.1) THEN
    CALL cpl_oasis_init(mpi_comm)
  ELSE
#endif
#ifdef W3_OMPH
    ! For hybrid MPI-OpenMP specify required thread level. JGLi06Sep2019
    IF( flhybr ) THEN
      CALL mpi_init_thread( mpi_thread_funneled, thrlev, ierr_mpi)
    ELSE
#endif
#ifdef W3_MPI
      CALL mpi_init      ( ierr_mpi )
#endif
#ifdef W3_OMPH
    ENDIF
#endif
 
#ifdef W3_MPI
    mpi_comm = mpi_comm_world
#endif
#ifdef W3_OASIS
  END IF
#endif
  !
  !
#ifdef W3_MPI
  CALL mpi_comm_size ( mpi_comm, naproc, ierr_mpi )
#endif
#ifdef W3_MPI
  CALL mpi_comm_rank ( mpi_comm, iaproc, ierr_mpi )
  iaproc = iaproc + 1
#endif
  memunit = 740+iaproc
  !
#ifdef W3_NCO
  !     IF ( IAPROC .EQ. 1 ) CALL W3TAGB                         &
  !                         ('WAVEFCST',1998,0007,0050,'NP21   ')
#endif
  call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 2')
  !
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 1.  IO set-up
  ! 1.a For shell
  !
  ndsi   = 10
  ndss   = 90
  ndso   =  6
  ndse   =  6
  ndst   =  6
  ndsl   = 50
#ifdef W3_COU
  ndso   =  333
  ndse   =  333
  ndst   =  333
#endif
 
 
  ndsf(-7)  = 1008
  ndsf(-6)  = 1009
  ndsf(-5)  = 1010
  ndsf(-4)  = 1011
  ndsf(-3)  = 1012
  ndsf(-2)  = 1013
  ndsf(-1)  = 1014
  ndsf(0)   = 1015
 
  ndsf(1)  = 11
  ndsf(2)  = 12
  ndsf(3)  = 13
  ndsf(4)  = 14
  ndsf(5)  = 15
  ndsf(6)  = 16
  ndsf(7)  = 17
  ndsf(8)  = 18
  ndsf(9)  = 19
  !
#ifdef W3_NCO
  !
  ! Redo according to NCO
  !
  ndsi   = 11
  ndss   = 90
  ndso   =  6
  ndse   = ndso
  ndst   = ndso
  ndsf(1)  = 12
  ndsf(2)  = 13
  ndsf(3)  = 14
  ndsf(4)  = 15
  ndsf(5)  = 16
  ndsf(6)  = 17
  ndsf(7)  = 18
  ndsf(8)  = 19
  ndsf(9)  = 20
#endif
  !
  napout = 1
  naperr = 1
  !
#ifdef W3_COU
  ofile  = 'output.ww3'
  ofl    = len_trim(ofile)
  j      = len_trim(fnmpre)
  IF ( iaproc .EQ. napout )             &
       OPEN (333,file=fnmpre(:j)//ofile(:ofl),err=2008,iostat=ierr)
#endif
 
  IF ( iaproc .EQ. napout ) WRITE (ndso,900)
  !
  IF ( iaproc .EQ. naperr ) THEN
    ndsen  = ndse
  ELSE
    ndsen  = -1
  END IF
#ifdef W3_OMPH
  IF ( iaproc .EQ. napout ) WRITE (ndso,905) &
       mpi_thread_funneled, thrlev
#endif
  !
#ifdef W3_OMPG
    IF(iaproc .EQ. napout) THEN
      WRITE(ndso, 906) omp_get_max_threads()
    ENDIF
#endif
 
  !
  ! 1.b For WAVEWATCH III (See W3INIT)
  !
  nds( 1) = 20
  nds( 2) =  6
  nds( 3) = 21
  nds( 4) =  6
  nds( 5) = 30
  nds( 6) = 30
  nds( 7) = 31
  nds( 8) = 32
  nds( 9) = 33
  nds(10) = 35
  nds(11) = 22
  nds(12) = 23
  nds(13) = 34
  nds(14) = 36
  nds(15) = 37
 
  !
  ntrace(1) =  nds(3)
  ntrace(2) =  10
  !
#ifdef W3_NCO
  !
  ! Redo according to NCO
  !
  nds( 1) = 51
  nds( 2) = ndso
  nds( 3) = ndso
  nds( 4) = ndso
  nds( 5) = 20
  nds( 6) = 21
  nds( 7) = 52
  nds( 8) = 53
  nds( 9) = 22
  nds(10) = 71
  nds(11) = 23
  nds(12) = 54
  nds(13) = 55
  ntrace(1) = ndso
#endif
  !
#ifdef W3_T
  WRITE (ndst,9000) (nds(i),i=1,12)
  WRITE (ndst,9001) (ntrace(i),i=1,2)
#endif
  !
  ! 1.c Local parameters
  !
  ! Default COMSTR to "$" (for when using nml input files)
  comstr = "$"
  !
  ! inferred from context: these flags (FL) are to indicate that the last (LST)
  !   field has been read from a file.
  fllstl = .false. ! This is associated with J.EQ.1 (wlev)
  fllsti = .false. ! This is associated with J.EQ.4 (ice)
  fllstr = .false. ! This is associated with J.EQ.6 (rhoa)
  fllst_all = .false. ! For all
 
  ! If using experimental mud or ice physics, additional lines will
  !  be read in from ww3_shel.inp and applied, so JFIRST is changed from
  !  its initialization setting "JFIRST=1" to some lower value.
#ifdef W3_IC1
  jfirst=-7
#endif
#ifdef W3_IC2
  jfirst=-7
#endif
#ifdef W3_IS2
  jfirst=-7
#endif
#ifdef W3_IC3
  jfirst=-7
#endif
#ifdef W3_BT8
  jfirst=-7
#endif
#ifdef W3_BT9
  jfirst=-7
#endif
#ifdef W3_IC4
  jfirst=-7
#endif
#ifdef W3_IC5
  jfirst=-7
#endif
 
  call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 2a')
  !
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 2.  Define input fields
  !
 
  !
  ! process ww3_prnc namelist
  !
  INQUIRE(file=trim(fnmpre)//"ww3_shel.nml", exist=flgnml)
  IF (flgnml) THEN
    ! Read namelist
    CALL w3nmlshel (mpi_comm, ndsi, trim(fnmpre)//'ww3_shel.nml',  &
         nml_domain, nml_input, nml_output_type,        &
         nml_output_date, nml_homog_count,             &
         nml_homog_input, ierr)
 
    ! 2.1 forcing flags
 
    flh(-7:10)=.false.
    flagtfc(-7)=trim(nml_input%FORCING%ICE_PARAM1)
    flagtfc(-6)=trim(nml_input%FORCING%ICE_PARAM2)
    flagtfc(-5)=trim(nml_input%FORCING%ICE_PARAM3)
    flagtfc(-4)=trim(nml_input%FORCING%ICE_PARAM4)
    flagtfc(-3)=trim(nml_input%FORCING%ICE_PARAM5)
    flagtfc(-2)=trim(nml_input%FORCING%MUD_DENSITY)
    flagtfc(-1)=trim(nml_input%FORCING%MUD_THICKNESS)
    flagtfc(0)=trim(nml_input%FORCING%MUD_VISCOSITY)
    flagtfc(1)=trim(nml_input%FORCING%WATER_LEVELS)
    flagtfc(2)=trim(nml_input%FORCING%CURRENTS)
    flagtfc(3)=trim(nml_input%FORCING%WINDS)
    flagtfc(4)=trim(nml_input%FORCING%ICE_CONC)
    flagtfc(5)=trim(nml_input%FORCING%ATM_MOMENTUM)
    flagtfc(6)=trim(nml_input%FORCING%AIR_DENSITY)
    flagtfc(7)=trim(nml_input%ASSIM%MEAN)
    flagtfc(8)=trim(nml_input%ASSIM%SPEC1D)
    flagtfc(9)=trim(nml_input%ASSIM%SPEC2D)
 
    IF (trim(nml_input%FORCING%ICE_PARAM1) .EQ. 'H') THEN
      flagtfc(-7)='T'
      flh(-7)=.true.
    END IF
    IF (trim(nml_input%FORCING%ICE_PARAM2) .EQ. 'H') THEN
      flagtfc(-6)='T'
      flh(-6)=.true.
    END IF
    IF (trim(nml_input%FORCING%ICE_PARAM3) .EQ. 'H') THEN
      flagtfc(-5)='T'
      flh(-5)=.true.
    END IF
    IF (trim(nml_input%FORCING%ICE_PARAM4) .EQ. 'H') THEN
      flagtfc(-4)='T'
      flh(-4)=.true.
    END IF
    IF (trim(nml_input%FORCING%ICE_PARAM5) .EQ. 'H') THEN
      flagtfc(-3)='T'
      flh(-3)=.true.
    END IF
    IF (trim(nml_input%FORCING%MUD_DENSITY) .EQ. 'H') THEN
      flagtfc(-2)='T'
      flh(-2)=.true.
    END IF
    IF (trim(nml_input%FORCING%MUD_THICKNESS) .EQ. 'H') THEN
      flagtfc(-1)='T'
      flh(-1)=.true.
    END IF
    IF (trim(nml_input%FORCING%MUD_VISCOSITY) .EQ. 'H') THEN
      flagtfc(0)='T'
      flh(0)=.true.
    END IF
    IF (trim(nml_input%FORCING%WATER_LEVELS) .EQ. 'H') THEN
      flagtfc(1)='T'
      flh(1)=.true.
    END IF
    IF (trim(nml_input%FORCING%CURRENTS) .EQ. 'H') THEN
      flagtfc(2)='T'
      flh(2)=.true.
    END IF
    IF (trim(nml_input%FORCING%WINDS) .EQ. 'H') THEN
      flagtfc(3)='T'
      flh(3)=.true.
    END IF
    IF (trim(nml_input%FORCING%ICE_CONC) .EQ. 'H') THEN
      flagtfc(4)='T'
      flh(4)=.true.
    END IF
    IF (trim(nml_input%FORCING%ATM_MOMENTUM) .EQ. 'H') THEN
      flagtfc(5)='T'
      flh(5)=.true.
    END IF
    IF (trim(nml_input%FORCING%AIR_DENSITY) .EQ. 'H') THEN
      flagtfc(6)='T'
      flh(6)=.true.
    END IF
 
    IF ( iaproc .EQ. napout ) WRITE (ndso,920)
    DO j=jfirst, 9
      IF (flagtfc(j).EQ.'T') THEN
        inflags1(j)=.true.
        flagsc(j)=.false.
      END IF
      IF (flagtfc(j).EQ.'F') THEN
        inflags1(j)=.false.
        flagsc(j)=.false.
      END IF
      IF (flagtfc(j).EQ.'C') THEN
        inflags1(j)=.true.
        flagsc(j)=.true.
      END IF
      IF ( j .LE. 6 ) THEN
        flh(j) = flh(j) .AND. inflags1(j)
      END IF
      IF ( inflags1(j) ) THEN
        yesxno = 'YES/--'
      ELSE
        yesxno = '---/NO'
      END IF
      IF ( flh(j) ) THEN
        strng  = '(homogeneous field) '
      ELSE IF ( flagsc(j) ) THEN
        strng  = '(coupling field) '
      ELSE
        strng  = '                    '
      END IF
      IF ( iaproc .EQ. napout ) WRITE (ndso,921) idflds(j), yesxno, strng
    END DO
#ifdef W3_COU
    IF (flagsc(1) .AND. inflags1(2) .AND. .NOT. flagsc(2)) GOTO 2102
    IF (flagsc(2) .AND. inflags1(1) .AND. .NOT. flagsc(1)) GOTO 2102
#endif
 
    inflags1(10) = .false.
#ifdef W3_MGW
    inflags1(10) = .true.
#endif
#ifdef W3_MGP
    inflags1(10) = .true.
#endif
#ifdef W3_MGW
    flh(10)   = .true.
#endif
#ifdef W3_MGP
    flh(10)   = .true.
#endif
    IF ( inflags1(10) .AND. iaproc.EQ.napout )                         &
         WRITE (ndso,921) idflds(10), 'YES/--', ' '
    !
    flflg  = inflags1(-7) .OR. inflags1(-6) .OR. inflags1(-5) .OR. inflags1(-4) &
         .OR. inflags1(-3) .OR. inflags1(-2) .OR. inflags1(-1)           &
         .OR. inflags1(0)  .OR. inflags1(1)  .OR. inflags1(2)            &
         .OR. inflags1(3)  .OR. inflags1(4)  .OR. inflags1(5)            &
         .OR. inflags1(6)  .OR. inflags1(7)  .OR. inflags1(8)            &
         .OR. inflags1(9)
    flhom  = flh(-7) .OR. flh(-6) .OR. flh(-5) .OR. flh(-4)       &
         .OR. flh(-3) .OR. flh(-2) .OR. flh(-1) .OR. flh(0)   &
         .OR. flh(1) .OR. flh(2) .OR. flh(3) .OR. flh(4)      &
         .OR. flh(5) .OR. flh(6) .OR. flh(10)
    !
    IF ( iaproc .EQ. napout ) WRITE (ndso,922)
    !
    !       INFLAGS2 is just "initial value of INFLAGS1", i.e. does *not* get
    !          changed when model reads last record of ice.ww3
    inflags2=inflags1
 
#ifdef W3_T
    WRITE (ndst,9020) flflg, inflags1, flhom, flh
#endif
 
 
 
    ! 2.2 Time setup
 
    READ(nml_domain%START,*) time0
    CALL t2d(time0,startdate,ierr)
    CALL d2j(startdate,startjulday,ierr)
    READ(nml_domain%STOP,*) timen
    CALL t2d(timen,stopdate,ierr)
    CALL d2j(stopdate,stopjulday,ierr)
 
    ! 2.3 Domain setup
 
    iostyp = nml_domain%IOSTYP
 
#ifdef W3_PDLIB
    IF (iostyp .gt. 1) THEN
      WRITE(*,*) 'IOSTYP not supported in domain decomposition mode'
      CALL extcde ( 6666 )
    ENDIF
#endif
 
    CALL w3iogr ( 'GRID', ndsf(7) )
    IF ( flagll ) THEN
      factor = 1.
    ELSE
      factor = 1.e-3
    END IF
 
    ! 2.4 Output dates
 
    READ(nml_output_date%FIELD%START, *)   odat(1), odat(2)
    READ(nml_output_date%FIELD%STRIDE, *)  odat(3)
    READ(nml_output_date%FIELD%STOP, *)    odat(4), odat(5)
 
    READ(nml_output_date%FIELD%OUTFFILE, *)  ofiles(1)
    !        OUTPTS(I)%OUTSTRIDE(1)=ODAT(3,I)
 
    READ(nml_output_date%POINT%START, *)   odat(6), odat(7)
    READ(nml_output_date%POINT%STRIDE, *)  odat(8)
    READ(nml_output_date%POINT%STOP, *)    odat(9), odat(10)
 
    READ(nml_output_date%POINT%OUTFFILE, *)  ofiles(2)
    !        OUTPTS(I)%OUTSTRIDE(2)=ODAT(8,I)
 
    READ(nml_output_date%TRACK%START, *)   odat(11), odat(12)
    READ(nml_output_date%TRACK%STRIDE, *)  odat(13)
    READ(nml_output_date%TRACK%STOP, *)    odat(14), odat(15)
    READ(nml_output_date%RESTART%START, *)   odat(16), odat(17)
    READ(nml_output_date%RESTART%STRIDE, *)  odat(18)
    READ(nml_output_date%RESTART%STOP, *)    odat(19), odat(20)
    READ(nml_output_date%RESTART2%START, *)   odat(36), odat(37)
    READ(nml_output_date%RESTART2%STRIDE, *)  odat(38)
    READ(nml_output_date%RESTART2%STOP, *)    odat(39), odat(40)
    READ(nml_output_date%BOUNDARY%START, *)   odat(21), odat(22)
    READ(nml_output_date%BOUNDARY%STRIDE, *)  odat(23)
    READ(nml_output_date%BOUNDARY%STOP, *)    odat(24), odat(25)
    READ(nml_output_date%PARTITION%START, *)   odat(26), odat(27)
    READ(nml_output_date%PARTITION%STRIDE, *)  odat(28)
    READ(nml_output_date%PARTITION%STOP, *)    odat(29), odat(30)
    READ(nml_output_date%COUPLING%START, *)   odat(31), odat(32)
    READ(nml_output_date%COUPLING%STRIDE, *)  odat(33)
    READ(nml_output_date%COUPLING%STOP, *)    odat(34), odat(35)
 
    ! set the time stride at 0 or more
    odat(3) = max( 0 , odat(3) )
    odat(8) = max( 0 , odat(8) )
    odat(13) = max( 0 , odat(13) )
    odat(18) = max( 0 , odat(18) )
    odat(23) = max( 0 , odat(23) )
    odat(28) = max( 0 , odat(28) )
    odat(33) = max( 0 , odat(33) )
    odat(38) = max( 0 , odat(38) )
    !
#ifdef W3_COU
    ! Test the validity of the coupling time step
    IF (odat(33) == 0) THEN
      IF ( iaproc .EQ. napout ) THEN
        WRITE(ndso,1010) odat(33), int(dtmax)
      END IF
      odat(33) = int(dtmax)
    ELSE IF (mod(odat(33),int(dtmax)) .NE. 0) THEN
      GOTO 2009
    END IF
#endif
    !
    ! 2.5 Output types
 
    npts   = 0
    notype = 6
#ifdef W3_COU
    notype = 7
#endif
    DO j = 1, notype
      !          OUTPTS(I)%OFILES(J)=OFILES(J)
      IF ( odat(5*(j-1)+3) .NE. 0 ) THEN
 
        ! Type 1: fields of mean wave parameters
        IF ( j .EQ. 1 ) THEN
          fldout = nml_output_type%FIELD%LIST
          CALL w3flgrdflag ( ndso, ndso, ndse, fldout, flgd,     &
               flgrd, iaproc, napout, ierr )
          IF ( ierr .NE. 0 ) GOTO 2222
 
 
          ! Type 2: point output
        ELSE IF ( j .EQ. 2 ) THEN
          OPEN (ndsl, file=trim(fnmpre)//trim(nml_output_type%POINT%FILE), &
               form='FORMATTED', status='OLD', err=2104, iostat=ierr)
 
          ! first loop to count the number of points
          ! second loop to allocate the array and store the points
          ipts = 0
          DO iloop=1,2
            rewind(ndsl)
            !
            IF ( iloop.EQ.2) THEN
              npts = ipts
              IF ( npts.GT.0 ) THEN
                ALLOCATE ( x(npts), y(npts), pnames(npts) )
                ipts = 0 ! reset counter to be reused for next do loop
              ELSE
                ALLOCATE ( x(1), y(1), pnames(1) )
                GOTO 2054
              END IF
            END IF
            !
            DO
              READ (ndsl,*,err=2004,iostat=ierr) tmpline
              ! if end of file or stopstring, then exit
              IF ( ierr.NE.0 .OR. index(tmpline,"STOPSTRING").NE.0 ) EXIT
              ! leading blanks removed and placed on the right
              test = adjustl( tmpline )
              IF ( test(1:1).EQ.comstr .OR. len_trim(test).EQ.0 ) THEN
                ! if comment or blank line, then skip
                cycle
              ELSE
                ! otherwise, backup to beginning of line
                backspace( ndsl, err=2004, iostat=ierr)
                READ (ndsl,*,err=2004,iostat=ierr) xx, yy, pn
              END IF
              ipts = ipts + 1
              IF ( iloop .EQ. 1 ) cycle
              IF ( iloop .EQ. 2 ) THEN
                x(ipts)      = xx
                y(ipts)      = yy
                pnames(ipts) = pn
                IF ( iaproc .EQ. napout ) THEN
                  IF ( flagll ) THEN
                    IF ( ipts .EQ. 1 ) THEN
                      WRITE (ndso,2945)                     &
                           factor*xx, factor*yy, pn
                    ELSE
                      WRITE (ndso,2946) ipts,               &
                           factor*xx, factor*yy, pn
                    END IF
                  ELSE
                    IF ( ipts .EQ. 1 ) THEN
                      WRITE (ndso,2955)                     &
                           factor*xx, factor*yy, pn
                    ELSE
                      WRITE (ndso,2956) ipts,               &
                           factor*xx, factor*yy, pn
                    END IF
                  END IF
                END IF
              END IF ! ILOOP.EQ.2
            END DO ! end of file
          END DO ! ILOOP
          CLOSE(ndsl)
 
          ! Type 3: track output
        ELSE IF ( j .EQ. 3 ) THEN
          tflagi = nml_output_type%TRACK%FORMAT
          IF ( .NOT. tflagi ) nds(11) = -nds(11)
          IF ( iaproc .EQ. napout ) THEN
            IF ( .NOT. tflagi ) THEN
              WRITE (ndso,3945) 'input', 'UNFORMATTED'
            ELSE
              WRITE (ndso,3945) 'input', 'FORMATTED'
            END IF
          END IF
 
          ! Type 6: partitioning
        ELSE IF ( j .EQ. 6 ) THEN
          iprt(1) = nml_output_type%PARTITION%X0
          iprt(2) = nml_output_type%PARTITION%XN
          iprt(3) = nml_output_type%PARTITION%NX
          iprt(4) = nml_output_type%PARTITION%Y0
          iprt(5) = nml_output_type%PARTITION%YN
          iprt(6) = nml_output_type%PARTITION%NY
          prtfrm = nml_output_type%PARTITION%FORMAT
          !
          IF ( iaproc .EQ. napout ) THEN
            IF ( prtfrm ) THEN
              yesxno = 'YES/--'
            ELSE
              yesxno = '---/NO'
            END IF
            WRITE (ndso,6945) iprt, yesxno
          END IF
 
#ifdef W3_COU
          ! Type 7: coupling
        ELSE IF ( j .EQ. 7 ) THEN
          fldout = nml_output_type%COUPLING%SENT
          CALL w3flgrdflag ( ndso, ndso, ndse, fldout, flg2,  &
               flgr2, iaproc, napout, ierr )
          IF ( ierr .NE. 0 ) GOTO 2222
          fldin = nml_output_type%COUPLING%RECEIVED
          cplt0 = nml_output_type%COUPLING%COUPLET0
#endif
 
        END IF ! J
      END IF ! ODAT
    END DO ! J
 
    ! Extra fields to be written in the restart
    fldrst = nml_output_type%RESTART%EXTRA
    CALL w3flgrdflag ( ndso, ndso, ndse, fldrst, flogr,  &
         flogrr, iaproc, napout, ierr )
    IF ( ierr .NE. 0 ) GOTO 2222
 
    ! force minimal allocation to avoid memory seg fault
    IF ( .NOT.ALLOCATED(x) .AND. npts.EQ.0 ) ALLOCATE ( x(1), y(1), pnames(1) )
 
    ! 2.6 Homogeneous field data
 
    IF ( flhom ) THEN
      IF ( iaproc .EQ. napout ) WRITE (ndso,951)                   &
           'Homogeneous field data (and moving grid) ...'
 
      nh(-7) = nml_homog_count%N_IC1
      nh(-6) = nml_homog_count%N_IC2
      nh(-5) = nml_homog_count%N_IC3
      nh(-4) = nml_homog_count%N_IC4
      nh(-3) = nml_homog_count%N_IC5
      nh(-2) = nml_homog_count%N_MDN
      nh(-1) = nml_homog_count%N_MTH
      nh(0)  = nml_homog_count%N_MVS
      nh(1)  = nml_homog_count%N_LEV
      nh(2)  = nml_homog_count%N_CUR
      nh(3)  = nml_homog_count%N_WND
      nh(4)  = nml_homog_count%N_ICE
      nh(5)  = nml_homog_count%N_TAU
      nh(6)  = nml_homog_count%N_RHO
      nh(10)  = nml_homog_count%N_MOV
      !
      n_tot = nml_homog_count%N_TOT
      !
      DO j=jfirst,10
        IF ( nh(j) .GT. nhmax ) GOTO 2006
      END DO
 
 
      ! Store homogeneous fields
      IF ( n_tot .GT. 0 ) THEN
        ihh(:)=0
        DO ih=1,n_tot
          READ(nml_homog_input(ih)%NAME,*) idtst
          SELECT CASE (idtst)
          CASE ('IC1')
            j=-7
          CASE ('IC2')
            j=-6
          CASE ('IC3')
            j=-5
          CASE ('IC4')
            j=-4
          CASE ('IC5')
            j=-3
          CASE ('MDN')
            j=-2
          CASE ('MTH')
            j=-1
          CASE ('MVS')
            j=0
          CASE ('LEV')
            j=1
          CASE ('CUR')
            j=2
          CASE ('WND')
            j=3
          CASE ('ICE')
            j=4
          CASE ('TAU')
            j=5
          CASE ('RHO')
            j=6
          CASE ('MOV')
            j=10
          CASE DEFAULT
            GOTO 2062
          END SELECT
          ihh(j)=ihh(j)+1
          READ(nml_homog_input(ih)%DATE,*) tho(:,j,ihh(j))
          ha(ihh(j),j) = nml_homog_input(ih)%VALUE1
          hd(ihh(j),j) = nml_homog_input(ih)%VALUE2
          hs(ihh(j),j) = nml_homog_input(ih)%VALUE3
        END DO
      END IF
 
#ifdef W3_O7
      DO j=jfirst, 10
        IF ( flh(j) .AND. iaproc.EQ.napout ) THEN
          WRITE (ndso,952) nh(j), idflds(j)
          DO i=1, nh(j)
            IF ( ( j .LE. 1 ) .OR. ( j .EQ. 4 ) .OR.      &
                 ( j .EQ. 6 ) ) THEN
              WRITE (ndso,953) i, tho(1,j,i), tho(2,j,i), &
                   ha(i,j)
            ELSE IF ( ( j .EQ. 2 ) .OR. ( j .EQ. 5 ) .OR. &
                 ( j .EQ. 10 ) ) THEN
              WRITE (ndso,953) i, tho(1,j,i), tho(2,j,i), &
                   ha(i,j), hd(i,j)
            ELSE IF ( j .EQ. 3 ) THEN
              WRITE (ndso,953) i, tho(1,j,i), tho(2,j,i), &
                   ha(i,j), hd(i,j), hs(i,j)
            END IF
          END DO
        END IF
      END DO
#endif
      !
      IF ( ( flh(-7) .AND. (nh(-7).EQ.0) ) .OR.                     &
           ( flh(-6) .AND. (nh(-6).EQ.0) ) .OR.                     &
           ( flh(-5) .AND. (nh(-5).EQ.0) ) .OR.                     &
           ( flh(-4) .AND. (nh(-4).EQ.0) ) .OR.                     &
           ( flh(-3) .AND. (nh(-3).EQ.0) ) .OR.                     &
           ( flh(-2) .AND. (nh(-2).EQ.0) ) .OR.                     &
           ( flh(-1) .AND. (nh(-1).EQ.0) ) .OR.                     &
           ( flh(0)  .AND. (nh(0).EQ.0)  ) .OR.                     &
           ( flh(1)  .AND. (nh(1).EQ.0)  ) .OR.                     &
           ( flh(2)  .AND. (nh(2).EQ.0)  ) .OR.                     &
           ( flh(3)  .AND. (nh(3).EQ.0)  ) .OR.                     &
           ( flh(4)  .AND. (nh(4).EQ.0)  ) .OR.                     &
           ( flh(5)  .AND. (nh(5).EQ.0)  ) .OR.                     &
           ( flh(6)  .AND. (nh(6).EQ.0)  ) .OR.                     &
           ( flh(10) .AND. (nh(10).EQ.0) ) ) GOTO 2007
      !
    END IF ! FLHOM
 
 
  END IF ! FLGNML
 
 
 
  !
  ! process old ww3_shel.inp format
  !
  IF (.NOT. flgnml) THEN
 
    OPEN (ndsi,file=trim(fnmpre)//'ww3_shel.inp',status='OLD',iostat=ierr)
    rewind(ndsi)
    !AR: I changed the error handling for err=2002, see commit message ...
    READ (ndsi,'(A)') comstr
    IF (comstr.EQ.' ') comstr = '$'
    IF ( iaproc .EQ. napout ) WRITE (ndso,901) comstr
 
    ! 2.1 forcing flags
 
    flh(-7:10) = .false.
    DO j=jfirst, 9
      CALL nextln ( comstr , ndsi , ndsen )
      IF ( j .LE. 6 ) THEN
        READ (ndsi,*) flagtfc(j), flh(j)
      ELSE
        READ (ndsi,*) flagtfc(j)
      END IF
    END DO
 
    IF ( iaproc .EQ. napout ) WRITE (ndso,920)
    DO j=jfirst, 9
      IF (flagtfc(j).EQ.'T') THEN
        inflags1(j)=.true.
        flagsc(j)=.false.
      END IF
      IF (flagtfc(j).EQ.'F') THEN
        inflags1(j)=.false.
        flagsc(j)=.false.
      END IF
      IF (flagtfc(j).EQ.'C') THEN
        inflags1(j)=.true.
        flagsc(j)=.true.
      END IF
      IF ( j .LE. 6 ) THEN
        flh(j) = flh(j) .AND. inflags1(j)
      END IF
      IF ( inflags1(j) ) THEN
        yesxno = 'YES/--'
      ELSE
        yesxno = '---/NO'
      END IF
      IF ( flh(j) ) THEN
        strng  = '(homogeneous field) '
      ELSE IF ( flagsc(j) ) THEN
        strng  = '(coupling field) '
      ELSE
        strng  = '                    '
      END IF
      IF ( iaproc .EQ. napout ) WRITE (ndso,921) idflds(j), yesxno, strng
    END DO
#ifdef W3_COU
    IF (flagsc(1) .AND. inflags1(2) .AND. .NOT. flagsc(2)) GOTO 2102
    IF (flagsc(2) .AND. inflags1(1) .AND. .NOT. flagsc(1)) GOTO 2102
#endif
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 2b')
    !
    inflags1(10) = .false.
#ifdef W3_MGW
    inflags1(10) = .true.
#endif
#ifdef W3_MGP
    inflags1(10) = .true.
#endif
#ifdef W3_MGW
    flh(10)   = .true.
#endif
#ifdef W3_MGP
    flh(10)   = .true.
#endif
    IF ( inflags1(10) .AND. iaproc.EQ.napout )                         &
         WRITE (ndso,921) idflds(10), 'YES/--', ' '
    !
    flflg  = inflags1(-7) .OR. inflags1(-6) .OR. inflags1(-5) .OR. inflags1(-4) &
         .OR. inflags1(-3) .OR. inflags1(-2) .OR. inflags1(-1)           &
         .OR. inflags1(0)  .OR. inflags1(1)  .OR. inflags1(2)            &
         .OR. inflags1(3)  .OR. inflags1(4)  .OR. inflags1(5)            &
         .OR. inflags1(6)  .OR. inflags1(7)  .OR. inflags1(8)            &
         .OR. inflags1(9)
    flhom  = flh(-7) .OR. flh(-6) .OR. flh(-5) .OR. flh(-4)   &
         .OR. flh(-3) .OR. flh(-2) .OR. flh(-1) .OR. flh(0)   &
         .OR. flh(1) .OR. flh(2) .OR. flh(3) .OR. flh(4)      &
         .OR. flh(5) .OR. flh(6) .OR. flh(10)
    !
    IF ( iaproc .EQ. napout ) WRITE (ndso,922)
    !
    !       INFLAGS2 is just "initial value of INFLAGS1", i.e. does *not* get
    !          changed when model reads last record of ice.ww3
    inflags2=inflags1
 
#ifdef W3_T
    WRITE (ndst,9020) flflg, inflags1, flhom, flh
#endif
 
 
    ! 2.2 Time setup
 
    CALL nextln ( comstr , ndsi , ndsen )
    READ (ndsi,*) time0
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 2c')
 
    CALL nextln ( comstr , ndsi , ndsen )
    READ (ndsi,*) timen
    !
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 2d')
 
    ! 2.3 Domain setup
 
    CALL nextln ( comstr , ndsi , ndsen )
    READ (ndsi,*) iostyp
#ifdef W3_PDLIB
    IF (iostyp .gt. 1) THEN
      WRITE(*,*) 'IOSTYP not supported in domain decomposition mode'
      CALL extcde ( 6666 )
    ENDIF
#endif
    CALL w3iogr ( 'GRID', ndsf(7) )
    IF ( flagll ) THEN
      factor = 1.
    ELSE
      factor = 1.e-3
    END IF
 
 
    ! 2.4 Output dates
 
    npts   = 0
    notype = 6
#ifdef W3_COU
    notype = 7
#endif
    DO j = 1, notype
      CALL nextln ( comstr , ndsi , ndsen )
      !
      ! CHECKPOINT
      IF(j .EQ. 4) THEN
        odat(38)=0
        words(1:7)=''
        READ (ndsi,'(A)') linein
        READ(linein,*,iostat=ierr) words
        READ(words( 1 ), * ) odat(16)
        READ(words( 2 ), * ) odat(17)
        READ(words( 3 ), * ) odat(18)
        READ(words( 4 ), * ) odat(19)
        READ(words( 5 ), * ) odat(20)
        IF (words(6) .EQ. 'T') THEN
          CALL nextln ( comstr , ndsi , ndsen )
          READ (ndsi,*,END=2001,ERR=2002)(ODAT(I),I=5*(8-1)+1,5*8)
          WRITE(*,*)(odat(i),i=5*(8-1)+1,5*8)
        END IF
        IF (words(7) .EQ. 'T') THEN
          CALL nextln ( comstr , ndsi , ndsen )
          READ (ndsi,'(A)',END=2001,ERR=2002) fldrst
        END IF
        CALL w3flgrdflag ( ndso, ndso, ndse, fldrst, flogr,  &
             flogrr, iaproc, napout, ierr )
        IF ( ierr .NE. 0 ) GOTO 2222
      ELSE
        !
        !INLINE NEW VARIABLE TO READ IF PRESENT OFILES(J), IF NOT ==0
        !          READ (NDSI,*) (ODAT(I),I=5*(J-1)+1,5*J)
        !          READ (NDSI,*,IOSTAT=IERR) (ODAT(I),I=5*(J-1)+1,5*J),OFILES(J)
        IF(j .LE. 2) THEN
          words(1:6)=''
          !          READ (NDSI,*,END=2001,ERR=2002)(ODAT(I),I=5*(J-1)+1,5*J),OFILES(J)
          READ (ndsi,'(A)') linein
          READ(linein,*,iostat=ierr) words
          !
          IF(j .EQ. 1) THEN
            READ(words( 1 ), * ) odat(1)
            READ(words( 2 ), * ) odat(2)
            READ(words( 3 ), * ) odat(3)
            READ(words( 4 ), * ) odat(4)
            READ(words( 5 ), * ) odat(5)
          ELSE
            READ(words( 1 ), * ) odat(6)
            READ(words( 2 ), * ) odat(7)
            READ(words( 3 ), * ) odat(8)
            READ(words( 4 ), * ) odat(9)
            READ(words( 5 ), * ) odat(10)
          END IF
 
          IF (words(6) .NE. '0' .AND. words(6) .NE. '1') THEN
            ofiles(j)=0
          ELSE
            READ(words( 6 ), * ) ofiles(j)
          END IF
 
 
#ifdef W3_COU
        ELSE IF(j .EQ. 7) THEN
          words(1:6)=''
          READ (ndsi,'(A)') linein
          READ(linein,*,iostat=ierr) words
 
          READ(words( 1 ), * ) odat(31)
          READ(words( 2 ), * ) odat(32)
          READ(words( 3 ), * ) odat(33)
          READ(words( 4 ), * ) odat(34)
          READ(words( 5 ), * ) odat(35)
 
          IF (words(6) .EQ. 'T') THEN
            cplt0 = .true.
          ELSE
            cplt0 = .false.
          END IF
#endif
        ELSE
          ofiles(j)=0
          READ (ndsi,*,END=2001,ERR=2002)(ODAT(I),I=5*(J-1)+1,5*J)
        END IF
        !          WRITE(*,*) 'OFILES(J)= ', OFILES(J),J
        !
        odat(5*(j-1)+3) = max( 0 , odat(5*(j-1)+3) )
        !
        write(jchar, '(i0)') j
        call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL NOTTYPE '//trim(jchar))
        !
        ! 2.5 Output types
 
        IF ( odat(5*(j-1)+3) .NE. 0 ) THEN
 
          ! Type 1: fields of mean wave parameters
          IF ( j .EQ. 1 ) THEN
            CALL w3readflgrd ( ndsi, ndso, 9, ndsen, comstr, flgd,   &
                 flgrd, iaproc, napout, ierr )
            IF ( ierr .NE. 0 ) GOTO 2222
 
 
 
            ! Type 2: point output
          ELSE IF ( j .EQ. 2 ) THEN
            DO iloop=1,2
              IF ( iloop .EQ. 1 ) THEN
                ndsi2  = ndsi
                IF ( iaproc .EQ. 1 ) OPEN                       &
                     (ndss,file=trim(fnmpre)//'ww3_shel.scratch')
              ELSE
                ndsi2  = ndss
#ifdef W3_MPI
                CALL mpi_barrier (mpi_comm,ierr_mpi)
#endif
                OPEN (ndss,file=trim(fnmpre)//'ww3_shel.scratch')
                rewind(ndss)
                !
                IF ( .NOT.ALLOCATED(x) ) THEN
                  IF ( npts.GT.0 ) THEN
                    ALLOCATE ( x(npts), y(npts), pnames(npts) )
                  ELSE
                    ALLOCATE ( x(1), y(1), pnames(1) )
                    GOTO 2054
                  END IF
                END IF
              END IF
              !
              npts   = 0
              DO
                CALL nextln ( comstr , ndsi , ndsen )
                READ (ndsi2,*) xx, yy, pn
                IF ( iloop.EQ.1 .AND. iaproc.EQ.1 ) THEN
                  backspace(ndsi)
                  READ (ndsi,'(A)') line
                  WRITE (ndss,'(A)') line
                END IF
                IF ( index(pn,"STOPSTRING").NE.0 ) EXIT
                npts   = npts + 1
                IF ( iloop .EQ. 1 ) cycle
                x(npts)      = xx
                y(npts)      = yy
                pnames(npts) = pn
                IF ( iaproc .EQ. napout ) THEN
                  IF ( flagll ) THEN
                    IF ( npts .EQ. 1 ) THEN
                      WRITE (ndso,2945)                     &
                           factor*xx, factor*yy, pn
                    ELSE
                      WRITE (ndso,2946) npts,               &
                           factor*xx, factor*yy, pn
                    END IF
                  ELSE
                    IF ( npts .EQ. 1 ) THEN
                      WRITE (ndso,2955)                     &
                           factor*xx, factor*yy, pn
                    ELSE
                      WRITE (ndso,2956) npts,               &
                           factor*xx, factor*yy, pn
                    END IF
                  END IF
                END IF
              END DO
              !
              IF ( iaproc.EQ.1 .AND. iloop.EQ.1 ) CLOSE (ndss)
            END DO
            !
            IF ( npts.EQ.0 .AND. iaproc.EQ.napout )               &
                 WRITE (ndso,2947)
            IF ( iaproc .EQ. 1 ) THEN
#ifdef W3_MPI
              CALL mpi_barrier ( mpi_comm, ierr_mpi )
#endif
              CLOSE (ndss,status='DELETE')
            ELSE
              CLOSE (ndss)
#ifdef W3_MPI
              CALL mpi_barrier ( mpi_comm, ierr_mpi )
#endif
            END IF
            !
 
 
            ! Type 3: track output
          ELSE IF ( j .EQ. 3 ) THEN
            CALL nextln ( comstr , ndsi , ndsen )
            READ (ndsi,*) tflagi
            !
            IF ( .NOT. tflagi ) nds(11) = -nds(11)
            IF ( iaproc .EQ. napout ) THEN
              IF ( .NOT. tflagi ) THEN
                WRITE (ndso,3945) 'input', 'UNFORMATTED'
              ELSE
                WRITE (ndso,3945) 'input', 'FORMATTED'
              END IF
            END IF
 
 
            ! Type 6: partitioning
          ELSE IF ( j .EQ. 6 ) THEN
            !             IPRT: IX0, IXN, IXS, IY0, IYN, IYS
            CALL nextln ( comstr , ndsi , ndsen )
            READ (ndsi,*) iprt, prtfrm
            !
            IF ( iaproc .EQ. napout ) THEN
              IF ( prtfrm ) THEN
                yesxno = 'YES/--'
              ELSE
                yesxno = '---/NO'
              END IF
              WRITE (ndso,6945) iprt, yesxno
            END IF
 
 
#ifdef W3_COU
            ! Type 7: coupling
          ELSE IF ( j .EQ. 7 ) THEN
            CALL w3readflgrd ( ndsi, ndso, ndss, ndsen, comstr, flg2,     &
                 flgr2, iaproc, napout, ierr )
            IF ( ierr .NE. 0 ) GOTO 2222
            CALL nextln ( comstr , ndsi , ndsen )
            READ (ndsi,'(A)',END=2001,ERR=2002,IOSTAT=IERR) fldin
#endif
 
          END IF ! J
        END IF ! ODAT
      END IF ! IF J=4
    END DO ! J
 
    ! force minimal allocation to avoid memory seg fault
    IF ( .NOT.ALLOCATED(x) .AND. npts.EQ.0 ) ALLOCATE ( x(1), y(1), pnames(1) )
 
    ! 2.6 Homogeneous field data
 
    IF ( flhom ) THEN
      IF ( iaproc .EQ. napout ) WRITE (ndso,951)                  &
           'Homogeneous field data (and moving grid) ...'
      nh     = 0
      !
      ! Start of loop
      DO
        CALL nextln ( comstr , ndsi , ndsen )
        READ (ndsi,*) idtst
 
 
        ! Exit if illegal id
        IF ( idtst.NE.idstr(-7) .AND. idtst.NE.idstr(-6) .AND.   &
             idtst.NE.idstr(-5) .AND. idtst.NE.idstr(-4) .AND.   &
             idtst.NE.idstr(-3) .AND. idtst.NE.idstr(-2) .AND.   &
             idtst.NE.idstr(-1) .AND. idtst.NE.idstr(0)  .AND.   &
             idtst.NE.idstr(1)  .AND. idtst.NE.idstr(2)  .AND.   &
             idtst.NE.idstr(3)  .AND. idtst.NE.idstr(4)  .AND.   &
             idtst.NE.idstr(5)  .AND. idtst.NE.idstr(6)  .AND.   &
             idtst.NE.idstr(10)  .AND. idtst.NE.'STP' ) GOTO 2005
 
        ! Stop conditions
        IF ( idtst .EQ. 'STP' ) THEN
          EXIT
        ELSE
          backspace( ndsi )
        END IF
 
        ! Store data
        DO j=lbound(idstr,1), 10
          IF ( idtst .EQ. idstr(j) ) THEN
            nh(j)    = nh(j) + 1
            IF ( nh(j) .GT. nhmax ) GOTO 2006
            IF ( j .LE. 1  ) THEN ! water levels, etc. : get HA
              READ (ndsi,*) idtst,           &
                   tho(1,j,nh(j)), tho(2,j,nh(j)),            &
                   ha(nh(j),j)
            ELSE IF ( j .EQ. 2 ) THEN ! currents: get HA and HD
              READ (ndsi,*) idtst,           &
                   tho(1,j,nh(j)), tho(2,j,nh(j)),            &
                   ha(nh(j),j), hd(nh(j),j)
            ELSE IF ( j .EQ. 3 ) THEN ! wind: get HA HD and HS
              READ (ndsi,*) idtst,           &
                   tho(1,j,nh(j)), tho(2,j,nh(j)),            &
                   ha(nh(j),j), hd(nh(j),j), hs(nh(j),j)
            ELSE IF ( j .EQ. 4 ) THEN ! ice
              READ (ndsi,*) idtst,           &
                   tho(1,j,nh(j)), tho(2,j,nh(j)),            &
                   ha(nh(j),j)
            ELSE IF ( j .EQ. 5 ) THEN ! atmospheric momentum
              READ (ndsi,*) idtst,           &
                   tho(1,j,nh(j)), tho(2,j,nh(j)),            &
                   ha(nh(j),j), hd(nh(j),j)
            ELSE IF ( j .EQ. 6 ) THEN ! air density
              READ (ndsi,*) idtst,           &
                   tho(1,j,nh(j)), tho(2,j,nh(j)),            &
                   ha(nh(j),j)
            ELSE IF ( j .EQ. 10 ) THEN ! mov: HA and HD
              READ (ndsi,*) idtst,           &
                   tho(1,j,nh(j)), tho(2,j,nh(j)),            &
                   ha(nh(j),j), hd(nh(j),j)
            END IF
          END IF
        END DO
      END DO
      call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 3')
      !
#ifdef W3_O7
      DO j=jfirst, 10
        IF ( flh(j) .AND. iaproc.EQ.napout ) THEN
          WRITE (ndso,952) nh(j), idflds(j)
          DO i=1, nh(j)
            IF ( ( j .LE. 1 ) .OR. ( j .EQ. 4 ) .OR.      &
                 ( j .EQ. 6 ) ) THEN
              WRITE (ndso,953) i, tho(1,j,i), tho(2,j,i), &
                   ha(i,j)
            ELSE IF ( ( j .EQ. 2 ) .OR. ( j .EQ. 5 ) .OR. &
                 ( j .EQ. 10 ) ) THEN
              WRITE (ndso,953) i, tho(1,j,i), tho(2,j,i), &
                   ha(i,j), hd(i,j)
            ELSE IF ( j .EQ. 3 ) THEN
              WRITE (ndso,953) i, tho(1,j,i), tho(2,j,i), &
                   ha(i,j), hd(i,j), hs(i,j)
            END IF
          END DO
        END IF
      END DO
#endif
      !
      !
      IF ( ( flh(-7) .AND. (nh(-7).EQ.0) ) .OR.                     &
           ( flh(-6) .AND. (nh(-6).EQ.0) ) .OR.                     &
           ( flh(-5) .AND. (nh(-5).EQ.0) ) .OR.                     &
           ( flh(-4) .AND. (nh(-4).EQ.0) ) .OR.                     &
           ( flh(-3) .AND. (nh(-3).EQ.0) ) .OR.                     &
           ( flh(-2) .AND. (nh(-2).EQ.0) ) .OR.                     &
           ( flh(-1) .AND. (nh(-1).EQ.0) ) .OR.                     &
           ( flh(0)  .AND. (nh(0).EQ.0)  ) .OR.                     &
           ( flh(1)  .AND. (nh(1).EQ.0)  ) .OR.                     &
           ( flh(2)  .AND. (nh(2).EQ.0)  ) .OR.                     &
           ( flh(3)  .AND. (nh(3).EQ.0)  ) .OR.                     &
           ( flh(4)  .AND. (nh(4).EQ.0)  ) .OR.                     &
           ( flh(5)  .AND. (nh(5).EQ.0)  ) .OR.                     &
           ( flh(6)  .AND. (nh(6).EQ.0)  ) .OR.                     &
           ( flh(10) .AND. (nh(10).EQ.0) ) ) GOTO 2007
      !
    END IF ! FLHOM
 
  END IF
 
 
 
 
 
  !
  ! ----------------
  !
 
  ! 2.1 input fields
 
  ! 2.1.a Opening field and data files
 
  IF ( iaproc .EQ. napout ) WRITE (ndso,950)
  IF ( flflg ) THEN
    IF ( iaproc .EQ. napout ) WRITE (ndso,951)                  &
         'Preparing input files ...'
    !
 
    DO j=jfirst, 6
      IF ( inflags1(j) .AND. .NOT. flagsc(j)) THEN
        IF ( flh(j) ) THEN
          IF ( iaproc .EQ. napout ) WRITE (ndso,954) idflds(j)
        ELSE
          flagtide = 0
          CALL w3fldo ('READ', idstr(j), ndsf(j), ndst,     &
               ndsen, nx, ny, gtype,               &
               ierr, fpre=trim(fnmpre), tideflagin=flagtide )
          IF ( ierr .NE. 0 ) GOTO 2222
#ifdef W3_TIDE
          IF (flagtide.GT.0.AND.j.EQ.1) flagstide(1)=.true.
          IF (flagtide.GT.0.AND.j.EQ.2) flagstide(2)=.true.
#endif
          IF ( iaproc .EQ. napout ) WRITE (ndso,955) idflds(j)
        END IF
      ELSE
        IF ( iaproc .EQ. napout ) WRITE (ndso,954) idflds(j)
      END IF
    END DO
    !
    DO j=7, 9
      IF ( inflags1(j) .AND. .NOT. flagsc(j)) THEN
        CALL w3fldo ('READ', idstr(j), ndsf(j), ndst, ndsen, &
             rcld(j), ny, nodata(j),                 &
             ierr, fpre=trim(fnmpre) )
        IF ( ierr .NE. 0 ) GOTO 2222
        IF ( iaproc .EQ. napout ) WRITE (ndso,956) idflds(j),&
             rcld(j), nodata(j)
      ELSE
        IF ( iaproc .EQ. napout ) WRITE (ndso,954) idflds(j)
      END IF
    END DO
    !
  END IF ! FLFLG
 
  call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 4')
 
  ! 2.2 Time setup
 
  IF ( iaproc .EQ. napout ) WRITE (ndso,930)
  CALL stme21 ( time0 , dtme21 )
  IF ( iaproc .EQ. napout ) WRITE (ndso,931) dtme21
  time = time0
  CALL stme21 ( timen , dtme21 )
  IF ( iaproc .EQ. napout ) WRITE (ndso,932) dtme21
#ifdef W3_OASIS
  time00 = time0
  timeend = timen
#endif
#ifdef W3_NL5
  qi5tbeg = time0
#endif
  !
  dttst  = dsec21( time0 , timen )
  IF ( dttst .LE. 0. ) GOTO 2003
 
 
  ! 2.3 Domain setup
 
  iostyp = max( 0 , min( 3 , iostyp ) )
#ifdef W3_PDLIB
  IF (iostyp .gt. 1) THEN
    WRITE(*,*) 'IOSTYP not supported in domain decomposition mode'
    CALL extcde ( 6666 )
  ENDIF
#endif
 
  IF ( iaproc .EQ. napout ) THEN
    IF ( iostyp .EQ. 0 ) THEN
      WRITE (ndso,940) 'No dedicated output process, ' //   &
           'parallel file system required.'
    ELSE IF ( iostyp .EQ. 1 ) THEN
      WRITE (ndso,940) 'No dedicated output process, ' //   &
           'any file system.'
    ELSE IF ( iostyp .EQ. 2 ) THEN
      WRITE (ndso,940) 'Single dedicated output process.'
    ELSE IF ( iostyp .EQ. 3 ) THEN
      WRITE (ndso,940) 'Multiple dedicated output processes.'
    ELSE
      WRITE (ndso,940) 'IOSTYP NOT RECOGNIZED'
    END IF
  END IF
 
 
  ! 2.4 Output dates
 
  DO j = 1, notype
    !
    IF ( odat(5*(j-1)+3) .NE. 0 ) THEN
      IF ( iaproc .EQ. napout ) WRITE (ndso,941) j, idotyp(j)
      ttime(1) = odat(5*(j-1)+1)
      ttime(2) = odat(5*(j-1)+2)
      CALL stme21 ( ttime , dtme21 )
      IF ( iaproc .EQ. napout ) WRITE (ndso,942) dtme21
      ttime(1) = odat(5*(j-1)+4)
      ttime(2) = odat(5*(j-1)+5)
      CALL stme21 ( ttime , dtme21 )
      IF ( iaproc .EQ. napout ) WRITE (ndso,943) dtme21
      ttime(1) = 0
      ttime(2) = 0
      dttst    = real( odat(5*(j-1)+3) )
      CALL tick21 ( ttime , dttst  )
      CALL stme21 ( ttime , dtme21 )
      IF ( ( odat(5*(j-1)+1) .NE. odat(5*(j-1)+4) .OR.          &
           odat(5*(j-1)+2) .NE. odat(5*(j-1)+5) ) .AND.       &
           iaproc .EQ. napout ) THEN
        IF ( dtme21(9:9) .NE. '0' ) THEN
          WRITE (ndso,1944) dtme21( 9:19)
        ELSE IF ( dtme21(10:10) .NE. '0' ) THEN
          WRITE (ndso,2944) dtme21(10:19)
        ELSE
          WRITE (ndso,3944) dtme21(12:19)
        END IF
      END IF
    END IF
  END DO
  !
  ! CHECKPOINT
  j=8
  IF (odat(38) .NE. 0) THEN
    IF ( iaproc .EQ. napout ) WRITE (ndso,941) j, idotyp(j)
    ttime(1) = odat(5*(j-1)+1)
    ttime(2) = odat(5*(j-1)+2)
    CALL stme21 ( ttime , dtme21 )
    IF ( iaproc .EQ. napout ) WRITE (ndso,942) dtme21
    ttime(1) = odat(5*(j-1)+4)
    ttime(2) = odat(5*(j-1)+5)
    CALL stme21 ( ttime , dtme21 )
    IF ( iaproc .EQ. napout ) WRITE (ndso,943) dtme21
    ttime(1) = 0
    ttime(2) = 0
    dttst    = real( odat(5*(j-1)+3) )
    CALL tick21 ( ttime , dttst  )
    CALL stme21 ( ttime , dtme21 )
    IF ( ( odat(5*(j-1)+1) .NE. odat(5*(j-1)+4) .OR.          &
         odat(5*(j-1)+2) .NE. odat(5*(j-1)+5) ) .AND.       &
         iaproc .EQ. napout ) THEN
      IF ( dtme21(9:9) .NE. '0' ) THEN
        WRITE (ndso,1944) dtme21( 9:19)
      ELSE IF ( dtme21(10:10) .NE. '0' ) THEN
        WRITE (ndso,2944) dtme21(10:19)
      ELSE
        WRITE (ndso,3944) dtme21(12:19)
      END IF
    END IF
  END IF
  !
  ! 2.5 Output types
 
#ifdef W3_T
  WRITE (ndst,9040) odat
  WRITE (ndst,9041) flgrd
  WRITE (ndst,9042) iprt, prtfrm
#endif
 
  !
  ! For outputs with non-zero time step, check dates :
  ! If output ends before run start OR output starts after run end,
  ! deactivate output cleanly with output time step = 0
  ! This is usefull for IOSTYP=3 (Multiple dedicated output processes)
  ! to avoid the definition of dedicated proc. for unused output.
  !
  DO j = 1, notype
    dttst  = dsec21( time0 , odat(5*(j-1)+4:5*(j-1)+5) )
    IF ( dttst .LT. 0 ) THEN
      odat(5*(j-1)+3) = 0
      IF ( iaproc .EQ. napout )  WRITE (ndso,8945) trim(idotyp(j))
      CONTINUE
    END IF
    dttst  = dsec21( odat(5*(j-1)+1:5*(j-1)+2), timen )
    IF ( dttst .LT. 0 ) THEN
      odat(5*(j-1)+3) = 0
      IF ( iaproc .EQ. napout )  WRITE (ndso,8945) trim(idotyp(j))
      CONTINUE
    END IF
  END DO
  !
  ! CHECKPOINT
  j = 8
  dttst  = dsec21( time0 , odat(5*(j-1)+4:5*(j-1)+5) )
  IF ( dttst .LT. 0 ) THEN
    odat(5*(j-1)+3) = 0
    IF ( iaproc .EQ. napout )  WRITE (ndso,8945) trim(idotyp(j))
    CONTINUE
  END IF
  dttst  = dsec21( odat(5*(j-1)+1:5*(j-1)+2), timen )
  IF ( dttst .LT. 0 ) THEN
    odat(5*(j-1)+3) = 0
    IF ( iaproc .EQ. napout )  WRITE (ndso,8945) trim(idotyp(j))
    CONTINUE
  END IF
  !
  call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 5')
  !
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 5.  Initializations
  !
 
  IF ( iaproc .EQ. napout ) WRITE (ndso,951) 'Wave model ...'
  !
#ifdef W3_TIDE
  IF (flagstide(1).OR.flagstide(2)) THEN
    CALL vuf_set_parameters
    IF (flagstide(1)) CALL w3fldtide1 ( 'READ',  ndsf(1), ndst, ndsen, nx, ny, idstr(1), ierr )
    IF (flagstide(2)) CALL w3fldtide1 ( 'READ',  ndsf(2), ndst, ndsen, nx, ny, idstr(2), ierr )
  END IF
#endif
  !
#ifdef W3_COU
  ! Sent coupled fields must be written in the restart when coupling at T+0
  IF (cplt0) THEN
    DO j=1, nogrp
      flogr(j)  = flogr(j)  .OR. flg2(j)
      DO i=1, ngrpp
        flogrr(j,i) = flogrr(j,i) .OR. flgr2(j,i)
      END DO
    END DO
  ENDIF
#endif
  !
  oarst = any(flogr)
  !
  CALL w3init ( 1, .false., 'ww3', nds, ntrace, odat, flgrd, flgr2, flgd,    &
       flg2, npts, x, y, pnames, iprt, prtfrm, mpi_comm,   &
       flagstidein=flagstide )
  !
  !      IF (MINVAL(VA) .LT. 0.) THEN
  !        WRITE(740+IAPROC,*) 'NEGATIVE ACTION SHELL 5', MINVAL(VA)
  !        CALL FLUSH(740+IAPROC)
  !        CALL EXTCDE(665)
  !      ENDIF
  !      IF (SUM(VA) .NE. SUM(VA)) THEN
  !        WRITE(740+IAPROC,*) 'NAN in ACTION SHEL1', SUM(VA)
  !        CALL FLUSH(740+IAPROC)
  !        CALL EXTCDE(666)
  !      ENDIF
 
  call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 5')
  !
#ifdef W3_TIDE
  IF (flagstide(1)) CALL w3fldtide2 ( 'READ',  ndsf(1), ndst, ndsen, nx, ny, idstr(1), 1, ierr )
  IF (flagstide(2)) CALL w3fldtide2 ( 'READ',  ndsf(2), ndst, ndsen, nx, ny, idstr(2), 1, ierr )
  ALLOCATE(v_arg(170,1),f_arg(170,1),u_arg(170,1))  ! to be removed later ...
#endif
  !
  ALLOCATE ( xxx(nx,ny) )
  !
 
  !
#ifdef W3_MPI
  CALL mpi_barrier ( mpi_comm, ierr_mpi )
#endif
  !
  IF ( iaproc .EQ. napout ) THEN
    CALL date_and_time ( values=clkdt2 )
  END IF
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  !
#ifdef W3_OASIS
  ! Initialize L_MASTER, COUPL_COMM
  IF ( iaproc .EQ. 1) THEN
    l_master = .true.
  ELSE
    l_master = .false.
  ENDIF
  ! Estimate the weights for the spatial interpolation
  IF (dtout(7).NE.0) THEN
    CALL cpl_oasis_grid(l_master,mpi_comm)
    CALL cpl_oasis_define(ndso, fldin, fldout)
  END IF
#endif
 
 
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 6.  Model without input
  !
  !      IF (MINVAL(VA) .LT. 0.) THEN
  !        WRITE(740+IAPROC,*) 'NEGATIVE ACTION SHELL 6', MINVAL(VA)
  !        CALL FLUSH(740+IAPROC)
  !        CALL EXTCDE(665)
  !      ENDIF
  !      IF (SUM(VA) .NE. SUM(VA)) THEN
  !        WRITE(740+IAPROC,*) 'NAN in ACTION SHEL2', SUM(VA)
  !        CALL FLUSH(740+IAPROC)
  !        CALL EXTCDE(666)
  !      ENDIF
  call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 6')
 
  IF ( .NOT. flflg ) THEN
    !
    IF ( iaproc .EQ. napout ) WRITE (ndso,960)
    CALL w3wave ( 1, odat, timen                      &
#ifdef W3_OASIS
         , .true., .false., mpi_comm, timen     &
#endif
         )
    !
    GOTO 2222
    !
  END IF
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 7.  Model with input
  !
  IF ( iaproc .EQ. napout ) WRITE (ndso,970)
  !
 
#ifdef W3_OASIS
  ! Send coupling fields at the initial time step
  IF ( flout(7) .AND. cplt0 ) THEN
#endif
#ifdef W3_OASACM
    CALL snd_fields_to_atmos()
#endif
#ifdef W3_OASOCM
    CALL snd_fields_to_ocean()
#endif
#ifdef W3_OASICM
    CALL snd_fields_to_ice()
#endif
#ifdef W3_OASIS
  END IF
#endif
 
700 CONTINUE
  !
  !
  ! 7.a Determine next time interval and input fields
  ! 7.a.1 Preparation
  !
  ttime  = timen
  !
  CALL stme21 ( time0 , dtme21 )
  IF ( iaproc .EQ. napout ) WRITE (ndso,971) dtme21
  !
#ifdef W3_T
  WRITE (ndst,9070) '0-N', time0, ttime,           &
       idstr(-7), inflags1(-7), ti1,     &
       idstr(-6), inflags1(-6), ti2,     &
       idstr(-5), inflags1(-5), ti3,     &
       idstr(-4), inflags1(-4), ti4,     &
       idstr(-3), inflags1(-3), ti5,     &
       idstr(-2), inflags1(-2), tzn,     &
       idstr(-1), inflags1(-1), ttn,     &
       idstr(0), inflags1(0), tvn,       &
       idstr(1), inflags1(1), tln,       &
       idstr(2), inflags1(2), tc0, tcn,  &
       idstr(3), inflags1(3), tw0, twn,  &
       idstr(4), inflags1(4), tin,       &
       idstr(5), inflags1(5), tu0, tun,  &
       idstr(6), inflags1(6), tr0, trn,  &
       idstr(7), inflags1(7), t0n,       &
       idstr(8), inflags1(8), t1n,       &
       idstr(9), inflags1(9), t2n,       &
       idstr(10), inflags1(10), tg0, tgn
#endif
  !
  call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 7')
 
  DO j=jfirst,10
    !
    write(jchar, '(i0)') j
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL UPDATE '//trim(jchar))
 
    IF ( inflags1(j) ) THEN
      !
      ! 7.a.2 Check if update is needed
      !
      IF (.NOT.flagsc(j)) THEN
        ttt(1) = tfn(1,j)
        ttt(2) = tfn(2,j)
        IF ( ttt(1) .EQ. -1 ) THEN
          dttst  = 0.
        ELSE
          dttst  = dsec21( time0 , ttt )
        END IF
#ifdef W3_OASIS
      ELSE
        IF ( dtout(7).NE.0 ) THEN
          ! TFN not initialized at TIME=TIME00, using TIME instead
          IF(nint(dsec21(time00,time)) == 0) THEN
            id_oasis_time = 0
            dttst=0.
          ELSE
            id_oasis_time = nint(dsec21( time00 , tfn(:,j) ))
            IF ( mod(nint(dsec21(time00,time)), nint(dtout(7))) .EQ. 0 .AND. &
                 dsec21(tfn(:,j), timeend) .GT. 0.0 ) dttst=0.
          ENDIF
        ENDIF
#endif
      END IF
      !
#ifdef W3_T
      WRITE (ndst,9071) idstr(j), dttst
#endif
      !
      ! 7.a.3 Update time and fields / data
      !
      IF ( dttst .LE. 0. ) THEN
 
#ifdef W3_TIDE
        IF ((fllevtide .AND.(j.EQ.1)).OR.(flcurtide.AND.(j.EQ.2))) THEN
          IF ( iaproc .EQ. napout ) WRITE (ndso,974) idflds(j)
        ELSE
#endif
          IF ( iaproc .EQ. napout ) WRITE (ndso,972) idflds(j)
#ifdef W3_TIDE
        END IF
#endif
        !
        ! IC1 : (in context of IC3 & IC2, this is ice thickness)
        IF ( j .EQ. -7 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 ttt, xxx, xxx, xxx, ti1, xxx, xxx, icep1, ierr)
          ELSE
#ifdef W3_OASIS
            coupl_comm = mpi_comm
#endif
#ifdef W3_OASICM
            IF (flagsc(j)) flagsci = .true.
            IF (.NOT.flagsci) id_oasis_time = -1
#endif
            CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                 ttt, xxx, xxx, xxx, ti1, xxx, xxx, icep1,  &
                 ierr, flagsc(j)                            &
#ifdef W3_OASICM
                 , coupl_comm                       &
#endif
                 )
          END IF
          IF ( ierr .LT. 0 ) fllst_all(j) = .true.
 
          ! IC2 : (in context of IC3, this is ice viscosity)
        ELSE IF ( j .EQ. -6 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 ttt, xxx, xxx, xxx, ti2, xxx, xxx, icep2, ierr)
          ELSE
            CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                 ttt, xxx, xxx, xxx, ti2, xxx, xxx, icep2,  &
                 ierr, flagsc(j))
          END IF
          IF ( ierr .LT. 0 )fllst_all(j) = .true.
 
          ! IC3 : (in context of IC3, this is ice density)
        ELSE IF ( j .EQ. -5 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 ttt, xxx, xxx, xxx, ti3, xxx, xxx, icep3, ierr)
          ELSE
            CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                 ttt, xxx, xxx, xxx, ti3, xxx, xxx, icep3,  &
                 ierr, flagsc(j))
          END IF
          IF ( ierr .LT. 0 )fllst_all(j) = .true.
 
          ! IC4 : (in context of IC3, this is ice modulus)
        ELSE IF ( j .EQ. -4 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 ttt, xxx, xxx, xxx, ti4, xxx, xxx, icep4, ierr)
          ELSE
            CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                 ttt, xxx, xxx, xxx, ti4, xxx, xxx, icep4,  &
                 ierr, flagsc(j))
          END IF
          IF ( ierr .LT. 0 )fllst_all(j) = .true.
 
          ! IC5 : ice flow diam.
        ELSE IF ( j .EQ. -3 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 ttt, xxx, xxx, xxx, ti5, xxx, xxx, icep5, ierr)
          ELSE
#ifdef W3_OASIS
            coupl_comm = mpi_comm
#endif
#ifdef W3_OASICM
            IF (flagsc(j)) flagsci = .true.
            IF (.NOT.flagsci) id_oasis_time = -1
#endif
            CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                 ttt, xxx, xxx, xxx, ti5, xxx, xxx, icep5,  &
                 ierr, flagsc(j)                            &
#ifdef W3_OASICM
                 , coupl_comm                       &
#endif
                 )
          END IF
          IF ( ierr .LT. 0 )fllst_all(j) = .true.
 
          ! MUD1 : mud density
        ELSE IF ( j .EQ. -2 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 ttt, xxx, xxx, xxx, tzn, xxx, xxx, mudd, ierr)
          ELSE
            CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                 ttt, xxx, xxx, xxx, tzn, xxx, xxx, mudd,   &
                 ierr, flagsc(j))
          END IF
          IF ( ierr .LT. 0 )fllst_all(j) = .true.
 
          ! MUD2 : mud thickness
        ELSE IF ( j .EQ. -1 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 ttt, xxx, xxx, xxx, ttn, xxx, xxx, mudt, ierr)
          ELSE
            CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                 ttt, xxx, xxx, xxx, ttn, xxx, xxx, mudt,   &
                 ierr, flagsc(j))
          END IF
          IF ( ierr .LT. 0 )fllst_all(j) = .true.
 
          ! MUD3 : mud viscosity
        ELSE IF ( j .EQ. 0 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 ttt, xxx, xxx, xxx, tvn, xxx, xxx, mudv, ierr)
          ELSE
            CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                 ttt, xxx, xxx, xxx, tvn, xxx, xxx, mudv,   &
                 ierr, flagsc(j))
          END IF
          IF ( ierr .LT. 0 )fllst_all(j) = .true.
 
          ! LEV : water levels
        ELSE IF ( j .EQ. 1 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 ttt, xxx, xxx, xxx, tln, xxx, xxx, wlev, ierr)
          ELSE
#ifdef W3_TIDE
            IF ( fllevtide ) THEN
              ierr=0
              IF ( tln(1) .EQ. -1 ) THEN
                tln = time
              ELSE
                CALL tick21 ( tln, tide_dt )
              END IF
            ELSE
#endif
#ifdef W3_OASIS
              coupl_comm = mpi_comm
#endif
#ifdef W3_OASOCM
              IF (.NOT.flagsc(j)) id_oasis_time = -1
#endif
              CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                   ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                   ttt, xxx, xxx, xxx, tln, xxx, xxx, wlev,   &
                   ierr, flagsc(j)                            &
#ifdef W3_OASOCM
                   , coupl_comm                       &
#endif
                   )
#ifdef W3_TIDE
            END IF
#endif
          END IF
          IF ( ierr .LT. 0 ) fllstl = .true.
          !could be:    IF ( IERR .LT. 0 ) FLLST_ALL(J) = .TRUE.
 
          ! CUR : currents
        ELSE IF ( j .EQ. 2 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 tc0, cx0, cy0, xxx, tcn, cxn, cyn, xxx, ierr)
            !
#ifdef W3_SMC
            !!Li  Reshape the CX0/N CY0/N space for sea-point only current.
            !!Li              JGLi26Jun2018.
          ELSE IF( fswnd ) THEN
            CALL w3fldg ('READ', idstr(j), ndsf(j), ndst,    &
                 ndsen, nsea, 1, nsea, 1, time0, timen, tc0, &
                 cx0, cy0, xxx, tcn, cxn, cyn, xxx, ierr)
            !!Li
#endif
          ELSE
#ifdef W3_TIDE
            IF ( flcurtide ) THEN
              ierr=0
              IF ( tcn(1) .EQ. -1 ) THEN
                tcn = time
              END IF
              tc0(:) = tcn(:)
              CALL tick21 ( tcn, tide_dt )
            ELSE
#endif
#ifdef W3_OASIS
              coupl_comm = mpi_comm
#endif
#ifdef W3_OASOCM
              IF (.NOT.flagsc(j)) id_oasis_time = -1
#endif
              CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                   ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                   tc0, cx0, cy0, xxx, tcn, cxn, cyn, xxx,    &
                   ierr, flagsc(j)                            &
#ifdef W3_OASOCM
                   , coupl_comm                       &
#endif
                   )
#ifdef W3_TIDE
            END IF
#endif
          END IF
 
          ! WND : winds
        ELSE IF ( j .EQ. 3 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 tw0, wx0, wy0, dt0, twn, wxn, wyn, dtn, ierr)
            !
#ifdef W3_SMC
            !!Li  Reshape the WX0/N WY0/N space for sea-point only wind.
            !!Li              JGLi26Jun2018.
          ELSE IF( fswnd ) THEN
            CALL w3fldg ('READ', idstr(j), ndsf(j), ndst,    &
                 ndsen, nsea, 1, nsea, 1, time0, timen, tw0, &
                 wx0, wy0, dt0, twn, wxn, wyn, dtn, ierr)
            !!Li
#endif
          ELSE
#ifdef W3_OASIS
            coupl_comm = mpi_comm
#endif
#ifdef W3_OASACM
            IF (.NOT.flagsc(j)) id_oasis_time = -1
#endif
            CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                 tw0, wx0, wy0, dt0, twn, wxn, wyn, dtn,    &
                 ierr, flagsc(j)                            &
#ifdef W3_OASACM
                 , coupl_comm                       &
#endif
                 )
          END IF
 
          ! ICE : ice conc.
        ELSE IF ( j .EQ. 4 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 ttt, xxx, xxx, xxx, tin, xxx, bergi, icei, ierr)
          ELSE
#ifdef W3_OASIS
            coupl_comm = mpi_comm
#endif
#ifdef W3_OASICM
            IF (flagsc(j)) flagsci = .true.
            IF (.NOT.flagsci) id_oasis_time = -1
#endif
            CALL w3fldg ('READ', idstr(j), ndsf(j),            &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen,    &
                 ttt, xxx, xxx, xxx, tin, xxx, bergi, icei,    &
                 ierr, flagsc(j)                               &
#ifdef W3_OASICM
                 , coupl_comm                          &
#endif
                 )
            IF ( ierr .LT. 0 ) fllsti = .true.
            !could be:      IF ( IERR .LT. 0 ) FLLST_ALL(J) = .TRUE.
          END IF
 
          ! TAU : atmospheric momentum
        ELSE IF ( j .EQ. 5 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 tu0, ux0, uy0, xxx, tun, uxn, uyn, xxx, ierr)
            !
#ifdef W3_SMC
            !!Li  Reshape the UX0/N UY0/N space for sea-point only current.
            !!Li              JGLi26Jun2018.
          ELSE IF( fswnd ) THEN
            CALL w3fldg ('READ', idstr(j), ndsf(j), ndst,    &
                 ndsen, nsea, 1, nsea, 1, time0, timen, tu0, &
                 ux0, uy0, xxx, tun, uxn, uyn, xxx, ierr)
            !!Li
#endif
          ELSE
#ifdef W3_OASIS
            coupl_comm = mpi_comm
#endif
#ifdef W3_OASACM
            IF (.NOT.flagsc(j)) id_oasis_time = -1
#endif
            CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                 tu0, ux0, uy0, xxx, tun, uxn, uyn, xxx,    &
                 ierr, flagsc(j)                            &
#ifdef W3_OASACM
                 , coupl_comm                               &
#endif
                 )
          END IF
 
          ! RHO : air density
        ELSE IF ( j .EQ. 6 ) THEN
          IF ( flh(j) ) THEN
            CALL w3fldh (j, ndst, ndsen, nx, ny, nx, ny,    &
                 time0, timen, nh(j), nhmax, tho, ha, hd, hs,&
                 tr0, xxx, xxx, rh0, trn, xxx, xxx, rhn, ierr)
#ifdef W3_SMC
            !!Li  Reshape the RH0/N space for sea-point only current.
            !!Li              JGLi26Jun2018.
          ELSE IF( fswnd ) THEN
            CALL w3fldg ('READ', idstr(j), ndsf(j), ndst,    &
                 ndsen, nsea, 1, nsea, 1, time0, timen, tr0, &
                 xxx, xxx, rh0, trn, xxx, xxx, rhn, ierr)
            !!Li
#endif
          ELSE
#ifdef W3_OASIS
            coupl_comm = mpi_comm
#endif
#ifdef W3_OASACM
            IF (.NOT.flagsc(j)) id_oasis_time = -1
#endif
            CALL w3fldg ('READ', idstr(j), ndsf(j),         &
                 ndst, ndsen, nx, ny, nx, ny, time0, timen, &
                 tr0, xxx, xxx, rh0, trn, xxx, xxx, rhn,    &
                 ierr, flagsc(j)                            &
#ifdef W3_OASACM
                 , coupl_comm                               &
#endif
                 )
            IF ( ierr .LT. 0 ) fllstr = .true.
          END IF
 
          ! Assim data
        ELSE IF ( j .EQ. 7 ) THEN
          CALL w3fldd ('SIZE', idstr(j), ndsf(j), ndst,      &
               ndsen, time0, t0n, rcld(j), ndt(j),           &
               ndtnew, data0, ierr )
          IF ( ierr .LT. 0 ) THEN
            inflags1(j) = .false.
            IF ( ALLOCATED(data0) ) DEALLOCATE(data0)
          ELSE
            ndt(j) = ndtnew
            IF ( ALLOCATED(data0) ) DEALLOCATE(data0)
            ALLOCATE ( data0(rcld(j),ndt(j)) )
            CALL w3fldd ('READ', idstr(j), ndsf(j), ndst, &
                 ndsen, time0, t0n, rcld(j), ndt(j),      &
                 ndtnew, data0, ierr )
          END IF
 
          ! Assim data
        ELSE IF ( j .EQ. 8 ) THEN
          CALL w3fldd ('SIZE', idstr(j), ndsf(j), ndst,      &
               ndsen, time0, t1n, rcld(j), ndt(j),           &
               ndtnew, data1, ierr )
          IF ( ierr .LT. 0 ) THEN
            inflags1(j) = .false.
            IF ( ALLOCATED(data1) ) DEALLOCATE(data1)
          ELSE
            ndt(j) = ndtnew
            IF ( ALLOCATED(data1) ) DEALLOCATE(data1)
            ALLOCATE ( data1(rcld(j),ndt(j)) )
            CALL w3fldd ('READ', idstr(j), ndsf(j), ndst, &
                 ndsen, time0, t1n, rcld(j), ndt(j),      &
                 ndtnew, data1, ierr )
          END IF
 
          ! Assim data
        ELSE IF ( j .EQ. 9 ) THEN
          CALL w3fldd ('SIZE', idstr(j), ndsf(j), ndst,      &
               ndsen, time0, t2n, rcld(j), ndt(j),           &
               ndtnew, data2, ierr )
          IF ( ierr .LT. 0 ) THEN
            inflags1(j) = .false.
            IF ( ALLOCATED(data2) ) DEALLOCATE(data2)
          ELSE
            ndt(j) = ndtnew
            IF ( ALLOCATED(data2) ) DEALLOCATE(data2)
            ALLOCATE ( data2(rcld(j),ndt(j)) )
            CALL w3fldd ('READ', idstr(j), ndsf(j), ndst, &
                 ndsen, time0, t2n, rcld(j), ndt(j),      &
                 ndtnew, data2, ierr )
          END IF
 
          ! Track
        ELSE IF ( j .EQ. 10 ) THEN
          CALL w3fldm (4, ndst, ndsen, time0, timen, nh(4),  &
               nhmax, tho, ha, hd, tg0, ga0, gd0,         &
               tgn, gan, gdn, ierr)
        END IF
        !
        IF ( ierr.GT.0 ) GOTO 2222
        IF ( ierr.LT.0 .AND. iaproc.EQ.napout ) WRITE (ndso,973) idflds(j)
 
 
      END IF ! DTTST .LE. 0.
      !
      ! 7.a.4 Update next ending time
      !
      IF ( inflags1(j) ) THEN
        ttt    = tfn(:,j)
        dttst  = dsec21( ttt , ttime )
        IF ( dttst.GT.0. .AND. .NOT.                          &
             ( (fllstl .AND. j.EQ.1) .OR.                   &
             (fllst_all(j) .AND. j.EQ.-7) .OR.            &
             (fllst_all(j) .AND. j.EQ.-6) .OR.            &
             (fllst_all(j) .AND. j.EQ.-5) .OR.            &
             (fllst_all(j) .AND. j.EQ.-4) .OR.            &
             (fllst_all(j) .AND. j.EQ.-3) .OR.            &
             (fllst_all(j) .AND. j.EQ.-2) .OR.            &
             (fllst_all(j) .AND. j.EQ.-1) .OR.            &
             (fllst_all(j) .AND. j.EQ.0 ) .OR.            &
             (fllsti .AND. j.EQ.4) .OR.                   &
             (fllstr .AND. j.EQ.6) ) ) THEN
          ttime  = ttt
          ! notes: if model has run out beyond field input, then this line should not
          !    be reached.
        END IF
      END IF
      !
    END IF ! INFLAGSC1(J)
    !
  END DO ! J=JFIRST,10
  !
  ! update the next assimilation data time
  !
#ifdef W3_OASIS
  first_step = .false.
#endif
 
  call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 8')
 
  tdn = ttime
  CALL tick21 ( tdn, 1. )
  DO j=7, 9
    IF ( inflags1(j) ) THEN
      ttt    = tfn(:,j)
      dttst  = dsec21( ttt , tdn )
      IF ( dttst.GT.0. ) tdn = ttt
    END IF
  END DO
  !
#ifdef W3_T
  WRITE (ndst,9072) '0-N', time0, ttime,           &
       idstr(-7), inflags1(-7), ti1,     &
       idstr(-6), inflags1(-6), ti2,     &
       idstr(-5), inflags1(-5), ti3,     &
       idstr(-4), inflags1(-4), ti4,     &
       idstr(-3), inflags1(-3), ti5,     &
       idstr(-2), inflags1(-2), tzn,     &
       idstr(-1), inflags1(-1), ttn,     &
       idstr(0), inflags1(0), tvn,       &
       idstr(1), inflags1(1), tln,       &
       idstr(2), inflags1(2), tc0, tcn,  &
       idstr(3), inflags1(3), tw0, twn,  &
       idstr(4), inflags1(4), tin,       &
       idstr(5), inflags1(5), tu0, tun,  &
       idstr(6), inflags1(6), tr0, trn,  &
       idstr(7), inflags1(7), t0n,       &
       idstr(8), inflags1(8), t1n,       &
       idstr(9), inflags1(9), t2n, tdn,  &
       idstr(10), inflags1(10), tg0, tgn
#endif
  !
  IF ( iaproc .EQ. napout ) WRITE (ndso,*) ' '
  !
  ! 7.b Run the wave model for the given interval
  !
  time0  = ttime
  !
  CALL w3wave ( 1, odat, time0                                    &
#ifdef W3_OASIS
       , .true., .false., mpi_comm, timen                         &
#endif
       )
  call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 9')
  !
  ! The following lines prevents us from trying to read past the end
  ! of the files. This feature existed in v3.14.
  ! "1" is for water levels
  ! "4" is for ice concentration:
  ! "6" is for air density:
  IF ( fllstl ) inflags1(1) = .false.
  IF ( fllsti ) inflags1(4) = .false.
  IF ( fllstr ) inflags1(6) = .false.
 
  ! We include something like this for mud and ice parameters also:
  DO j=-7,0
    IF (fllst_all(j))THEN
      inflags1(j)=.false.
    END IF
  END DO
 
  !
  ! 7.c Run data assimilation at ending time
  !
  dttst  = dsec21( time , tdn )
  IF ( dttst .EQ. 0 ) THEN
    CALL stme21 ( time0 , dtme21 )
    IF ( iaproc .EQ. napout ) WRITE (ndso,975) dtme21
    !
    flgdas(1) = dsec21(time,t0n) .EQ. 0.
    flgdas(2) = dsec21(time,t1n) .EQ. 0.
    flgdas(3) = dsec21(time,t2n) .EQ. 0.
    !
    CALL w3wdas ( flgdas, rcld, ndt, data0, data1, data2 )
    !
    ! 7.d Call wave model again after data assimilation for output only
    !
    dttst  = dsec21( time , timen )
 
    IF ( dttst .EQ. 0. ) THEN
      IF ( iaproc .EQ. napout ) WRITE (ndso,*) ' '
      CALL w3wave ( 1, odat, time0                                 &
#ifdef W3_OASIS
           , .true., .false., mpi_comm, timen              &
#endif
           )
    END IF
  END IF
  !
  ! 7.e Check times
  !
  call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 10')
 
  dttst  = dsec21( time0 , timen )
  IF ( dttst .GT. 0. ) GOTO 700
  !
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  !     End of shel
  !
  GOTO 2222
  !
  ! Error escape locations
  !
2000 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1000) ierr
  CALL extcde ( 1000 )
  !
2001 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1001)
  CALL extcde ( 1001 )
  !
2002 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1002) ierr
  CALL extcde ( 1002 )
  !
2102 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1102)
  CALL extcde ( 1102 )
  !
2003 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1003)
  CALL extcde ( 1003 )
  !
2104 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1104) ierr
  CALL extcde ( 1104 )
  !
2004 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1004) ierr
  CALL extcde ( 1004 )
  !
2005 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1005) idtst
  CALL extcde ( 1005 )
  !
2006 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1006) idtst, nh(j)
  CALL extcde ( 1006 )
  !
2062 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1062) idtst
  CALL extcde ( 1062 )
  !
2007 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1007)
  CALL extcde ( 1007 )
  !
2008 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1008) ierr
  CALL extcde ( 1008 )
  !
#ifdef W3_COU
2009 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1009) odat(33), nint(dtmax)
  CALL extcde ( 1009 )
#endif
  !
2054 CONTINUE
  IF ( iaproc .EQ. naperr ) WRITE (ndse,1054)
  CALL extcde ( 1054 )
2222 CONTINUE
  !
#ifdef W3_MPI
  CALL mpi_barrier ( mpi_comm, ierr_mpi )
#endif
  !
  IF ( iaproc .EQ. napout ) THEN
    CALL date_and_time ( values=clkdt3 )
    clkfin = max(tdiff( clkdt1,clkdt2 ), 0.)
    clkfel = max(tdiff( clkdt1,clkdt3 ), 0.)
    WRITE (ndso,997) clkfin
    WRITE (ndso,998) clkfel
    IF ( ndso .NE. nds(1) ) THEN
      WRITE (nds(1),997) clkfin
      WRITE (nds(1),998) clkfel
    END IF
    WRITE (ndso,999)
  END IF
  !
#ifdef W3_NCO
  !     IF ( IAPROC .EQ. 1 ) CALL W3TAGE('WAVEFCST')
#endif
#ifdef W3_OASIS
  IF (oasised.EQ.1) THEN
    CALL cpl_oasis_finalize
  ELSE
#endif
#ifdef W3_MPI
    CALL mpi_finalize  ( ierr_mpi )
#endif
#ifdef W3_OASIS
  END IF
#endif
  !
  !
  ! Formats
  !
900 FORMAT (/15x,'      *** WAVEWATCH III Program shell ***      '/ &
       15x,'==============================================='/)
901 FORMAT ( '  Comment character is ''',a,''''/)
  !
#ifdef W3_OMPH
905 FORMAT ( '  Hybrid MPI/OMP thread support level:'/        &
       '     Requested: ', i2/                          &
       '      Provided: ', i2/ )
#endif
  !
#ifdef W3_OMPG
906 FORMAT ( '  OMP threading enabled. Number of threads: ', i3 / )
#endif
920 FORMAT (/'  Input fields : '/                                   &
       ' --------------------------------------------------')
921 FORMAT ( '       ',a,2x,a,2x,a)
922 FORMAT ( ' ' )
  !
930 FORMAT (/'  Time interval : '/                                  &
       ' --------------------------------------------------')
931 FORMAT ( '       Starting time : ',a)
932 FORMAT ( '       Ending time   : ',a/)
  !
940 FORMAT (/'  Output requests : '/                                &
       ' --------------------------------------------------'/ &
       '       ',a)
941 FORMAT (/'       Type',i2,' : ',a/                              &
       '      -----------------------------------------')
942 FORMAT ( '            From     : ',a)
943 FORMAT ( '            To       : ',a)
1944 FORMAT ( '            Interval : ', 8x,a11/)
2944 FORMAT ( '            Interval : ', 9x,a10/)
3944 FORMAT ( '            Interval : ',11x,a8/)
2945 FORMAT ( '            Point  1 : ',2f8.2,2x,a)
2955 FORMAT ( '            Point  1 : ',2(f8.1,'E3'),2x,a)
2946 FORMAT ( '              ',i6,' : ',2f8.2,2x,a)
2956 FORMAT ( '              ',i6,' : ',2(f8.1,'E3'),2x,a)
2947 FORMAT ( '            No points defined')
3945 FORMAT ( '            The file with ',a,' data is ',a,'.')
6945 FORMAT ( '            IX first,last,inc :',3i5/                 &
       '            IY first,last,inc :',3i5/                 &
       '            Formatted file    :    ',a)
8945 FORMAT ( '            output dates out of run dates : ', a,     &
       ' deactivated')
  !
950 FORMAT (/'  Initializations :'/                                 &
       ' --------------------------------------------------')
951 FORMAT ( '       ',a)
#ifdef W3_O7
952 FORMAT ( '       ',i6,2x,a)
953 FORMAT ( '          ',i6,i11.8,i7.6,3e12.4)
#endif
954 FORMAT ( '            ',a,': file not needed')
955 FORMAT ( '            ',a,': file OK')
956 FORMAT ( '            ',a,': file OK, recl =',i3,               &
       '  undef = ',e10.3)
  !
960 FORMAT (/'  Running model without input fields'/                &
       ' --------------------------------------------------'/)
  !
970 FORMAT (/'  Running model with input fields'/                   &
       ' --------------------------------------------------')
971 FORMAT (/'  Updating input at ',a)
972 FORMAT ( '     Updating ',a)
973 FORMAT ( '        Past last ',a)
#ifdef W3_TIDE
974 FORMAT ( '     Updating ',a,'using tidal constituents')
#endif
975 FORMAT (/'  Data assimmilation at ',a)
  !
997 FORMAT (/'  Initialization time :',f10.2,' s')
998 FORMAT ( '  Elapsed time        :',f10.2,' s')
  !
999 FORMAT(/'  End of program '/                                    &
       ' ===================================='/               &
       '         WAVEWATCH III Program shell '/)
  !
1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     ERROR IN OPENING INPUT FILE'/                    &
       '     IOSTAT =',i5/)
  !
1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     PREMATURE END OF INPUT FILE'/)
  !
1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     ERROR IN READING FROM INPUT FILE'/               &
       '     IOSTAT =',i5/)
  !
1102 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     LEVEL AND CURRENT ARE MIXING COUPLED AND FORCED'/&
       '     IT MUST BE FULLY COUPLED OR DISABLED '/)
  !
1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     ILLEGAL TIME INTERVAL'/)
  !
1104 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     ERROR IN OPENING POINT FILE'/                    &
       '     IOSTAT =',i5/)
  !
1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     ERROR IN READING FROM POINT FILE'/               &
       '     IOSTAT =',i5/)
  !
1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     ILLEGAL ID STRING HOMOGENEOUS FIELD : ',a/)
  !
1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     TOO MANY HOMOGENEOUS FIELDS : ',a,1x,i4/)
  !
1062 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : ***'/             &
       '     HOMOGENEOUS NAME NOT RECOGNIZED : ', a/)
  !
1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     INSUFFICIENT DATA FOR HOMOGENEOUS FIELDS'/)
  !
1008 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     ERROR IN OPENING OUTPUT FILE'/                   &
       '     IOSTAT =',i5/)
  !
#ifdef W3_COU
1009 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     COUPLING TIME STEP NOT MULTIPLE OF'/             &
       '     MODEL TIME STEP: ',i6, i6/)
#endif
  !
#ifdef W3_COU
1010 FORMAT (/' *** WAVEWATCH III WARNING IN W3SHEL : *** '/         &
       '     COUPLING TIME STEP NOT DEFINED, '/               &
       '     IT WILL BE OVERRIDEN TO DEFAULT VALUE'/          &
       '     FROM ',i6, ' TO ',i6/)
#endif
  !
1054 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/           &
       '     POINT OUTPUT ACTIVATED BUT NO POINTS DEFINED'/)
  !
  !
#ifdef W3_T
9000 FORMAT ( ' TEST W3SHEL : UNIT NUMBERS  :',12i4)
9001 FORMAT ( ' TEST W3SHEL : SUBR. TRACING :',2i4)
#endif
  !
#ifdef W3_T
9020 FORMAT ( ' TEST W3SHEL : FLAGS DEF / HOM  : ',9l2,2x,9l2)
#endif
  !
#ifdef W3_T
9040 FORMAT ( ' TEST W3SHEL : ODAT   : ',i9.8,i7.6,i7,i9.8,i7.6,  &
       4(/24x,i9.8,i7.6,i7,i9.8,i7.6) )
9041 FORMAT ( ' TEST W3SHEL : FLGRD  : ',20l2)
9042 FORMAT ( ' TEST W3SHEL : IPR, PRFRM : ',6i6,1x,l1)
#endif
  !
#ifdef W3_T
9070 FORMAT ( ' TEST W3SHEL : ',a,3x,2(i10.8,i7.6)/                &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,2(i10.8,i7.6)/                &
       '               ',a,l3,2(i10.8,i7.6)/                &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,2(i10.8,i7.6)/                &
       '               ',a,l3,2(i10.8,i7.6)/                &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,17x,(i10.8,i7.6)/             &
       '               ',a,l3,2(i10.8,i7.6))
9071 FORMAT ( ' TEST W3SHEL : ',a,', DTTST = ',e10.3)
9072 FORMAT ( ' TEST W3SHEL : ',a,3x,2(i10.8,i7.6)/               &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,2(i10.8,i7.6)/               &
       '               ',a,l3,2(i10.8,i7.6)/               &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,2(i10.8,i7.6)/               &
       '               ',a,l3,2(i10.8,i7.6)/               &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,17x,(i10.8,i7.6)/            &
       '               ',a,l3,17x,2(i10.8,i7.6)/           &
       '               ',a,l3,2(i10.8,i7.6))
#endif
  !/
  !/ End of W3SHEL ----------------------------------------------------- /
  !/
END PROGRAM w3shel