!> @file !> @brief Contains module WMWAVEMD. !> !> @author H. L. Tolman @date 22-Mar-2021 #include "w3macros.h" !/ ------------------------------------------------------------------- / !> !> @brief 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 !> MODULE WMWAVEMD !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 22-Mar-2021 | !/ +-----------------------------------+ !/ !/ 13-Jun-2005 : Origination. ( version 3.07 ) !/ 30-Jan-2006 : Add static nesting. ( version 3.08 ) !/ 25-May-2006 : Add overlapping grids. ( version 3.09 ) !/ 09-Aug-2006 : Unified point output added. ( version 3.10 ) !/ 22-Dec-2006 : Final algorith changes for tests. ( version 3.10 ) !/ 25-Jan-2007 : Tweaking algorithm. ( version 3.10 ) !/ 02-Feb-2007 : Replacing MPI_BCAST with WMBCST. ( version 3.10 ) !/ 07-Feb-2007 : Reintroduce pre-fetching. ( version 3.10 ) !/ 10-May-2007 : Removing / streamlining WMBCST. ( version 3.11 ) !/ 21-Jun-2007 : Dedicated output processes. ( version 3.11 ) !/ 20-Sep-2007 : Fix reset of GRSTAT in 0.b ( version 3.13 ) !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) !/ 20-Aug-2010 : Fix MAPSTA/MAPST2 bug. ( version 3.14.6 ) !/ 12-Mar-2012 : Use MPI_COMM_NULL for checks. ( version 3.14 ) !/ 28-Jan-2014 : Add memory hwm to profiling. ( version 5.00 ) !/ 22-Mar-2021 : Support for air density input ( version 7.13 ) !/ !/ Copyright 2009-2014 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights !/ reserved. WAVEWATCH III is a trademark of the NWS. !/ No unauthorized use without permission. !/ ! 1. Purpose : ! ! Running the multi-grid version of WAVEWATCH III up to a given ! ending time for each grid. ! ! 2. Variables and types : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! 3. Subroutines and functions : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! WMWAVE Subr. Public Wave model initialization. ! WMPRNT Subr. Public Print action table to log file. ! WMBCST Subr. Public Non-blocking MPI broadcast. ! WMWOUT Subr. Public Non-blocking MPI broadcast. ! ---------------------------------------------------------------- ! ! 4. Subroutines and functions used : ! ! See subroutine documentation. ! ! 5. Remarks : ! ! 6. Switches : ! ! See subroutine documentation. ! ! 7. Source code : ! !/ ------------------------------------------------------------------- / PUBLIC !/ CONTAINS !/ ------------------------------------------------------------------- / !> !> @brief Run multi-grid version of WAVEWATCH III. !> !> @param[in] TEND Ending time for calculations for each grid. !> @author H. L. Tolman @date 22-Mar-2021 !> SUBROUTINE WMWAVE ( TEND ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 22-Mar-2021 | !/ +-----------------------------------+ !/ !/ 13-Jun-2005 : Origination. ( version 3.07 ) !/ 30-Jan-2006 : Add static nesting. ( version 3.08 ) !/ 25-May-2006 : Add overlapping grids. ( version 3.09 ) !/ 09-Aug-2006 : Unified point output added. ( version 3.10 ) !/ 22-Dec-2006 : Final algorith changes for tests. ( version 3.10 ) !/ 25-Jan-2007 : Tweaking algorithm. ( version 3.10 ) !/ 02-Feb-2007 : Replacing MPI_BCAST with WMBCST. ( version 3.10 ) !/ 07-Feb-2007 : Reintroduce pre-fetching. ( version 3.10 ) !/ 10-May-2007 : Removing / streamlining WMBCST. ( version 3.11 ) !/ 21-Jun-2007 : Dedicated output processes. ( version 3.11 ) !/ 20-Sep-2007 : Fix reset of GRSTAT in 0.b ( version 3.13 ) !/ 20-Aug-2010 : Fix MAPSTA/MAPST2 bug sec. 9.a. ( version 3.14.6 ) !/ 12-Mar-2012 : Use MPI_COMM_NULL for checks. ( version 3.14 ) !/ 28-Jan-2014 : Add memory hwm to profiling. ( version 5.00 ) !/ 22-Mar-2021 : Support for air density input ( version 7.13 ) !/ ! 1. Purpose : ! ! Run multi-grid version of WAVEWATCH III. ! ! 2. Method : ! ! See manual. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! TEND I.A. I Ending time for calculations for each grid. ! ---------------------------------------------------------------- ! ! Local variables ! ---------------------------------------------------------------- ! J Int. Group counter. ! JJ Int. Grid in group counter. ! I Int. Grid counter. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SETG Subr W3GDATMD Point to grid/model. ! W3SETW Subr W3WDATMD Point to grid/model. ! W3SETA Subr W3ADATMD Point to grid/model. ! W3SETO Subr W3ODATMD Point to grid/model. ! W3IOPE Subr W3IOPOMD Extracting point output. ! W3WAVE Subr W3WAVEMD Actual ave model routine. ! STRACE Subr W3SERVMD Subroutine tracing. ! EXTCDE Subr Id. Abort program with exit code. ! WWTIME Subr Id. System time in readable format. ! PRTIME Subr Id. Profiling routine ( !/MPRF ) ! STME21 Subr W3TIMEMD Print date and time readable. ! DSEC21 Func Id. Difference between times. ! TICK21 Subr Id. Advance time. ! WMSETM Subr WMMDATMD Point to grid/model. ! WMUPDT Subr WMUPDTMD Update input fields at driver level. ! WMIOBG Subr WMINIOMD Gather staged boundary data. ! WMIOBS Subr Id. Stage boundary data. ! WMIOBF Subr Id. Finalize WMIOBS. ( !/MPI ) ! WMIOHS Subr Id. Stage high-to-low data. ! WMIOHG Subr Id. Gather staged high-to-low data. ! WMIOHF Subr Id. Finalize WMIOHS. ( !/MPI ) ! WMIOES Subr Id. Stage same-rank data. ! WMIOEG Subr Id. Gather staged same-rank data. ! WMIOEF Subr Id. Finalize WMIOES. ( !/MPI ) ! WMIOPO Subr WMIOPOMD Unified point output. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3MLTI Prog. N/A Multi-grid model driver. ! .... Any coupled model. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! See formats 1000 and following, or escape locations 2000 and ! following. ! ! 7. Remarks : ! ! - If no action is taken in the endless loop, an error is ! assumed (code 2099). This should never take place in the ! default driver, but may be a problem in a coupled model. ! - If output is requested for the initial model time, TSYNC ! is set to TIME instead of (-1,0) for GRSTAT = 0. In this case ! input is updated, after which GRSTAT is set to 6 instead ! of 1. This assures that restarts do not impact model results ! by spurious double reconciliations. ! ! 8. Structure : ! ! See source code and manual. ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! !/T Enable test output. ! !/MPIT Enable test output (use with !/MPI only). ! !/MPRF Profiling. ! ! !/SHRD, !/DIST, !/MPI ! Shared / distributed program model. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE CONSTANTS !/ USE W3GDATMD, ONLY: W3SETG USE W3WDATMD, ONLY: W3SETW USE W3ADATMD, ONLY: W3SETA USE W3ODATMD, ONLY: W3SETO, NOTYPE USE W3IOPOMD, ONLY: W3IOPE USE W3WAVEMD, ONLY: W3WAVE USE W3SERVMD, ONLY: EXTCDE, WWTIME #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif #ifdef W3_MPRF USE W3TIMEMD, ONLY: PRTIME #endif USE W3TIMEMD, ONLY: DSEC21, STME21, TICK21 USE WMMDATMD, ONLY: WMSETM USE WMUPDTMD, ONLY: WMUPDT USE WMINIOMD, ONLY: WMIOBG, WMIOBS, WMIOBF, WMIOHG, WMIOHS, & WMIOHF, WMIOEG, WMIOES, WMIOEF USE WMIOPOMD, ONLY: WMIOPO !/ USE W3GDATMD, ONLY: DTMAX, NX, NY, MAPSTA, MAPST2 USE W3WDATMD, ONLY: TIME, VA USE W3ODATMD, ONLY: FLOUT, TONEXT, DTOUT, TOLAST, IAPROC, & NAPPNT, NOPTS, UNIPTS #ifdef W3_MPI USE W3ODATMD, ONLY: NRQPO, IRQPO1 #endif USE W3IDATMD, ONLY: INFLAGS1 USE WMMDATMD, ONLY: MDSO, MDSS, MDST, MDSE, IMPROC, & NMPROC, NMPSCR, NMPERR, NMPTST, NMPLOG, & STIME, ETIME, NMV, TMV, AMV, DMV, & NRGRD, NRGRP, GRANK, INGRP, GRDHGH, GRDEQL, & GRDLOW, TSYNC, TMAX, TOUTP, TDATA, GRSTAT, & FLLSTL, FLLSTI, FLLSTR, DTRES, FLGHG1, & FLGHG2, MAPMSK #ifdef W3_MPI USE WMMDATMD, ONLY: MPI_COMM_MWAVE, MPI_COMM_GRD, & MPI_COMM_BCT, CROOT, FBCAST #endif #ifdef W3_MPRF USE WMMDATMD, ONLY: MDSP #endif !/ IMPLICIT NONE ! #ifdef W3_MPI INCLUDE "mpif.h" #endif !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: TEND(2,NRGRD) !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: J, JJ, I, JO, TPRNT(2), TAUX(2), & II, JJJ, IX, IY, UPNEXT(2), UPLAST(2) INTEGER :: DUMMY2(35)=0 #ifdef W3_T INTEGER :: ILOOP #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif #ifdef W3_MPI INTEGER :: IERR_MPI, NMPSCS INTEGER, ALLOCATABLE :: STATUS(:,:) #endif REAL :: DTTST, DTMAXI #ifdef W3_MPRF REAL :: PRFT0, PRFTN, PRFTS REAL(KIND=8) :: get_memory #endif CHARACTER(LEN=8) :: WTIME CHARACTER(LEN=23) :: MTIME LOGICAL :: DONE, TSTAMP, FLAGOK, DO_UPT, & FLG_O1, FLG_O2 #ifdef W3_MPI LOGICAL :: FLAG #endif LOGICAL, ALLOCATABLE :: FLSYNC(:), GRSYNC(:), TMSYNC(:), & FLEQOK(:) #ifdef W3_MPI LOGICAL, ALLOCATABLE :: PREGTB(:), PREGTH(:), PREGTE(:) #endif !/ !/ ------------------------------------------------------------------- / ! #ifdef W3_S CALL STRACE (IENT, 'WMWAVE') #endif ! #ifdef W3_MPRF CALL PRTIME ( PRFT0 ) #endif ! #ifdef W3_O10 IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) WRITE (MDSS,900) #endif ! ! 0. Initializations ------------------------------------------------ / ! 0.a Initial testing ! Test GRSTAT ! DO I=1, NRGRD IF ( ( GRSTAT(I).LT.0 .OR. GRSTAT(I).GT.7 ) .AND. & GRSTAT(I).NE.99 ) GOTO 2000 ! ! Consistency of times for grids ! IF ( TSYNC(1,I) .NE. -1 ) THEN DTTST = DSEC21 ( TSYNC(:,I), TEND(:,I) ) IF ( DTTST .LT. 0. ) GOTO 2001 END IF END DO ! ! Consistency of times within groups, set global TSYNC(:,0) ! DO J=1, NRGRP DO JJ=2, INGRP(J,0) IF ( DSEC21(TSYNC(:,INGRP(J,1)),TSYNC(:,INGRP(J,JJ))).NE.0. & .OR. DSEC21(TEND(:,INGRP(J,1)),TEND(:,INGRP(J,JJ))).NE.0. ) & GOTO 2002 END DO IF ( GRANK(INGRP(J,1)).EQ.1 .AND. TSYNC(1,0).EQ.-1 ) & TSYNC(:,0) = TSYNC(:,INGRP(J,1)) END DO ! ! Check if FLSYNC initialized ! IF ( .NOT. ALLOCATED(FLSYNC) ) THEN ALLOCATE ( FLSYNC(NRGRD), GRSYNC(NRGRP), TMSYNC(NRGRD), & FLEQOK(NRGRD) ) #ifdef W3_MPI ALLOCATE ( PREGTB(NRGRD), PREGTH(NRGRD), PREGTE(NRGRD) ) #endif FLSYNC = .FALSE. GRSYNC = .FALSE. TMSYNC = .TRUE. FLEQOK = .FALSE. #ifdef W3_MPI PREGTB = .FALSE. PREGTH = .FALSE. PREGTE = .FALSE. #endif END IF ! ! 0.b Reset GRSTAT as needed ! DO I=1, NRGRD CALL W3SETW ( I, MDSE, MDST ) DTTST = DSEC21 ( TIME, TEND(:,I) ) IF ( GRSTAT(I).EQ.99 .AND. DTTST.GT.0. ) GRSTAT(I) = 0 END DO ! ! 0.c Other initializations ! DTRES = 0. #ifdef W3_MPI NMPSCS = NMPSCR #endif ! IF ( UNIPTS ) THEN CALL W3SETO ( 0, MDSE, MDST ) UPNEXT = TONEXT(:,2) UPLAST = TOLAST(:,2) DO_UPT = .TRUE. ELSE UPNEXT(1) = -1 UPNEXT(2) = 0 DO_UPT = .FALSE. END IF ! ! 0.d Output ! IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN CALL WMPRNT ( MDSO, NRGRD, TSYNC(:,0), GRSTAT ) CALL STME21 ( TSYNC(:,0), MTIME ) CALL WWTIME ( WTIME ) WRITE (MDSS,901) MTIME, WTIME, MINVAL(GRSTAT), MAXVAL(GRSTAT) TPRNT = TSYNC(:,0) TSTAMP = .TRUE. ENDIF ! #ifdef W3_MPI CALL MPI_BARRIER (MPI_COMM_MWAVE,IERR_MPI) #endif ! #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,990) PRFT0, PRFTN, get_memory() #endif ! ! 1. Setting up loop structure -------------------------------------- / ! #ifdef W3_T ILOOP = 0 #endif ! LOOP_OUTER: DO ! IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC .AND. & DSEC21(TPRNT,TSYNC(:,0)).NE.0. ) THEN IF ( .NOT. TSTAMP ) WRITE (MDSS,*) CALL WMPRNT ( MDSO, NRGRD, TSYNC(:,0), GRSTAT ) CALL STME21 ( TSYNC(:,0), MTIME ) CALL WWTIME ( WTIME ) WRITE (MDSS,901) MTIME, WTIME, MINVAL(GRSTAT), MAXVAL(GRSTAT) ! TPRNT = TSYNC(:,0) TSTAMP = .TRUE. ENDIF ! #ifdef W3_T ILOOP = ILOOP + 1 WRITE (MDST,9000) ILOOP, TSYNC(:,0) DO I=1, NRGRD CALL W3SETW ( I, MDSE, MDST ) WRITE (MDST,9001) I, GRSTAT(I), TIME, TSYNC(:,I), TEND(:,I) END DO IF ( ILOOP .EQ. -1 ) CALL EXTCDE ( 508 ) #endif ! DONE = .FALSE. TPRNT = TSYNC(:,0) ! LOOP_J: DO J=1, NRGRP ! #ifdef W3_MPI GRSYNC(J) = .FALSE. DO JJ=1, INGRP(J,0) I = INGRP(J,JJ) CALL WMSETM ( I, MDSE, MDST ) GRSYNC(J) = GRSYNC(J) .OR. FBCAST END DO #endif ! LOOP_JJ: DO JJ=1, INGRP(J,0) I = INGRP(J,JJ) CALL WMSETM ( I, MDSE, MDST ) ! #ifdef W3_MPI IF ( GRSTAT(I).EQ.0 ) TMSYNC(I) = .NOT. FBCAST IF ( FBCAST ) THEN NMPSCR = CROOT ELSE NMPSCR = NMPSCS END IF #endif ! ! 2. Update input fields -------------------------------------------- / ! ( GRSTAT = 0 ) ! ! 2.a Check TDATA and finish step if data is still OK ! #ifdef W3_SHRD IF ( GRSTAT(I) .EQ. 0 ) THEN #endif #ifdef W3_MPI IF ( GRSTAT(I).EQ.0 .AND. .NOT.FLSYNC(I) ) THEN #endif ! #ifdef W3_T WRITE (MDST,9002) I, GRSTAT(I), ' ' #endif ! IF ( TDATA(1,I) .EQ. -1 ) THEN DTTST = 0. ELSE CALL W3SETW ( I, MDSE, MDST ) DTTST = DSEC21 ( TIME , TDATA(:,I) ) END IF #ifdef W3_T WRITE (MDST,9020) DTTST #endif ! IF ( DTTST .GT. 0. ) THEN GRSTAT(I) = 1 #ifdef W3_T WRITE (MDST,9003) I, GRSTAT(I) #endif DONE = .TRUE. END IF ! #ifdef W3_MPI END IF ! IF ( GRSTAT(I).EQ.0 .AND. .NOT.FLSYNC(I) #endif #ifdef W3_SHRD END IF ! IF ( GRSTAT(I) .EQ. 0 ) #endif ! ! 2.b Update input and TDATA ! #ifdef W3_SHRD IF ( GRSTAT(I) .EQ. 0 ) THEN #endif #ifdef W3_MPI IF ( GRSTAT(I).EQ.0 .AND. .NOT.FLSYNC(I) .AND. & MPI_COMM_GRD .NE. MPI_COMM_NULL ) THEN #endif ! #ifdef W3_MPRF CALL PRTIME ( PRFT0 ) #endif IF ( DTTST .LE. 0 ) THEN IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & WRITE (MDSS,*) TSTAMP = .FALSE. CALL WMUPDT ( I, TDATA(:,I) ) #ifdef W3_T WRITE (MDST,9021) TIME, TDATA(:,I), TEND(:,I) #endif END IF ! ! 2.c Finish up if possible ( !/SHRD or .NOT. FBCAST or no update ) ! #ifdef W3_SHRD GRSTAT(I) = 1 DONE = .TRUE. #endif ! #ifdef W3_MPI IF ( .NOT. GRSYNC(J) ) THEN #endif #ifdef W3_MPIT WRITE (MDST,9902) I, GRSTAT(I), & 'NO SYNC FOR TDATA NEEDED' #endif #ifdef W3_MPI GRSTAT(I) = 1 DONE = .TRUE. END IF ! IF ( .NOT. GRSYNC(J) ) #endif ! #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN, get_memory(), & 'ST00', I #endif ! #ifdef W3_MPI END IF ! IF ( GRSTAT(I).EQ.0 .AND. .NOT.FLSYNC(I) .AND. MPI_COMM_GRD .NE. MPI_COMM_NULL ) #endif #ifdef W3_SHRD END IF ! IF ( GRSTAT(I) .EQ. 0 ) #endif ! ! 2.d Synchronize in parts ( !/MPI ) ! #ifdef W3_MPI IF ( GRSTAT(I).EQ.0 .AND. GRSYNC(J) ) THEN DONE = .TRUE. #endif ! #ifdef W3_MPI IF ( FLSYNC(I) ) THEN #endif #ifdef W3_MPIT WRITE (MDST,9902) I, GRSTAT(I), & 'SYNCING TDATA' #endif #ifdef W3_MPRF IF (FLSYNC(I)) CALL PRTIME ( PRFT0 ) #endif #ifdef W3_MPI IF ( FBCAST ) CALL WMBCST & ( TDATA(1,I), 2, I, NRGRD, 1 ) #endif #ifdef W3_MPRF IF (FLSYNC(I)) CALL PRTIME ( PRFTN ) IF (FLSYNC(I)) WRITE (MDSP,991) & PRFT0, PRFTN, get_memory(), 'BCST',I #endif #ifdef W3_MPIT WRITE (MDST,9902) I, GRSTAT(I), 'SYNCING DONE' #endif #ifdef W3_MPI GRSTAT(I) = 1 FLSYNC(I) = .FALSE. IF ( GRSYNC(J) ) CYCLE LOOP_JJ ELSE #endif #ifdef W3_MPIT WRITE (MDST,9902) I, GRSTAT(I), & 'CYCLE BEFORE SYNCING TDATA' #endif #ifdef W3_MPI FLSYNC(I) = .TRUE. CYCLE LOOP_JJ END IF ! IF ( FLSYNC(I) ) #endif ! #ifdef W3_MPI END IF ! IF ( GRSTAT(I).EQ.0 .AND. GRSYNC(J) #endif ! ! 3. Update data from lower ranked grids ---------------------------- / ! ( GRSTAT = 1 ) ! ! 3.a Skip for initial output only ! IF ( GRSTAT(I) .EQ. 1 .AND. TSYNC(1,I) .NE. -1 ) THEN #ifdef W3_T WRITE (MDST,9002) I, GRSTAT(I), 'FIRST PART' #endif CALL W3SETW ( I, MDSE, MDST ) DTTST = DSEC21 ( TIME, TSYNC(:,I) ) IF ( DTTST .EQ. 0. ) THEN GRSTAT(I) = 7 #ifdef W3_T WRITE (MDST,9003) I, GRSTAT(I) #endif DONE = .TRUE. END IF END IF ! IF ( GRSTAT(I) .EQ. 1 .AND. TSYNC(1,I) .NE. -1 ) ! ! 3.b Normal processing ! IF ( GRSTAT(I) .EQ. 1 ) THEN #ifdef W3_T WRITE (MDST,9002) I, GRSTAT(I), 'SECOND PART' #endif #ifdef W3_MPRF CALL PRTIME ( PRFT0 ) #endif ! ! 3.b.1 Test if data is there ! FLAGOK = .TRUE. CALL W3SETW ( I, MDSE, MDST ) TAUX = TIME DO JJJ=1, GRDLOW(I,0) CALL W3SETW ( GRDLOW(I,JJJ), MDSE, MDST ) FLAGOK = FLAGOK .AND. DSEC21(TAUX,TIME).GT.0. & .AND. GRSTAT(GRDLOW(I,JJJ)).EQ.5 END DO CALL W3SETW ( I, MDSE, MDST ) ! #ifdef W3_T WRITE (MDST,9004) FLAGOK #endif ! ! 3.b.1 Get the data ! #ifdef W3_MPI IF ( .NOT.FLAGOK .AND. .NOT.PREGTB(I) ) THEN IF ( MPI_COMM_GRD.NE.MPI_COMM_NULL ) & CALL WMIOBG (I,FLAG) PREGTB(I) = .TRUE. END IF #endif ! IF ( FLAGOK ) THEN #ifdef W3_SHRD CALL WMIOBG ( I, FLAGOK ) #endif #ifdef W3_MPI IF ( MPI_COMM_GRD.NE.MPI_COMM_NULL ) & CALL WMIOBG ( I ) PREGTB(I) = .FALSE. #endif GRSTAT(I) = 2 DONE = .TRUE. END IF ! IF ( FLAGOK ) ! #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN, get_memory(), & 'ST01', I #endif END IF ! IF ( GRSTAT(I) .EQ. 1 ) ! ! 4. Update model time step ----------------------------------------- / ! ( GRSTAT = 2 ) ! IF ( GRSTAT(I) .EQ. 2 ) THEN #ifdef W3_T WRITE (MDST,9002) I, GRSTAT(I), ' ' #endif #ifdef W3_MPRF CALL PRTIME ( PRFT0 ) #endif ! ! 4.a Check TMAX and update as necessary ( needs !/MPI synchronizaion ) ! CALL W3SETW ( I, MDSE, MDST ) IF ( TMAX(1,I) .EQ. -1 ) THEN TMAX(:,I) = TIME DTTST = 0. ELSE DTTST = DSEC21(TIME,TMAX(:,I)) END IF ! IF ( DTTST .LE. 0 ) THEN CALL W3SETG ( I, MDSE, MDST ) DTMAXI = REAL(NINT(DTMAX+DTRES(I)+0.0001)) DTRES(I)= DTRES(I)+ DTMAX - DTMAXI IF ( ABS(DTRES(I)) .LT. 0.001 ) DTRES(I) = 0. TMAX(:,I) = TIME CALL TICK21 ( TMAX(:,I), DTMAXI ) TAUX = TMAX(:,I) IF ( TDATA(1,I) .NE. -1 ) THEN IF ( DSEC21(TDATA(:,I),TMAX(:,I)) .GT. 0 ) & TMAX(:,I) = TDATA(:,I) END IF IF ( TOUTP(1,I) .NE. -1 ) THEN IF ( DSEC21(TOUTP(:,I),TMAX(:,I)) .GT. 0 ) & TMAX(:,I) = TOUTP(:,I) END IF IF ( UNIPTS ) THEN IF ( DSEC21(UPNEXT,TMAX(:,I)) .GT. 0 ) & TMAX(:,I) = UPNEXT(:) END IF #ifdef W3_T WRITE (MDST,9040) TMAX(:,I), DTRES(I), TAUX, & TDATA(:,I), TOUTP(:,I), UPNEXT #endif DONE = .TRUE. CYCLE LOOP_JJ #ifdef W3_T ELSE WRITE (MDST,9041) TMAX(:,I) #endif END IF ! IF ( DTTST .LE. 0 ) ! ! 4.b Lowest ranked grids, minimum of all TMAXes ! #ifdef W3_T WRITE (MDST,9042) GRANK(I) #endif ! IF ( GRANK(I) .EQ. 1 ) THEN ! TAUX = TMAX(:,I) FLAGOK = .TRUE. ! ! 4.b.1 Check if all grids have reached previous sync point ! DO II=1, NRGRD CALL W3SETW ( II, MDSE, MDST ) #ifdef W3_SHRD IF ( TIME(1) .NE. -1 ) THEN #endif #ifdef W3_MPI IF ( TIME(1).NE.-1 .AND. & MPI_COMM_GRD.NE.MPI_COMM_NULL ) THEN #endif IF ( DSEC21(TIME,TSYNC(:,0)) .NE. 0 ) THEN FLAGOK = .FALSE. EXIT END IF #ifdef W3_MPI END IF ! IF ( TIME(1).NE.-1 .AND. MPI_COMM_GRD.NE.MPI_COMM_NULL ) #endif #ifdef W3_SHRD END IF ! IF ( TIME(1) .NE. -1 ) THEN #endif END DO ! ! 4.b.2 Check availability of data ! DO II=1, NRGRD IF ( GRANK(II) .EQ. 1 ) THEN IF ( TMAX(1,II) .EQ. -1 ) THEN FLAGOK = .FALSE. EXIT ELSE IF ( DSEC21 (TAUX,TMAX(:,II)) .LT. 0. ) & TAUX = TMAX(:,II) END IF END IF END DO ! CALL W3SETW ( I, MDSE, MDST ) FLAGOK = FLAGOK .AND. DSEC21(TIME,TAUX).GT.0. ! ! 4.b.3 Update TSYNC for all grids ! IF ( FLAGOK ) THEN ! TSYNC(:,0) = TAUX DO_UPT = .TRUE. DO II=1, NRGRD IF ( GRANK(II) .EQ. 1 ) THEN TSYNC(:,II) = TAUX IF ( GRSTAT(II) .EQ. 2 ) GRSTAT(II) = 3 #ifdef W3_T IF ( GRSTAT(II) .EQ. 3 ) & WRITE (MDST,9003) II, GRSTAT(II) #endif END IF END DO DONE = .TRUE. #ifdef W3_MPRF CALL PRTIME ( PRFTS ) WRITE (MDSP,992) PRFTS, PRFTS, & get_memory(), 'TIME', TSYNC(:,0) #endif ! ! 4.b.4 Output ! #ifdef W3_T WRITE (MDST,9043) TSYNC(:,0) WRITE (MDST,9045) WRITE (MDST,9046) (II,TSYNC(:,II),II=0,NRGRD) #endif ! ! 4.b.5 Skip computations so that all grids start processing ! simultaneously. ! #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN, & get_memory(), 'ST02', I #endif #ifdef W3_T IF ( INGRP(J,0) .GT. 1 ) WRITE (MDST,9006) #endif IF ( INGRP(J,0) .GT. 1 ) GOTO 1111 ! END IF ! IF ( FLAGOK ) ! ! 4.c Other grids, logical from relations and TMAXes ! ELSE IF ( TSYNC(1,0) .NE. -1 ) THEN ! TAUX = TSYNC(:,0) FLAGOK = .TRUE. ! ! 4.c.1 Check availability of data within group ! Time within group needs to be the same for load balancing. ! DO JJJ=1, INGRP(J,0) II = INGRP(J,JJJ) IF ( TMAX(1,II) .EQ. -1 ) THEN FLAGOK = .FALSE. EXIT ELSE IF ( DSEC21 (TAUX,TMAX(:,II)) .LT. 0. ) & TAUX = TMAX(:,II) END IF END DO ! ! 4.c.2 Check with dependent lower rank grids ( TSYNC ) ! DO JJJ=1, GRDLOW(I,0) II = GRDLOW(I,JJJ) IF ( TSYNC(1,II) .EQ. -1 ) THEN FLAGOK = .FALSE. EXIT ELSE IF ( DSEC21 (TAUX,TSYNC(:,II)) .LT. 0. ) & TAUX = TSYNC(:,II) END IF END DO ! ! 4.c.3 Check with dependent higher rank grids ( TSYNC ) ! No check needed ! ! 4.c.4 Final check against grid time ! CALL W3SETW ( I, MDSE, MDST ) FLAGOK = FLAGOK .AND. DSEC21(TIME,TAUX).GT.0. ! ! 4.c.5 Update TSYNC throughout group ! IF ( FLAGOK ) THEN ! DO JJJ=1, INGRP(J,0) II = INGRP(J,JJJ) TSYNC(:,II) = TAUX IF ( GRSTAT(II) .EQ. 2 ) GRSTAT(II) = 3 #ifdef W3_T IF ( GRSTAT(II) .EQ. 3 ) & WRITE (MDST,9003) II, GRSTAT(II) #endif END DO DONE = .TRUE. ! #ifdef W3_T WRITE (MDST,9044) TSYNC(:,I), TAUX WRITE (MDST,9045) WRITE (MDST,9046) (II,TSYNC(:,II),II=0,NRGRD) #endif ! ! 4.c.6 Skip computations so that all grids in group are advanced ! simultaneously. #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN, & get_memory(), 'ST02', I #endif #ifdef W3_T IF ( INGRP(J,0) .GT. 1 ) WRITE (MDST,9006) #endif IF ( INGRP(J,0) .GT. 1 ) GOTO 1111 ! END IF ! IF ( FLAGOK ) ! END IF ! 4.b IF ( GRANK(I) .EQ. 1 ) ! END IF ! 4. IF ( GRSTAT(I) .EQ. 2 ) ! ! 5. Run the wave model --------------------------------------------- / ! ( GRSTAT = 3 ) w3xdatmd data structures set in W3WAVE ! ! 5.a Run model ! #ifdef W3_SHRD IF ( GRSTAT(I) .EQ. 3 ) THEN #endif ! #ifdef W3_MPI IF ( GRSTAT(I).EQ.3 .AND. & MPI_COMM_GRD .EQ. MPI_COMM_NULL ) THEN CALL W3SETW ( I, MDSE, MDST ) TIME = TSYNC(:,I) GRSTAT(I) = 4 DONE = .TRUE. ELSE IF ( GRSTAT(I).EQ.3 .AND. & MPI_COMM_GRD .NE. MPI_COMM_NULL ) THEN #endif ! #ifdef W3_T WRITE (MDST,9002) I, GRSTAT(I), 'RUNNING MODEL' #endif #ifdef W3_MPRF CALL PRTIME ( PRFT0 ) #endif ! CALL WMSETM ( I, MDSE, MDST ) CALL W3WAVE ( I, DUMMY2, TSYNC(:,I), .FALSE., .TRUE. ) IF ( FLLSTL ) INFLAGS1(1) = .FALSE. IF ( FLLSTI ) INFLAGS1(4) = .FALSE. IF ( FLLSTR ) INFLAGS1(6) = .FALSE. ! ! 5.b Stage data for grids with equal rank ! #ifdef W3_MPI CALL WMIOEF ( I ) #endif CALL WMIOES ( I ) ! ! 5.c Finish up ! GRSTAT(I) = 4 DONE = .TRUE. ! #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN, get_memory(), & 'ST03', I #endif ! #ifdef W3_MPI END IF ! IF ( GRSTAT(I).EQ.3 .AND. MPI_COMM_GRD .EQ. MPI_COMM_NULL ) #endif #ifdef W3_SHRD END IF ! IF ( GRSTAT(I) .EQ. 3 ) #endif ! ! 6. Reconcile grids with same rank --------------------------------- / ! and stage data transfer to higher and lower ranked grids. ! ( GRSTAT = 4 ) ! IF ( GRSTAT(I) .EQ. 4 ) THEN #ifdef W3_MPRF CALL PRTIME ( PRFT0 ) #endif ! ! 6.a Test against times and statuses of dependent grids ! Note: This is done per GROUP, not per local equal grid dependence ! Therefore, it is essential that sync times per group are ! equal (4.c.1) and that all equal grid dependences are a ! subset of groups (WMGEQL 5.d) ! #ifdef W3_T WRITE (MDST,9002) I, GRSTAT(I), 'FIRST PART' WRITE (MDST,9005) FLEQOK(I) #endif ! ! 6.a.1 Check if sync point is reached ! IF ( .NOT. FLEQOK(I) ) THEN ! FLAGOK = .TRUE. CALL W3SETW ( I, MDSE, MDST ) TAUX = TIME DO JJJ=1, INGRP(J,0) CALL W3SETW ( INGRP(J,JJJ), MDSE, MDST ) FLAGOK = FLAGOK .AND. DSEC21(TAUX,TIME).EQ.0. & .AND. GRSTAT(INGRP(J,JJJ)).EQ.4 END DO CALL W3SETW ( I, MDSE, MDST ) #ifdef W3_T WRITE (MDST,9004) FLAGOK #endif ! ! 6.a.2 Point reached, set flag for all in group and cycle ! IF ( FLAGOK ) THEN DO JJJ=1, INGRP(J,0) FLEQOK(INGRP(J,JJJ)) = .TRUE. #ifdef W3_T WRITE (MDST,9061) INGRP(J,JJJ), & FLEQOK(INGRP(J,JJJ)) #endif END DO DONE = .TRUE. #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN, & get_memory(), 'ST04', I #endif ! #ifdef W3_T IF ( INGRP(J,0) .GT. 1 ) WRITE (MDST,9006) #endif IF ( INGRP(J,0) .GT. 1 ) GOTO 1111 END IF ! IF ( FLAGOK ) ! END IF ! IF ( .NOT. FLEQOK(I) ) ! ! 6.b Call gathering routine, reset FLEQOK and cycle ! #ifdef W3_MPI IF ( .NOT.FLEQOK(I) .AND. .NOT.PREGTE(I) ) THEN IF ( MPI_COMM_GRD.NE.MPI_COMM_NULL ) & CALL WMIOEG (I,FLAG) PREGTE(I) = .TRUE. END IF #endif ! IF ( FLEQOK(I) ) THEN #ifdef W3_SHRD CALL WMIOEG ( I ) #endif #ifdef W3_MPI IF ( MPI_COMM_GRD.NE.MPI_COMM_NULL ) & CALL WMIOEG ( I ) PREGTE(I) = .FALSE. #endif GRSTAT(I) = 5 FLEQOK(I) = .FALSE. DONE = .TRUE. END IF ! ! 6.c Stage data ! IF ( GRSTAT(I) .EQ. 5 ) THEN ! #ifdef W3_T WRITE (MDST,9002) I, GRSTAT(I)-1, 'SECOND PART' #endif ! #ifdef W3_SHRD CALL WMIOBS ( I ) #endif ! #ifdef W3_MPI IF ( MPI_COMM_GRD .NE. MPI_COMM_NULL ) THEN CALL WMIOBF ( I ) CALL WMIOBS ( I ) END IF #endif ! #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN, & get_memory(), 'ST04', I #endif CYCLE LOOP_JJ ! END IF ! IF ( GRSTAT(I) .EQ. 5 ) ! #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN, & get_memory(), 'ST04', I #endif ! END IF ! 6. IF ( GRSTAT(I) .EQ. 4 ) ! ! 7. Reconcile with higher ranked grids ----------------------------- / ! ( GRSTAT = 5 ) ! ! This needs to be a little more complicated than with boundary ! data to assure proper logic in cases where data providing ! data does not get data back (e.g., as for the boundary grid ! in mww3_test_04) ! IF ( GRSTAT(I) .EQ. 5 ) THEN #ifdef W3_MPRF CALL PRTIME ( PRFT0 ) #endif #ifdef W3_T WRITE (MDST,9002) I, GRSTAT(I), ' ' #endif ! ! 7.a Test against times and statuses of dependent grids ! IF ( GRDHGH(I,0) .EQ. 0 ) THEN GRSTAT(I) = 6 DONE = .TRUE. ELSE ! FLAGOK = .TRUE. CALL W3SETW ( I, MDSE, MDST ) TAUX = TIME DO JJJ=1, GRDHGH(I,0) CALL W3SETW ( GRDHGH(I,JJJ), MDSE, MDST ) IF ( .NOT. ( DSEC21(TAUX,TIME).EQ.0. .AND. & ( GRSTAT(GRDHGH(I,JJJ)).GE.7 .OR. & GRSTAT(GRDHGH(I,JJJ)).LE.2 ) ) ) & FLAGOK = .FALSE. END DO CALL W3SETW ( I, MDSE, MDST ) ! #ifdef W3_T WRITE (MDST,9004) FLAGOK #endif ! ! 7.b Call gathering routine ! #ifdef W3_MPI IF ( .NOT.FLAGOK .AND. .NOT.PREGTH(I) ) THEN IF ( MPI_COMM_GRD.NE.MPI_COMM_NULL ) & CALL WMIOHG ( I, FLAG ) PREGTH(I) = .TRUE. END IF #endif ! IF ( FLAGOK ) THEN #ifdef W3_SHRD CALL WMIOHG ( I, FLAGOK ) #endif #ifdef W3_MPI IF ( MPI_COMM_GRD.NE.MPI_COMM_NULL ) & CALL WMIOHG ( I ) PREGTH(I) = .FALSE. #endif GRSTAT(I) = 6 DONE = .TRUE. END IF ! IF ( FLAGOK ) ! END IF ! IF ( GRDHGH(I,0) .EQ. 0 ) ! ! 7.c Stage data ! #ifdef W3_SHRD IF ( GRSTAT(I) .EQ. 6 ) CALL WMIOHS ( I ) #endif ! #ifdef W3_MPI IF ( GRSTAT(I) .EQ. 6 .AND. & MPI_COMM_GRD .NE. MPI_COMM_NULL ) THEN CALL WMIOHF ( I ) CALL WMIOHS ( I ) END IF #endif ! #ifdef W3_T IF (GRSTAT(I).EQ.6) WRITE(MDST,9003) I, GRSTAT(I) #endif #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN, get_memory(), & 'ST05', I #endif END IF ! 7. IF ( GRSTAT(I) .EQ. 5 ) ! ! 8. Perform data assimmilation ------------------------------------- / ! ( GRSTAT = 6 ) Placeholder only ..... ! IF ( GRSTAT(I) .EQ. 6 ) THEN #ifdef W3_MPRF CALL PRTIME ( PRFT0 ) #endif #ifdef W3_T WRITE (MDST,9002) I, GRSTAT(I), ' ' #endif GRSTAT(I) = 7 #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN, get_memory(), & 'ST06', I #endif DONE = .TRUE. END IF ! IF ( GRSTAT(I) .EQ. 6 ) ! ! 9. Perform output ------------------------------------------------- / ! ( GRSTAT = 7 ) w3xdatmd data structures set in W3WAVE ! ! ! 9.a Check times and finish step if no output to be made ! #ifdef W3_SHRD IF ( GRSTAT(I) .EQ. 7 ) THEN #endif #ifdef W3_MPI IF ( GRSTAT(I).EQ.7 .AND. .NOT.FLSYNC(I) ) THEN #endif ! #ifdef W3_T WRITE (MDST,9002) I, GRSTAT(I), ' ' #endif ! IF ( TOUTP(1,I) .EQ. -1 ) THEN DTTST = 1. ELSE CALL W3SETW ( I, MDSE, MDST ) DTTST = DSEC21 ( TIME , TOUTP(:,I) ) END IF #ifdef W3_T WRITE (MDST,9090) DTTST #endif FLG_O1 = DTTST .EQ. 0. ! IF ( UNIPTS ) THEN CALL W3SETW ( I, MDSE, MDST ) DTTST = DSEC21 ( TIME , UPNEXT ) FLG_O2 = DTTST .EQ. 0. ELSE FLG_O2 = .FALSE. END IF ! IF ( .NOT.FLG_O1 .AND. .NOT.FLG_O2 ) THEN GRSTAT(I) = 8 #ifdef W3_T WRITE (MDST,9003) I, GRSTAT(I) #endif DONE = .TRUE. END IF ! #ifdef W3_MPI END IF ! IF ( GRSTAT(I).EQ.7 .AND. .NOT.FLSYNC(I) ) #endif #ifdef W3_SHRD END IF ! IF ( GRSTAT(I) .EQ. 7 ) #endif ! ! 9.b Perform output ! IF ( GRSTAT(I) .EQ. 7 ) THEN #ifdef W3_MPI IF ( MPI_COMM_GRD .NE. MPI_COMM_NULL ) THEN #endif ! #ifdef W3_MPRF CALL PRTIME ( PRFT0 ) #endif ! IF ( FLG_O1 ) THEN CALL W3SETG ( I, MDSE, MDST ) CALL WMSETM ( I, MDSE, MDST ) IF ( FLGHG1 .AND. .NOT.FLGHG2 .AND. & GRDHGH(I,0).GT.0 ) THEN MAPST2 = MAPST2 - 8*MAPMSK MAPSTA = ABS(MAPSTA) DO IX=1, NX DO IY=1, NY IF ( MAPST2(IY,IX) .GT. 0 ) & MAPSTA(IY,IX) = - MAPSTA(IY,IX) END DO END DO ! END IF ! CALL W3WAVE ( I, DUMMY2, TSYNC(:,I), .FALSE. ) ! IF ( FLGHG1 .AND. .NOT.FLGHG2 .AND. & GRDHGH(I,0).GT.0 ) THEN MAPST2 = MAPST2 + 8*MAPMSK MAPSTA = ABS(MAPSTA) DO IX=1, NX DO IY=1, NY IF ( MAPST2(IY,IX) .GT. 0 ) & MAPSTA(IY,IX) = - MAPSTA(IY,IX) END DO END DO END IF ! IF ( FLLSTL ) INFLAGS1(1) = .FALSE. IF ( FLLSTI ) INFLAGS1(4) = .FALSE. IF ( FLLSTR ) INFLAGS1(6) = .FALSE. ! ! 9.c Update TOUPT ! TOUTP(1,I) = -1 TOUTP(2,I) = 0 ! DO JO=1, NOTYPE IF ( .NOT.FLOUT(JO) ) CYCLE IF ( TOUTP(1,I) .EQ. -1 ) THEN TOUTP(:,I) = TONEXT(:,JO) ELSE DTTST = DSEC21 ( TOUTP(:,I) , TONEXT(:,JO) ) IF (DTTST.LT.0.) TOUTP(:,I) = TONEXT(:,JO) ENDIF END DO ! CHECKPOINT JO=8 IF ( .NOT.FLOUT(JO) ) CYCLE IF ( TOUTP(1,I) .EQ. -1 ) THEN TOUTP(:,I) = TONEXT(:,JO) ELSE DTTST = DSEC21 ( TOUTP(:,I) , TONEXT(:,JO) ) IF (DTTST.LT.0.) TOUTP(:,I) = TONEXT(:,JO) ENDIF ! END CHECKPOINT ! #ifdef W3_T WRITE (MDST,9091) TOUTP(:,I) #endif ! END IF ! IF ( FLG_O1 ) ! ! 9.d Process unified point output for selected grid ! IF ( UNIPTS ) THEN IF ( FLG_O2 ) THEN CALL W3SETO ( I, MDSE, MDST ) ! #ifdef W3_MPI IF ( NRQPO.NE.0 ) CALL MPI_STARTALL & ( NRQPO, IRQPO1, IERR_MPI ) #endif ! IF ( NOPTS.NE.0 .AND. IAPROC.EQ.NAPPNT ) THEN CALL W3SETG ( I, MDSE, MDST ) CALL W3SETA ( I, MDSE, MDST ) CALL W3IOPE ( VA ) END IF ! #ifdef W3_MPI IF ( NRQPO .NE. 0 ) THEN ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQPO) ) CALL MPI_WAITALL & ( NRQPO, IRQPO1, STATUS, IERR_MPI ) DEALLOCATE ( STATUS ) END IF #endif ! #ifdef W3_T WRITE (MDST,9092) NOPTS #endif ! END IF ! IF ( FLG_O2 ) ! END IF ! IF ( UNIPTS ) ! #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN,get_memory(), & 'ST07', I #endif ! ! 9.e Update TOUPT outside communicator ! #ifdef W3_MPI ELSE IF ( FLG_O1 ) THEN #endif ! #ifdef W3_MPI CALL W3SETO ( I, MDSE, MDST ) CALL W3SETW ( I, MDSE, MDST ) #endif ! #ifdef W3_MPI TIME = TOUTP(:,I) TOUTP(1,I) = -1 TOUTP(2,I) = 0 #endif ! #ifdef W3_MPI DO JO=1, NOTYPE #endif ! #ifdef W3_MPI IF ( FLOUT(JO) ) THEN DO DTTST = DSEC21 ( TIME, TONEXT(:,JO) ) IF ( DTTST .LE. 0. ) THEN CALL TICK21 ( TONEXT(:,JO), DTOUT(JO) ) DTTST = DSEC21 ( TONEXT(:,JO), TOLAST(:,JO) ) IF ( DTTST .LT. 0. ) THEN FLOUT(JO) = .FALSE. EXIT END IF ELSE EXIT END IF END DO END IF ! IF ( FLOUT(JO) ) #endif ! #ifdef W3_MPI IF ( .NOT.FLOUT(JO) ) CYCLE IF ( TOUTP(1,I) .EQ. -1 ) THEN TOUTP(:,I) = TONEXT(:,JO) ELSE DTTST = DSEC21 ( TOUTP(:,I) , TONEXT(:,JO) ) IF (DTTST.LT.0.) TOUTP(:,I) = TONEXT(:,JO) ENDIF #endif ! #ifdef W3_MPI END DO ! DO JO=1, NOTYPE #endif ! ! Checkpoint ! #ifdef W3_MPI JO=8 #endif ! #ifdef W3_MPI IF ( FLOUT(JO) ) THEN DO DTTST = DSEC21 ( TIME, TONEXT(:,JO) ) IF ( DTTST .LE. 0. ) THEN CALL TICK21 ( TONEXT(:,JO), DTOUT(JO) ) DTTST = DSEC21 ( TONEXT(:,JO), TOLAST(:,JO) ) IF ( DTTST .LT. 0. ) THEN FLOUT(JO) = .FALSE. EXIT END IF ELSE EXIT END IF END DO END IF ! IF ( FLOUT(JO) ) #endif ! #ifdef W3_MPI IF ( .NOT.FLOUT(JO) ) CYCLE IF ( TOUTP(1,I) .EQ. -1 ) THEN TOUTP(:,I) = TONEXT(:,JO) ELSE DTTST = DSEC21 ( TOUTP(:,I) , TONEXT(:,JO) ) IF (DTTST.LT.0.) TOUTP(:,I) = TONEXT(:,JO) ENDIF #endif ! ! End Checkpoint #ifdef W3_MPIT WRITE (MDST,9991) TOUTP(:,I) #endif #ifdef W3_MPI END IF ! 9.b IF ( MPI_COMM_GRD .NE. MPI_COMM_NULL ) #endif ! ! 9.f Finish up ! GRSTAT(I) = 8 DONE = .TRUE. ! END IF ! 9.b IF ( GRSTAT(I) .EQ. 7 ) ! ! 10. Go to next time step ------------------------------------------- / ! ( GRSTAT = 8 ) ( 9 added for diagnostic output only ... ) ! ( Unified point output and synchronization added ) ! IF ( GRSTAT(I) .EQ. 8 ) THEN ! #ifdef W3_T WRITE (MDST,9002) I, GRSTAT(I), ' ' #endif ! ! 10.a Processing unified point output ! IF ( UNIPTS .AND. DO_UPT ) THEN CALL W3SETW ( I, MDSE, MDST ) FLAGOK = DSEC21 ( TIME, UPNEXT ) .EQ. 0. #ifdef W3_T WRITE (MDST,9095) FLAGOK #endif ELSE FLAGOK = .FALSE. END IF ! IF ( FLAGOK ) THEN ! DO II=1, NRGRD CALL W3SETW ( II, MDSE, MDST ) FLAGOK = FLAGOK .AND. GRSTAT(II).EQ.8 .AND. & DSEC21(TIME,UPNEXT).EQ.0. END DO #ifdef W3_T WRITE (MDST,9096) FLAGOK #endif ! IF ( FLAGOK ) THEN ! #ifdef W3_MPRF CALL PRTIME ( PRFT0 ) #endif CALL WMIOPO ( UPNEXT ) DO_UPT = .FALSE. ! CALL W3SETO ( 0, MDSE, MDST ) CALL TICK21 ( UPNEXT, DTOUT(2) ) IF ( DSEC21(UPNEXT,UPLAST) .GE. 0. ) THEN TONEXT(:,2) = UPNEXT ELSE UNIPTS = .FALSE. UPNEXT(1) = -1 UPNEXT(2) = 0 END IF ! DO II=1, NRGRD CALL W3SETW ( II, MDSE, MDST ) DTTST = DSEC21 ( TIME, TEND(:,II) ) IF ( DTTST .GT. 0. ) THEN GRSTAT(II) = 9 ELSE IF ( DTTST .EQ. 0 ) THEN GRSTAT(II) = 99 END IF TSYNC(1,II) = -1 TSYNC(2,II) = 0 #ifdef W3_T IF ( I .NE. II ) & WRITE (MDST,9003) II, GRSTAT(II) #endif END DO ! DONE = .TRUE. #ifdef W3_MPRF CALL PRTIME ( PRFTN ) WRITE (MDSP,991) PRFT0, PRFTN, & get_memory(), 'UPTS',I #endif END IF ! IF ( FLAGOK ) ! ELSE FLAGOK = .TRUE. END IF ! IF ( FLAGOK ) ! ! 10.b Regular processing ! IF ( FLAGOK ) THEN CALL W3SETW ( I, MDSE, MDST ) DTTST = DSEC21 ( TIME, TEND(:,I) ) IF ( DTTST .GT. 0. ) THEN GRSTAT(I) = 9 DONE = .TRUE. ELSE IF ( DTTST .EQ. 0 ) THEN GRSTAT(I) = 99 DONE = .TRUE. END IF #ifdef W3_T WRITE (MDST,9003) I, GRSTAT(I) #endif END IF ! IF ( FLAGOK ) ! IF ( GRSTAT(I).EQ.9 .OR. GRSTAT(I).EQ.99 ) THEN TSYNC(1,I) = -1 TSYNC(2,I) = 0 END IF ! END IF ! 10. IF ( GRSTAT(I) .EQ. 8 ) ! ! ... End of loops started in 1. ------------------------------------- / ! END DO LOOP_JJ ! 1111 CONTINUE ! END DO LOOP_J ! #ifdef W3_MPI NMPSCR = NMPSCS #endif IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & CALL WMPRNT ( MDSO, NRGRD, TSYNC(:,0), GRSTAT ) ! DO I=1, NRGRD IF ( GRSTAT(I) .EQ. 9 ) GRSTAT(I) = 0 END DO ! IF ( .NOT. DONE ) GOTO 2099 IF ( MINVAL(GRSTAT) .EQ. 99 ) EXIT LOOP_OUTER END DO LOOP_OUTER ! ! End of routine -------------------------------------------------- / IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN CALL WWTIME ( WTIME ) WRITE (MDSS,902) WTIME ENDIF ! #ifdef W3_MPI DO I=1, NRGRD CALL WMSETM ( I, MDSE, MDST ) IF ( MPI_COMM_GRD .NE. MPI_COMM_NULL ) THEN CALL WMIOBF ( I ) CALL WMIOHF ( I ) CALL WMIOEF ( I ) END IF END DO #endif ! #ifdef W3_O10 IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) WRITE (MDSS,999) #endif ! #ifdef W3_T WRITE (MDST,9100) #endif ! RETURN ! ! Escape locations ! 2000 CONTINUE IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1000) I, GRSTAT(I) CALL EXTCDE ( 2000 ) RETURN ! 2001 CONTINUE IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1001) I, TSYNC(:,I), & TEND(:,I) CALL EXTCDE ( 2001 ) RETURN ! 2002 CONTINUE IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1002) J, INGRP(J,1), & INGRP(J,JJ), TSYNC(:,INGRP(J,1)), TSYNC(:,INGRP(J,JJ)), & TEND(:,INGRP(J,1)), TEND(:,INGRP(J,JJ)) CALL EXTCDE ( 2002 ) RETURN ! 2099 CONTINUE IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1099) CALL EXTCDE ( 2099 ) RETURN ! ! Formats ! 900 FORMAT ( ' ========== STARTING WAVE MODEL (WMWAVE) ==========', & '============================'/) 901 FORMAT (' MWW3 calculating for ',A,' at ',A,' status [', & I2,'-',I2,']') 902 FORMAT (' MWW3 reached the end of the computation loop at ',A) #ifdef W3_MPRF 990 FORMAT (1X,3F12.3,' WMWAVE INIT') 991 FORMAT (1X,3F12.3,' WMWAVE ',A4,I6) 992 FORMAT (1X,3F12.3,' WMWAVE ',A4,I9.8,I7.6) #endif 999 FORMAT (/' ========== END OF WAVE MODEL (WMWAVE) ============', & '============================'/) ! 1000 FORMAT (/' *** WAVEWATCH III ERROR IN WMWAVE : *** '/ & ' GRID',I3,' HAS ILLEGAL GRSTAT :',I8/) ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN WMWAVE : *** '/ & ' GRID',I3,' HAS ILLEGAL TSYNC / TEND '/ & ' TSYNC :',I9.8,I7.6/ & ' TEND :',I9.8,I7.6/) ! 1002 FORMAT (/' *** WAVEWATCH III ERROR IN WMWAVE : *** '/ & ' GROUP',I3,' HAS INCOMPATIBLE TIMES ', & 'IN GRIDS ',I3,' AND ',I3/ & ' TSYNC :',I9.8,I7.6,1X,I9.8,I7.6/ & ' TEND :',I9.8,I7.6,1X,I9.8,I7.6/) ! ! Note: This 1099 error can occur when multi-grid time steps are not ! compatible. 1099 FORMAT (/' *** WAVEWATCH III ERROR IN WMWAVE : *** '/ & ' ABORT FOR POSSIBLE ENDLESS LOOP '/) ! #ifdef W3_T 9000 FORMAT ( ' TEST WMWAVE : LOOP',I8,' ======================', & '===== (',I9.8,I7.6,' ) =='/ & ' GRID, GRSTAT, TIME, TSYNC, TEND') 9001 FORMAT ( ' ',I3,I3,3(I10.8,I7.6)) 9002 FORMAT ( ' TEST WMWAVE : PROCESSING GRID',I3, & ' STATUS',I3,' ',A) #endif #ifdef W3_MPIT 9902 FORMAT ( ' MPIT WMWAVE : PROCESSING GRID',I3, & ' STATUS',I3,' ',A) #endif #ifdef W3_T 9003 FORMAT ( ' TEST WMWAVE : GRID',I3,' STATUS RESET TO',I3) 9004 FORMAT ( ' TEST WMWAVE : FLAGOK = ',L1) 9005 FORMAT ( ' TEST WMWAVE : FLEQOK = ',L1) 9006 FORMAT ( ' TEST WMWAVE : CYCLE GROUP') #endif ! #ifdef W3_T 9020 FORMAT ( ' TEST WMWAVE : DTTST ',E10.3) 9021 FORMAT ( ' TEST WMWAVE : TIME :',I10.8,I7.6/ & ' TDATA :',I10.8,I7.6/ & ' TEND :',I10.8,I7.6) #endif ! #ifdef W3_T 9040 FORMAT ( ' TEST WMWAVE : TMAX :',I10.8,I7.6,F8.2/ & ' DTMAX :',I10.8,I7.6/ & ' TDATA :',I10.8,I7.6/ & ' TOUTP :',I10.8,I7.6/ & ' UPNEXT:',I10.8,I7.6) 9041 FORMAT ( ' TEST WMWAVE : TMAX :',I10.8,I7.6) #endif #ifdef W3_MPIT 9941 FORMAT ( ' MPIT WMWAVE : TMAX :',I10.8,I7.6) #endif #ifdef W3_T 9042 FORMAT ( ' TEST WMWAVE : GRANK :',I4,' FOR GRSTAT = 2') 9043 FORMAT ( ' TEST WMWAVE : GLOBAL TSYNC :',I10.8,I7.6) 9044 FORMAT ( ' TEST WMWAVE : LOCAL TSYNC :',I10.8,I7.6, & ' (',I8.8,I7.6,')') 9045 FORMAT ( ' TEST WMWAVE : GRID TSYNC') 9046 FORMAT ( ' ',I5,I10.8,I7.6) #endif ! #ifdef W3_T 9061 FORMAT ( ' GRID',I4,', FLEQOK = ',L1) #endif ! #ifdef W3_T 9090 FORMAT ( ' TEST WMWAVE : DTTST ',E10.3) 9091 FORMAT ( ' TEST WMWAVE : NEXT TOUTP :',I10.8,I7.6) #endif #ifdef W3_MPIT 9991 FORMAT ( ' MPIT WMWAVE : NEXT TOUTP :',I10.8,I7.6) #endif #ifdef W3_T 9092 FORMAT ( ' TEST WMWAVE : UNIFIED POINT OUTPUT PREP DONE',I6) #endif ! #ifdef W3_T 9095 FORMAT ( ' TEST WMWAVE : UNIFIED POINT OUTPUT, FLAGOK = ',L1) 9096 FORMAT ( ' ALL GRIDS, FLAGOK = ',L1) #endif ! #ifdef W3_T 9100 FORMAT ( ' TEST WMWAVE : LOOP DONE ======================', & '==============================') #endif !/ !/ End of WMWAVE ----------------------------------------------------- / !/ END SUBROUTINE WMWAVE !/ ------------------------------------------------------------------- / !> !> @brief Print out action table in the log file log.\ mww3. !> !> @param[in] MDSO !> @param[in] NRGRD Number of grids. !> @param[in] TSYNC Synchronization time. !> @param[in] GRSTAT Status array per grid. !> !> @author H. L. Tolman @date 22-Feb-2005 !> SUBROUTINE WMPRNT ( MDSO, NRGRD, TSYNC, GRSTAT ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 22-Feb-2005 | !/ +-----------------------------------+ !/ !/ 22-Feb-2005 : Origination. ( version 3.07 ) !/ ! 1. Purpose : ! ! Print out action table in the log file log.ww3m ! ! 2. Method : ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! NRGRD Int. I Number of grids. ! TSYN I.A. I Synchronization time. ! GRSTAT I.A. I Status array per grid. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! STME21 Subr. W3TIMEMD Print date and time readable. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMWAVE Subr. WMWAVEMD Multi-grid wave model routine. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! None. ! ! 7. Remarks : ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! !/T Test output. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif USE W3TIMEMD, ONLY: STME21 !/ IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: MDSO, NRGRD, TSYNC(2), GRSTAT(NRGRD) !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER, PARAMETER :: IW = 15 INTEGER :: I, I0, IN #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif INTEGER, SAVE :: IDLAST(2) LOGICAL, SAVE :: FIRST = .TRUE. CHARACTER(LEN=23) :: IDTIME CHARACTER(LEN=3) :: STR(IW), LNE(IW) !/ !/ ------------------------------------------------------------------- / !/ #ifdef W3_S CALL STRACE (IENT, 'WMPRNT') #endif ! DO I=1, IW LNE(I) = '---' END DO ! IF ( FIRST ) THEN WRITE (MDSO,900) NRGRD, LNE, '-+' FIRST = .FALSE. IDLAST(1) = -1 IDLAST(2) = 0 ELSE BACKSPACE (MDSO) END IF ! CALL STME21 ( TSYNC, IDTIME ) ! DO I=1, MIN(IW,NRGRD) WRITE (STR(I),'(I3)') GRSTAT(I) END DO DO I=1+MIN(IW,NRGRD), IW STR(I) = ' ' END DO ! IF ( IDLAST(1).EQ.TSYNC(1) .AND. IDLAST(2).EQ.TSYNC(2) ) THEN #ifdef W3_O11 WRITE (MDSO,903) STR, ' |' #endif ELSE IF ( IDLAST(1) .EQ. TSYNC(1) ) THEN WRITE (MDSO,902) IDTIME(12:19), STR, ' |' ELSE WRITE (MDSO,901) IDTIME(01:19), STR, ' |' END IF IDLAST = TSYNC ! IF ( NRGRD .GT. IW ) THEN I0 = 1 IN = IW DO I0 = I0 + IW IN = IN + IW DO I=I0, MIN(IN,NRGRD) WRITE (STR(I-I0+1),'(I3)') GRSTAT(I) END DO DO I=1+MIN(IN,NRGRD), IN STR(I-I0+1) = ' ' END DO WRITE (MDSO,903) STR, ' |' IF ( IN .GE. NRGRD ) EXIT END DO END IF ! WRITE (MDSO,904) LNE, '-+' ! RETURN ! ! Formats ! 900 FORMAT (1X,' Time (sync rank 1) | Status for',I3,' grids'/ & 1X,'---------------------+',16A) 901 FORMAT (2X,A19,' |',16A) 902 FORMAT (2X,11X,A8,' |',16A) 903 FORMAT (21X,' |',16A) 904 FORMAT (1X,'---------------------+',16A) !/ !/ End of WMPRNT ----------------------------------------------------- / !/ END SUBROUTINE WMPRNT !/ ------------------------------------------------------------------- / !> !> @brief Non-blocking broadcast for integer arrays. !> !> @details 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. !> !> @param[inout] DATA Data to be send/received. !> @param[in] NR Size of array. !> @param[in] IMOD Model number. !> @param[in] NMOD Number of models. !> @param[in] ID ID number, used with NMOD for ITAG. !> @author H. L. Tolman @date 02-Feb-2007 !> SUBROUTINE WMBCST ( DATA, NR, IMOD, NMOD, ID ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 02-Feb-2007 ! !/ +-----------------------------------+ !/ !/ 02-Feb-2007 : Origination. ( version 3.10 ) !/ ! 1. Purpose : ! ! Non-blocking broadcast, initially for times only, but made for ! any integer array. Sending data from first process in the ! model cummunicator to all processes that are in the overall ! communicator but not in the model communicator. ! ! 2. Method : ! ! Standard send and receives using defined communicator. Send ! form first processor in communicator. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! DATA I.A. I/O Data to be send/received. ! NR Int. I Size of array. ! IMOD Int. I Model number. ! NMOD Int. I Number of models. ! ID Int. I ID number, used with NMOD for ITAG. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Sur. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMWAVE Subr. WMWAVEMD Multi-grid wave model routine. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! !/MPIT Enable test output ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / ! #ifdef W3_MPI USE WMMDATMD, ONLY: MDST, MTAGB, IMPROC, NMPROC, ALLPRC, & CROOT, MPI_COMM_MWAVE #endif ! #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif ! IMPLICIT NONE ! #ifdef W3_MPI INCLUDE "mpif.h" #endif !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: NR, IMOD, NMOD, ID INTEGER, INTENT(INOUT) :: DATA(NR) !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ #ifdef W3_MPI INTEGER :: ITAG, IP, IERR_MPI, & STATUS(MPI_STATUS_SIZE) #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif !/ #ifdef W3_S CALL STRACE (IENT, 'WMBCST') #endif ! ! -------------------------------------------------------------------- / ! 0. Initializations ! #ifdef W3_MPI ITAG = MTAGB + IMOD + ID*NMOD #endif ! ! -------------------------------------------------------------------- / ! 1. Processor to send data from ! #ifdef W3_MPI IF ( ALLPRC(IMPROC,IMOD) .EQ. 1 ) THEN DO IP=1, NMPROC IF ( ALLPRC(IP,IMOD) .EQ. 0 ) THEN #endif #ifdef W3_MPI CALL MPI_SEND ( DATA, NR, MPI_INTEGER, IP-1, & ITAG, MPI_COMM_MWAVE, IERR_MPI ) END IF END DO #endif ! ! -------------------------------------------------------------------- / ! 2. Processor to receive data at ! #ifdef W3_MPI ELSE IF ( ALLPRC(IMPROC,IMOD) .EQ. 0 ) THEN #endif #ifdef W3_MPI CALL MPI_RECV ( DATA, NR, MPI_INTEGER, CROOT-1, ITAG, & MPI_COMM_MWAVE, STATUS, IERR_MPI ) #endif ! ! -------------------------------------------------------------------- / ! 3. Processor with no action ! #ifdef W3_MPI END IF #endif ! RETURN ! ! Formats ! #ifdef W3_MPIT 9000 FORMAT ( ' TEST WMBCST : INPUTS :',4I4) 9001 FORMAT ( ' TEST WMBCST : IMPROC, NMPROC:',2I5,' ALLPRC :') 9002 FORMAT (14X,13I5) #endif ! #ifdef W3_MPIT 9010 FORMAT ( ' TEST WMBCST : IAPROC =',I5,' SENDING TO ',I5) #endif ! #ifdef W3_MPIT 9020 FORMAT ( ' TEST WMBCST : IAPROC =',I5, & ' RECEIVING FROM ',I5) #endif ! #ifdef W3_MPIT 9030 FORMAT ( ' TEST WMBCST : IAPROC =',I5,' NO ACTION') #endif !/ !/ End of WMBCST ----------------------------------------------------- / !/ END SUBROUTINE WMBCST !/ ------------------------------------------------------------------- / !> !> @brief Non-blocking broadcast using dummy parameter to have output. !> !> @details 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. !> !> @param[in] IMOD Model number. !> @param[in] NMOD Number of models. !> @param[in] ID ID number, used with NMOD for ITAG. !> !> @author H. L. Tolman @date 21-Jun-2007 !> SUBROUTINE WMWOUT ( IMOD, NMOD, ID ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 21-Jun-2007 ! !/ +-----------------------------------+ !/ !/ 21-Jun-2007 : Origination. ( version 3.11 ) !/ ! 1. Purpose : ! ! Non-blocking broadcast using dummy parameter to have output! ! processes wait for computations on first node to be finished. ! Neede for profiling purposes only. ! ! 2. Method : ! ! Standard send and recieves using defined communicator. Send ! form first processor in communicator. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number. ! NMOD Int. I Number of models. ! ID Int. I ID number, used with NMOD for ITAG. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Sur. W3SERVMD Subroutine tracing. ! W3SETO Subr. W3ODATMD Point to data structure ! W3SETA Subr. W3ADATMD Point to data structure ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMWAVE Subr. WMWAVEMD Multi-grid wave model routine. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! !/MPIT Enable test output ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / ! #ifdef W3_MPI USE W3ODATMD, ONLY: W3SETO USE W3ADATMD, ONLY: W3SETA #endif ! #ifdef W3_MPI USE W3ODATMD, ONLY: IAPROC, NAPROC, NTPROC USE W3ADATMD, ONLY: MPI_COMM_WAVE USE WMMDATMD, ONLY: MDST, MDSE, MTAGB #endif ! #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif ! IMPLICIT NONE ! #ifdef W3_MPI INCLUDE "mpif.h" #endif !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD, NMOD, ID !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ #ifdef W3_MPI INTEGER :: ITAG, IP, IERR_MPI, & STATUS(MPI_STATUS_SIZE) #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif #ifdef W3_MPI REAL, SAVE :: DUMMY = 999. #endif !/ #ifdef W3_S CALL STRACE (IENT, 'WMWOUT') #endif ! ! -------------------------------------------------------------------- / ! 0. Initializations ! #ifdef W3_MPI CALL W3SETO ( IMOD, MDSE, MDST ) CALL W3SETA ( IMOD, MDSE, MDST ) ITAG = MTAGB + IMOD + ID*NMOD #endif ! #ifdef W3_MPI IF ( IAPROC .LT. 1 ) THEN #endif #ifdef W3_MPI RETURN END IF #endif ! ! -------------------------------------------------------------------- / ! 1. Processor to send data from ! #ifdef W3_MPI IF ( IAPROC .EQ. 1 ) THEN DO IP=NAPROC+1, NTPROC #endif #ifdef W3_MPI CALL MPI_SEND ( DUMMY, 1, MPI_INTEGER, IP-1, & ITAG, MPI_COMM_WAVE, IERR_MPI ) END DO #endif ! ! -------------------------------------------------------------------- / ! 2. Processor to receive data at ! #ifdef W3_MPI ELSE IF ( IAPROC .GT. NAPROC ) THEN #endif #ifdef W3_MPI CALL MPI_RECV ( DUMMY, 1, MPI_INTEGER, 0, ITAG, & MPI_COMM_WAVE, STATUS, IERR_MPI ) #endif ! ! -------------------------------------------------------------------- / ! 3. Processor with no action ! #ifdef W3_MPI END IF #endif ! RETURN ! ! Formats ! #ifdef W3_MPIT 9000 FORMAT ( ' TEST WMWOUT : INPUTS :',4I4) 9001 FORMAT ( ' TEST WMWOUT : IAPROC, NAPROC, NTPROC :',3I5) 9002 FORMAT ( ' TEST WMWOUT : NOT IN COMMUNICATOR') #endif ! #ifdef W3_MPIT 9010 FORMAT ( ' TEST WMWOUT : IAPROC =',I5,' SENDING TO ',I5) #endif ! #ifdef W3_MPIT 9020 FORMAT ( ' TEST WMWOUT : IAPROC =',I5, & ' RECEIVING FROM ',I5) #endif ! #ifdef W3_MPIT 9030 FORMAT ( ' TEST WMWOUT : IAPROC =',I5,' NO ACTION') #endif !/ !/ End of WMWOUT ----------------------------------------------------- / !/ END SUBROUTINE WMWOUT !/ !/ End of module WMWAVEMD -------------------------------------------- / !/ END MODULE WMWAVEMD