WAVEWATCH III  beta 0.0.1
Functions/Subroutines
wmwavemd Module Reference

Running the multi-grid version of WAVEWATCH III up to a given ending time for each grid. More...

Functions/Subroutines

subroutine wmwave (TEND)
 Run multi-grid version of WAVEWATCH III. More...
 
subroutine wmprnt (MDSO, NRGRD, TSYNC, GRSTAT)
 Print out action table in the log file log. mww3. More...
 
subroutine wmbcst (DATA, NR, IMOD, NMOD, ID)
 Non-blocking broadcast for integer arrays. More...
 
subroutine wmwout (IMOD, NMOD, ID)
 Non-blocking broadcast using dummy parameter to have output. More...
 

Detailed Description

Running the multi-grid version of WAVEWATCH III up to a given ending time for each grid.

Author
H. L. Tolman
Date
22-Mar-2021

Function/Subroutine Documentation

◆ wmbcst()

subroutine wmwavemd::wmbcst ( integer, dimension(nr), intent(inout)  DATA,
integer, intent(in)  NR,
integer, intent(in)  IMOD,
integer, intent(in)  NMOD,
integer, intent(in)  ID 
)

Non-blocking broadcast for integer arrays.

Non-blocking broadcast, initially for times only, but made for any integer array. Sending data from first process in the model communicator to all processes that are in the overall communicator but not in the model communicator.

Standard send and receives using defined communicator. Send form first processor in communicator.

Parameters
[in,out]DATAData to be send/received.
[in]NRSize of array.
[in]IMODModel number.
[in]NMODNumber of models.
[in]IDID number, used with NMOD for ITAG.
Author
H. L. Tolman
Date
02-Feb-2007

Definition at line 1952 of file wmwavemd.F90.

1952  !/
1953  !/ +-----------------------------------+
1954  !/ | WAVEWATCH III NOAA/NCEP |
1955  !/ | H. L. Tolman |
1956  !/ | FORTRAN 90 |
1957  !/ | Last update : 02-Feb-2007 !
1958  !/ +-----------------------------------+
1959  !/
1960  !/ 02-Feb-2007 : Origination. ( version 3.10 )
1961  !/
1962  ! 1. Purpose :
1963  !
1964  ! Non-blocking broadcast, initially for times only, but made for
1965  ! any integer array. Sending data from first process in the
1966  ! model cummunicator to all processes that are in the overall
1967  ! communicator but not in the model communicator.
1968  !
1969  ! 2. Method :
1970  !
1971  ! Standard send and receives using defined communicator. Send
1972  ! form first processor in communicator.
1973  !
1974  ! 3. Parameters :
1975  !
1976  ! Parameter list
1977  ! ----------------------------------------------------------------
1978  ! DATA I.A. I/O Data to be send/received.
1979  ! NR Int. I Size of array.
1980  ! IMOD Int. I Model number.
1981  ! NMOD Int. I Number of models.
1982  ! ID Int. I ID number, used with NMOD for ITAG.
1983  ! ----------------------------------------------------------------
1984  !
1985  ! 4. Subroutines used :
1986  !
1987  ! Name Type Module Description
1988  ! ----------------------------------------------------------------
1989  ! STRACE Sur. W3SERVMD Subroutine tracing.
1990  ! ----------------------------------------------------------------
1991  !
1992  ! 5. Called by :
1993  !
1994  ! Name Type Module Description
1995  ! ----------------------------------------------------------------
1996  ! WMWAVE Subr. WMWAVEMD Multi-grid wave model routine.
1997  ! ----------------------------------------------------------------
1998  !
1999  ! 6. Error messages :
2000  !
2001  ! 7. Remarks :
2002  !
2003  ! 8. Structure :
2004  !
2005  ! 9. Switches :
2006  !
2007  ! !/S Enable subroutine tracing.
2008  ! !/MPIT Enable test output
2009  !
2010  ! 10. Source code :
2011  !
2012  !/ ------------------------------------------------------------------- /
2013  !
2014 #ifdef W3_MPI
2015  USE wmmdatmd, ONLY: mdst, mtagb, improc, nmproc, allprc, &
2016  croot, mpi_comm_mwave
2017 #endif
2018  !
2019 #ifdef W3_S
2020  USE w3servmd, ONLY: strace
2021 #endif
2022  !
2023  IMPLICIT NONE
2024  !
2025 #ifdef W3_MPI
2026  include "mpif.h"
2027 #endif
2028  !/
2029  !/ ------------------------------------------------------------------- /
2030  !/ Parameter list
2031  !/
2032  INTEGER, INTENT(IN) :: NR, IMOD, NMOD, ID
2033  INTEGER, INTENT(INOUT) :: DATA(NR)
2034  !/
2035  !/ ------------------------------------------------------------------- /
2036  !/ Local parameters
2037  !/
2038 #ifdef W3_MPI
2039  INTEGER :: ITAG, IP, IERR_MPI, &
2040  STATUS(MPI_STATUS_SIZE)
2041 #endif
2042 #ifdef W3_S
2043  INTEGER, SAVE :: IENT = 0
2044 #endif
2045  !/
2046 #ifdef W3_S
2047  CALL strace (ient, 'WMBCST')
2048 #endif
2049  !
2050  ! -------------------------------------------------------------------- /
2051  ! 0. Initializations
2052  !
2053 #ifdef W3_MPI
2054  itag = mtagb + imod + id*nmod
2055 #endif
2056  !
2057  ! -------------------------------------------------------------------- /
2058  ! 1. Processor to send data from
2059  !
2060 #ifdef W3_MPI
2061  IF ( allprc(improc,imod) .EQ. 1 ) THEN
2062  DO ip=1, nmproc
2063  IF ( allprc(ip,imod) .EQ. 0 ) THEN
2064 #endif
2065 #ifdef W3_MPI
2066  CALL mpi_send ( DATA, nr, mpi_integer, ip-1, &
2067  itag, mpi_comm_mwave, ierr_mpi )
2068  END IF
2069  END DO
2070 #endif
2071  !
2072  ! -------------------------------------------------------------------- /
2073  ! 2. Processor to receive data at
2074  !
2075 #ifdef W3_MPI
2076  ELSE IF ( allprc(improc,imod) .EQ. 0 ) THEN
2077 #endif
2078 #ifdef W3_MPI
2079  CALL mpi_recv ( DATA, nr, mpi_integer, croot-1, itag, &
2080  mpi_comm_mwave, status, ierr_mpi )
2081 #endif
2082 
2083  !
2084  ! -------------------------------------------------------------------- /
2085  ! 3. Processor with no action
2086  !
2087 #ifdef W3_MPI
2088  END IF
2089 #endif
2090  !
2091  RETURN
2092  !
2093  ! Formats
2094  !
2095 #ifdef W3_MPIT
2096 9000 FORMAT ( ' TEST WMBCST : INPUTS :',4i4)
2097 9001 FORMAT ( ' TEST WMBCST : IMPROC, NMPROC:',2i5,' ALLPRC :')
2098 9002 FORMAT (14x,13i5)
2099 #endif
2100  !
2101 #ifdef W3_MPIT
2102 9010 FORMAT ( ' TEST WMBCST : IAPROC =',i5,' SENDING TO ',i5)
2103 #endif
2104  !
2105 #ifdef W3_MPIT
2106 9020 FORMAT ( ' TEST WMBCST : IAPROC =',i5, &
2107  ' RECEIVING FROM ',i5)
2108 #endif
2109  !
2110 #ifdef W3_MPIT
2111 9030 FORMAT ( ' TEST WMBCST : IAPROC =',i5,' NO ACTION')
2112 #endif
2113  !/
2114  !/ End of WMBCST ----------------------------------------------------- /
2115  !/

References wmmdatmd::allprc, wmmdatmd::croot, wmmdatmd::improc, include(), wmmdatmd::mdst, wmmdatmd::mpi_comm_mwave, wmmdatmd::mtagb, wmmdatmd::nmproc, and w3servmd::strace().

Referenced by wmwave().

◆ wmprnt()

subroutine wmwavemd::wmprnt ( integer, intent(in)  MDSO,
integer, intent(in)  NRGRD,
integer, dimension(2), intent(in)  TSYNC,
integer, dimension(nrgrd), intent(in)  GRSTAT 
)

Print out action table in the log file log. mww3.

Parameters
[in]MDSO
[in]NRGRDNumber of grids.
[in]TSYNCSynchronization time.
[in]GRSTATStatus array per grid.
Author
H. L. Tolman
Date
22-Feb-2005

Definition at line 1777 of file wmwavemd.F90.

1777  !/
1778  !/ +-----------------------------------+
1779  !/ | WAVEWATCH III NOAA/NCEP |
1780  !/ | H. L. Tolman |
1781  !/ | FORTRAN 90 |
1782  !/ | Last update : 22-Feb-2005 |
1783  !/ +-----------------------------------+
1784  !/
1785  !/ 22-Feb-2005 : Origination. ( version 3.07 )
1786  !/
1787  ! 1. Purpose :
1788  !
1789  ! Print out action table in the log file log.ww3m
1790  !
1791  ! 2. Method :
1792  !
1793  ! 3. Parameters :
1794  !
1795  ! Parameter list
1796  ! ----------------------------------------------------------------
1797  ! NRGRD Int. I Number of grids.
1798  ! TSYN I.A. I Synchronization time.
1799  ! GRSTAT I.A. I Status array per grid.
1800  ! ----------------------------------------------------------------
1801  !
1802  ! 4. Subroutines used :
1803  !
1804  ! Name Type Module Description
1805  ! ----------------------------------------------------------------
1806  ! STRACE Subr. W3SERVMD Subroutine tracing.
1807  ! STME21 Subr. W3TIMEMD Print date and time readable.
1808  ! ----------------------------------------------------------------
1809  !
1810  ! 5. Called by :
1811  !
1812  ! Name Type Module Description
1813  ! ----------------------------------------------------------------
1814  ! WMWAVE Subr. WMWAVEMD Multi-grid wave model routine.
1815  ! ----------------------------------------------------------------
1816  !
1817  ! 6. Error messages :
1818  !
1819  ! None.
1820  !
1821  ! 7. Remarks :
1822  !
1823  ! 8. Structure :
1824  !
1825  ! See source code.
1826  !
1827  ! 9. Switches :
1828  !
1829  ! !/S Enable subroutine tracing.
1830  ! !/T Test output.
1831  !
1832  ! 10. Source code :
1833  !
1834  !/ ------------------------------------------------------------------- /
1835 #ifdef W3_S
1836  USE w3servmd, ONLY: strace
1837 #endif
1838  USE w3timemd, ONLY: stme21
1839  !/
1840  IMPLICIT NONE
1841  !/
1842  !/ ------------------------------------------------------------------- /
1843  !/ Parameter list
1844  !/
1845  INTEGER, INTENT(IN) :: MDSO, NRGRD, TSYNC(2), GRSTAT(NRGRD)
1846  !/
1847  !/ ------------------------------------------------------------------- /
1848  !/ Local parameters
1849  !/
1850  INTEGER, PARAMETER :: IW = 15
1851  INTEGER :: I, I0, IN
1852 #ifdef W3_S
1853  INTEGER, SAVE :: IENT = 0
1854 #endif
1855  INTEGER, SAVE :: IDLAST(2)
1856  LOGICAL, SAVE :: FIRST = .true.
1857  CHARACTER(LEN=23) :: IDTIME
1858  CHARACTER(LEN=3) :: STR(IW), LNE(IW)
1859  !/
1860  !/ ------------------------------------------------------------------- /
1861  !/
1862 #ifdef W3_S
1863  CALL strace (ient, 'WMPRNT')
1864 #endif
1865  !
1866  DO i=1, iw
1867  lne(i) = '---'
1868  END DO
1869  !
1870  IF ( first ) THEN
1871  WRITE (mdso,900) nrgrd, lne, '-+'
1872  first = .false.
1873  idlast(1) = -1
1874  idlast(2) = 0
1875  ELSE
1876  backspace(mdso)
1877  END IF
1878  !
1879  CALL stme21 ( tsync, idtime )
1880  !
1881  DO i=1, min(iw,nrgrd)
1882  WRITE (str(i),'(I3)') grstat(i)
1883  END DO
1884  DO i=1+min(iw,nrgrd), iw
1885  str(i) = ' '
1886  END DO
1887  !
1888  IF ( idlast(1).EQ.tsync(1) .AND. idlast(2).EQ.tsync(2) ) THEN
1889 #ifdef W3_O11
1890  WRITE (mdso,903) str, ' |'
1891 #endif
1892  ELSE IF ( idlast(1) .EQ. tsync(1) ) THEN
1893  WRITE (mdso,902) idtime(12:19), str, ' |'
1894  ELSE
1895  WRITE (mdso,901) idtime(01:19), str, ' |'
1896  END IF
1897  idlast = tsync
1898  !
1899  IF ( nrgrd .GT. iw ) THEN
1900  i0 = 1
1901  in = iw
1902  DO
1903  i0 = i0 + iw
1904  in = in + iw
1905  DO i=i0, min(in,nrgrd)
1906  WRITE (str(i-i0+1),'(I3)') grstat(i)
1907  END DO
1908  DO i=1+min(in,nrgrd), in
1909  str(i-i0+1) = ' '
1910  END DO
1911  WRITE (mdso,903) str, ' |'
1912  IF ( in .GE. nrgrd ) EXIT
1913  END DO
1914  END IF
1915  !
1916  WRITE (mdso,904) lne, '-+'
1917  !
1918  RETURN
1919  !
1920  ! Formats
1921  !
1922 900 FORMAT (1x,' Time (sync rank 1) | Status for',i3,' grids'/ &
1923  1x,'---------------------+',16a)
1924 901 FORMAT (2x,a19,' |',16a)
1925 902 FORMAT (2x,11x,a8,' |',16a)
1926 903 FORMAT (21x,' |',16a)
1927 904 FORMAT (1x,'---------------------+',16a)
1928  !/
1929  !/ End of WMPRNT ----------------------------------------------------- /
1930  !/

References w3timemd::stme21(), and w3servmd::strace().

Referenced by wmwave().

◆ wmwave()

subroutine wmwavemd::wmwave ( integer, dimension(2,nrgrd), intent(in)  TEND)

Run multi-grid version of WAVEWATCH III.

Parameters
[in]TENDEnding time for calculations for each grid.
Author
H. L. Tolman
Date
22-Mar-2021

Definition at line 91 of file wmwavemd.F90.

91  !/
92  !/ +-----------------------------------+
93  !/ | WAVEWATCH III NOAA/NCEP |
94  !/ | H. L. Tolman |
95  !/ | FORTRAN 90 |
96  !/ | Last update : 22-Mar-2021 |
97  !/ +-----------------------------------+
98  !/
99  !/ 13-Jun-2005 : Origination. ( version 3.07 )
100  !/ 30-Jan-2006 : Add static nesting. ( version 3.08 )
101  !/ 25-May-2006 : Add overlapping grids. ( version 3.09 )
102  !/ 09-Aug-2006 : Unified point output added. ( version 3.10 )
103  !/ 22-Dec-2006 : Final algorith changes for tests. ( version 3.10 )
104  !/ 25-Jan-2007 : Tweaking algorithm. ( version 3.10 )
105  !/ 02-Feb-2007 : Replacing MPI_BCAST with WMBCST. ( version 3.10 )
106  !/ 07-Feb-2007 : Reintroduce pre-fetching. ( version 3.10 )
107  !/ 10-May-2007 : Removing / streamlining WMBCST. ( version 3.11 )
108  !/ 21-Jun-2007 : Dedicated output processes. ( version 3.11 )
109  !/ 20-Sep-2007 : Fix reset of GRSTAT in 0.b ( version 3.13 )
110  !/ 20-Aug-2010 : Fix MAPSTA/MAPST2 bug sec. 9.a. ( version 3.14.6 )
111  !/ 12-Mar-2012 : Use MPI_COMM_NULL for checks. ( version 3.14 )
112  !/ 28-Jan-2014 : Add memory hwm to profiling. ( version 5.00 )
113  !/ 22-Mar-2021 : Support for air density input ( version 7.13 )
114  !/
115  ! 1. Purpose :
116  !
117  ! Run multi-grid version of WAVEWATCH III.
118  !
119  ! 2. Method :
120  !
121  ! See manual.
122  !
123  ! 3. Parameters :
124  !
125  ! Parameter list
126  ! ----------------------------------------------------------------
127  ! TEND I.A. I Ending time for calculations for each grid.
128  ! ----------------------------------------------------------------
129  !
130  ! Local variables
131  ! ----------------------------------------------------------------
132  ! J Int. Group counter.
133  ! JJ Int. Grid in group counter.
134  ! I Int. Grid counter.
135  ! ----------------------------------------------------------------
136  !
137  ! 4. Subroutines used :
138  !
139  ! Name Type Module Description
140  ! ----------------------------------------------------------------
141  ! W3SETG Subr W3GDATMD Point to grid/model.
142  ! W3SETW Subr W3WDATMD Point to grid/model.
143  ! W3SETA Subr W3ADATMD Point to grid/model.
144  ! W3SETO Subr W3ODATMD Point to grid/model.
145  ! W3IOPE Subr W3IOPOMD Extracting point output.
146  ! W3WAVE Subr W3WAVEMD Actual ave model routine.
147  ! STRACE Subr W3SERVMD Subroutine tracing.
148  ! EXTCDE Subr Id. Abort program with exit code.
149  ! WWTIME Subr Id. System time in readable format.
150  ! PRTIME Subr Id. Profiling routine ( !/MPRF )
151  ! STME21 Subr W3TIMEMD Print date and time readable.
152  ! DSEC21 Func Id. Difference between times.
153  ! TICK21 Subr Id. Advance time.
154  ! WMSETM Subr WMMDATMD Point to grid/model.
155  ! WMUPDT Subr WMUPDTMD Update input fields at driver level.
156  ! WMIOBG Subr WMINIOMD Gather staged boundary data.
157  ! WMIOBS Subr Id. Stage boundary data.
158  ! WMIOBF Subr Id. Finalize WMIOBS. ( !/MPI )
159  ! WMIOHS Subr Id. Stage high-to-low data.
160  ! WMIOHG Subr Id. Gather staged high-to-low data.
161  ! WMIOHF Subr Id. Finalize WMIOHS. ( !/MPI )
162  ! WMIOES Subr Id. Stage same-rank data.
163  ! WMIOEG Subr Id. Gather staged same-rank data.
164  ! WMIOEF Subr Id. Finalize WMIOES. ( !/MPI )
165  ! WMIOPO Subr WMIOPOMD Unified point output.
166  ! ----------------------------------------------------------------
167  !
168  ! 5. Called by :
169  !
170  ! Name Type Module Description
171  ! ----------------------------------------------------------------
172  ! W3MLTI Prog. N/A Multi-grid model driver.
173  ! .... Any coupled model.
174  ! ----------------------------------------------------------------
175  !
176  ! 6. Error messages :
177  !
178  ! See formats 1000 and following, or escape locations 2000 and
179  ! following.
180  !
181  ! 7. Remarks :
182  !
183  ! - If no action is taken in the endless loop, an error is
184  ! assumed (code 2099). This should never take place in the
185  ! default driver, but may be a problem in a coupled model.
186  ! - If output is requested for the initial model time, TSYNC
187  ! is set to TIME instead of (-1,0) for GRSTAT = 0. In this case
188  ! input is updated, after which GRSTAT is set to 6 instead
189  ! of 1. This assures that restarts do not impact model results
190  ! by spurious double reconciliations.
191  !
192  ! 8. Structure :
193  !
194  ! See source code and manual.
195  !
196  ! 9. Switches :
197  !
198  ! !/S Enable subroutine tracing.
199  ! !/T Enable test output.
200  ! !/MPIT Enable test output (use with !/MPI only).
201  ! !/MPRF Profiling.
202  !
203  ! !/SHRD, !/DIST, !/MPI
204  ! Shared / distributed program model.
205  !
206  ! 10. Source code :
207  !
208  !/ ------------------------------------------------------------------- /
209  USE constants
210  !/
211  USE w3gdatmd, ONLY: w3setg
212  USE w3wdatmd, ONLY: w3setw
213  USE w3adatmd, ONLY: w3seta
214  USE w3odatmd, ONLY: w3seto, notype
215  USE w3iopomd, ONLY: w3iope
216  USE w3wavemd, ONLY: w3wave
217  USE w3servmd, ONLY: extcde, wwtime
218 #ifdef W3_S
219  USE w3servmd, ONLY: strace
220 #endif
221 #ifdef W3_MPRF
222  USE w3timemd, ONLY: prtime
223 #endif
224  USE w3timemd, ONLY: dsec21, stme21, tick21
225  USE wmmdatmd, ONLY: wmsetm
226  USE wmupdtmd, ONLY: wmupdt
227  USE wminiomd, ONLY: wmiobg, wmiobs, wmiobf, wmiohg, wmiohs, &
228  wmiohf, wmioeg, wmioes, wmioef
229  USE wmiopomd, ONLY: wmiopo
230  !/
231  USE w3gdatmd, ONLY: dtmax, nx, ny, mapsta, mapst2
232  USE w3wdatmd, ONLY: time, va
233  USE w3odatmd, ONLY: flout, tonext, dtout, tolast, iaproc, &
234  nappnt, nopts, unipts
235 #ifdef W3_MPI
236  USE w3odatmd, ONLY: nrqpo, irqpo1
237 #endif
238  USE w3idatmd, ONLY: inflags1
239  USE wmmdatmd, ONLY: mdso, mdss, mdst, mdse, improc, &
240  nmproc, nmpscr, nmperr, nmptst, nmplog, &
241  stime, etime, nmv, tmv, amv, dmv, &
242  nrgrd, nrgrp, grank, ingrp, grdhgh, grdeql, &
243  grdlow, tsync, tmax, toutp, tdata, grstat, &
244  fllstl, fllsti, fllstr, dtres, flghg1, &
245  flghg2, mapmsk
246 #ifdef W3_MPI
247  USE wmmdatmd, ONLY: mpi_comm_mwave, mpi_comm_grd, &
248  mpi_comm_bct, croot, fbcast
249 #endif
250 #ifdef W3_MPRF
251  USE wmmdatmd, ONLY: mdsp
252 #endif
253  !/
254  IMPLICIT NONE
255  !
256 #ifdef W3_MPI
257  include "mpif.h"
258 #endif
259  !/
260  !/ ------------------------------------------------------------------- /
261  !/ Parameter list
262  !/
263  INTEGER, INTENT(IN) :: TEND(2,NRGRD)
264  !/
265  !/ ------------------------------------------------------------------- /
266  !/ Local parameters
267  !/
268  INTEGER :: J, JJ, I, JO, TPRNT(2), TAUX(2), &
269  II, JJJ, IX, IY, UPNEXT(2), UPLAST(2)
270  INTEGER :: DUMMY2(35)=0
271 #ifdef W3_T
272  INTEGER :: ILOOP
273 #endif
274 #ifdef W3_S
275  INTEGER, SAVE :: IENT = 0
276 #endif
277 #ifdef W3_MPI
278  INTEGER :: IERR_MPI, NMPSCS
279  INTEGER, ALLOCATABLE :: STATUS(:,:)
280 #endif
281  REAL :: DTTST, DTMAXI
282 #ifdef W3_MPRF
283  REAL :: PRFT0, PRFTN, PRFTS
284  REAL(KIND=8) :: get_memory
285 #endif
286  CHARACTER(LEN=8) :: WTIME
287  CHARACTER(LEN=23) :: MTIME
288  LOGICAL :: DONE, TSTAMP, FLAGOK, DO_UPT, &
289  FLG_O1, FLG_O2
290 #ifdef W3_MPI
291  LOGICAL :: FLAG
292 #endif
293  LOGICAL, ALLOCATABLE :: FLSYNC(:), GRSYNC(:), TMSYNC(:), &
294  FLEQOK(:)
295 #ifdef W3_MPI
296  LOGICAL, ALLOCATABLE :: PREGTB(:), PREGTH(:), PREGTE(:)
297 #endif
298  !/
299  !/ ------------------------------------------------------------------- /
300  !
301 #ifdef W3_S
302  CALL strace (ient, 'WMWAVE')
303 #endif
304  !
305 #ifdef W3_MPRF
306  CALL prtime ( prft0 )
307 #endif
308  !
309 #ifdef W3_O10
310  IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,900)
311 #endif
312  !
313  ! 0. Initializations ------------------------------------------------ /
314  ! 0.a Initial testing
315  ! Test GRSTAT
316  !
317  DO i=1, nrgrd
318  IF ( ( grstat(i).LT.0 .OR. grstat(i).GT.7 ) .AND. &
319  grstat(i).NE.99 ) GOTO 2000
320  !
321  ! Consistency of times for grids
322  !
323  IF ( tsync(1,i) .NE. -1 ) THEN
324  dttst = dsec21( tsync(:,i), tend(:,i) )
325  IF ( dttst .LT. 0. ) GOTO 2001
326  END IF
327  END DO
328  !
329  ! Consistency of times within groups, set global TSYNC(:,0)
330  !
331  DO j=1, nrgrp
332  DO jj=2, ingrp(j,0)
333  IF ( dsec21(tsync(:,ingrp(j,1)),tsync(:,ingrp(j,jj))).NE.0. &
334  .OR. dsec21(tend(:,ingrp(j,1)),tend(:,ingrp(j,jj))).NE.0. ) &
335  GOTO 2002
336  END DO
337  IF ( grank(ingrp(j,1)).EQ.1 .AND. tsync(1,0).EQ.-1 ) &
338  tsync(:,0) = tsync(:,ingrp(j,1))
339  END DO
340  !
341  ! Check if FLSYNC initialized
342  !
343  IF ( .NOT. ALLOCATED(flsync) ) THEN
344  ALLOCATE ( flsync(nrgrd), grsync(nrgrp), tmsync(nrgrd), &
345  fleqok(nrgrd) )
346 #ifdef W3_MPI
347  ALLOCATE ( pregtb(nrgrd), pregth(nrgrd), pregte(nrgrd) )
348 #endif
349  flsync = .false.
350  grsync = .false.
351  tmsync = .true.
352  fleqok = .false.
353 #ifdef W3_MPI
354  pregtb = .false.
355  pregth = .false.
356  pregte = .false.
357 #endif
358  END IF
359  !
360  ! 0.b Reset GRSTAT as needed
361  !
362  DO i=1, nrgrd
363  CALL w3setw ( i, mdse, mdst )
364  dttst = dsec21( time, tend(:,i) )
365  IF ( grstat(i).EQ.99 .AND. dttst.GT.0. ) grstat(i) = 0
366  END DO
367  !
368  ! 0.c Other initializations
369  !
370  dtres = 0.
371 #ifdef W3_MPI
372  nmpscs = nmpscr
373 #endif
374  !
375  IF ( unipts ) THEN
376  CALL w3seto ( 0, mdse, mdst )
377  upnext = tonext(:,2)
378  uplast = tolast(:,2)
379  do_upt = .true.
380  ELSE
381  upnext(1) = -1
382  upnext(2) = 0
383  do_upt = .false.
384  END IF
385  !
386  ! 0.d Output
387  !
388  IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN
389  CALL wmprnt ( mdso, nrgrd, tsync(:,0), grstat )
390  CALL stme21 ( tsync(:,0), mtime )
391  CALL wwtime ( wtime )
392  WRITE (mdss,901) mtime, wtime, minval(grstat), maxval(grstat)
393  tprnt = tsync(:,0)
394  tstamp = .true.
395  ENDIF
396  !
397 #ifdef W3_MPI
398  CALL mpi_barrier (mpi_comm_mwave,ierr_mpi)
399 #endif
400  !
401 #ifdef W3_MPRF
402  CALL prtime ( prftn )
403  WRITE (mdsp,990) prft0, prftn, get_memory()
404 #endif
405  !
406  ! 1. Setting up loop structure -------------------------------------- /
407  !
408 #ifdef W3_T
409  iloop = 0
410 #endif
411  !
412  loop_outer: DO
413  !
414  IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc .AND. &
415  dsec21(tprnt,tsync(:,0)).NE.0. ) THEN
416  IF ( .NOT. tstamp ) WRITE (mdss,*)
417  CALL wmprnt ( mdso, nrgrd, tsync(:,0), grstat )
418  CALL stme21 ( tsync(:,0), mtime )
419  CALL wwtime ( wtime )
420  WRITE (mdss,901) mtime, wtime, minval(grstat), maxval(grstat)
421 
422  !
423  tprnt = tsync(:,0)
424  tstamp = .true.
425  ENDIF
426  !
427 #ifdef W3_T
428  iloop = iloop + 1
429  WRITE (mdst,9000) iloop, tsync(:,0)
430  DO i=1, nrgrd
431  CALL w3setw ( i, mdse, mdst )
432  WRITE (mdst,9001) i, grstat(i), time, tsync(:,i), tend(:,i)
433  END DO
434  IF ( iloop .EQ. -1 ) CALL extcde ( 508 )
435 #endif
436  !
437  done = .false.
438  tprnt = tsync(:,0)
439  !
440  loop_j: DO j=1, nrgrp
441  !
442 #ifdef W3_MPI
443  grsync(j) = .false.
444  DO jj=1, ingrp(j,0)
445  i = ingrp(j,jj)
446  CALL wmsetm ( i, mdse, mdst )
447  grsync(j) = grsync(j) .OR. fbcast
448  END DO
449 #endif
450  !
451  loop_jj: DO jj=1, ingrp(j,0)
452  i = ingrp(j,jj)
453  CALL wmsetm ( i, mdse, mdst )
454  !
455 #ifdef W3_MPI
456  IF ( grstat(i).EQ.0 ) tmsync(i) = .NOT. fbcast
457  IF ( fbcast ) THEN
458  nmpscr = croot
459  ELSE
460  nmpscr = nmpscs
461  END IF
462 #endif
463  !
464  ! 2. Update input fields -------------------------------------------- /
465  ! ( GRSTAT = 0 )
466  !
467  ! 2.a Check TDATA and finish step if data is still OK
468  !
469 #ifdef W3_SHRD
470  IF ( grstat(i) .EQ. 0 ) THEN
471 #endif
472 #ifdef W3_MPI
473  IF ( grstat(i).EQ.0 .AND. .NOT.flsync(i) ) THEN
474 #endif
475  !
476 #ifdef W3_T
477  WRITE (mdst,9002) i, grstat(i), ' '
478 #endif
479  !
480  IF ( tdata(1,i) .EQ. -1 ) THEN
481  dttst = 0.
482  ELSE
483  CALL w3setw ( i, mdse, mdst )
484  dttst = dsec21( time , tdata(:,i) )
485  END IF
486 #ifdef W3_T
487  WRITE (mdst,9020) dttst
488 #endif
489  !
490  IF ( dttst .GT. 0. ) THEN
491  grstat(i) = 1
492 #ifdef W3_T
493  WRITE (mdst,9003) i, grstat(i)
494 #endif
495  done = .true.
496  END IF
497  !
498 #ifdef W3_MPI
499  END IF ! IF ( GRSTAT(I).EQ.0 .AND. .NOT.FLSYNC(I)
500 #endif
501 #ifdef W3_SHRD
502  END IF ! IF ( GRSTAT(I) .EQ. 0 )
503 #endif
504  !
505  ! 2.b Update input and TDATA
506  !
507 #ifdef W3_SHRD
508  IF ( grstat(i) .EQ. 0 ) THEN
509 #endif
510 #ifdef W3_MPI
511  IF ( grstat(i).EQ.0 .AND. .NOT.flsync(i) .AND. &
512  mpi_comm_grd .NE. mpi_comm_null ) THEN
513 #endif
514  !
515 #ifdef W3_MPRF
516  CALL prtime ( prft0 )
517 #endif
518  IF ( dttst .LE. 0 ) THEN
519  IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) &
520  WRITE (mdss,*)
521  tstamp = .false.
522  CALL wmupdt ( i, tdata(:,i) )
523 #ifdef W3_T
524  WRITE (mdst,9021) time, tdata(:,i), tend(:,i)
525 #endif
526  END IF
527  !
528  ! 2.c Finish up if possible ( !/SHRD or .NOT. FBCAST or no update )
529  !
530 #ifdef W3_SHRD
531  grstat(i) = 1
532  done = .true.
533 #endif
534  !
535 #ifdef W3_MPI
536  IF ( .NOT. grsync(j) ) THEN
537 #endif
538 #ifdef W3_MPIT
539  WRITE (mdst,9902) i, grstat(i), &
540  'NO SYNC FOR TDATA NEEDED'
541 #endif
542 #ifdef W3_MPI
543  grstat(i) = 1
544  done = .true.
545  END IF ! IF ( .NOT. GRSYNC(J) )
546 #endif
547  !
548 #ifdef W3_MPRF
549  CALL prtime ( prftn )
550  WRITE (mdsp,991) prft0, prftn, get_memory(), &
551  'ST00', i
552 #endif
553  !
554 #ifdef W3_MPI
555  END IF ! IF ( GRSTAT(I).EQ.0 .AND. .NOT.FLSYNC(I) .AND. MPI_COMM_GRD .NE. MPI_COMM_NULL )
556 #endif
557 #ifdef W3_SHRD
558  END IF ! IF ( GRSTAT(I) .EQ. 0 )
559 #endif
560  !
561  ! 2.d Synchronize in parts ( !/MPI )
562  !
563 #ifdef W3_MPI
564  IF ( grstat(i).EQ.0 .AND. grsync(j) ) THEN
565  done = .true.
566 #endif
567  !
568 #ifdef W3_MPI
569  IF ( flsync(i) ) THEN
570 #endif
571 #ifdef W3_MPIT
572  WRITE (mdst,9902) i, grstat(i), &
573  'SYNCING TDATA'
574 #endif
575 #ifdef W3_MPRF
576  IF (flsync(i)) CALL prtime ( prft0 )
577 #endif
578 #ifdef W3_MPI
579  IF ( fbcast ) CALL wmbcst &
580  ( tdata(1,i), 2, i, nrgrd, 1 )
581 #endif
582 #ifdef W3_MPRF
583  IF (flsync(i)) CALL prtime ( prftn )
584  IF (flsync(i)) WRITE (mdsp,991) &
585  prft0, prftn, get_memory(), 'BCST',i
586 #endif
587 #ifdef W3_MPIT
588  WRITE (mdst,9902) i, grstat(i), 'SYNCING DONE'
589 #endif
590 #ifdef W3_MPI
591  grstat(i) = 1
592  flsync(i) = .false.
593  IF ( grsync(j) ) cycle loop_jj
594  ELSE
595 #endif
596 #ifdef W3_MPIT
597  WRITE (mdst,9902) i, grstat(i), &
598  'CYCLE BEFORE SYNCING TDATA'
599 #endif
600 #ifdef W3_MPI
601  flsync(i) = .true.
602  cycle loop_jj
603  END IF ! IF ( FLSYNC(I) )
604 #endif
605  !
606 #ifdef W3_MPI
607  END IF ! IF ( GRSTAT(I).EQ.0 .AND. GRSYNC(J)
608 #endif
609  !
610  ! 3. Update data from lower ranked grids ---------------------------- /
611  ! ( GRSTAT = 1 )
612  !
613  ! 3.a Skip for initial output only
614  !
615  IF ( grstat(i) .EQ. 1 .AND. tsync(1,i) .NE. -1 ) THEN
616 #ifdef W3_T
617  WRITE (mdst,9002) i, grstat(i), 'FIRST PART'
618 #endif
619  CALL w3setw ( i, mdse, mdst )
620  dttst = dsec21( time, tsync(:,i) )
621  IF ( dttst .EQ. 0. ) THEN
622  grstat(i) = 7
623 #ifdef W3_T
624  WRITE (mdst,9003) i, grstat(i)
625 #endif
626  done = .true.
627  END IF
628  END IF ! IF ( GRSTAT(I) .EQ. 1 .AND. TSYNC(1,I) .NE. -1 )
629  !
630  ! 3.b Normal processing
631  !
632 
633  IF ( grstat(i) .EQ. 1 ) THEN
634 #ifdef W3_T
635  WRITE (mdst,9002) i, grstat(i), 'SECOND PART'
636 #endif
637 #ifdef W3_MPRF
638  CALL prtime ( prft0 )
639 #endif
640  !
641  ! 3.b.1 Test if data is there
642  !
643  flagok = .true.
644  CALL w3setw ( i, mdse, mdst )
645  taux = time
646  DO jjj=1, grdlow(i,0)
647  CALL w3setw ( grdlow(i,jjj), mdse, mdst )
648  flagok = flagok .AND. dsec21(taux,time).GT.0. &
649  .AND. grstat(grdlow(i,jjj)).EQ.5
650  END DO
651  CALL w3setw ( i, mdse, mdst )
652  !
653 #ifdef W3_T
654  WRITE (mdst,9004) flagok
655 #endif
656  !
657  ! 3.b.1 Get the data
658  !
659 #ifdef W3_MPI
660  IF ( .NOT.flagok .AND. .NOT.pregtb(i) ) THEN
661  IF ( mpi_comm_grd.NE.mpi_comm_null ) &
662  CALL wmiobg (i,flag)
663  pregtb(i) = .true.
664  END IF
665 #endif
666  !
667  IF ( flagok ) THEN
668 #ifdef W3_SHRD
669  CALL wmiobg ( i, flagok )
670 #endif
671 #ifdef W3_MPI
672  IF ( mpi_comm_grd.NE.mpi_comm_null ) &
673  CALL wmiobg ( i )
674  pregtb(i) = .false.
675 #endif
676  grstat(i) = 2
677  done = .true.
678  END IF ! IF ( FLAGOK )
679  !
680 #ifdef W3_MPRF
681  CALL prtime ( prftn )
682  WRITE (mdsp,991) prft0, prftn, get_memory(), &
683  'ST01', i
684 #endif
685  END IF ! IF ( GRSTAT(I) .EQ. 1 )
686  !
687  ! 4. Update model time step ----------------------------------------- /
688  ! ( GRSTAT = 2 )
689  !
690  IF ( grstat(i) .EQ. 2 ) THEN
691 #ifdef W3_T
692  WRITE (mdst,9002) i, grstat(i), ' '
693 #endif
694 #ifdef W3_MPRF
695  CALL prtime ( prft0 )
696 #endif
697  !
698  ! 4.a Check TMAX and update as necessary ( needs !/MPI synchronizaion )
699  !
700  CALL w3setw ( i, mdse, mdst )
701  IF ( tmax(1,i) .EQ. -1 ) THEN
702  tmax(:,i) = time
703  dttst = 0.
704  ELSE
705  dttst = dsec21(time,tmax(:,i))
706  END IF
707  !
708  IF ( dttst .LE. 0 ) THEN
709  CALL w3setg ( i, mdse, mdst )
710  dtmaxi = real(nint(dtmax+dtres(i)+0.0001))
711  dtres(i)= dtres(i)+ dtmax - dtmaxi
712  IF ( abs(dtres(i)) .LT. 0.001 ) dtres(i) = 0.
713  tmax(:,i) = time
714  CALL tick21 ( tmax(:,i), dtmaxi )
715  taux = tmax(:,i)
716  IF ( tdata(1,i) .NE. -1 ) THEN
717  IF ( dsec21(tdata(:,i),tmax(:,i)) .GT. 0 ) &
718  tmax(:,i) = tdata(:,i)
719  END IF
720  IF ( toutp(1,i) .NE. -1 ) THEN
721  IF ( dsec21(toutp(:,i),tmax(:,i)) .GT. 0 ) &
722  tmax(:,i) = toutp(:,i)
723  END IF
724  IF ( unipts ) THEN
725  IF ( dsec21(upnext,tmax(:,i)) .GT. 0 ) &
726  tmax(:,i) = upnext(:)
727  END IF
728 #ifdef W3_T
729  WRITE (mdst,9040) tmax(:,i), dtres(i), taux, &
730  tdata(:,i), toutp(:,i), upnext
731 #endif
732  done = .true.
733  cycle loop_jj
734 #ifdef W3_T
735  ELSE
736  WRITE (mdst,9041) tmax(:,i)
737 #endif
738  END IF ! IF ( DTTST .LE. 0 )
739  !
740  ! 4.b Lowest ranked grids, minimum of all TMAXes
741  !
742 #ifdef W3_T
743  WRITE (mdst,9042) grank(i)
744 #endif
745  !
746  IF ( grank(i) .EQ. 1 ) THEN
747  !
748  taux = tmax(:,i)
749  flagok = .true.
750  !
751  ! 4.b.1 Check if all grids have reached previous sync point
752  !
753  DO ii=1, nrgrd
754  CALL w3setw ( ii, mdse, mdst )
755 #ifdef W3_SHRD
756  IF ( time(1) .NE. -1 ) THEN
757 #endif
758 #ifdef W3_MPI
759  IF ( time(1).NE.-1 .AND. &
760  mpi_comm_grd.NE.mpi_comm_null ) THEN
761 #endif
762  IF ( dsec21(time,tsync(:,0)) .NE. 0 ) THEN
763  flagok = .false.
764  EXIT
765  END IF
766 #ifdef W3_MPI
767  END IF ! IF ( TIME(1).NE.-1 .AND. MPI_COMM_GRD.NE.MPI_COMM_NULL )
768 #endif
769 #ifdef W3_SHRD
770  END IF ! IF ( TIME(1) .NE. -1 ) THEN
771 #endif
772  END DO
773  !
774  ! 4.b.2 Check availability of data
775  !
776  DO ii=1, nrgrd
777  IF ( grank(ii) .EQ. 1 ) THEN
778  IF ( tmax(1,ii) .EQ. -1 ) THEN
779  flagok = .false.
780  EXIT
781  ELSE
782  IF ( dsec21(taux,tmax(:,ii)) .LT. 0. ) &
783  taux = tmax(:,ii)
784  END IF
785  END IF
786  END DO
787  !
788  CALL w3setw ( i, mdse, mdst )
789  flagok = flagok .AND. dsec21(time,taux).GT.0.
790  !
791  ! 4.b.3 Update TSYNC for all grids
792  !
793  IF ( flagok ) THEN
794  !
795  tsync(:,0) = taux
796  do_upt = .true.
797  DO ii=1, nrgrd
798  IF ( grank(ii) .EQ. 1 ) THEN
799  tsync(:,ii) = taux
800  IF ( grstat(ii) .EQ. 2 ) grstat(ii) = 3
801 #ifdef W3_T
802  IF ( grstat(ii) .EQ. 3 ) &
803  WRITE (mdst,9003) ii, grstat(ii)
804 #endif
805  END IF
806  END DO
807  done = .true.
808 #ifdef W3_MPRF
809  CALL prtime ( prfts )
810  WRITE (mdsp,992) prfts, prfts, &
811  get_memory(), 'TIME', tsync(:,0)
812 #endif
813  !
814  ! 4.b.4 Output
815  !
816 #ifdef W3_T
817  WRITE (mdst,9043) tsync(:,0)
818  WRITE (mdst,9045)
819  WRITE (mdst,9046) (ii,tsync(:,ii),ii=0,nrgrd)
820 #endif
821  !
822  ! 4.b.5 Skip computations so that all grids start processing
823  ! simultaneously.
824  !
825 #ifdef W3_MPRF
826  CALL prtime ( prftn )
827  WRITE (mdsp,991) prft0, prftn, &
828  get_memory(), 'ST02', i
829 #endif
830 #ifdef W3_T
831  IF ( ingrp(j,0) .GT. 1 ) WRITE (mdst,9006)
832 #endif
833  IF ( ingrp(j,0) .GT. 1 ) GOTO 1111
834  !
835  END IF ! IF ( FLAGOK )
836  !
837  ! 4.c Other grids, logical from relations and TMAXes
838  !
839  ELSE IF ( tsync(1,0) .NE. -1 ) THEN
840  !
841  taux = tsync(:,0)
842  flagok = .true.
843  !
844  ! 4.c.1 Check availability of data within group
845  ! Time within group needs to be the same for load balancing.
846  !
847  DO jjj=1, ingrp(j,0)
848  ii = ingrp(j,jjj)
849  IF ( tmax(1,ii) .EQ. -1 ) THEN
850  flagok = .false.
851  EXIT
852  ELSE
853  IF ( dsec21(taux,tmax(:,ii)) .LT. 0. ) &
854  taux = tmax(:,ii)
855  END IF
856  END DO
857  !
858  ! 4.c.2 Check with dependent lower rank grids ( TSYNC )
859  !
860  DO jjj=1, grdlow(i,0)
861  ii = grdlow(i,jjj)
862  IF ( tsync(1,ii) .EQ. -1 ) THEN
863  flagok = .false.
864  EXIT
865  ELSE
866  IF ( dsec21(taux,tsync(:,ii)) .LT. 0. ) &
867  taux = tsync(:,ii)
868  END IF
869  END DO
870  !
871  ! 4.c.3 Check with dependent higher rank grids ( TSYNC )
872  ! No check needed
873  !
874  ! 4.c.4 Final check against grid time
875  !
876  CALL w3setw ( i, mdse, mdst )
877  flagok = flagok .AND. dsec21(time,taux).GT.0.
878  !
879  ! 4.c.5 Update TSYNC throughout group
880  !
881  IF ( flagok ) THEN
882  !
883  DO jjj=1, ingrp(j,0)
884  ii = ingrp(j,jjj)
885  tsync(:,ii) = taux
886  IF ( grstat(ii) .EQ. 2 ) grstat(ii) = 3
887 #ifdef W3_T
888  IF ( grstat(ii) .EQ. 3 ) &
889  WRITE (mdst,9003) ii, grstat(ii)
890 #endif
891 
892  END DO
893  done = .true.
894  !
895 #ifdef W3_T
896  WRITE (mdst,9044) tsync(:,i), taux
897  WRITE (mdst,9045)
898  WRITE (mdst,9046) (ii,tsync(:,ii),ii=0,nrgrd)
899 #endif
900  !
901  ! 4.c.6 Skip computations so that all grids in group are advanced
902  ! simultaneously.
903 
904 #ifdef W3_MPRF
905  CALL prtime ( prftn )
906  WRITE (mdsp,991) prft0, prftn, &
907  get_memory(), 'ST02', i
908 #endif
909 #ifdef W3_T
910  IF ( ingrp(j,0) .GT. 1 ) WRITE (mdst,9006)
911 #endif
912  IF ( ingrp(j,0) .GT. 1 ) GOTO 1111
913  !
914  END IF ! IF ( FLAGOK )
915  !
916  END IF ! 4.b IF ( GRANK(I) .EQ. 1 )
917  !
918  END IF ! 4. IF ( GRSTAT(I) .EQ. 2 )
919  !
920  ! 5. Run the wave model --------------------------------------------- /
921  ! ( GRSTAT = 3 ) w3xdatmd data structures set in W3WAVE
922  !
923  ! 5.a Run model
924  !
925 #ifdef W3_SHRD
926  IF ( grstat(i) .EQ. 3 ) THEN
927 #endif
928  !
929 #ifdef W3_MPI
930  IF ( grstat(i).EQ.3 .AND. &
931  mpi_comm_grd .EQ. mpi_comm_null ) THEN
932  CALL w3setw ( i, mdse, mdst )
933  time = tsync(:,i)
934  grstat(i) = 4
935  done = .true.
936  ELSE IF ( grstat(i).EQ.3 .AND. &
937  mpi_comm_grd .NE. mpi_comm_null ) THEN
938 #endif
939  !
940 #ifdef W3_T
941  WRITE (mdst,9002) i, grstat(i), 'RUNNING MODEL'
942 #endif
943 #ifdef W3_MPRF
944  CALL prtime ( prft0 )
945 #endif
946  !
947  CALL wmsetm ( i, mdse, mdst )
948  CALL w3wave ( i, dummy2, tsync(:,i), .false., .true. )
949  IF ( fllstl ) inflags1(1) = .false.
950  IF ( fllsti ) inflags1(4) = .false.
951  IF ( fllstr ) inflags1(6) = .false.
952  !
953  ! 5.b Stage data for grids with equal rank
954  !
955 #ifdef W3_MPI
956  CALL wmioef ( i )
957 #endif
958  CALL wmioes ( i )
959  !
960  ! 5.c Finish up
961  !
962  grstat(i) = 4
963  done = .true.
964  !
965 #ifdef W3_MPRF
966  CALL prtime ( prftn )
967  WRITE (mdsp,991) prft0, prftn, get_memory(), &
968  'ST03', i
969 #endif
970  !
971 #ifdef W3_MPI
972  END IF ! IF ( GRSTAT(I).EQ.3 .AND. MPI_COMM_GRD .EQ. MPI_COMM_NULL )
973 #endif
974 #ifdef W3_SHRD
975  END IF ! IF ( GRSTAT(I) .EQ. 3 )
976 #endif
977  !
978  ! 6. Reconcile grids with same rank --------------------------------- /
979  ! and stage data transfer to higher and lower ranked grids.
980  ! ( GRSTAT = 4 )
981  !
982  IF ( grstat(i) .EQ. 4 ) THEN
983 #ifdef W3_MPRF
984  CALL prtime ( prft0 )
985 #endif
986  !
987  ! 6.a Test against times and statuses of dependent grids
988  ! Note: This is done per GROUP, not per local equal grid dependence
989  ! Therefore, it is essential that sync times per group are
990  ! equal (4.c.1) and that all equal grid dependences are a
991  ! subset of groups (WMGEQL 5.d)
992  !
993 #ifdef W3_T
994  WRITE (mdst,9002) i, grstat(i), 'FIRST PART'
995  WRITE (mdst,9005) fleqok(i)
996 #endif
997  !
998  ! 6.a.1 Check if sync point is reached
999  !
1000  IF ( .NOT. fleqok(i) ) THEN
1001  !
1002  flagok = .true.
1003  CALL w3setw ( i, mdse, mdst )
1004  taux = time
1005  DO jjj=1, ingrp(j,0)
1006  CALL w3setw ( ingrp(j,jjj), mdse, mdst )
1007  flagok = flagok .AND. dsec21(taux,time).EQ.0. &
1008  .AND. grstat(ingrp(j,jjj)).EQ.4
1009  END DO
1010  CALL w3setw ( i, mdse, mdst )
1011 #ifdef W3_T
1012  WRITE (mdst,9004) flagok
1013 #endif
1014  !
1015  ! 6.a.2 Point reached, set flag for all in group and cycle
1016  !
1017  IF ( flagok ) THEN
1018  DO jjj=1, ingrp(j,0)
1019  fleqok(ingrp(j,jjj)) = .true.
1020 #ifdef W3_T
1021  WRITE (mdst,9061) ingrp(j,jjj), &
1022  fleqok(ingrp(j,jjj))
1023 #endif
1024  END DO
1025  done = .true.
1026 #ifdef W3_MPRF
1027  CALL prtime ( prftn )
1028  WRITE (mdsp,991) prft0, prftn, &
1029  get_memory(), 'ST04', i
1030 #endif
1031  !
1032 #ifdef W3_T
1033  IF ( ingrp(j,0) .GT. 1 ) WRITE (mdst,9006)
1034 #endif
1035  IF ( ingrp(j,0) .GT. 1 ) GOTO 1111
1036  END IF ! IF ( FLAGOK )
1037  !
1038  END IF ! IF ( .NOT. FLEQOK(I) )
1039  !
1040  ! 6.b Call gathering routine, reset FLEQOK and cycle
1041  !
1042 #ifdef W3_MPI
1043  IF ( .NOT.fleqok(i) .AND. .NOT.pregte(i) ) THEN
1044  IF ( mpi_comm_grd.NE.mpi_comm_null ) &
1045  CALL wmioeg (i,flag)
1046  pregte(i) = .true.
1047  END IF
1048 #endif
1049  !
1050  IF ( fleqok(i) ) THEN
1051 #ifdef W3_SHRD
1052  CALL wmioeg ( i )
1053 #endif
1054 #ifdef W3_MPI
1055  IF ( mpi_comm_grd.NE.mpi_comm_null ) &
1056  CALL wmioeg ( i )
1057  pregte(i) = .false.
1058 #endif
1059  grstat(i) = 5
1060  fleqok(i) = .false.
1061  done = .true.
1062  END IF
1063  !
1064  ! 6.c Stage data
1065  !
1066  IF ( grstat(i) .EQ. 5 ) THEN
1067  !
1068 #ifdef W3_T
1069  WRITE (mdst,9002) i, grstat(i)-1, 'SECOND PART'
1070 #endif
1071  !
1072 #ifdef W3_SHRD
1073  CALL wmiobs ( i )
1074 #endif
1075  !
1076 #ifdef W3_MPI
1077  IF ( mpi_comm_grd .NE. mpi_comm_null ) THEN
1078  CALL wmiobf ( i )
1079  CALL wmiobs ( i )
1080  END IF
1081 #endif
1082  !
1083 #ifdef W3_MPRF
1084  CALL prtime ( prftn )
1085  WRITE (mdsp,991) prft0, prftn, &
1086  get_memory(), 'ST04', i
1087 #endif
1088  cycle loop_jj
1089  !
1090  END IF ! IF ( GRSTAT(I) .EQ. 5 )
1091  !
1092 #ifdef W3_MPRF
1093  CALL prtime ( prftn )
1094  WRITE (mdsp,991) prft0, prftn, &
1095  get_memory(), 'ST04', i
1096 #endif
1097  !
1098  END IF ! 6. IF ( GRSTAT(I) .EQ. 4 )
1099  !
1100  ! 7. Reconcile with higher ranked grids ----------------------------- /
1101  ! ( GRSTAT = 5 )
1102  !
1103  ! This needs to be a little more complicated than with boundary
1104  ! data to assure proper logic in cases where data providing
1105  ! data does not get data back (e.g., as for the boundary grid
1106  ! in mww3_test_04)
1107  !
1108  IF ( grstat(i) .EQ. 5 ) THEN
1109 #ifdef W3_MPRF
1110  CALL prtime ( prft0 )
1111 #endif
1112 #ifdef W3_T
1113  WRITE (mdst,9002) i, grstat(i), ' '
1114 #endif
1115  !
1116  ! 7.a Test against times and statuses of dependent grids
1117  !
1118  IF ( grdhgh(i,0) .EQ. 0 ) THEN
1119  grstat(i) = 6
1120  done = .true.
1121  ELSE
1122  !
1123  flagok = .true.
1124  CALL w3setw ( i, mdse, mdst )
1125  taux = time
1126  DO jjj=1, grdhgh(i,0)
1127  CALL w3setw ( grdhgh(i,jjj), mdse, mdst )
1128  IF ( .NOT. ( dsec21(taux,time).EQ.0. .AND. &
1129  ( grstat(grdhgh(i,jjj)).GE.7 .OR. &
1130  grstat(grdhgh(i,jjj)).LE.2 ) ) ) &
1131  flagok = .false.
1132  END DO
1133  CALL w3setw ( i, mdse, mdst )
1134  !
1135 #ifdef W3_T
1136  WRITE (mdst,9004) flagok
1137 #endif
1138  !
1139  ! 7.b Call gathering routine
1140  !
1141 #ifdef W3_MPI
1142  IF ( .NOT.flagok .AND. .NOT.pregth(i) ) THEN
1143  IF ( mpi_comm_grd.NE.mpi_comm_null ) &
1144  CALL wmiohg ( i, flag )
1145  pregth(i) = .true.
1146  END IF
1147 #endif
1148  !
1149  IF ( flagok ) THEN
1150 #ifdef W3_SHRD
1151  CALL wmiohg ( i, flagok )
1152 #endif
1153 #ifdef W3_MPI
1154  IF ( mpi_comm_grd.NE.mpi_comm_null ) &
1155  CALL wmiohg ( i )
1156  pregth(i) = .false.
1157 #endif
1158  grstat(i) = 6
1159  done = .true.
1160  END IF ! IF ( FLAGOK )
1161  !
1162  END IF ! IF ( GRDHGH(I,0) .EQ. 0 )
1163 
1164  !
1165  ! 7.c Stage data
1166  !
1167 #ifdef W3_SHRD
1168  IF ( grstat(i) .EQ. 6 ) CALL wmiohs ( i )
1169 #endif
1170  !
1171 #ifdef W3_MPI
1172  IF ( grstat(i) .EQ. 6 .AND. &
1173  mpi_comm_grd .NE. mpi_comm_null ) THEN
1174  CALL wmiohf ( i )
1175  CALL wmiohs ( i )
1176  END IF
1177 #endif
1178  !
1179 #ifdef W3_T
1180  IF (grstat(i).EQ.6) WRITE(mdst,9003) i, grstat(i)
1181 #endif
1182 #ifdef W3_MPRF
1183  CALL prtime ( prftn )
1184  WRITE (mdsp,991) prft0, prftn, get_memory(), &
1185  'ST05', i
1186 #endif
1187  END IF ! 7. IF ( GRSTAT(I) .EQ. 5 )
1188  !
1189  ! 8. Perform data assimmilation ------------------------------------- /
1190  ! ( GRSTAT = 6 ) Placeholder only .....
1191  !
1192  IF ( grstat(i) .EQ. 6 ) THEN
1193 #ifdef W3_MPRF
1194  CALL prtime ( prft0 )
1195 #endif
1196 #ifdef W3_T
1197  WRITE (mdst,9002) i, grstat(i), ' '
1198 #endif
1199  grstat(i) = 7
1200 #ifdef W3_MPRF
1201  CALL prtime ( prftn )
1202  WRITE (mdsp,991) prft0, prftn, get_memory(), &
1203  'ST06', i
1204 #endif
1205  done = .true.
1206  END IF ! IF ( GRSTAT(I) .EQ. 6 )
1207  !
1208  ! 9. Perform output ------------------------------------------------- /
1209  ! ( GRSTAT = 7 ) w3xdatmd data structures set in W3WAVE
1210  !
1211  !
1212  ! 9.a Check times and finish step if no output to be made
1213  !
1214 #ifdef W3_SHRD
1215  IF ( grstat(i) .EQ. 7 ) THEN
1216 #endif
1217 #ifdef W3_MPI
1218  IF ( grstat(i).EQ.7 .AND. .NOT.flsync(i) ) THEN
1219 #endif
1220  !
1221 #ifdef W3_T
1222  WRITE (mdst,9002) i, grstat(i), ' '
1223 #endif
1224  !
1225  IF ( toutp(1,i) .EQ. -1 ) THEN
1226  dttst = 1.
1227  ELSE
1228  CALL w3setw ( i, mdse, mdst )
1229  dttst = dsec21( time , toutp(:,i) )
1230  END IF
1231 #ifdef W3_T
1232  WRITE (mdst,9090) dttst
1233 #endif
1234  flg_o1 = dttst .EQ. 0.
1235  !
1236  IF ( unipts ) THEN
1237  CALL w3setw ( i, mdse, mdst )
1238  dttst = dsec21( time , upnext )
1239  flg_o2 = dttst .EQ. 0.
1240  ELSE
1241  flg_o2 = .false.
1242  END IF
1243  !
1244  IF ( .NOT.flg_o1 .AND. .NOT.flg_o2 ) THEN
1245  grstat(i) = 8
1246 #ifdef W3_T
1247  WRITE (mdst,9003) i, grstat(i)
1248 #endif
1249  done = .true.
1250  END IF
1251  !
1252 #ifdef W3_MPI
1253  END IF ! IF ( GRSTAT(I).EQ.7 .AND. .NOT.FLSYNC(I) )
1254 #endif
1255 #ifdef W3_SHRD
1256  END IF ! IF ( GRSTAT(I) .EQ. 7 )
1257 #endif
1258  !
1259  ! 9.b Perform output
1260  !
1261  IF ( grstat(i) .EQ. 7 ) THEN
1262 #ifdef W3_MPI
1263  IF ( mpi_comm_grd .NE. mpi_comm_null ) THEN
1264 #endif
1265  !
1266 #ifdef W3_MPRF
1267  CALL prtime ( prft0 )
1268 #endif
1269  !
1270  IF ( flg_o1 ) THEN
1271  CALL w3setg ( i, mdse, mdst )
1272  CALL wmsetm ( i, mdse, mdst )
1273  IF ( flghg1 .AND. .NOT.flghg2 .AND. &
1274  grdhgh(i,0).GT.0 ) THEN
1275  mapst2 = mapst2 - 8*mapmsk
1276  mapsta = abs(mapsta)
1277  DO ix=1, nx
1278  DO iy=1, ny
1279  IF ( mapst2(iy,ix) .GT. 0 ) &
1280  mapsta(iy,ix) = - mapsta(iy,ix)
1281  END DO
1282  END DO
1283  !
1284  END IF
1285  !
1286  CALL w3wave ( i, dummy2, tsync(:,i), .false. )
1287  !
1288  IF ( flghg1 .AND. .NOT.flghg2 .AND. &
1289  grdhgh(i,0).GT.0 ) THEN
1290  mapst2 = mapst2 + 8*mapmsk
1291  mapsta = abs(mapsta)
1292  DO ix=1, nx
1293  DO iy=1, ny
1294  IF ( mapst2(iy,ix) .GT. 0 ) &
1295  mapsta(iy,ix) = - mapsta(iy,ix)
1296  END DO
1297  END DO
1298  END IF
1299  !
1300  IF ( fllstl ) inflags1(1) = .false.
1301  IF ( fllsti ) inflags1(4) = .false.
1302  IF ( fllstr ) inflags1(6) = .false.
1303  !
1304  ! 9.c Update TOUPT
1305  !
1306  toutp(1,i) = -1
1307  toutp(2,i) = 0
1308  !
1309  DO jo=1, notype
1310  IF ( .NOT.flout(jo) ) cycle
1311  IF ( toutp(1,i) .EQ. -1 ) THEN
1312  toutp(:,i) = tonext(:,jo)
1313  ELSE
1314  dttst = dsec21( toutp(:,i) , tonext(:,jo) )
1315  IF (dttst.LT.0.) toutp(:,i) = tonext(:,jo)
1316  ENDIF
1317  END DO
1318  ! CHECKPOINT
1319  jo=8
1320  IF ( .NOT.flout(jo) ) cycle
1321  IF ( toutp(1,i) .EQ. -1 ) THEN
1322  toutp(:,i) = tonext(:,jo)
1323  ELSE
1324  dttst = dsec21( toutp(:,i) , tonext(:,jo) )
1325  IF (dttst.LT.0.) toutp(:,i) = tonext(:,jo)
1326  ENDIF
1327  ! END CHECKPOINT
1328  !
1329 #ifdef W3_T
1330  WRITE (mdst,9091) toutp(:,i)
1331 #endif
1332  !
1333  END IF ! IF ( FLG_O1 )
1334 
1335  !
1336  ! 9.d Process unified point output for selected grid
1337  !
1338  IF ( unipts ) THEN
1339  IF ( flg_o2 ) THEN
1340  CALL w3seto ( i, mdse, mdst )
1341  !
1342 #ifdef W3_MPI
1343  IF ( nrqpo.NE.0 ) CALL mpi_startall &
1344  ( nrqpo, irqpo1, ierr_mpi )
1345 #endif
1346  !
1347  IF ( nopts.NE.0 .AND. iaproc.EQ.nappnt ) THEN
1348  CALL w3setg ( i, mdse, mdst )
1349  CALL w3seta ( i, mdse, mdst )
1350  CALL w3iope ( va )
1351  END IF
1352  !
1353 #ifdef W3_MPI
1354  IF ( nrqpo .NE. 0 ) THEN
1355  ALLOCATE ( status(mpi_status_size,nrqpo) )
1356  CALL mpi_waitall &
1357  ( nrqpo, irqpo1, status, ierr_mpi )
1358  DEALLOCATE ( status )
1359  END IF
1360 #endif
1361  !
1362 #ifdef W3_T
1363  WRITE (mdst,9092) nopts
1364 #endif
1365  !
1366  END IF ! IF ( FLG_O2 )
1367  !
1368  END IF ! IF ( UNIPTS )
1369  !
1370 #ifdef W3_MPRF
1371  CALL prtime ( prftn )
1372  WRITE (mdsp,991) prft0, prftn,get_memory(), &
1373  'ST07', i
1374 #endif
1375  !
1376  ! 9.e Update TOUPT outside communicator
1377  !
1378 #ifdef W3_MPI
1379  ELSE IF ( flg_o1 ) THEN
1380 #endif
1381  !
1382 #ifdef W3_MPI
1383  CALL w3seto ( i, mdse, mdst )
1384  CALL w3setw ( i, mdse, mdst )
1385 #endif
1386  !
1387 #ifdef W3_MPI
1388  time = toutp(:,i)
1389  toutp(1,i) = -1
1390  toutp(2,i) = 0
1391 #endif
1392  !
1393 #ifdef W3_MPI
1394  DO jo=1, notype
1395 #endif
1396  !
1397 #ifdef W3_MPI
1398  IF ( flout(jo) ) THEN
1399  DO
1400  dttst = dsec21( time, tonext(:,jo) )
1401  IF ( dttst .LE. 0. ) THEN
1402  CALL tick21 ( tonext(:,jo), dtout(jo) )
1403  dttst = dsec21( tonext(:,jo), tolast(:,jo) )
1404  IF ( dttst .LT. 0. ) THEN
1405  flout(jo) = .false.
1406  EXIT
1407  END IF
1408  ELSE
1409  EXIT
1410  END IF
1411  END DO
1412  END IF ! IF ( FLOUT(JO) )
1413 #endif
1414  !
1415 #ifdef W3_MPI
1416  IF ( .NOT.flout(jo) ) cycle
1417  IF ( toutp(1,i) .EQ. -1 ) THEN
1418  toutp(:,i) = tonext(:,jo)
1419  ELSE
1420  dttst = dsec21( toutp(:,i) , tonext(:,jo) )
1421  IF (dttst.LT.0.) toutp(:,i) = tonext(:,jo)
1422  ENDIF
1423 #endif
1424  !
1425 #ifdef W3_MPI
1426  END DO ! DO JO=1, NOTYPE
1427 #endif
1428  !
1429  ! Checkpoint
1430  !
1431 #ifdef W3_MPI
1432  jo=8
1433 #endif
1434  !
1435 #ifdef W3_MPI
1436  IF ( flout(jo) ) THEN
1437  DO
1438  dttst = dsec21( time, tonext(:,jo) )
1439  IF ( dttst .LE. 0. ) THEN
1440  CALL tick21 ( tonext(:,jo), dtout(jo) )
1441  dttst = dsec21( tonext(:,jo), tolast(:,jo) )
1442  IF ( dttst .LT. 0. ) THEN
1443  flout(jo) = .false.
1444  EXIT
1445  END IF
1446  ELSE
1447  EXIT
1448  END IF
1449  END DO
1450  END IF ! IF ( FLOUT(JO) )
1451 #endif
1452  !
1453 #ifdef W3_MPI
1454  IF ( .NOT.flout(jo) ) cycle
1455  IF ( toutp(1,i) .EQ. -1 ) THEN
1456  toutp(:,i) = tonext(:,jo)
1457  ELSE
1458  dttst = dsec21( toutp(:,i) , tonext(:,jo) )
1459  IF (dttst.LT.0.) toutp(:,i) = tonext(:,jo)
1460  ENDIF
1461 #endif
1462  !
1463 
1464  ! End Checkpoint
1465 #ifdef W3_MPIT
1466  WRITE (mdst,9991) toutp(:,i)
1467 #endif
1468 #ifdef W3_MPI
1469  END IF ! 9.b IF ( MPI_COMM_GRD .NE. MPI_COMM_NULL )
1470 #endif
1471  !
1472  ! 9.f Finish up
1473  !
1474  grstat(i) = 8
1475  done = .true.
1476  !
1477  END IF ! 9.b IF ( GRSTAT(I) .EQ. 7 )
1478  !
1479  ! 10. Go to next time step ------------------------------------------- /
1480  ! ( GRSTAT = 8 ) ( 9 added for diagnostic output only ... )
1481  ! ( Unified point output and synchronization added )
1482  !
1483  IF ( grstat(i) .EQ. 8 ) THEN
1484  !
1485 #ifdef W3_T
1486  WRITE (mdst,9002) i, grstat(i), ' '
1487 #endif
1488  !
1489  ! 10.a Processing unified point output
1490  !
1491  IF ( unipts .AND. do_upt ) THEN
1492  CALL w3setw ( i, mdse, mdst )
1493  flagok = dsec21( time, upnext ) .EQ. 0.
1494 #ifdef W3_T
1495  WRITE (mdst,9095) flagok
1496 #endif
1497  ELSE
1498  flagok = .false.
1499  END IF
1500  !
1501  IF ( flagok ) THEN
1502  !
1503  DO ii=1, nrgrd
1504  CALL w3setw ( ii, mdse, mdst )
1505  flagok = flagok .AND. grstat(ii).EQ.8 .AND. &
1506  dsec21(time,upnext).EQ.0.
1507  END DO
1508 #ifdef W3_T
1509  WRITE (mdst,9096) flagok
1510 #endif
1511  !
1512  IF ( flagok ) THEN
1513  !
1514 #ifdef W3_MPRF
1515  CALL prtime ( prft0 )
1516 #endif
1517  CALL wmiopo ( upnext )
1518  do_upt = .false.
1519  !
1520  CALL w3seto ( 0, mdse, mdst )
1521  CALL tick21 ( upnext, dtout(2) )
1522  IF ( dsec21(upnext,uplast) .GE. 0. ) THEN
1523  tonext(:,2) = upnext
1524  ELSE
1525  unipts = .false.
1526  upnext(1) = -1
1527  upnext(2) = 0
1528  END IF
1529  !
1530  DO ii=1, nrgrd
1531  CALL w3setw ( ii, mdse, mdst )
1532  dttst = dsec21( time, tend(:,ii) )
1533  IF ( dttst .GT. 0. ) THEN
1534  grstat(ii) = 9
1535  ELSE IF ( dttst .EQ. 0 ) THEN
1536  grstat(ii) = 99
1537  END IF
1538  tsync(1,ii) = -1
1539  tsync(2,ii) = 0
1540 #ifdef W3_T
1541  IF ( i .NE. ii ) &
1542  WRITE (mdst,9003) ii, grstat(ii)
1543 #endif
1544  END DO
1545  !
1546  done = .true.
1547 #ifdef W3_MPRF
1548  CALL prtime ( prftn )
1549  WRITE (mdsp,991) prft0, prftn, &
1550  get_memory(), 'UPTS',i
1551 #endif
1552  END IF ! IF ( FLAGOK )
1553  !
1554  ELSE
1555  flagok = .true.
1556  END IF ! IF ( FLAGOK )
1557  !
1558  ! 10.b Regular processing
1559  !
1560  IF ( flagok ) THEN
1561  CALL w3setw ( i, mdse, mdst )
1562  dttst = dsec21( time, tend(:,i) )
1563  IF ( dttst .GT. 0. ) THEN
1564  grstat(i) = 9
1565  done = .true.
1566  ELSE IF ( dttst .EQ. 0 ) THEN
1567  grstat(i) = 99
1568  done = .true.
1569  END IF
1570 #ifdef W3_T
1571  WRITE (mdst,9003) i, grstat(i)
1572 #endif
1573  END IF ! IF ( FLAGOK )
1574  !
1575  IF ( grstat(i).EQ.9 .OR. grstat(i).EQ.99 ) THEN
1576  tsync(1,i) = -1
1577  tsync(2,i) = 0
1578  END IF
1579  !
1580  END IF ! 10. IF ( GRSTAT(I) .EQ. 8 )
1581  !
1582  ! ... End of loops started in 1. ------------------------------------- /
1583  !
1584  END DO loop_jj
1585  !
1586 1111 CONTINUE
1587  !
1588  END DO loop_j
1589  !
1590 #ifdef W3_MPI
1591  nmpscr = nmpscs
1592 #endif
1593  IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) &
1594  CALL wmprnt ( mdso, nrgrd, tsync(:,0), grstat )
1595  !
1596  DO i=1, nrgrd
1597  IF ( grstat(i) .EQ. 9 ) grstat(i) = 0
1598  END DO
1599  !
1600  IF ( .NOT. done ) GOTO 2099
1601  IF ( minval(grstat) .EQ. 99 ) EXIT loop_outer
1602  END DO loop_outer
1603  !
1604  ! End of routine -------------------------------------------------- /
1605 
1606  IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN
1607  CALL wwtime ( wtime )
1608  WRITE (mdss,902) wtime
1609  ENDIF
1610  !
1611 #ifdef W3_MPI
1612  DO i=1, nrgrd
1613  CALL wmsetm ( i, mdse, mdst )
1614  IF ( mpi_comm_grd .NE. mpi_comm_null ) THEN
1615  CALL wmiobf ( i )
1616  CALL wmiohf ( i )
1617  CALL wmioef ( i )
1618  END IF
1619  END DO
1620 #endif
1621  !
1622 #ifdef W3_O10
1623  IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,999)
1624 #endif
1625  !
1626 #ifdef W3_T
1627  WRITE (mdst,9100)
1628 #endif
1629  !
1630  RETURN
1631  !
1632  ! Escape locations
1633  !
1634 2000 CONTINUE
1635  IF ( improc .EQ. nmperr ) WRITE (mdse,1000) i, grstat(i)
1636  CALL extcde ( 2000 )
1637  RETURN
1638  !
1639 2001 CONTINUE
1640  IF ( improc .EQ. nmperr ) WRITE (mdse,1001) i, tsync(:,i), &
1641  tend(:,i)
1642  CALL extcde ( 2001 )
1643  RETURN
1644  !
1645 2002 CONTINUE
1646  IF ( improc .EQ. nmperr ) WRITE (mdse,1002) j, ingrp(j,1), &
1647  ingrp(j,jj), tsync(:,ingrp(j,1)), tsync(:,ingrp(j,jj)), &
1648  tend(:,ingrp(j,1)), tend(:,ingrp(j,jj))
1649  CALL extcde ( 2002 )
1650  RETURN
1651  !
1652 2099 CONTINUE
1653  IF ( improc .EQ. nmperr ) WRITE (mdse,1099)
1654  CALL extcde ( 2099 )
1655  RETURN
1656  !
1657  ! Formats
1658  !
1659 900 FORMAT ( ' ========== STARTING WAVE MODEL (WMWAVE) ==========', &
1660  '============================'/)
1661 901 FORMAT (' MWW3 calculating for ',a,' at ',a,' status [', &
1662  i2,'-',i2,']')
1663 902 FORMAT (' MWW3 reached the end of the computation loop at ',a)
1664 #ifdef W3_MPRF
1665 990 FORMAT (1x,3f12.3,' WMWAVE INIT')
1666 991 FORMAT (1x,3f12.3,' WMWAVE ',a4,i6)
1667 992 FORMAT (1x,3f12.3,' WMWAVE ',a4,i9.8,i7.6)
1668 #endif
1669 999 FORMAT (/' ========== END OF WAVE MODEL (WMWAVE) ============', &
1670  '============================'/)
1671  !
1672 1000 FORMAT (/' *** WAVEWATCH III ERROR IN WMWAVE : *** '/ &
1673  ' GRID',i3,' HAS ILLEGAL GRSTAT :',i8/)
1674  !
1675 1001 FORMAT (/' *** WAVEWATCH III ERROR IN WMWAVE : *** '/ &
1676  ' GRID',i3,' HAS ILLEGAL TSYNC / TEND '/ &
1677  ' TSYNC :',i9.8,i7.6/ &
1678  ' TEND :',i9.8,i7.6/)
1679  !
1680 1002 FORMAT (/' *** WAVEWATCH III ERROR IN WMWAVE : *** '/ &
1681  ' GROUP',i3,' HAS INCOMPATIBLE TIMES ', &
1682  'IN GRIDS ',i3,' AND ',i3/ &
1683  ' TSYNC :',i9.8,i7.6,1x,i9.8,i7.6/ &
1684  ' TEND :',i9.8,i7.6,1x,i9.8,i7.6/)
1685  !
1686  ! Note: This 1099 error can occur when multi-grid time steps are not
1687  ! compatible.
1688 1099 FORMAT (/' *** WAVEWATCH III ERROR IN WMWAVE : *** '/ &
1689  ' ABORT FOR POSSIBLE ENDLESS LOOP '/)
1690  !
1691 #ifdef W3_T
1692 9000 FORMAT ( ' TEST WMWAVE : LOOP',i8,' ======================', &
1693  '===== (',i9.8,i7.6,' ) =='/ &
1694  ' GRID, GRSTAT, TIME, TSYNC, TEND')
1695 9001 FORMAT ( ' ',i3,i3,3(i10.8,i7.6))
1696 9002 FORMAT ( ' TEST WMWAVE : PROCESSING GRID',i3, &
1697  ' STATUS',i3,' ',a)
1698 #endif
1699 #ifdef W3_MPIT
1700 9902 FORMAT ( ' MPIT WMWAVE : PROCESSING GRID',i3, &
1701  ' STATUS',i3,' ',a)
1702 #endif
1703 #ifdef W3_T
1704 9003 FORMAT ( ' TEST WMWAVE : GRID',i3,' STATUS RESET TO',i3)
1705 9004 FORMAT ( ' TEST WMWAVE : FLAGOK = ',l1)
1706 9005 FORMAT ( ' TEST WMWAVE : FLEQOK = ',l1)
1707 9006 FORMAT ( ' TEST WMWAVE : CYCLE GROUP')
1708 #endif
1709  !
1710 #ifdef W3_T
1711 9020 FORMAT ( ' TEST WMWAVE : DTTST ',e10.3)
1712 9021 FORMAT ( ' TEST WMWAVE : TIME :',i10.8,i7.6/ &
1713  ' TDATA :',i10.8,i7.6/ &
1714  ' TEND :',i10.8,i7.6)
1715 #endif
1716  !
1717 #ifdef W3_T
1718 9040 FORMAT ( ' TEST WMWAVE : TMAX :',i10.8,i7.6,f8.2/ &
1719  ' DTMAX :',i10.8,i7.6/ &
1720  ' TDATA :',i10.8,i7.6/ &
1721  ' TOUTP :',i10.8,i7.6/ &
1722  ' UPNEXT:',i10.8,i7.6)
1723 9041 FORMAT ( ' TEST WMWAVE : TMAX :',i10.8,i7.6)
1724 #endif
1725 #ifdef W3_MPIT
1726 9941 FORMAT ( ' MPIT WMWAVE : TMAX :',i10.8,i7.6)
1727 #endif
1728 #ifdef W3_T
1729 9042 FORMAT ( ' TEST WMWAVE : GRANK :',i4,' FOR GRSTAT = 2')
1730 9043 FORMAT ( ' TEST WMWAVE : GLOBAL TSYNC :',i10.8,i7.6)
1731 9044 FORMAT ( ' TEST WMWAVE : LOCAL TSYNC :',i10.8,i7.6, &
1732  ' (',i8.8,i7.6,')')
1733 9045 FORMAT ( ' TEST WMWAVE : GRID TSYNC')
1734 9046 FORMAT ( ' ',i5,i10.8,i7.6)
1735 #endif
1736  !
1737 #ifdef W3_T
1738 9061 FORMAT ( ' GRID',i4,', FLEQOK = ',l1)
1739 #endif
1740  !
1741 #ifdef W3_T
1742 9090 FORMAT ( ' TEST WMWAVE : DTTST ',e10.3)
1743 9091 FORMAT ( ' TEST WMWAVE : NEXT TOUTP :',i10.8,i7.6)
1744 #endif
1745 #ifdef W3_MPIT
1746 9991 FORMAT ( ' MPIT WMWAVE : NEXT TOUTP :',i10.8,i7.6)
1747 #endif
1748 #ifdef W3_T
1749 9092 FORMAT ( ' TEST WMWAVE : UNIFIED POINT OUTPUT PREP DONE',i6)
1750 #endif
1751  !
1752 #ifdef W3_T
1753 9095 FORMAT ( ' TEST WMWAVE : UNIFIED POINT OUTPUT, FLAGOK = ',l1)
1754 9096 FORMAT ( ' ALL GRIDS, FLAGOK = ',l1)
1755 #endif
1756  !
1757 #ifdef W3_T
1758 9100 FORMAT ( ' TEST WMWAVE : LOOP DONE ======================', &
1759  '==============================')
1760 #endif
1761  !/
1762  !/ End of WMWAVE ----------------------------------------------------- /
1763  !/

References wmmdatmd::amv, wmmdatmd::croot, wmmdatmd::dmv, w3timemd::dsec21(), w3gdatmd::dtmax, w3odatmd::dtout, wmmdatmd::dtres, wmmdatmd::etime, w3servmd::extcde(), wmmdatmd::fbcast, wmmdatmd::flghg1, wmmdatmd::flghg2, wmmdatmd::fllsti, wmmdatmd::fllstl, wmmdatmd::fllstr, w3odatmd::flout, wmmdatmd::grank, wmmdatmd::grdeql, wmmdatmd::grdhgh, wmmdatmd::grdlow, wmmdatmd::grstat, w3odatmd::iaproc, wmmdatmd::improc, include(), w3idatmd::inflags1, wmmdatmd::ingrp, w3odatmd::irqpo1, wmmdatmd::mapmsk, w3gdatmd::mapst2, w3gdatmd::mapsta, wmmdatmd::mdse, wmmdatmd::mdso, wmmdatmd::mdsp, wmmdatmd::mdss, wmmdatmd::mdst, wmmdatmd::mpi_comm_bct, wmmdatmd::mpi_comm_grd, wmmdatmd::mpi_comm_mwave, w3odatmd::nappnt, wmmdatmd::nmperr, wmmdatmd::nmplog, wmmdatmd::nmproc, wmmdatmd::nmpscr, wmmdatmd::nmptst, wmmdatmd::nmv, w3odatmd::nopts, w3odatmd::notype, wmmdatmd::nrgrd, wmmdatmd::nrgrp, w3odatmd::nrqpo, w3gdatmd::nx, w3gdatmd::ny, w3timemd::prtime(), wmmdatmd::stime, w3timemd::stme21(), w3servmd::strace(), wmmdatmd::tdata, w3timemd::tick21(), w3wdatmd::time, wmmdatmd::tmax, wmmdatmd::tmv, w3odatmd::tolast, w3odatmd::tonext, wmmdatmd::toutp, wmmdatmd::tsync, w3odatmd::unipts, w3wdatmd::va, w3iopomd::w3iope(), w3adatmd::w3seta(), w3gdatmd::w3setg(), w3odatmd::w3seto(), w3wdatmd::w3setw(), w3wavemd::w3wave(), wmbcst(), wminiomd::wmiobf(), wminiomd::wmiobg(), wminiomd::wmiobs(), wminiomd::wmioef(), wminiomd::wmioeg(), wminiomd::wmioes(), wminiomd::wmiohf(), wminiomd::wmiohg(), wminiomd::wmiohs(), wmiopomd::wmiopo(), wmprnt(), wmmdatmd::wmsetm(), wmupdtmd::wmupdt(), and w3servmd::wwtime().

Referenced by w3mlti(), and w3sbs1().

◆ wmwout()

subroutine wmwavemd::wmwout ( integer, intent(in)  IMOD,
integer, intent(in)  NMOD,
integer, intent(in)  ID 
)

Non-blocking broadcast using dummy parameter to have output.

Processes wait for computations on first node to be finished. Needed for profiling purposes only.

Standard send and recieves using defined communicator. Send form first processor in communicator.

Parameters
[in]IMODModel number.
[in]NMODNumber of models.
[in]IDID number, used with NMOD for ITAG.
Author
H. L. Tolman
Date
21-Jun-2007

Definition at line 2134 of file wmwavemd.F90.

2134  !/
2135  !/ +-----------------------------------+
2136  !/ | WAVEWATCH III NOAA/NCEP |
2137  !/ | H. L. Tolman |
2138  !/ | FORTRAN 90 |
2139  !/ | Last update : 21-Jun-2007 !
2140  !/ +-----------------------------------+
2141  !/
2142  !/ 21-Jun-2007 : Origination. ( version 3.11 )
2143  !/
2144  ! 1. Purpose :
2145  !
2146  ! Non-blocking broadcast using dummy parameter to have output!
2147  ! processes wait for computations on first node to be finished.
2148  ! Neede for profiling purposes only.
2149  !
2150  ! 2. Method :
2151  !
2152  ! Standard send and recieves using defined communicator. Send
2153  ! form first processor in communicator.
2154  !
2155  ! 3. Parameters :
2156  !
2157  ! Parameter list
2158  ! ----------------------------------------------------------------
2159  ! IMOD Int. I Model number.
2160  ! NMOD Int. I Number of models.
2161  ! ID Int. I ID number, used with NMOD for ITAG.
2162  ! ----------------------------------------------------------------
2163  !
2164  ! 4. Subroutines used :
2165  !
2166  ! Name Type Module Description
2167  ! ----------------------------------------------------------------
2168  ! STRACE Sur. W3SERVMD Subroutine tracing.
2169  ! W3SETO Subr. W3ODATMD Point to data structure
2170  ! W3SETA Subr. W3ADATMD Point to data structure
2171  ! ----------------------------------------------------------------
2172  !
2173  ! 5. Called by :
2174  !
2175  ! Name Type Module Description
2176  ! ----------------------------------------------------------------
2177  ! WMWAVE Subr. WMWAVEMD Multi-grid wave model routine.
2178  ! ----------------------------------------------------------------
2179  !
2180  ! 6. Error messages :
2181  !
2182  ! 7. Remarks :
2183  !
2184  ! 8. Structure :
2185  !
2186  ! 9. Switches :
2187  !
2188  ! !/S Enable subroutine tracing.
2189  ! !/MPIT Enable test output
2190  !
2191  ! 10. Source code :
2192  !
2193  !/ ------------------------------------------------------------------- /
2194  !
2195 #ifdef W3_MPI
2196  USE w3odatmd, ONLY: w3seto
2197  USE w3adatmd, ONLY: w3seta
2198 #endif
2199  !
2200 #ifdef W3_MPI
2201  USE w3odatmd, ONLY: iaproc, naproc, ntproc
2202  USE w3adatmd, ONLY: mpi_comm_wave
2203  USE wmmdatmd, ONLY: mdst, mdse, mtagb
2204 #endif
2205  !
2206 #ifdef W3_S
2207  USE w3servmd, ONLY: strace
2208 #endif
2209  !
2210  IMPLICIT NONE
2211  !
2212 #ifdef W3_MPI
2213  include "mpif.h"
2214 #endif
2215  !/
2216  !/ ------------------------------------------------------------------- /
2217  !/ Parameter list
2218  !/
2219  INTEGER, INTENT(IN) :: IMOD, NMOD, ID
2220  !/
2221  !/ ------------------------------------------------------------------- /
2222  !/ Local parameters
2223  !/
2224 #ifdef W3_MPI
2225  INTEGER :: ITAG, IP, IERR_MPI, &
2226  STATUS(MPI_STATUS_SIZE)
2227 #endif
2228 #ifdef W3_S
2229  INTEGER, SAVE :: IENT = 0
2230 #endif
2231 #ifdef W3_MPI
2232  REAL, SAVE :: DUMMY = 999.
2233 #endif
2234  !/
2235 #ifdef W3_S
2236  CALL strace (ient, 'WMWOUT')
2237 #endif
2238  !
2239  ! -------------------------------------------------------------------- /
2240  ! 0. Initializations
2241  !
2242 #ifdef W3_MPI
2243  CALL w3seto ( imod, mdse, mdst )
2244  CALL w3seta ( imod, mdse, mdst )
2245  itag = mtagb + imod + id*nmod
2246 #endif
2247  !
2248 #ifdef W3_MPI
2249  IF ( iaproc .LT. 1 ) THEN
2250 #endif
2251 #ifdef W3_MPI
2252  RETURN
2253  END IF
2254 #endif
2255  !
2256  ! -------------------------------------------------------------------- /
2257  ! 1. Processor to send data from
2258  !
2259 #ifdef W3_MPI
2260  IF ( iaproc .EQ. 1 ) THEN
2261  DO ip=naproc+1, ntproc
2262 #endif
2263 #ifdef W3_MPI
2264  CALL mpi_send ( dummy, 1, mpi_integer, ip-1, &
2265  itag, mpi_comm_wave, ierr_mpi )
2266  END DO
2267 #endif
2268  !
2269  ! -------------------------------------------------------------------- /
2270  ! 2. Processor to receive data at
2271  !
2272 #ifdef W3_MPI
2273  ELSE IF ( iaproc .GT. naproc ) THEN
2274 #endif
2275 #ifdef W3_MPI
2276  CALL mpi_recv ( dummy, 1, mpi_integer, 0, itag, &
2277  mpi_comm_wave, status, ierr_mpi )
2278 #endif
2279  !
2280  ! -------------------------------------------------------------------- /
2281  ! 3. Processor with no action
2282  !
2283 #ifdef W3_MPI
2284  END IF
2285 #endif
2286  !
2287  RETURN
2288  !
2289  ! Formats
2290  !
2291 #ifdef W3_MPIT
2292 9000 FORMAT ( ' TEST WMWOUT : INPUTS :',4i4)
2293 9001 FORMAT ( ' TEST WMWOUT : IAPROC, NAPROC, NTPROC :',3i5)
2294 9002 FORMAT ( ' TEST WMWOUT : NOT IN COMMUNICATOR')
2295 #endif
2296  !
2297 #ifdef W3_MPIT
2298 9010 FORMAT ( ' TEST WMWOUT : IAPROC =',i5,' SENDING TO ',i5)
2299 #endif
2300  !
2301 #ifdef W3_MPIT
2302 9020 FORMAT ( ' TEST WMWOUT : IAPROC =',i5, &
2303  ' RECEIVING FROM ',i5)
2304 #endif
2305  !
2306 #ifdef W3_MPIT
2307 9030 FORMAT ( ' TEST WMWOUT : IAPROC =',i5,' NO ACTION')
2308 #endif
2309  !/
2310  !/ End of WMWOUT ----------------------------------------------------- /
2311  !/

References w3odatmd::iaproc, include(), wmmdatmd::mdse, wmmdatmd::mdst, w3adatmd::mpi_comm_wave, wmmdatmd::mtagb, w3odatmd::naproc, w3odatmd::ntproc, w3servmd::strace(), w3adatmd::w3seta(), and w3odatmd::w3seto().

w3timemd::dsec21
real function dsec21(TIME1, TIME2)
Definition: w3timemd.F90:333
include
cmake src_list cmake include(${CMAKE_CURRENT_SOURCE_DIR}/cmake/check_switches.cmake) check_switches("$
Definition: CMakeLists.txt:15
w3odatmd::nrqpo
integer, pointer nrqpo
Definition: w3odatmd.F90:486
wmmdatmd::mdse
integer mdse
MDSE.
Definition: wmmdatmd.F90:316
w3idatmd::inflags1
logical, dimension(:), pointer inflags1
Definition: w3idatmd.F90:260
wmiopomd
Module for generating a single point output file for a multi- grid model implementation.
Definition: wmiopomd.F90:15
w3odatmd::notype
integer notype
Definition: w3odatmd.F90:327
wmupdtmd
Update model input at the driver level of the multi-grid version of WAVEWATCH III.
Definition: wmupdtmd.F90:14
w3adatmd
Define data structures to set up wave model auxiliary data for several models simultaneously.
Definition: w3adatmd.F90:26
wmmdatmd::stime
integer, dimension(2) stime
STIME.
Definition: wmmdatmd.F90:328
wmmdatmd::fllsti
logical, pointer fllsti
FLLSTI.
Definition: wmmdatmd.F90:562
wmmdatmd::dmv
real, dimension(:,:), pointer dmv
DMV.
Definition: wmmdatmd.F90:551
wmmdatmd::croot
integer, pointer croot
CROOT.
Definition: wmmdatmd.F90:545
w3wdatmd
Define data structures to set up wave model dynamic data for several models simultaneously.
Definition: w3wdatmd.F90:18
wmmdatmd::nmpscr
integer nmpscr
NMPSCR.
Definition: wmmdatmd.F90:324
w3odatmd::nopts
integer, pointer nopts
Definition: w3odatmd.F90:484
wmmdatmd::tmax
integer, dimension(:,:), allocatable tmax
TMAX.
Definition: wmmdatmd.F90:363
wmmdatmd::fllstl
logical, pointer fllstl
FLLSTL.
Definition: wmmdatmd.F90:560
w3odatmd::ntproc
integer, pointer ntproc
Definition: w3odatmd.F90:457
w3odatmd::dtout
real, dimension(:), pointer dtout
Definition: w3odatmd.F90:467
wmmdatmd::nrgrp
integer nrgrp
NRGRP.
Definition: wmmdatmd.F90:332
wmmdatmd::nmv
integer, pointer nmv
NMV.
Definition: wmmdatmd.F90:537
w3odatmd::iaproc
integer, pointer iaproc
Definition: w3odatmd.F90:457
wmmdatmd::mdss
integer mdss
MDSS.
Definition: wmmdatmd.F90:314
w3wdatmd::time
integer, dimension(:), pointer time
Definition: w3wdatmd.F90:172
w3odatmd::irqpo1
integer, dimension(:), pointer irqpo1
Definition: w3odatmd.F90:490
w3odatmd::unipts
logical unipts
Definition: w3odatmd.F90:333
wmmdatmd::mpi_comm_grd
integer, pointer mpi_comm_grd
MPI_COMM_GRD.
Definition: wmmdatmd.F90:543
wmmdatmd::grdeql
integer, dimension(:,:), allocatable grdeql
GRDEQL.
Definition: wmmdatmd.F90:357
wmmdatmd::nmplog
integer nmplog
NMPLOG.
Definition: wmmdatmd.F90:323
wminiomd
Internal IO routines for the multi-grid model.
Definition: wminiomd.F90:14
wmmdatmd::improc
integer improc
IMPROC.
Definition: wmmdatmd.F90:322
w3gdatmd::w3setg
subroutine w3setg(IMOD, NDSE, NDST)
Definition: w3gdatmd.F90:2152
wmmdatmd::grdhgh
integer, dimension(:,:), allocatable grdhgh
GRDHGH.
Definition: wmmdatmd.F90:356
wmmdatmd::ingrp
integer, dimension(:,:), allocatable ingrp
INGRP.
Definition: wmmdatmd.F90:355
w3servmd::wwtime
subroutine wwtime(STRNG)
Definition: w3servmd.F90:664
wmmdatmd::toutp
integer, dimension(:,:), allocatable toutp
TOUTP.
Definition: wmmdatmd.F90:364
wmmdatmd::nmproc
integer nmproc
NMPROC.
Definition: wmmdatmd.F90:321
w3adatmd::w3seta
subroutine w3seta(IMOD, NDSE, NDST)
Select one of the WAVEWATCH III grids / models.
Definition: w3adatmd.F90:2645
wminiomd::wmioef
subroutine wmioef(IMOD)
Finalize staging of internal same-rank data in the data structure EQSTGE (MPI only).
Definition: wminiomd.F90:3399
w3odatmd::tonext
integer, dimension(:,:), pointer tonext
Definition: w3odatmd.F90:464
wmmdatmd::mdsp
integer mdsp
MDSP.
Definition: wmmdatmd.F90:341
wmmdatmd::flghg1
logical flghg1
FLGHG1.
Definition: wmmdatmd.F90:379
w3wavemd
Contains wave model subroutine, w3wave.
Definition: w3wavemd.F90:13
wmmdatmd::amv
real, dimension(:,:), pointer amv
AMV.
Definition: wmmdatmd.F90:550
wmmdatmd::mapmsk
integer, dimension(:,:), pointer mapmsk
MAPMSK.
Definition: wmmdatmd.F90:540
wmmdatmd::fllstr
logical, pointer fllstr
FLLSTR.
Definition: wmmdatmd.F90:561
wmmdatmd::mpi_comm_bct
integer, pointer mpi_comm_bct
MPI_COMM_BCT.
Definition: wmmdatmd.F90:544
w3servmd
Definition: w3servmd.F90:3
w3timemd::tick21
subroutine tick21(TIME, DTIME)
Definition: w3timemd.F90:84
wmmdatmd::mtagb
integer, parameter mtagb
MTAGB.
Definition: wmmdatmd.F90:345
wmupdtmd::wmupdt
subroutine wmupdt(IMOD, TDATA)
Update inputs for selected wave model grid.
Definition: wmupdtmd.F90:103
w3wdatmd::w3setw
subroutine w3setw(IMOD, NDSE, NDST)
Select one of the WAVEWATCH III grids / models.
Definition: w3wdatmd.F90:660
wmmdatmd::tmv
integer, dimension(:,:,:), pointer tmv
TMV.
Definition: wmmdatmd.F90:538
w3odatmd::w3seto
subroutine w3seto(IMOD, NDSERR, NDSTST)
Definition: w3odatmd.F90:1523
wminiomd::wmioeg
subroutine wmioeg(IMOD, DONE)
Gather internal same-rank data for a given model.
Definition: wminiomd.F90:2820
w3timemd::stme21
subroutine stme21(TIME, DTME21)
Definition: w3timemd.F90:682
w3odatmd
Definition: w3odatmd.F90:3
wmmdatmd::grdlow
integer, dimension(:,:), allocatable grdlow
GRDLOW.
Definition: wmmdatmd.F90:359
w3odatmd::tolast
integer, dimension(:,:), pointer tolast
Definition: w3odatmd.F90:464
w3odatmd::naproc
integer, pointer naproc
Definition: w3odatmd.F90:457
wmmdatmd::allprc
integer, dimension(:,:), allocatable allprc
ALLPRC.
Definition: wmmdatmd.F90:360
wmmdatmd::fbcast
logical, pointer fbcast
FBCAST.
Definition: wmmdatmd.F90:568
wmmdatmd::nmperr
integer nmperr
NMPERR.
Definition: wmmdatmd.F90:326
wmiopomd::wmiopo
subroutine wmiopo(TOUT)
Gather and write unified point output.
Definition: wmiopomd.F90:640
wmmdatmd::mdst
integer mdst
MDST.
Definition: wmmdatmd.F90:315
wminiomd::wmiohg
subroutine wmiohg(IMOD, DONE)
Gather internal high-to-low data for a given model.
Definition: wminiomd.F90:1724
w3timemd::prtime
subroutine prtime(PTIME)
Definition: w3timemd.F90:990
w3odatmd::flout
logical, dimension(:), pointer flout
Definition: w3odatmd.F90:468
wmmdatmd::nmptst
integer nmptst
NMPTST.
Definition: wmmdatmd.F90:325
w3servmd::strace
subroutine strace(IENT, SNAME)
Definition: w3servmd.F90:148
wmmdatmd::wmsetm
subroutine wmsetm(IMOD, NDSE, NDST)
Select one of the WAVEWATCH III grids / models.
Definition: wmmdatmd.F90:1169
wminiomd::wmiobf
subroutine wmiobf(IMOD)
Finalize staging of internal boundary data in the data structure BPSTGE (MPI only).
Definition: wminiomd.F90:1212
w3idatmd
Define data structures to set up wave model input data for several models simultaneously.
Definition: w3idatmd.F90:16
wmmdatmd::grank
integer, dimension(:), allocatable grank
GRANK.
Definition: wmmdatmd.F90:353
w3wavemd::w3wave
subroutine w3wave(IMOD, ODAT, TEND, STAMP, NO_OUT ifdef W3_OASIS
Run WAVEWATCH III for a given time interval.
Definition: w3wavemd.F90:230
w3odatmd::nappnt
integer, pointer nappnt
Definition: w3odatmd.F90:457
wminiomd::wmioes
subroutine wmioes(IMOD)
Stage internal same-rank data in the data structure EQSTGE.
Definition: wminiomd.F90:2493
wminiomd::wmiohf
subroutine wmiohf(IMOD)
Finalize staging of internal high-to-low data in the data structure HGSTGE (MPI only).
Definition: wminiomd.F90:2325
w3adatmd::mpi_comm_wave
integer, pointer mpi_comm_wave
Definition: w3adatmd.F90:676
constants
Define some much-used constants for global use (all defined as PARAMETER).
Definition: constants.F90:20
w3gdatmd
Definition: w3gdatmd.F90:16
wmmdatmd
Define data structures to set up wave model dynamic data for several models simultaneously.
Definition: wmmdatmd.F90:16
wmmdatmd::flghg2
logical flghg2
FLGHG2.
Definition: wmmdatmd.F90:380
w3timemd
Definition: w3timemd.F90:3
wminiomd::wmiobs
subroutine wmiobs(IMOD)
Stage internal boundary data in the data structure BPSTGE.
Definition: wminiomd.F90:105
wminiomd::wmiobg
subroutine wmiobg(IMOD, DONE)
Gather internal boundary data for a given model.
Definition: wminiomd.F90:497
wminiomd::wmiohs
subroutine wmiohs(IMOD)
Stage internal high-to-low data in the data structure HGSTGE.
Definition: wminiomd.F90:1384
w3iopomd::w3iope
subroutine w3iope(A)
Extract point output data and store in output COMMONs.
Definition: w3iopomd.F90:697
w3gdatmd::mapsta
integer, dimension(:,:), pointer mapsta
Definition: w3gdatmd.F90:1163
wmmdatmd::dtres
real, dimension(:), allocatable dtres
DTRES.
Definition: wmmdatmd.F90:377
w3iopomd
Process point output.
Definition: w3iopomd.F90:19
w3gdatmd::mapst2
integer, dimension(:,:), pointer mapst2
Definition: w3gdatmd.F90:1163
wmmdatmd::etime
integer, dimension(2) etime
ETIME.
Definition: wmmdatmd.F90:329
w3gdatmd::dtmax
real, pointer dtmax
Definition: w3gdatmd.F90:1183
wmmdatmd::mpi_comm_mwave
integer mpi_comm_mwave
MPI_COMM_MWAVE.
Definition: wmmdatmd.F90:344