WAVEWATCH III  beta 0.0.1
wmwavemd.F90
Go to the documentation of this file.
1 
5 
6 #include "w3macros.h"
7 !/ ------------------------------------------------------------------- /
14 MODULE wmwavemd
15  !/
16  !/ +-----------------------------------+
17  !/ | WAVEWATCH III NOAA/NCEP |
18  !/ | H. L. Tolman |
19  !/ | FORTRAN 90 |
20  !/ | Last update : 22-Mar-2021 |
21  !/ +-----------------------------------+
22  !/
23  !/ 13-Jun-2005 : Origination. ( version 3.07 )
24  !/ 30-Jan-2006 : Add static nesting. ( version 3.08 )
25  !/ 25-May-2006 : Add overlapping grids. ( version 3.09 )
26  !/ 09-Aug-2006 : Unified point output added. ( version 3.10 )
27  !/ 22-Dec-2006 : Final algorith changes for tests. ( version 3.10 )
28  !/ 25-Jan-2007 : Tweaking algorithm. ( version 3.10 )
29  !/ 02-Feb-2007 : Replacing MPI_BCAST with WMBCST. ( version 3.10 )
30  !/ 07-Feb-2007 : Reintroduce pre-fetching. ( version 3.10 )
31  !/ 10-May-2007 : Removing / streamlining WMBCST. ( version 3.11 )
32  !/ 21-Jun-2007 : Dedicated output processes. ( version 3.11 )
33  !/ 20-Sep-2007 : Fix reset of GRSTAT in 0.b ( version 3.13 )
34  !/ 29-May-2009 : Preparing distribution version. ( version 3.14 )
35  !/ 20-Aug-2010 : Fix MAPSTA/MAPST2 bug. ( version 3.14.6 )
36  !/ 12-Mar-2012 : Use MPI_COMM_NULL for checks. ( version 3.14 )
37  !/ 28-Jan-2014 : Add memory hwm to profiling. ( version 5.00 )
38  !/ 22-Mar-2021 : Support for air density input ( version 7.13 )
39  !/
40  !/ Copyright 2009-2014 National Weather Service (NWS),
41  !/ National Oceanic and Atmospheric Administration. All rights
42  !/ reserved. WAVEWATCH III is a trademark of the NWS.
43  !/ No unauthorized use without permission.
44  !/
45  ! 1. Purpose :
46  !
47  ! Running the multi-grid version of WAVEWATCH III up to a given
48  ! ending time for each grid.
49  !
50  ! 2. Variables and types :
51  !
52  ! Name Type Scope Description
53  ! ----------------------------------------------------------------
54  ! ----------------------------------------------------------------
55  !
56  ! 3. Subroutines and functions :
57  !
58  ! Name Type Scope Description
59  ! ----------------------------------------------------------------
60  ! WMWAVE Subr. Public Wave model initialization.
61  ! WMPRNT Subr. Public Print action table to log file.
62  ! WMBCST Subr. Public Non-blocking MPI broadcast.
63  ! WMWOUT Subr. Public Non-blocking MPI broadcast.
64  ! ----------------------------------------------------------------
65  !
66  ! 4. Subroutines and functions used :
67  !
68  ! See subroutine documentation.
69  !
70  ! 5. Remarks :
71  !
72  ! 6. Switches :
73  !
74  ! See subroutine documentation.
75  !
76  ! 7. Source code :
77  !
78  !/ ------------------------------------------------------------------- /
79  PUBLIC
80  !/
81 CONTAINS
82  !/ ------------------------------------------------------------------- /
89 
90  SUBROUTINE wmwave ( TEND )
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  !/
1764  END SUBROUTINE wmwave
1765  !/ ------------------------------------------------------------------- /
1776  SUBROUTINE wmprnt ( MDSO, NRGRD, TSYNC, GRSTAT )
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  !/
1931  END SUBROUTINE wmprnt
1932  !/ ------------------------------------------------------------------- /
1951  SUBROUTINE wmbcst ( DATA, NR, IMOD, NMOD, ID )
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  !/
2116  END SUBROUTINE wmbcst
2117  !/ ------------------------------------------------------------------- /
2133  SUBROUTINE wmwout ( IMOD, NMOD, ID )
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  !/
2312  END SUBROUTINE wmwout
2313  !/
2314  !/ End of module WMWAVEMD -------------------------------------------- /
2315  !/
2316 END MODULE wmwavemd
wmmdatmd::tdata
integer, dimension(:,:), allocatable tdata
TDATA.
Definition: wmmdatmd.F90:365
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
wmwavemd::wmwave
subroutine wmwave(TEND)
Run multi-grid version of WAVEWATCH III.
Definition: wmwavemd.F90:91
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
wmmdatmd::mdso
integer mdso
MDSO.
Definition: wmmdatmd.F90:313
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::tsync
integer, dimension(:,:), allocatable tsync
TSYNC.
Definition: wmmdatmd.F90:362
wmmdatmd::mdss
integer mdss
MDSS.
Definition: wmmdatmd.F90:314
w3wdatmd::time
integer, dimension(:), pointer time
Definition: w3wdatmd.F90:172
wmwavemd
Running the multi-grid version of WAVEWATCH III up to a given ending time for each grid.
Definition: wmwavemd.F90:14
w3odatmd::irqpo1
integer, dimension(:), pointer irqpo1
Definition: w3odatmd.F90:490
w3odatmd::unipts
logical unipts
Definition: w3odatmd.F90:333
w3gdatmd::ny
integer, pointer ny
Definition: w3gdatmd.F90:1097
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
wmwavemd::wmbcst
subroutine wmbcst(DATA, NR, IMOD, NMOD, ID)
Non-blocking broadcast for integer arrays.
Definition: wmwavemd.F90:1952
wminiomd
Internal IO routines for the multi-grid model.
Definition: wminiomd.F90:14
w3wdatmd::va
real, dimension(:,:), pointer va
Definition: w3wdatmd.F90:183
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
wmmdatmd::nrgrd
integer nrgrd
NRGRD.
Definition: wmmdatmd.F90:330
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
wmwavemd::wmprnt
subroutine wmprnt(MDSO, NRGRD, TSYNC, GRSTAT)
Print out action table in the log file log. mww3.
Definition: wmwavemd.F90:1777
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
wmmdatmd::grstat
integer, dimension(:), allocatable grstat
GRSTAT.
Definition: wmmdatmd.F90:366
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
wmwavemd::wmwout
subroutine wmwout(IMOD, NMOD, ID)
Non-blocking broadcast using dummy parameter to have output.
Definition: wmwavemd.F90:2134
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
w3servmd::extcde
subroutine extcde(IEXIT, UNIT, MSG, FILE, LINE, COMM)
Definition: w3servmd.F90:736
w3gdatmd::nx
integer, pointer nx
Definition: w3gdatmd.F90:1097
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