#include "w3macros.h" !/ ------------------------------------------------------------------- / MODULE WMINIOMD !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 28-Sep-2016 | !/ +-----------------------------------+ !/ !/ 29-May-2006 : Origination. ( version 3.09 ) !/ 21-Dec-2006 : VTIME change in WMIOHx and WMIOEx. ( version 3.10 ) !/ 22-Jan-2007 : Adding NAVMAX in WMIOEG. ( version 3.10 ) !/ 30-Jan-2007 : Fix memory leak WMIOBS. ( version 3.10 ) !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) !/ 28-Sep-2016 : Add error traps for MPI tags. ( version 5.15 ) !/ !/ Copyright 2009 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 : ! ! Internal IO routines for the multi-grid model. ! ! 2. Variables and types : ! ! 3. Subroutines and functions : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! WMIOBS Subr. Public Stage internal boundary data. ! WMIOBG Subr. Public Gather internal boundary data. ! WMIOBF Subr. Public Finalize WMIOBS. ( !/MPI ) ! WMIOHS Subr. Public Stage internal high to low data. ! WMIOHG Subr. Public Gather internal high to low data. ! WMIOHF Subr. Public Finalize WMIOHS. ( !/MPI ) ! WMIOES Subr. Public Stage internal same rank data. ! WMIOEG Subr. Public Gather internal same rank data. ! WMIOEF Subr. Public Finalize WMIOES. ( !/MPI ) ! ---------------------------------------------------------------- ! ! 4. Subroutines and functions used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SETG, W3SETW, W3SETA, W3SETO, WMSETM ! Subr. WxxDATMD Manage data structures. ! W3UBPT Subr. W3UBPTMD Update internal bounday spectra. ! W3IOBC Subr W3IOBCMD I/O of boundary data. ! W3CSPC Subr. W3CSPCMD Spectral grid conversion. ! STRACE Sur. W3SERVMD Subroutine tracing. ! ! MPI_ISEND, MPI_IRECV, MPI_TESTALL, MPI_WAITALL ! Subr. mpif.h MPI routines. ! ---------------------------------------------------------------- ! ! 5. Remarks : ! ! !/SHRD Shared/distributed memory models. ! !/DIST ! !/MPI ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! !/MPIT ! ! 6. Switches : ! ! 7. Source code : ! !/ ------------------------------------------------------------------- / PUBLIC !/ CONTAINS !/ ------------------------------------------------------------------- / SUBROUTINE WMIOBS ( IMOD ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 06-Jun-2018 ! !/ +-----------------------------------+ !/ !/ 06-Oct-2005 : Origination. ( version 3.08 ) !/ 29-May-2006 : Adding buffering for MPI. ( version 3.09 ) !/ 30-Jan-2007 : Fix memory leak. ( version 3.10 ) !/ 28-Sep-2016 : Add error traps for MPI tags. ( version 5.15 ) !/ 06-Jun-2018 : Use W3PARALL/add DEBUGIOBC/PDLIB ( version 6.04 ) !/ ! 1. Purpose : ! ! Stage internal boundary data in the data structure BPSTGE. ! ! 2. Method : ! ! For the shared memory version, arrays are initialized and the ! data are copied. For the distributed memory version, the data ! are moved using a non-blocking send. in this case, the arrays ! are dimensioned on the recieving side. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number of grid from which data is to ! be staged. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SETG, W3SETW, W3SETA, W3SETO, WMSETM ! Subr. WxxDATMD Manage data structures. ! W3CSPC Subr. W3CSPCMD Spectral grid conversion. ! STRACE Subr. W3SERVMD Subroutine tracing. ! EXTCDE Sur. Id. Program abort. ! ! MPI_ISEND ! Subr. mpif.h MPI routines. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMINIT Subr WMINITMD Multi-grid model initialization. ! WMWAVE Subr WMWAVEMD Multi-grid wave model. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! See FORMAT label 1001. ! ! 7. Remarks : ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/SHRD Shared/distributed memory models. ! !/DIST ! !/MPI ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! !/MPIT ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / ! USE W3GDATMD USE W3WDATMD USE W3ADATMD USE W3ODATMD USE WMMDATMD ! USE W3CSPCMD, ONLY: W3CSPC USE W3SERVMD, ONLY: EXTCDE USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/MPI INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: J, I, IOFF, ISEA, JSEA, IS !/DIST INTEGER :: ISPROC !/MPI INTEGER :: IP, IT0, ITAG, IERR_MPI !/MPI INTEGER, POINTER :: NRQ, IRQ(:) !/S INTEGER, SAVE :: IENT = 0 REAL, POINTER :: SBPI(:,:), TSTORE(:,:) !/ !/S CALL STRACE (IENT, 'WMIOBS') ! ! -------------------------------------------------------------------- / ! 0. Initializations ! !/T WRITE (MDST,9000) IMOD !/T WRITE (MDST,9001) NBI2G(:,IMOD) ! IF ( SUM(NBI2G(:,IMOD)) .EQ. 0 ) RETURN ! CALL W3SETO ( IMOD, MDSE, MDST ) CALL W3SETG ( IMOD, MDSE, MDST ) CALL W3SETW ( IMOD, MDSE, MDST ) CALL W3SETA ( IMOD, MDSE, MDST ) ! ! -------------------------------------------------------------------- / ! 1. Loop over grids ! DO J=1, NRGRD ! IF ( NBI2G(J,IMOD) .EQ. 0 ) CYCLE ! CALL WMSETM ( J , MDSE, MDST ) ! IF ( IMOD .EQ. 1 ) THEN IOFF = 0 ELSE IOFF = SUM(NBI2G(J,1:IMOD-1)) END IF ! !/T WRITE (MDST,9010) NBI2G(J,IMOD),IMOD,J,IOFF+1,RESPEC(J,IMOD) ! ! -------------------------------------------------------------------- / ! 2. Allocate arrays ! !/SHRD IF ( BPSTGE(J,IMOD)%INIT ) THEN !/SHRD IF ( SIZE(BPSTGE(J,IMOD)%SBPI(:,1)) .NE. NSPEC .OR. & !/SHRD SIZE(BPSTGE(J,IMOD)%SBPI(1,:)) & !/SHRD .NE. NBI2G(J,IMOD) ) THEN !/SHRD DEALLOCATE ( BPSTGE(J,IMOD)%SBPI ) !/SHRD BPSTGE(J,IMOD)%INIT = .FALSE. !/SHRD END IF !/SHRD END IF ! !/SHRD IF ( .NOT. BPSTGE(J,IMOD)%INIT ) THEN !/SHRD NSPEC => SGRDS(J)%NSPEC !/SHRD ALLOCATE ( BPSTGE(J,IMOD)%SBPI(NSPEC,NBI2G(J,IMOD)) ) !/SHRD NSPEC => SGRDS(IMOD)%NSPEC !/SHRD BPSTGE(J,IMOD)%INIT = .TRUE. !/SHRD END IF ! !/SHRD IF ( RESPEC(J,IMOD) ) THEN !/SHRD ALLOCATE ( TSTORE(NSPEC,NBI2G(J,IMOD)) ) !/SHRD SBPI => TSTORE !/SHRD ELSE !/SHRD SBPI => BPSTGE(J,IMOD)%SBPI !/SHRD END IF ! !/MPI NAPROC => OUTPTS(J)%NAPROC !/MPI ALLOCATE ( IRQ(NBI2G(J,IMOD)*NAPROC+NAPROC) ) !/MPI ALLOCATE ( BPSTGE(J,IMOD)%TSTORE(NSPEC,NBI2G(J,IMOD)) ) !/MPI NAPROC => OUTPTS(IMOD)%NAPROC ! !/MPI NRQ => BPSTGE(J,IMOD)%NRQBPS !/MPI SBPI => BPSTGE(J,IMOD)%TSTORE ! !/MPI NRQ = 0 !/MPI IRQ = 0 ! ! -------------------------------------------------------------------- / ! 3. Set the time ! Note that with MPI the send needs to be posted to the local ! processor too to make time management possible. ! !/T WRITE (MDST,9030) TIME !/MPIT WRITE (MDST,9080) ! !/SHRD BPSTGE(J,IMOD)%VTIME = TIME ! !/MPI IF ( IAPROC .EQ. 1 ) THEN !/MPI BPSTGE(J,IMOD)%STIME = TIME !/MPI ITAG = MTAG0 + IMOD + (J-1)*NRGRD !/MPI IF ( ITAG .GT. MTAG1 ) THEN !/MPI WRITE (MDSE,1001) !/MPI CALL EXTCDE (1001) !/MPI END IF !/MPI DO IP=1, NMPROC !/MPI IF ( ALLPRC(IP,J) .NE. 0 .AND. & !/MPI ALLPRC(IP,J) .LE. OUTPTS(J)%NAPROC ) THEN !/MPI NRQ = NRQ + 1 !/MPI CALL MPI_ISEND ( BPSTGE(J,IMOD)%STIME, 2, & !/MPI MPI_INTEGER, IP-1, ITAG, & !/MPI MPI_COMM_MWAVE, IRQ(NRQ), & !/MPI IERR_MPI ) !/MPIT WRITE (MDST,9081) NRQ, IP, ITAG-MTAG0, & !/MPIT IRQ(NRQ), IERR_MPI !/MPI END IF !/MPI END DO !/MPI END IF ! ! -------------------------------------------------------------------- / ! 4. Stage the spectral data ! DO I=1, NBI2G(J,IMOD) ! ISEA = NBI2S(IOFF+I,2) !/SHRD JSEA = ISEA !/DIST CALL INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) !/DIST IF ( ISPROC .NE. IAPROC ) CYCLE !/MPI IT0 = MTAG0 + NRGRD**2 + SUM(NBI2G(1:J-1,:)) + & !/MPI SUM(NBI2G(J,1:IMOD-1)) ! DO IS=1, NSPEC SBPI(IS,I) = VA(IS,JSEA) * SIG2(IS) / CG(1+(IS-1)/NTH,ISEA) END DO ! !/MPI DO IP=1, NMPROC !/MPI IF ( ALLPRC(IP,J) .NE. 0 .AND. & !/MPI ALLPRC(IP,J) .LE. OUTPTS(J)%NAPROC ) THEN !/MPI NRQ = NRQ + 1 !/MPI ITAG = IT0 + I !/MPI IF ( ITAG .GT. MTAG1 ) THEN !/MPI WRITE (MDSE,1001) !/MPI CALL EXTCDE (1001) !/MPI END IF !/MPI CALL MPI_ISEND ( SBPI(1,I), NSPEC, MPI_REAL, & !/MPI IP-1, ITAG, MPI_COMM_MWAVE, & !/MPI IRQ(NRQ), IERR_MPI ) !/MPIT WRITE (MDST,9082) NRQ, JSEA, IP, ITAG-MTAG0, & !/MPIT IRQ(NRQ), IERR_MPI !/MPI END IF !/MPI END DO ! END DO ! !/MPIT WRITE (MDST,9083) !/MPIT WRITE (MDST,9084) NRQ ! !/MPI IF ( NRQ .GT. 0 ) THEN !/MPI ALLOCATE ( BPSTGE(J,IMOD)%IRQBPS(NRQ) ) !/MPI BPSTGE(J,IMOD)%IRQBPS = IRQ(:NRQ) !/MPI ELSE !/MPI DEALLOCATE ( BPSTGE(J,IMOD)%TSTORE ) !/MPI END IF ! !/MPI DEALLOCATE ( IRQ ) ! ! -------------------------------------------------------------------- / ! 5. Convert spectra ( !/SHRD only ) ! !/SHRD IF ( RESPEC(J,IMOD) ) THEN !/SHRD SBPI => BPSTGE(J,IMOD)%SBPI !/SHRD CALL W3CSPC ( TSTORE, NK, NTH, XFR, FR1, TH(1), & !/SHRD SBPI, SGRDS(J)%NK, SGRDS(J)%NTH, SGRDS(J)%XFR, & !/SHRD SGRDS(J)%FR1, SGRDS(J)%TH(1), NBI2G(J,IMOD), & !/SHRD MDST, MDSE, SGRDS(J)%FACHFE ) !/SHRD DEALLOCATE ( TSTORE ) !/SHRD END IF ! ! ... End of loop over grids ! END DO ! RETURN ! ! Formats ! !/MPI 1001 FORMAT (/' *** ERROR WMIOBS : REQUESTED MPI TAG EXCEEDS', & !/MPI ' UPPER BOUND (MTAG1) ***') !/T 9000 FORMAT ( ' TEST WMIOBS : STAGING DATA FROM GRID ',I3) !/T 9001 FORMAT ( ' TEST WMIOBS : NR. OF SPECTRA PER GRID : '/ & !/T ' ',25I4) ! !/T 9010 FORMAT ( ' TEST WMIOBS : STAGING',I4,' SPECTRA FROM GRID ', & !/T I3,' TO GRID ',I3/ & !/T ' STARTING WITH SPECTRUM ',I4, & !/T ', RESPEC =',L2) ! !/T 9030 FORMAT ( ' TEST WMIOBS : TIME :',I10.8,I7.6) ! !/MPIT 9080 FORMAT (/' MPIT WMIOBS: COMMUNICATION CALLS '/ & !/MPIT ' +------+------+------+------+--------------+'/ & !/MPIT ' | IH | ID | TARG | TAG | handle err |'/ & !/MPIT ' +------+------+------+------+--------------+') !/MPIT 9081 FORMAT ( ' |',I5,' | TIME |',2(I5,' |'),I9,I4,' |') !/MPIT 9082 FORMAT ( ' |',I5,' |',I5,' |',2(I5,' |'),I9,I4,' |') !/MPIT 9083 FORMAT ( ' +------+------+------+------+--------------+') !/MPIT 9084 FORMAT ( ' MPIT WMIOBS: NRQBPT:',I10/) !/ !/ End of WMIOBS ----------------------------------------------------- / !/ END SUBROUTINE WMIOBS !/ ------------------------------------------------------------------- / SUBROUTINE WMIOBG ( IMOD, DONE ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 29-May-2006 ! !/ +-----------------------------------+ !/ !/ 18-Oct-2005 : Origination. ( version 3.08 ) !/ 29-May-2006 : Adding buffering for MPI. ( version 3.09 ) !/ ! 1. Purpose : ! ! Gather internal boundary data for a given model. ! ! 2. Method : ! ! For the shared memory version, datat are gathered from the data ! structure BPSTGE. For the distributed memeory version, the ! gathering of thee data are finished first. ! ! Gathering of data is triggered by the time stamp of the data ! that is presently in the storage arrays. ! ! This routine preempts the data flow normally executed by ! W3IOBC and W3UBPT, and hence bypasses both routines in W3WAVE. ! ! 2. Method : ! ! Using storage array BPSTAGE and time stamps. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number of grid from which data is to ! be gathered. ! DONE Log. O Flag for completion of operation (opt). ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SETG, W3SETW, W3SETA, W3SETO, WMSETM ! Subr. WxxDATMD Manage data structures. ! W3CSPC Subr. W3CSPCMD Spectral grid conversion. ! W3UBPT Subr. W3UBPTMD Update internal bounday spectra. ! W3IOBC Subr W3IOBCMD I/O of boundary data. ! STRACE Sur. W3SERVMD Subroutine tracing. ! EXTCDE Sur. Id. Program abort. ! DSEC21 Func. W3TIMEMD Difference between times. ! ! MPI_IRECV, MPI_TESTALL, MPI_WAITALL ! Subr. mpif.h MPI routines. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMINIT Subr WMINITMD Multi-grid model initialization. ! WMWAVE Subr WMWAVEMD Multi-grid wave model. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! See FORMAT labels 1001-1002. ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/SHRD Shared/distributed memory models. ! !/DIST ! !/MPI ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / ! USE W3GDATMD USE W3WDATMD USE W3ADATMD USE W3ODATMD USE WMMDATMD ! USE W3CSPCMD, ONLY: W3CSPC USE W3TIMEMD, ONLY: DSEC21 USE W3UPDTMD, ONLY: W3UBPT USE W3IOBCMD, ONLY: W3IOBC USE W3SERVMD, ONLY: EXTCDE ! USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC_GLOB !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/MPI INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD LOGICAL, INTENT(OUT), OPTIONAL :: DONE !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: J, I, IOFF, TTEST(2), ITEST !/MPI INTEGER :: IERR_MPI, IT0, ITAG, IFROM, & !/MPI ISEA, JSEA, ISPROC !/MPIT INTEGER :: ICOUNT !/S INTEGER, SAVE :: IENT = 0 INTEGER, POINTER :: VTIME(:) !/MPI INTEGER, POINTER :: NRQ, IRQ(:) !/MPI INTEGER, ALLOCATABLE :: STATUS(:,:) REAL :: DTTST, DT1, DT2, W1, W2 REAL, POINTER :: SBPI(:,:) !/MPI REAL, ALLOCATABLE :: TSTORE(:,:) !/MPI LOGICAL :: FLAGOK !/MPIT LOGICAL :: FLAG !/ !/S CALL STRACE (IENT, 'WMIOBG') !/DEBUGIOBC WRITE(740+IAPROC,*) 'Begin of W3IOBG' !/DEBUGIOBC FLUSH(740+IAPROC) ! ! -------------------------------------------------------------------- / ! 0. Initializations ! !/T WRITE (MDST,9000) IMOD !/T WRITE (MDST,9001) NBI2G(IMOD,:) ! IF ( PRESENT(DONE) ) DONE = .FALSE. ! CALL W3SETO ( IMOD, MDSE, MDST ) ! IF ( IAPROC .GT. NAPROC ) THEN IF ( PRESENT(DONE) ) DONE = .TRUE. !/T WRITE (MDST,9002) RETURN END IF ! IF ( SUM(NBI2G(IMOD,:)) .EQ. 0 ) THEN IF ( PRESENT(DONE) ) DONE = .TRUE. !/T WRITE (MDST,9003) RETURN END IF ! CALL W3SETG ( IMOD, MDSE, MDST ) CALL W3SETW ( IMOD, MDSE, MDST ) CALL W3SETA ( IMOD, MDSE, MDST ) ! IF ( TBPIN(1) .NE. -1 ) THEN IF ( DSEC21(TIME,TBPIN) .GT. 0. ) THEN IF ( PRESENT(DONE) ) DONE = .TRUE. !/T WRITE (MDST,9004) RETURN END IF END IF ! ! -------------------------------------------------------------------- / ! 1. Testing / gathering data in staging arrays ! !/T WRITE (MDST,9010) ! ! 1.a Shared memory version, test valid times. - - - - - - - - - - - - / ! !/SHRD DO J=1, NRGRD ! !/SHRD IF ( NBI2G(IMOD,J) .EQ. 0 ) CYCLE !/SHRD VTIME => BPSTGE(IMOD,J)%VTIME ! !/SHRD IF ( VTIME(1) .EQ. -1 ) THEN !/SHRD IF ( NMPROC .EQ. NMPERR ) WRITE (MDSE,1001) !/SHRD CALL EXTCDE ( 1001 ) !/SHRD END IF ! !/SHRD DTTST = DSEC21 ( TIME, VTIME ) !/SHRD IF ( DTTST.LE.0. .AND. TBPIN(1).NE.-1 ) RETURN ! !/SHRD END DO ! ! 1.b Distributed memory version - - - - - - - - - - - - - - - - - - - / ! !/MPIT WRITE (MDST,9011) NBISTA(IMOD) ! ! 1.b.1 NBISTA = 0 ! Check if staging arrays are initialized. ! Post the proper receives. ! !/MPI IF ( NBISTA(IMOD) .EQ. 0 ) THEN ! !/MPI NRQ => MDATAS(IMOD)%NRQBPG !/MPI NRQ = NRGRD + SUM(NBI2G(IMOD,:)) !/MPI ALLOCATE ( MDATAS(IMOD)%IRQBPG(NRQ) ) !/MPI IRQ => MDATAS(IMOD)%IRQBPG !/MPI IRQ = 0 !/MPI NRQ = 0 ! !/MPI DO J=1, NRGRD !/MPI IF ( NBI2G(IMOD,J) .EQ. 0 ) CYCLE ! ! ..... Staging arrays ! !/MPI IF ( BPSTGE(IMOD,J)%INIT ) THEN !/MPI IF ( RESPEC(IMOD,J) ) THEN !/MPI DEALLOCATE ( BPSTGE(IMOD,J)%SBPI ) !/MPI BPSTGE(IMOD,J)%INIT = .FALSE. !/MPIT WRITE (MDST,9012) J, 'RESET' !/MPI ELSE !/MPI IF ( SIZE(BPSTGE(IMOD,J)%SBPI(:,1)) .NE. & !/MPI SGRDS(J)%NSPEC .OR. & !/MPI SIZE(BPSTGE(IMOD,J)%SBPI(1,:)) .NE. & !/MPI NBI2G(IMOD,J) ) THEN !/MPI IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1003) !/MPI CALL EXTCDE (1003) !/MPI END IF !/MPIT WRITE (MDST,9012) J, 'TESTED' !/MPI END IF !/MPI END IF ! !/MPI IF ( .NOT. BPSTGE(IMOD,J)%INIT ) THEN !/MPI NSPEC => SGRDS(J)%NSPEC !/MPI ALLOCATE (BPSTGE(IMOD,J)%SBPI(NSPEC,NBI2G(IMOD,J))) !/MPI NSPEC => SGRDS(IMOD)%NSPEC !/MPI BPSTGE(IMOD,J)%INIT = .TRUE. !/MPIT WRITE (MDST,9012) J, 'INITIALIZED' !/MPI END IF ! ! ..... Check valid time to determine staging. ! !/MPI VTIME => BPSTGE(IMOD,J)%VTIME !/MPI IF ( VTIME(1) .EQ. -1 ) THEN !/MPI DTTST = 0. !/MPI ELSE !/MPI DTTST = DSEC21 ( TIME, VTIME ) !/MPI END IF !/MPIT WRITE (MDST,9013) VTIME, DTTST ! ! ..... Post receives for data gather ! !/MPI IF ( DTTST .LE. 0. ) THEN !/MPIT WRITE (MDST,9014) J ! ! ..... Time ! !/MPI ITAG = MTAG0 + J + (IMOD-1)*NRGRD !/MPI IFROM = MDATAS(J)%CROOT - 1 !/MPI NRQ = NRQ + 1 !/MPI CALL MPI_IRECV ( BPSTGE(IMOD,J)%VTIME, 2, & !/MPI MPI_INTEGER, IFROM, ITAG, & !/MPI MPI_COMM_MWAVE, IRQ(NRQ), & !/MPI IERR_MPI ) !/MPIT WRITE (MDST,9015) NRQ, IFROM+1, ITAG-MTAG0, & !/MPIT IRQ(NRQ), IERR_MPI ! ! ..... Spectra ! !/MPI IF ( J .EQ. 1 ) THEN !/MPI IOFF = 0 !/MPI ELSE !/MPI IOFF = SUM(NBI2G(IMOD,1:J-1)) !/MPI END IF ! !/MPI IT0 = MTAG0 + NRGRD**2 + SUM(NBI2G(1:IMOD-1,:)) & !/MPI + SUM(NBI2G(IMOD,1:J-1)) ! !/MPI SBPI => BPSTGE(IMOD,J)%SBPI ! !/MPI NAPROC => OUTPTS(J)%NAPROC !/MPI NSPEC => SGRDS(J)%NSPEC !/MPI DO I=1, NBI2G(IMOD,J) !/MPI ISEA = NBI2S(IOFF+I,2) !/MPI CALL INIT_GET_JSEA_ISPROC_GLOB(ISEA, J, JSEA, ISPROC) !/MPI NRQ = NRQ + 1 !/MPI ITAG = IT0 + I !/MPI CALL MPI_IRECV ( SBPI(1,I), NSPEC, & !/MPI MPI_REAL, ISPROC-1, & !/MPI ITAG, MPI_COMM_MWAVE, & !/MPI IRQ(NRQ), IERR_MPI ) !/MPIT WRITE (MDST,9016) NRQ, JSEA, ISPROC, & !/MPIT ITAG-MTAG0, IRQ(NRQ), IERR_MPI !/MPI END DO !/MPI NSPEC => SGRDS(IMOD)%NSPEC !/MPI NAPROC => OUTPTS(IMOD)%NAPROC ! ! ..... End IF for posting receives 1.b.1 ! !/MPIT WRITE (MDST,9017) !/MPI END IF ! ! ..... End grid loop J in 1.b.1 ! !/MPI END DO !/MPIT WRITE (MDST,9018) NRQ ! ! ..... Reset status ! NOTE: if NBI.EQ.0 all times are already OK, skip to section 2 ! !/MPI IF ( NBI .GT. 0 ) THEN !/MPI NBISTA(IMOD) = 1 !/MPIT WRITE (MDST,9011) NBISTA(IMOD) !/MPI END IF ! ! ..... End IF in 1.b.1 ! !/MPI END IF ! ! 1.b.2 NBISTA = 1 ! Wait for communication to finish. ! If DONE defined, check if done, otherwise wait. ! !/MPI IF ( NBISTA(IMOD) .EQ. 1 ) THEN ! !/MPI NRQ => MDATAS(IMOD)%NRQBPG !/MPI IRQ => MDATAS(IMOD)%IRQBPG !/MPI ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) ! ! ..... Test communication if DONE is present, wait otherwise ! !/MPI IF ( PRESENT(DONE) ) THEN ! !/MPI CALL MPI_TESTALL ( NRQ, IRQ, FLAGOK, STATUS, & !/MPI IERR_MPI ) ! !/MPIT ICOUNT = 0 !/MPIT DO I=1, NRQ !/MPIT CALL MPI_TEST ( IRQ(I), FLAG, STATUS(1,1), & !/MPIT IERR_MPI ) !/MPIT FLAGOK = FLAGOK .AND. FLAG !/MPIT IF ( FLAG ) ICOUNT = ICOUNT + 1 !/MPIT END DO !/MPIT WRITE (MDST,9019) 100. * REAL(ICOUNT) / REAL(NRQ) ! !/MPI ELSE ! !/MPI CALL MPI_WAITALL ( NRQ, IRQ, STATUS, IERR_MPI ) !/MPI FLAGOK = .TRUE. ! !/MPI END IF ! !/MPI DEALLOCATE ( STATUS ) ! ! ..... Go on based on FLAGOK ! !/MPI IF ( FLAGOK ) THEN !/MPI DEALLOCATE ( MDATAS(IMOD)%IRQBPG ) !/MPI NRQ = 0 !/MPI ELSE !/MPI RETURN !/MPI END IF ! !/MPI NBISTA(IMOD) = 2 !/MPIT WRITE (MDST,9011) NBISTA(IMOD) ! ! 1.b.3 Convert spectra if needed ! !/MPI DO J=1, NRGRD ! !/MPI IF ( RESPEC(IMOD,J) .AND. NBI2G(IMOD,J).NE.0 ) THEN ! !/MPIT WRITE (MDST,9100) J !/MPI NSPEC => SGRDS(J)%NSPEC !/MPI ALLOCATE ( TSTORE(NSPEC,NBI2G(IMOD,J))) !/MPI NSPEC => SGRDS(IMOD)%NSPEC !/MPI TSTORE = BPSTGE(IMOD,J)%SBPI !/MPI DEALLOCATE ( BPSTGE(IMOD,J)%SBPI ) !/MPI ALLOCATE (BPSTGE(IMOD,J)%SBPI(NSPEC,NBI2G(IMOD,J))) ! !/MPI SBPI => BPSTGE(IMOD,J)%SBPI !/MPI CALL W3CSPC ( TSTORE, SGRDS(J)%NK, SGRDS(J)%NTH, & !/MPI SGRDS(J)%XFR, SGRDS(J)%FR1, SGRDS(J)%TH(1), & !/MPI SBPI, NK, NTH, XFR, FR1, TH(1), & !/MPI NBI2G(IMOD,J), MDST, MDSE, SGRDS(IMOD)%FACHFE) ! !/MPI DEALLOCATE ( TSTORE ) ! !/MPI END IF ! !/MPI END DO ! !/MPI NBISTA(IMOD) = 0 !/MPIT WRITE (MDST,9011) NBISTA(IMOD) ! !/MPI END IF ! ! -------------------------------------------------------------------- / ! 2. Update arrays ABPI0/N and data times ! !/T WRITE (MDST,9020) ! ! 2.a Determine next valid time ! TTEST = -1 DO J=1, NRGRD IF ( NBI2G(IMOD,J) .EQ. 0 ) CYCLE VTIME => BPSTGE(IMOD,J)%VTIME IF ( TTEST(1) .EQ. -1 ) THEN TTEST = VTIME ELSE DTTST = DSEC21(VTIME,TTEST) IF ( DTTST .GT. 0. ) TTEST = VTIME END IF END DO ! !/T WRITE (MDST,9021) TTEST ! ! 2.b Shift data ! IF ( TBPIN(1) .EQ. -1 ) THEN DTTST = DSEC21(TTEST,TIME) IF ( DTTST .NE. 0. ) THEN IF ( NMPROC .EQ. NMPERR ) WRITE (MDSE,1002) CALL EXTCDE(1002) END IF ABPI0 = 0. ELSE TBPI0 = TBPIN ABPI0 = ABPIN END IF ! ! 2.c Loop over grids for new spectra ! DO J=1, NRGRD ! IF ( NBI2G(IMOD,J) .EQ. 0 ) CYCLE VTIME => BPSTGE(IMOD,J)%VTIME SBPI => BPSTGE(IMOD,J)%SBPI ! IF ( J .EQ. 1 ) THEN IOFF = 0 ELSE IOFF = SUM(NBI2G(IMOD,1:J-1)) END IF ! IF ( TBPIN(1) .EQ. -1 ) THEN W1 = 0. W2 = 1. ELSE DT1 = DSEC21(TBPI0,VTIME) DT2 = DSEC21(TBPI0,TTEST) W2 = DT2 / DT1 W1 = 1. - W2 END IF !/T WRITE (MDST,9022) NBI2G(IMOD,J), J, IOFF+1, W1, W2 ! ABPIN(:,IOFF+1:IOFF+NBI2G(IMOD,J)) = & W1 * ABPI0(:,IOFF+1:IOFF+NBI2G(IMOD,J)) + & W2 * SBPI(:,1:NBI2G(IMOD,J)) ! END DO ! ! 2.d New time ! TBPIN = TTEST ! ! -------------------------------------------------------------------- / ! 3. Dump data to file if requested ! IF ( IAPROC.EQ.NAPBPT .AND. BCDUMP(IMOD) ) THEN !/T WRITE (MDST,9030) CALL W3IOBC ( 'DUMP', NDS(9), TBPIN, TBPIN, ITEST, IMOD ) END IF ! ! -------------------------------------------------------------------- / ! 4. Update arrays BBPI0/N ! !/T WRITE (MDST,9040) ! CALL W3UBPT ! ! -------------------------------------------------------------------- / ! 5. Successful update ! IF ( PRESENT(DONE) ) DONE = .TRUE. !/DEBUGIOBC WRITE(740+IAPROC,*) 'End of W3IOBG' !/DEBUGIOBC FLUSH(740+IAPROC) ! RETURN ! ! Formats ! !/SHRD 1001 FORMAT (/' *** ERROR WMIOBG : NO DATA IN STAGING ARRAY ***'/ & !/SHRD ' CALL WMIOBS FIRST '/) 1002 FORMAT (/' *** ERROR WMIOBG : INITIAL DATA NOT AT INITAL ', & 'MODEL TIME ***'/) !/MPI 1003 FORMAT (/' *** ERROR WMIOBG : UNEXPECTED SIZE OF STAGING', & !/MPI ' ARRAY ***') ! !/T 9000 FORMAT ( ' TEST WMIOBG : GATHERING DATA FOR GRID ',I3) !/T 9001 FORMAT ( ' TEST WMIOBG : NR. OF SPECTRA PER SOURCE GRID : '/ & !/T ' ',25I4) !/T 9002 FORMAT ( ' TEST WMIOBG : NO DATA NEEDED ON PROCESSOR') !/T 9003 FORMAT ( ' TEST WMIOBG : NO DATA TO BE GATHERED') !/T 9004 FORMAT ( ' TEST WMIOBG : DATA UP TO DATE') ! !/T 9010 FORMAT ( ' TEST WMIOBG : TEST DATA AVAILABILITY') !/MPIT 9011 FORMAT ( ' MPIT WMIOBG : NBISTA =',I2) !/MPIT 9012 FORMAT ( ' STAGING ARRAY FROM',I4,1X,A) !/MPIT 9013 FORMAT ( ' VTIME, DTTST :',I9.8,I7.6,1X,F8.1) !/MPIT 9014 FORMAT (/' MPIT WMIOBG : RECEIVE FROM GRID',I4/ & !/MPIT ' +------+------+------+------+--------------+'/ & !/MPIT ' | IH | ID | FROM | TAG | handle err |'/ & !/MPIT ' +------+------+------+------+--------------+') !/MPIT 9015 FORMAT ( ' |',I5,' | TIME |',2(I5,' |'),I9,I4,' |') !/MPIT 9016 FORMAT ( ' |',I5,' |',I5,' |',2(I5,' |'),I9,I4,' |') !/MPIT 9017 FORMAT ( ' +------+------+------+------+--------------+'/) !/MPIT 9018 FORMAT ( ' MPIT WMIOBG : NRQHGH:',I10/) !/MPIT 9019 FORMAT ( ' MPIT WMIOBG : RECEIVES FINISHED :',F6.1,'%') !/MPIT 9100 FORMAT ( ' MPIT WMIOBG : CONVERTING SPECTRA FROM GRID',I3) ! !/T 9020 FORMAT ( ' TEST WMIOBG : FILLING ABPI0/N AND TIMES') !/T 9021 FORMAT ( ' TEST WMIOBG : NEXT VALID TIME FOR ABPIN:',I9.8,I7.6) !/T 9022 FORMAT ( ' TEST WMIOBG : GETTING',I4,' SPECTRA FROM GRID ', & !/T I3,' STORING AT ',I3/ & !/T ' WEIGHTS : ',2F6.3) ! !/T 9030 FORMAT ( ' TEST WMIOBG : DUMP DATA TO FILE') ! !/T 9040 FORMAT ( ' TEST WMIOBG : FILLING BBPI0/N') !/ !/ End of WMIOBG ----------------------------------------------------- / !/ END SUBROUTINE WMIOBG !/ ------------------------------------------------------------------- / SUBROUTINE WMIOBF ( IMOD ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 29-May-2006 ! !/ +-----------------------------------+ !/ !/ 18-Oct-2005 : Origination. ( version 3.08 ) !/ 29-May-2006 : Adding buffering for MPI. ( version 3.09 ) !/ ! 1. Purpose : ! ! Finalize staging of internal boundary data in the data ! structure BPSTGE (MPI only). ! ! 2. Method : ! ! Post appropriate 'wait' functions to assure that the ! communication has finished. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number of grid from which data has ! been staged. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! ! MPI_WAITALL ! Subr. mpif.h MPI routines. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMINIT Subr WMINITMD Multi-grid model initialization. ! WMWAVE Subr WMWAVEMD Multi-grid wave model. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! 7. Remarks : ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/SHRD Shared/distributed memory models. ! !/DIST ! !/MPI ! ! !/S Enable subroutine tracing. ! !/T Test output. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / ! USE WMMDATMD ! !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/MPI INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: J !/MPI INTEGER :: IERR_MPI !/MPI INTEGER, POINTER :: NRQ, IRQ(:) !/MPI INTEGER, ALLOCATABLE :: STATUS(:,:) !/S INTEGER, SAVE :: IENT = 0 !/ !/S CALL STRACE (IENT, 'WMIOBF') ! ! -------------------------------------------------------------------- / ! 0. Initializations ! !/T WRITE (MDST,9000) IMOD ! ! -------------------------------------------------------------------- / ! 1. Loop over grids ! DO J=1, NRGRD ! !/MPI NRQ => BPSTGE(J,IMOD)%NRQBPS ! ! 1.a Nothing to finalize ! !/MPI IF ( NRQ .EQ. 0 ) CYCLE !/MPI IRQ => BPSTGE(J,IMOD)%IRQBPS ! ! 1.b Wait for communication to end ! !/MPI ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) !/MPI CALL MPI_WAITALL ( NRQ, IRQ, STATUS, IERR_MPI ) !/MPI DEALLOCATE ( STATUS ) ! ! 1.c Reset arrays and counter ! !/MPI NRQ = 0 !/MPI DEALLOCATE ( BPSTGE(J,IMOD)%IRQBPS , & !/MPI BPSTGE(J,IMOD)%TSTORE ) ! !/T WRITE (MDST,9010) J ! END DO ! RETURN ! ! Formats ! !/T 9000 FORMAT ( ' TEST WMIOBF : FINALIZE STAGING DATA FROM GRID ',I3) !/T 9010 FORMAT ( ' TEST WMIOBF : FINISHED WITH TARGET ',I3) !/ !/ End of WMIOBF ----------------------------------------------------- / !/ END SUBROUTINE WMIOBF !/ ------------------------------------------------------------------- / SUBROUTINE WMIOHS ( IMOD ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 28-Sep-2016 ! !/ +-----------------------------------+ !/ !/ 27-Jan-2006 : Origination. ( version 3.08 ) !/ 20-Dec-2006 : Remove VTIME from MPI comm. ( version 3.10 ) !/ 28-Sep-2016 : Add error traps for MPI tags. ( version 5.15 ) !/ ! 1. Purpose : ! ! Stage internal high-to-low data in the data structure HGSTGE. ! ! 2. Method : ! ! Directly fill staging arrays in shared memory version, or post ! the corresponding sends in distributed memory version. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number of grid from which data is to ! be staged. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SETG, W3SETW, W3SETA, W3SETO, WMSETM ! Subr. WxxDATMD Manage data structures. ! STRACE Subr. W3SERVMD Subroutine tracing. ! EXTCDE Sur. Id. Program abort. ! DSEC21 Func. W3TIMEMD Difference between times. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMWAVE Subr WMWAVEMD Multi-grid wave model. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! See FORMAT label 1001. ! ! 7. Remarks : ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/SHRD Shared/distributed memory models. ! !/DIST ! !/MPI ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! !/MPIT ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / ! USE W3GDATMD USE W3WDATMD USE W3ADATMD USE W3ODATMD USE WMMDATMD ! USE W3SERVMD, ONLY: EXTCDE !/S USE W3SERVMD, ONLY: STRACE USE W3TIMEMD, ONLY: DSEC21 USE W3PARALL, ONLY: INIT_GET_ISEA ! IMPLICIT NONE ! !/MPI INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: J, NR, I, JSEA, ISEA, IS !/MPI INTEGER :: ITAG, IP, IT0, IERR_MPI INTEGER :: I1, I2 !/S INTEGER, SAVE :: IENT = 0 !/MPI INTEGER, POINTER :: NRQ, IRQ(:), NRQOUT, OUTDAT(:,:) REAL :: DTOUTP !/SHRD REAL, POINTER :: SHGH(:,:,:) !/MPI REAL, POINTER :: SHGH(:,:) !/ !/S CALL STRACE (IENT, 'WMIOHS') ! ! -------------------------------------------------------------------- / ! 0. Initializations ! !/T WRITE (MDST,9000) IMOD, FLGHG1 ! IF ( .NOT. FLGHG1 ) THEN !/T WRITE (MDST,9001) HGSTGE(:,IMOD)%NSND IF ( SUM(HGSTGE(:,IMOD)%NSND) .EQ. 0 ) RETURN ELSE !/T WRITE (MDST,9001) HGSTGE(:,IMOD)%NSN1 IF ( SUM(HGSTGE(:,IMOD)%NSN1) .EQ. 0 ) RETURN END IF ! CALL W3SETO ( IMOD, MDSE, MDST ) CALL W3SETG ( IMOD, MDSE, MDST ) CALL W3SETW ( IMOD, MDSE, MDST ) CALL W3SETA ( IMOD, MDSE, MDST ) ! ! -------------------------------------------------------------------- / ! 1. Loop over grids ! DO J=1, NRGRD ! IF ( J .EQ. IMOD ) CYCLE ! IF ( .NOT. FLGHG1 ) THEN NR = HGSTGE(J,IMOD)%NSND ELSE IF ( FLGHG2 ) THEN NR = HGSTGE(J,IMOD)%NSN1 ELSE IF ( TOUTP(1,J) .EQ. -1 ) THEN DTOUTP = 1. ELSE DTOUTP = DSEC21(TIME,TOUTP(:,J)) END IF IF ( DTOUTP .EQ. 0. ) THEN NR = HGSTGE(J,IMOD)%NSND ELSE NR = HGSTGE(J,IMOD)%NSN1 END IF END IF ! !/T IF ( NR .EQ. 0 ) THEN !/T WRITE (MDST,9010) J, NR !/T ELSE !/T WRITE (MDST,9011) J, NR, DSEC21(TIME,TSYNC(:,J)), DTOUTP !/T END IF ! IF ( NR .EQ. 0 ) CYCLE IF ( DSEC21(TIME,TSYNC(:,J)) .NE. 0. ) CYCLE ! ! -------------------------------------------------------------------- / ! 2. Allocate arrays and/or point pointers ! !/SHRD SHGH => HGSTGE(J,IMOD)%SHGH !/MPI ALLOCATE ( HGSTGE(J,IMOD)%TSTORE(NSPEC,NR) ) !/MPI SHGH => HGSTGE(J,IMOD)%TSTORE ! !/MPI ALLOCATE ( HGSTGE(J,IMOD)%IRQHGS(NR) ) !/MPI ALLOCATE ( HGSTGE(J,IMOD)%OUTDAT(NR,3) ) ! !/MPI NRQ => HGSTGE(J,IMOD)%NRQHGS !/MPI NRQOUT => HGSTGE(J,IMOD)%NRQOUT !/MPI IRQ => HGSTGE(J,IMOD)%IRQHGS !/MPI OUTDAT => HGSTGE(J,IMOD)%OUTDAT !/MPI NRQ = 0 !/MPI NRQOUT = 0 !/MPI IRQ = 0 ! ! -------------------------------------------------------------------- / ! 3. Set the time ! !/SHRD only. ! !/T WRITE (MDST,9030) TIME ! !/SHRD HGSTGE(J,IMOD)%VTIME = TIME ! ! -------------------------------------------------------------------- / ! 4. Stage the spectral data ! !/MPIT WRITE (MDST,9080) !/MPI IT0 = MTAG1 + 1 ! DO I=1, NR ! JSEA = HGSTGE(J,IMOD)%ISEND(I,1) CALL INIT_GET_ISEA(ISEA, JSEA) !/DIST IP = HGSTGE(J,IMOD)%ISEND(I,2) I1 = HGSTGE(J,IMOD)%ISEND(I,3) I2 = HGSTGE(J,IMOD)%ISEND(I,4) !/MPI ITAG = HGSTGE(J,IMOD)%ISEND(I,5) + IT0 !/MPI IF ( ITAG .GT. MTAG2 ) THEN !/MPI WRITE (MDSE,1001) !/MPI CALL EXTCDE (1001) !/MPI END IF ! DO IS=1, NSPEC !/SHRD SHGH(IS,I2,I1) = VA(IS,JSEA) * SIG2(IS) & !/SHRD / CG(1+(IS-1)/NTH,ISEA) !/MPI SHGH( IS,I ) = VA(IS,JSEA) * SIG2(IS) & !/MPI / CG(1+(IS-1)/NTH,ISEA) END DO ! !/MPI IF ( IP .NE. IMPROC ) THEN !/MPI NRQ = NRQ + 1 !/MPI CALL MPI_ISEND ( SHGH(1,I), NSPEC, MPI_REAL, IP-1, & !/MPI ITAG, MPI_COMM_MWAVE, IRQ(NRQ), IERR_MPI ) !/MPIT WRITE (MDST,9082) NRQ, JSEA, IP, ITAG-MTAG1, & !/MPIT IRQ(NRQ), IERR_MPI !/MPI ELSE !/MPI NRQOUT = NRQOUT + 1 !/MPI OUTDAT(NRQOUT,1) = I !/MPI OUTDAT(NRQOUT,2) = I2 !/MPI OUTDAT(NRQOUT,3) = I1 !/MPI END IF ! END DO ! !/MPIT WRITE (MDST,9083) !/MPIT WRITE (MDST,9084) NRQ ! END DO ! RETURN ! ! Formats ! !/MPI 1001 FORMAT (/' *** ERROR WMIOHS : REQUESTED MPI TAG EXCEEDS', & !/MPI ' UPPER BOUND (MTAG2) ***') !/T 9000 FORMAT ( ' TEST WMIOHS : STAGING DATA FROM GRID ',I3, & !/T ' FLGHG1 = ',L1) !/T 9001 FORMAT ( ' TEST WMIOHS : NR. OF SPECTRA PER GRID : '/ & !/T ' ',15I6) ! !/T 9010 FORMAT ( ' TEST WMIOHS : POSTING DATA TO GRID ',I3, & !/T ' NR = ',I6) !/T 9011 FORMAT ( ' TEST WMIOHS : POSTING DATA TO GRID ',I3, & !/T ' NR = ',I6,' TIME GAP = ',2F8.1) ! !/T 9030 FORMAT ( ' TEST WMIOHS : TIME :',I10.8,I7.6) ! !/MPIT 9080 FORMAT (/' MPIT WMIOHS: COMMUNICATION CALLS '/ & !/MPIT ' +------+------+------+------+--------------+'/ & !/MPIT ' | IH | ID | TARG | TAG | handle err |'/ & !/MPIT ' +------+------+------+------+--------------+') !/MPIT 9082 FORMAT ( ' |',I5,' |',I5,' |',2(I5,' |'),I9,I4,' |') !/MPIT 9083 FORMAT ( ' +------+------+------+------+--------------+') !/MPIT 9084 FORMAT ( ' MPIT WMIOHS: NRQHGS:',I10/) !/ !/ End of WMIOHS ----------------------------------------------------- / !/ END SUBROUTINE WMIOHS !/ ------------------------------------------------------------------- / SUBROUTINE WMIOHG ( IMOD, DONE ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 20-Dec-2006 ! !/ +-----------------------------------+ !/ !/ 27-Jan-2006 : Origination. ( version 3.08 ) !/ 20-Dec-2006 : Remove VTIME from MPI comm. ( version 3.10 ) !/ ! 1. Purpose : ! ! Gather internal high-to-low data for a given model. ! ! 2. Method : ! ! For distributed memory version first receive all staged data. ! After staged data is present, average, convert as necessary, ! and store in basic spatral arrays. ! ! 2. Method : ! ! Using storage array HGSTAGE and time stamps. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number of grid from which data is to ! be gathered. ! DONE Log. O Flag for completion of operation (opt). ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SETG, W3SETW, W3SETA, W3SETO ! Subr. WxxDATMD Manage data structures. ! W3CSPC Subr. W3CSPCMD Spectral grid conversion. ! STRACE Sur. W3SERVMD Subroutine tracing. ! DSEC21 Func. W3TIMEMD Difference between times. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMWAVE Subr WMWAVEMD Multi-grid wave model. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! See FORMAT labels 1001-1002. ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/SHRD Shared/distributed memory models. ! !/DIST ! !/MPI ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! !/MPIT ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / ! USE W3GDATMD USE W3WDATMD USE W3ADATMD USE W3ODATMD USE WMMDATMD ! USE W3CSPCMD, ONLY: W3CSPC USE W3TIMEMD, ONLY: DSEC21 ! USE W3SERVMD, ONLY: EXTCDE !/PDLIB use yowNodepool, only: npa !/PDLIB USE yowExchangeModule, only : PDLIB_exchange2Dreal USE W3PARALL, ONLY : INIT_GET_ISEA !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/MPI INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD LOGICAL, INTENT(OUT), OPTIONAL :: DONE !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: NTOT, J, IS, NA, IA, JSEA, ISEA, I !/MPI INTEGER :: ITAG, IT0, IFROM, ILOC, NLOC, & !/MPI ISPROC, IERR_MPI, ICOUNT, & !/MPI I0, I1, I2 !/S INTEGER, SAVE :: IENT = 0 INTEGER, POINTER :: VTIME(:) !/MPI INTEGER, POINTER :: NRQ, IRQ(:), STATUS(:,:) REAL :: DTTST, WGTH REAL, POINTER :: SPEC1(:,:), SPEC2(:,:), SPEC(:,:) !/MPI REAL, POINTER :: SHGH(:,:,:) LOGICAL :: FLGALL !/MPI LOGICAL :: FLAGOK !/MPIT LOGICAL :: FLAG !/ !/S CALL STRACE (IENT, 'WMIOHG') ! ! -------------------------------------------------------------------- / ! 0. Initializations ! IF ( TOUTP(1,IMOD) .EQ. -1 ) THEN DTTST = 1. ELSE DTTST = DSEC21 ( WDATAS(IMOD)%TIME , TOUTP(:,IMOD) ) END IF ! IF ( .NOT. FLGHG1 ) THEN FLGALL = .TRUE. ELSE IF ( FLGHG2 ) THEN FLGALL = .FALSE. ELSE IF ( DTTST .EQ. 0. ) THEN FLGALL = .TRUE. ELSE FLGALL = .FALSE. END IF ! !/T WRITE (MDST,9000) IMOD, DTTST, FLGALL ! IF ( FLGALL ) THEN !/T WRITE (MDST,9001) HGSTGE(IMOD,:)%NREC NTOT = SUM(HGSTGE(IMOD,:)%NREC) ELSE !/T WRITE (MDST,9001) HGSTGE(IMOD,:)%NRC1 NTOT = SUM(HGSTGE(IMOD,:)%NRC1) END IF ! IF ( PRESENT(DONE) ) DONE = .FALSE. ! IF ( NTOT .EQ. 0 ) THEN IF ( PRESENT(DONE) ) DONE = .TRUE. !/T WRITE (MDST,9003) RETURN END IF ! CALL W3SETO ( IMOD, MDSE, MDST ) CALL W3SETG ( IMOD, MDSE, MDST ) CALL W3SETW ( IMOD, MDSE, MDST ) CALL W3SETA ( IMOD, MDSE, MDST ) ! ! -------------------------------------------------------------------- / ! 1. Testing / gathering data in staging arrays ! !/T WRITE (MDST,9010) TIME ! ! 1.a Shared memory version, test valid times. - - - - - - - - - - - - / ! !/SHRD DO J=1, NRGRD ! !/SHRD IF ( FLGALL ) THEN !/SHRD NTOT = HGSTGE(IMOD,J)%NREC !/SHRD ELSE !/SHRD NTOT = HGSTGE(IMOD,J)%NRC1 !/SHRD END IF !/SHRD IF ( NTOT .EQ. 0 ) CYCLE ! !/SHRD VTIME => HGSTGE(IMOD,J)%VTIME !/SHRD IF ( VTIME(1) .EQ. -1 ) RETURN !/SHRD DTTST = DSEC21 ( TIME, VTIME ) !/SHRD IF ( DTTST .NE. 0. ) RETURN ! !/SHRD END DO ! ! 1.b Distributed memory version - - - - - - - - - - - - - - - - - - - / ! !/MPIT WRITE (MDST,9011) HGHSTA(IMOD) ! ! 1.b.1 HGHSTA = 0 ! Check if staging arrays are initialized. ! Post the proper receives. ! !/MPI IF ( HGHSTA(IMOD) .EQ. 0 ) THEN ! !/MPI NRQ => MDATAS(IMOD)%NRQHGG !/MPI NRQ = 0 !/MPI DO J=1, NRGRD !/MPI IF ( FLGALL ) THEN !/MPI NRQ = NRQ + HGSTGE(IMOD,J)%NREC * & !/MPI HGSTGE(IMOD,J)%NSMX !/MPI ELSE !/MPI NRQ = NRQ + HGSTGE(IMOD,J)%NRC1 * & !/MPI HGSTGE(IMOD,J)%NSMX !/MPI END IF !/MPI END DO !/MPI NRQ = MAX(1,NRQ) !/MPI ALLOCATE ( IRQ(NRQ) ) !/MPI IRQ = 0 !/MPI NRQ = 0 ! !/MPI DO J=1, NRGRD !/MPI IF ( HGSTGE(IMOD,J)%NTOT .EQ. 0 ) CYCLE ! ! ..... Check valid time to determine staging. ! !/MPI VTIME => HGSTGE(IMOD,J)%VTIME !/MPI IF ( VTIME(1) .EQ. -1 ) THEN !/MPI DTTST = 1. !/MPI ELSE !/MPI DTTST = DSEC21 ( TIME, VTIME ) !/MPI END IF !/MPIT WRITE (MDST,9013) VTIME, DTTST ! ! ..... Post receives for data gather ! !/MPI IF ( DTTST .NE. 0. ) THEN !/MPIT WRITE (MDST,9014) J ! ! ..... Spectra ! !/MPI IT0 = MTAG1 + 1 !/MPI SHGH => HGSTGE(IMOD,J)%SHGH ! !/MPI IF ( FLGALL ) THEN !/MPI NTOT = HGSTGE(IMOD,J)%NREC !/MPI ELSE !/MPI NTOT = HGSTGE(IMOD,J)%NRC1 !/MPI END IF ! !/MPI DO I=1, NTOT !/MPIT JSEA = HGSTGE(IMOD,J)%LJSEA(I) !/MPI NLOC = HGSTGE(IMOD,J)%NRAVG(I) !/MPI DO ILOC=1, NLOC !/MPI ISPROC = HGSTGE(IMOD,J)%IMPSRC(I,ILOC) !/MPI ITAG = HGSTGE(IMOD,J)%ITAG(I,ILOC) + IT0 !/MPI IF ( ISPROC .NE. IMPROC ) THEN !/MPI NRQ = NRQ + 1 !/MPI CALL MPI_IRECV ( SHGH(1,ILOC,I), & !/MPI SGRDS(J)%NSPEC, MPI_REAL, & !/MPI ISPROC-1, ITAG, MPI_COMM_MWAVE, & !/MPI IRQ(NRQ), IERR_MPI ) !/MPIT WRITE (MDST,9016) NRQ, JSEA, ISPROC, & !/MPIT ITAG-MTAG1, IRQ(NRQ), IERR_MPI !/MPI END IF !/MPI END DO !/MPI END DO ! ! ..... End IF for posting receives 1.b.1 ! !/MPIT WRITE (MDST,9017) !/MPI END IF ! ! ..... End grid loop J in 1.b.1 ! !/MPI END DO !/MPIT WRITE (MDST,9018) NRQ ! !/MPI ALLOCATE ( MDATAS(IMOD)%IRQHGG(NRQ) ) !/MPI MDATAS(IMOD)%IRQHGG = IRQ(1:NRQ) !/MPI DEALLOCATE ( IRQ ) ! ! ..... Reset status ! !/MPI IF ( NRQ .GT. 0 ) THEN !/MPI HGHSTA(IMOD) = 1 !/MPIT WRITE (MDST,9011) HGHSTA(IMOD) !/MPI END IF ! ! ..... End IF in 1.b.1 ! !/MPI END IF ! ! 1.b.2 HGHSTA = 1 ! Wait for communication to finish. ! If DONE defined, check if done, otherwise wait. ! !/MPI IF ( HGHSTA(IMOD) .EQ. 1 ) THEN ! !/MPI NRQ => MDATAS(IMOD)%NRQHGG !/MPI IRQ => MDATAS(IMOD)%IRQHGG !/MPI ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) ! ! ..... Test communication if DONE is present, wait otherwise ! !/MPI IF ( PRESENT(DONE) ) THEN ! !/MPI CALL MPI_TESTALL ( NRQ, IRQ, FLAGOK, STATUS, & !/MPI IERR_MPI ) ! !/MPIT ICOUNT = 0 !/MPIT DO I=1, NRQ !/MPIT CALL MPI_TEST ( IRQ(I), FLAG, STATUS(1,1), & !/MPIT IERR_MPI ) !/MPIT FLAGOK = FLAGOK .AND. FLAG !/MPIT IF ( FLAG ) ICOUNT = ICOUNT + 1 !/MPIT END DO !/MPIT WRITE (MDST,9019) 100. * REAL(ICOUNT) / REAL(NRQ) ! !/MPI ELSE ! !/MPI CALL MPI_WAITALL ( NRQ, IRQ, STATUS, IERR_MPI ) !/MPI FLAGOK = .TRUE. !/MPIT WRITE (MDST,9019) 100. ! !/MPI END IF ! !/MPI DEALLOCATE ( STATUS ) ! ! ..... Go on based on FLAGOK ! !/MPI IF ( FLAGOK ) THEN !/MPI NRQ = 0 !/MPI DEALLOCATE ( MDATAS(IMOD)%IRQHGG ) !/MPI ELSE !/MPI RETURN !/MPI END IF ! !/MPI HGHSTA(IMOD) = 0 !/MPIT WRITE (MDST,9011) HGHSTA(IMOD) ! !/MPI END IF ! ! ..... process locally stored data ! !/MPI DO J=1, NRGRD !/MPI HGSTGE(IMOD,J)%VTIME = TIME !/MPI IF ( J .EQ. IMOD ) CYCLE !/MPI DO IS=1, HGSTGE(IMOD,J)%NRQOUT !/MPI I0 = HGSTGE(IMOD,J)%OUTDAT(IS,1) !/MPI I2 = HGSTGE(IMOD,J)%OUTDAT(IS,2) !/MPI I1 = HGSTGE(IMOD,J)%OUTDAT(IS,3) !/MPI HGSTGE(IMOD,J)%SHGH(:,I2,I1) = HGSTGE(IMOD,J)%TSTORE(:,I0) !/MPI END DO !/MPI END DO ! ! -------------------------------------------------------------------- / ! 2. Data available, process grid by grid ! !/T WRITE (MDST,9020) ! ! 2.a Loop over grids ! DO J=1, NRGRD ! IF ( FLGALL ) THEN NTOT = HGSTGE(IMOD,J)%NREC ELSE NTOT = HGSTGE(IMOD,J)%NRC1 END IF IF ( NTOT .EQ. 0 ) CYCLE ! !/T WRITE (MDST,9021) J, NTOT ! ! 2.b Set up temp data structures ! IF ( RESPEC(IMOD,J) ) THEN ALLOCATE ( SPEC1(SGRDS(J)%NSPEC,NTOT), SPEC2(NSPEC,NTOT) ) SPEC => SPEC1 ELSE ALLOCATE ( SPEC2(NSPEC,NTOT) ) SPEC => SPEC2 END IF ! ! 2.c Average spectra to temp storage ! !/T WRITE (MDST,9022) ! DO IS=1, NTOT NA = HGSTGE(IMOD,J)%NRAVG(IS) WGTH = HGSTGE(IMOD,J)%WGTH(IS,1) SPEC(:,IS) = WGTH * HGSTGE(IMOD,J)%SHGH(:,1,IS) DO IA=2, NA WGTH = HGSTGE(IMOD,J)%WGTH(IS,IA) SPEC(:,IS) = SPEC(:,IS) + WGTH*HGSTGE(IMOD,J)%SHGH(:,IA,IS) END DO END DO ! ! 2.d Convert spectral grid as needed ! IF ( RESPEC(IMOD,J) ) THEN ! !/T WRITE (MDST,9023) ! CALL W3CSPC ( SPEC1, SGRDS(J)%NK, SGRDS(J)%NTH, & SGRDS(J)%XFR, SGRDS(J)%FR1, SGRDS(J)%TH(1), & SPEC2 , NK, NTH, XFR, FR1, TH(1), & NTOT, MDST, MDSE, FACHFE) DEALLOCATE ( SPEC1 ) ! END IF ! ! 2.e Move spectra to model ! !/T WRITE (MDST,9024) ! DO IS=1, NTOT JSEA = HGSTGE(IMOD,J)%LJSEA(IS) CALL INIT_GET_ISEA(ISEA, JSEA) DO I=1, NSPEC VA(I,JSEA) = SPEC2(I,IS) / SIG2(I) * CG(1+(I-1)/NTH,ISEA) END DO END DO ! DEALLOCATE ( SPEC2 ) ! END DO ! ! -------------------------------------------------------------------- / ! 3. Set flag if reqeusted ! IF ( PRESENT(DONE) ) DONE = .TRUE. ! !/PDLIB CALL PDLIB_exchange2Dreal(VA(:,1:NPA)) ! ! Formats ! !/T 9000 FORMAT ( ' TEST WMIOHG : GATHERING DATA FOR GRID ',I3/ & !/T ' DTOUTP, FLGALL :',F8.1,L4) !/T 9001 FORMAT ( ' TEST WMIOHG : NR. OF SPECTRA PER SOURCE GRID : '/ & !/T ' ',25I4) !/T 9003 FORMAT ( ' TEST WMIOHG : NO DATA TO BE GATHERED') ! !/T 9010 FORMAT ( ' TEST WMIOHG : TEST DATA AVAILABILITY FOR',I9.8,I7.6) !/MPIT 9011 FORMAT ( ' MPIT WMIOHG : HGHSTA =',I2) !/MPIT 9013 FORMAT ( ' VTIME, DTTST :',I9.8,I7.6,1X,F8.1) !/MPIT 9014 FORMAT (/' MPIT WMIOHG : RECEIVE FROM GRID',I4/ & !/MPIT ' +------+------+------+------+--------------+'/ & !/MPIT ' | IH | ID | FROM | TAG | handle err |'/ & !/MPIT ' +------+------+------+------+--------------+') !/MPIT 9016 FORMAT ( ' |',I5,' |',I5,' |',2(I5,' |'),I9,I4,' |') !/MPIT 9017 FORMAT ( ' +------+------+------+------+--------------+'/) !/MPIT 9018 FORMAT ( ' MPIT WMIOHG : NRQBPT:',I10/) !/MPIT 9019 FORMAT ( ' MPIT WMIOHG : RECEIVES FINISHED :',F6.1,'%') ! !/T 9020 FORMAT ( ' TEST WMIOHG : PROCESSING DATA GRID BY GRID') !/T 9021 FORMAT ( ' FROM GRID ',I3,' NR OF SPECTRA :',I6) !/T 9022 FORMAT ( ' AVERAGE SPECTRA TO TEMP STORAGE') !/T 9023 FORMAT ( ' CONVERT SPECTRAL GRID') !/T 9024 FORMAT ( ' MOVE SPECTRA TO PERMANENT STORAGE') !/ !/ End of WMIOHG ----------------------------------------------------- / !/ END SUBROUTINE WMIOHG !/ ------------------------------------------------------------------- / SUBROUTINE WMIOHF ( IMOD ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 16-Jan-2006 ! !/ +-----------------------------------+ !/ !/ 16-Jan-2006 : Origination. ( version 3.08 ) !/ ! 1. Purpose : ! ! Finalize staging of internal high-to-low data in the data ! structure HGSTGE (MPI only). ! ! 2. Method : ! ! Post appropriate 'wait' functions to assure that the ! communication has finished. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number of grid from which data has ! been staged. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMWAVE Subr WMWAVEMD Multi-grid wave model. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! 7. Remarks : ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/SHRD Shared/distributed memory models. ! !/DIST ! !/MPI ! ! !/S Enable subroutine tracing. ! !/T Test output. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / ! USE WMMDATMD ! !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/MPI INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: J !/MPI INTEGER :: IERR_MPI !/MPI INTEGER, POINTER :: NRQ, IRQ(:) !/MPI INTEGER, ALLOCATABLE :: STATUS(:,:) !/S INTEGER, SAVE :: IENT = 0 !/ !/S CALL STRACE (IENT, 'WMIOHF') ! ! -------------------------------------------------------------------- / ! 0. Initializations ! !/T WRITE (MDST,9000) IMOD ! ! -------------------------------------------------------------------- / ! 1. Loop over grids ! DO J=1, NRGRD ! !/MPI NRQ => HGSTGE(J,IMOD)%NRQHGS ! ! 1.a Nothing to finalize ! !/MPI IF ( NRQ .EQ. 0 ) CYCLE !/MPI IRQ => HGSTGE(J,IMOD)%IRQHGS ! ! 1.b Wait for communication to end ! !/MPI ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) !/MPI CALL MPI_WAITALL ( NRQ, IRQ, STATUS, IERR_MPI ) !/MPI DEALLOCATE ( STATUS ) ! ! 1.c Reset arrays and counter ! !/MPI NRQ = 0 !/MPI DEALLOCATE ( HGSTGE(J,IMOD)%IRQHGS, & !/MPI HGSTGE(J,IMOD)%TSTORE, & !/MPI HGSTGE(J,IMOD)%OUTDAT ) ! !/T WRITE (MDST,9010) J ! END DO ! RETURN ! ! Formats ! !/T 9000 FORMAT ( ' TEST WMIOHF : FINALIZE STAGING DATA FROM GRID ',I3) !/T 9010 FORMAT ( ' TEST WMIOHF : FINISHED WITH TARGET ',I3) !/ !/ End of WMIOHF ----------------------------------------------------- / !/ END SUBROUTINE WMIOHF !/ ------------------------------------------------------------------- / SUBROUTINE WMIOES ( IMOD ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 28-Sep-2016 ! !/ +-----------------------------------+ !/ !/ 25-May-2006 : Origination. ( version 3.09 ) !/ 21-Dec-2006 : Remove VTIME from MPI comm. ( version 3.10 ) !/ 28-Sep-2016 : Add error traps for MPI tags. ( version 5.15 ) !/ ! 1. Purpose : ! ! Stage internal same-rank data in the data structure EQSTGE. ! ! 2. Method : ! ! Directly fill staging arrays in shared memory version, or post ! the corresponding sends in distributed memory version. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number of grid from which data is to ! be staged. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SETG, W3SETW, W3SETA, W3SETO, WMSETM ! Subr. WxxDATMD Manage data structures. ! STRACE Subr. W3SERVMD Subroutine tracing. ! EXTCDE Sur. Id. Program abort. ! DSEC21 Func. W3TIMEMD Difference between times. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMWAVE Subr WMWAVEMD Multi-grid wave model. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! See FORMAT label 1001. ! ! 7. Remarks : ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/SHRD Shared/distributed memory models. ! !/DIST ! !/MPI ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! !/MPIT ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / ! USE W3GDATMD USE W3WDATMD USE W3ADATMD USE W3ODATMD USE WMMDATMD ! USE W3SERVMD, ONLY: EXTCDE !/S USE W3SERVMD, ONLY: STRACE USE W3TIMEMD, ONLY: DSEC21 ! IMPLICIT NONE ! !/MPI INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: J, NR, I, ISEA, JSEA, IS, I1, I2 !/MPI INTEGER :: IT0, ITAG, IP, IERR_MPI !/S INTEGER, SAVE :: IENT = 0 !/MPI INTEGER, POINTER :: NRQ, IRQ(:), NRQOUT, OUTDAT(:,:) !/SHRD REAL, POINTER :: SEQL(:,:,:) !/MPI REAL, POINTER :: SEQL(:,:) !/ !/S CALL STRACE (IENT, 'WMIOES') ! ! -------------------------------------------------------------------- / ! 0. Initializations ! !/T WRITE (MDST,9000) IMOD !/T WRITE (MDST,9001) EQSTGE(:,IMOD)%NSND ! CALL W3SETO ( IMOD, MDSE, MDST ) CALL W3SETG ( IMOD, MDSE, MDST ) CALL W3SETW ( IMOD, MDSE, MDST ) CALL W3SETA ( IMOD, MDSE, MDST ) ! ! -------------------------------------------------------------------- / ! 1. Loop over grids ! DO J=1, NRGRD ! IF ( J .EQ. IMOD ) CYCLE NR = EQSTGE(J,IMOD)%NSND ! !/T IF ( NR .EQ. 0 ) THEN !/T WRITE (MDST,9010) J, NR !/T ELSE !/T WRITE (MDST,9011) J, NR, DSEC21(TIME,TSYNC(:,J)) !/T END IF ! IF ( NR .EQ. 0 ) CYCLE IF ( DSEC21(TIME,TSYNC(:,J)) .NE. 0. ) STOP ! ! -------------------------------------------------------------------- / ! 2. Allocate arrays and/or point pointers ! !/SHRD SEQL => EQSTGE(J,IMOD)%SEQL !/MPI ALLOCATE ( EQSTGE(J,IMOD)%TSTORE(NSPEC,NR) ) !/MPI SEQL => EQSTGE(J,IMOD)%TSTORE ! !/MPI ALLOCATE ( EQSTGE(J,IMOD)%IRQEQS(NR) , & !/MPI EQSTGE(J,IMOD)%OUTDAT(NR,3) ) ! !/MPI NRQ => EQSTGE(J,IMOD)%NRQEQS !/MPI NRQOUT => EQSTGE(J,IMOD)%NRQOUT !/MPI IRQ => EQSTGE(J,IMOD)%IRQEQS !/MPI OUTDAT => EQSTGE(J,IMOD)%OUTDAT !/MPI NRQ = 0 !/MPI NRQOUT = 0 !/MPI IRQ = 0 ! ! -------------------------------------------------------------------- / ! 3. Set the time ! Note that with MPI the send needs to be posted to the local ! processor too to make time management possible. ! !/T WRITE (MDST,9030) TIME ! !/SHRD EQSTGE(J,IMOD)%VTIME = TIME ! ! -------------------------------------------------------------------- / ! 4. Stage the spectral data ! !/MPIT WRITE (MDST,9080) !/MPI IT0 = MTAG2 + 1 ! DO I=1, NR ! ISEA = EQSTGE(J,IMOD)%SIS(I) JSEA = EQSTGE(J,IMOD)%SJS(I) I1 = EQSTGE(J,IMOD)%SI1(I) I2 = EQSTGE(J,IMOD)%SI2(I) !/MPI IP = EQSTGE(J,IMOD)%SIP(I) !/MPI ITAG = EQSTGE(J,IMOD)%STG(I) + IT0 !/MPI IF ( ITAG .GT. MTAG_UB ) THEN !/MPI WRITE (MDSE,1001) !/MPI CALL EXTCDE (1001) !/MPI END IF ! DO IS=1, NSPEC !/SHRD SEQL(IS,I1,I2) = VA(IS,JSEA) * SIG2(IS) & !/SHRD / CG(1+(IS-1)/NTH,ISEA) !/MPI SEQL( IS,I ) = VA(IS,JSEA) * SIG2(IS) & !/MPI / CG(1+(IS-1)/NTH,ISEA) END DO ! !/MPI IF ( IP .NE. IMPROC ) THEN !/MPI NRQ = NRQ + 1 !/MPI CALL MPI_ISEND ( SEQL(1,I), NSPEC, MPI_REAL, IP-1, & !/MPI ITAG, MPI_COMM_MWAVE, IRQ(NRQ), IERR_MPI ) !/MPIT WRITE (MDST,9082) NRQ, JSEA, IP, ITAG-MTAG2, & !/MPIT IRQ(NRQ), IERR_MPI !/MPI ELSE !/MPI NRQOUT = NRQOUT + 1 !/MPI OUTDAT(NRQOUT,1) = I !/MPI OUTDAT(NRQOUT,2) = I1 !/MPI OUTDAT(NRQOUT,3) = I2 !/MPI END IF ! END DO ! !/MPIT WRITE (MDST,9083) !/MPIT WRITE (MDST,9084) NRQ ! END DO ! RETURN ! ! Formats ! !/MPI 1001 FORMAT (/' *** ERROR WMIOES : REQUESTED MPI TAG EXCEEDS', & !/MPI ' UPPER BOUND (MTAG_UB) ***') !/T 9000 FORMAT ( ' TEST WMIOES : STAGING DATA FROM GRID ',I3) !/T 9001 FORMAT ( ' TEST WMIOES : NR. OF SPECTRA PER GRID : '/ & !/T ' ',15I6) ! !/T 9010 FORMAT ( ' TEST WMIOES : POSTING DATA TO GRID ',I3, & !/T ' NR = ',I6) !/T 9011 FORMAT ( ' TEST WMIOES : POSTING DATA TO GRID ',I3, & !/T ' NR = ',I6,' TIME GAP = ',F8.1) ! !/T 9030 FORMAT ( ' TEST WMIOES : TIME :',I10.8,I7.6) !/ !/MPIT 9080 FORMAT (/' MPIT WMIOES: COMMUNICATION CALLS '/ & !/MPIT ' +------+------+------+------+--------------+'/ & !/MPIT ' | IH | ID | TARG | TAG | handle err |'/ & !/MPIT ' +------+------+------+------+--------------+') !/MPIT 9082 FORMAT ( ' |',I5,' |',I5,' |',2(I5,' |'),I9,I4,' |') !/MPIT 9083 FORMAT ( ' +------+------+------+------+--------------+') !/MPIT 9084 FORMAT ( ' MPIT WMIOES: NRQEQS:',I10/) !/ !/ End of WMIOES ----------------------------------------------------- / !/ END SUBROUTINE WMIOES !/ ------------------------------------------------------------------- / SUBROUTINE WMIOEG ( IMOD, DONE ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 22-Jan-2007 ! !/ +-----------------------------------+ !/ !/ 25-May-2006 : Origination. ( version 3.09 ) !/ 21-Dec-2006 : Remove VTIME from MPI comm. ( version 3.10 ) !/ 22-Jan-2007 : Adding NAVMAX. ( version 3.10 ) !/ ! 1. Purpose : ! ! Gather internal same-rank data for a given model. ! ! 2. Method : ! ! For distributed memory version first receive all staged data. ! After staged data is present, average, convert as necessary, ! and store in basic spatral arrays. ! ! 2. Method : ! ! Using storage array EQSTGE and time stamps. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number of grid from which data is to ! be gathered. ! DONE Log. O Flag for completion of operation (opt). ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SETG, W3SETW, W3SETA, W3SETO ! Subr. WxxDATMD Manage data structures. ! W3CSPC Subr. W3CSPCMD Spectral grid conversion. ! STRACE Sur. W3SERVMD Subroutine tracing. ! DSEC21 Func. W3TIMEMD Difference between times. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMWAVE Subr WMWAVEMD Multi-grid wave model. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! See FORMAT labels 1001-1002. ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/SHRD Shared/distributed memory models. ! !/DIST ! !/MPI ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! !/MPIT ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / ! USE W3GDATMD USE W3WDATMD USE W3ADATMD USE W3ODATMD USE WMMDATMD ! USE W3CSPCMD, ONLY: W3CSPC USE W3TIMEMD, ONLY: DSEC21 USE W3SERVMD, ONLY: EXTCDE !/PDLIB use yowNodepool, only: npa !/PDLIB USE yowExchangeModule, only : PDLIB_exchange2Dreal !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/MPI INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD LOGICAL, INTENT(OUT), OPTIONAL :: DONE !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: J, I, ISEA, JSEA, IA, IS !/S INTEGER, SAVE :: IENT = 0 !/MPI INTEGER :: IT0, ITAG, IFROM, IERR_MPI, & !/MPI NA, IP, I1, I2 !/MPIT INTEGER :: ICOUNT INTEGER, POINTER :: VTIME(:) !/MPI INTEGER, POINTER :: NRQ, IRQ(:), STATUS(:,:) REAL :: DTTST, WGHT REAL, POINTER :: SPEC1(:,:), SPEC2(:,:), SPEC(:,:) !/MPI REAL, POINTER :: SEQL(:,:,:) !/MPI LOGICAL :: FLAGOK !/MPI LOGICAL :: FLAG !/ !/S CALL STRACE (IENT, 'WMIOEG') ! ! -------------------------------------------------------------------- / ! 0. Initializations ! !/T WRITE (MDST,9000) IMOD !/T WRITE (MDST,9001) 'NREC', EQSTGE(IMOD,:)%NREC ! IF ( PRESENT(DONE) ) DONE = .FALSE. ! IF ( EQSTGE(IMOD,IMOD)%NREC .EQ. 0 ) THEN IF ( PRESENT(DONE) ) DONE = .TRUE. !/T WRITE (MDST,9002) RETURN END IF ! CALL W3SETO ( IMOD, MDSE, MDST ) CALL W3SETG ( IMOD, MDSE, MDST ) CALL W3SETW ( IMOD, MDSE, MDST ) CALL W3SETA ( IMOD, MDSE, MDST ) ! ! -------------------------------------------------------------------- / ! 1. Testing / gathering data in staging arrays ! !/T WRITE (MDST,9010) TIME ! ! 1.a Shared memory version, test valid times. - - - - - - - - - - - - / ! !/SHRD DO J=1, NRGRD ! !/SHRD IF ( IMOD .EQ. J ) CYCLE !/SHRD IF ( EQSTGE(IMOD,J)%NREC .EQ. 0 ) CYCLE ! !/SHRD VTIME => EQSTGE(IMOD,J)%VTIME !/SHRD IF ( VTIME(1) .EQ. -1 ) RETURN !/SHRD DTTST = DSEC21 ( TIME, VTIME ) !/SHRD IF ( DTTST .NE. 0. ) RETURN ! !/SHRD END DO ! ! 1.b Distributed memory version - - - - - - - - - - - - - - - - - - - / ! !/MPIT WRITE (MDST,9011) EQLSTA(IMOD) ! ! 1.b.1 EQLSTA = 0 ! Check if staging arrays are initialized. ! Post the proper receives. ! !/MPI IF ( EQLSTA(IMOD) .EQ. 0 ) THEN ! !/MPI NRQ => MDATAS(IMOD)%NRQEQG !/MPI NRQ = 0 !/MPI DO J=1, NRGRD !/MPI IF ( J .EQ. IMOD ) CYCLE !/MPI NRQ = NRQ + EQSTGE(IMOD,J)%NREC * & !/MPI EQSTGE(IMOD,J)%NAVMAX !/MPI END DO !/MPI ALLOCATE ( IRQ(NRQ) ) !/MPI IRQ = 0 !/MPI NRQ = 0 ! !/MPI DO J=1, NRGRD !/MPI IF ( IMOD .EQ. J ) CYCLE !/MPI IF ( EQSTGE(IMOD,J)%NREC .EQ. 0 ) CYCLE ! ! ..... Check valid time to determine staging. ! !/MPI VTIME => EQSTGE(IMOD,J)%VTIME !/MPI IF ( VTIME(1) .EQ. -1 ) THEN !/MPI DTTST = 1. !/MPI ELSE !/MPI DTTST = DSEC21 ( TIME, VTIME ) !/MPI END IF !/MPIT WRITE (MDST,9013) VTIME, DTTST ! ! ..... Post receives for data gather ! !/MPI IF ( DTTST .NE. 0. ) THEN !/MPIT WRITE (MDST,9014) J ! ! ..... Spectra ! !/MPI IT0 = MTAG2 + 1 !/MPI SEQL => EQSTGE(IMOD,J)%SEQL ! !/MPI DO I=1, EQSTGE(IMOD,J)%NREC !/MPI JSEA = EQSTGE(IMOD,J)%JSEA(I) !/MPI NA = EQSTGE(IMOD,J)%NAVG(I) !/MPI DO IA=1, NA !/MPI IP = EQSTGE(IMOD,J)%RIP(I,IA) !/MPI ITAG = EQSTGE(IMOD,J)%RTG(I,IA) + IT0 !/MPI IF ( IP .NE. IMPROC ) THEN !/MPI NRQ = NRQ + 1 !/MPI CALL MPI_IRECV ( SEQL(1,I,IA), & !/MPI SGRDS(J)%NSPEC, MPI_REAL, & !/MPI IP-1, ITAG, MPI_COMM_MWAVE, & !/MPI IRQ(NRQ), IERR_MPI ) !/MPIT WRITE (MDST,9016) NRQ, JSEA, IP, & !/MPIT ITAG-MTAG2, IRQ(NRQ), IERR_MPI !/MPI END IF !/MPI END DO !/MPI END DO ! ! ..... End IF for posting receives 1.b.1 ! !/MPIT WRITE (MDST,9017) !/MPI END IF ! ! ..... End grid loop J in 1.b.1 ! !/MPI END DO !/MPIT WRITE (MDST,9018) NRQ ! !/MPI IF ( NRQ .NE. 0 ) THEN !/MPI ALLOCATE ( MDATAS(IMOD)%IRQEQG(NRQ) ) !/MPI MDATAS(IMOD)%IRQEQG = IRQ(1:NRQ) !/MPI END IF ! !/MPI DEALLOCATE ( IRQ ) ! ! ..... Reset status ! !/MPI IF ( NRQ .GT. 0 ) THEN !/MPI EQLSTA(IMOD) = 1 !/MPIT WRITE (MDST,9011) EQLSTA(IMOD) !/MPI END IF ! ! ..... End IF in 1.b.1 ! !/MPI END IF ! ! 1.b.2 EQLSTA = 1 ! Wait for communication to finish. ! If DONE defined, check if done, otherwise wait. ! !/MPI IF ( EQLSTA(IMOD) .EQ. 1 ) THEN ! !/MPI NRQ => MDATAS(IMOD)%NRQEQG !/MPI IRQ => MDATAS(IMOD)%IRQEQG !/MPI ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) ! ! ..... Test communication if DONE is present, wait otherwise ! !/MPI IF ( PRESENT(DONE) ) THEN ! !/MPI CALL MPI_TESTALL ( NRQ, IRQ, FLAGOK, STATUS, & !/MPI IERR_MPI ) ! !/MPIT ICOUNT = 0 !/MPIT DO I=1, NRQ !/MPIT CALL MPI_TEST ( IRQ(I), FLAG, STATUS(1,1), & !/MPIT IERR_MPI ) !/MPIT FLAGOK = FLAGOK .AND. FLAG !/MPIT IF ( FLAG ) ICOUNT = ICOUNT + 1 !/MPIT END DO !/MPIT WRITE (MDST,9019) 100. * REAL(ICOUNT) / REAL(NRQ) ! !/MPI ELSE ! !/MPI CALL MPI_WAITALL ( NRQ, IRQ, STATUS, IERR_MPI ) !/MPI FLAGOK = .TRUE. !/MPIT WRITE (MDST,9019) 100. ! !/MPI END IF ! !/MPI DEALLOCATE ( STATUS ) ! ! ..... Go on based on FLAGOK ! !/MPI IF ( FLAGOK ) THEN !/MPI IF ( NRQ.NE.0 ) DEALLOCATE ( MDATAS(IMOD)%IRQEQG ) !/MPI NRQ = 0 !/MPI ELSE !/MPI RETURN !/MPI END IF ! !/MPI EQLSTA(IMOD) = 0 !/MPIT WRITE (MDST,9011) EQLSTA(IMOD) ! !/MPI END IF ! ! ..... process locally stored data ! !/MPI DO J=1, NRGRD !/MPI EQSTGE(IMOD,J)%VTIME = TIME !/MPI IF ( J .EQ. IMOD ) CYCLE !/MPI DO IS=1, EQSTGE(IMOD,J)%NRQOUT !/MPI I = EQSTGE(IMOD,J)%OUTDAT(IS,1) !/MPI I1 = EQSTGE(IMOD,J)%OUTDAT(IS,2) !/MPI I2 = EQSTGE(IMOD,J)%OUTDAT(IS,3) !/MPI EQSTGE(IMOD,J)%SEQL(:,I1,I2) = EQSTGE(IMOD,J)%TSTORE(:,I) !/MPI END DO !/MPI END DO ! ! -------------------------------------------------------------------- / ! 2. Data available, process grid by grid ! !/T WRITE (MDST,9020) ! ! 2.a Do 'native' grid IMOD ! !/T WRITE (MDST,9021) IMOD, EQSTGE(IMOD,IMOD)%NREC ! DO I=1, EQSTGE(IMOD,IMOD)%NREC JSEA = EQSTGE(IMOD,IMOD)%JSEA(I) WGHT = EQSTGE(IMOD,IMOD)%WGHT(I) VA(:,JSEA) = WGHT * VA(:,JSEA) END DO ! ! 2.b Loop over other grids ! DO J=1, NRGRD IF ( IMOD.EQ.J .OR. EQSTGE(IMOD,J)%NREC.EQ.0 ) CYCLE ! !/T WRITE (MDST,9022) J, EQSTGE(IMOD,J)%NREC ! ! 2.c Average spectra ! !/T WRITE (MDST,9023) ALLOCATE ( SPEC1(SGRDS(J)%NSPEC,EQSTGE(IMOD,J)%NREC) ) SPEC1 = 0. ! DO I=1, EQSTGE(IMOD,J)%NREC DO IA=1, EQSTGE(IMOD,J)%NAVG(I) SPEC1(:,I) = SPEC1(:,I) + EQSTGE(IMOD,J)%SEQL(:,I,IA) * & EQSTGE(IMOD,J)%WAVG(I,IA) END DO END DO ! ! 2.d Convert spectra ! IF ( RESPEC(IMOD,J) ) THEN !/T WRITE (MDST,9024) ALLOCATE ( SPEC2(NSPEC,EQSTGE(IMOD,J)%NREC) ) ! CALL W3CSPC ( SPEC1, SGRDS(J)%NK, SGRDS(J)%NTH, & SGRDS(J)%XFR, SGRDS(J)%FR1, SGRDS(J)%TH(1), & SPEC2 , NK, NTH, XFR, FR1, TH(1), & EQSTGE(IMOD,J)%NREC, MDST, MDSE, FACHFE) ! SPEC => SPEC2 ELSE SPEC => SPEC1 END IF ! ! 2.e Apply to native grid ! DO I=1, EQSTGE(IMOD,J)%NREC ISEA = EQSTGE(IMOD,J)%ISEA(I) JSEA = EQSTGE(IMOD,J)%JSEA(I) WGHT = EQSTGE(IMOD,J)%WGHT(I) DO IS=1, NSPEC VA(IS,JSEA) = VA(IS,JSEA) + WGHT * & SPEC(IS,I) / SIG2(IS) * CG(1+(IS-1)/NTH,ISEA) END DO END DO ! ! 2.f Final clean up ! DEALLOCATE ( SPEC1 ) IF ( RESPEC(IMOD,J) ) DEALLOCATE ( SPEC2 ) END DO ! ! -------------------------------------------------------------------- / ! 3. Set flag if requested ! IF ( PRESENT(DONE) ) DONE = .TRUE. ! !/PDLIB CALL PDLIB_exchange2Dreal(VA(:,1:NPA)) ! ! Formats ! !/T 9000 FORMAT ( ' TEST WMIOEG : GATHERING DATA FOR GRID ',I4) !/T 9001 FORMAT ( ' TEST WMIOEG : ',A,' PER SOURCE GRID : '/13X,20I5) !/T 9002 FORMAT ( ' TEST WMIOEG : NO DATA TO BE GATHERED') ! !/T 9010 FORMAT ( ' TEST WMIOEG : TEST DATA AVAILABILITY FOR',I9.8,I7.6) !/MPIT 9011 FORMAT ( ' MPIT WMIOEG : EQLSTA =',I2) !/MPIT 9012 FORMAT ( ' STAGING ARRAY FROM',I4,1X,A) !/MPIT 9013 FORMAT ( ' VTIME, DTTST :',I9.8,I7.6,1X,F8.1) !/MPIT 9014 FORMAT (/' MPIT WMIOEG : RECEIVE FROM GRID',I4/ & !/MPIT ' +------+------+------+------+--------------+'/ & !/MPIT ' | IH | ID | FROM | TAG | handle err |'/ & !/MPIT ' +------+------+------+------+--------------+') !/MPIT 9016 FORMAT ( ' |',I5,' |',I5,' |',2(I5,' |'),I9,I4,' |') !/MPIT 9017 FORMAT ( ' +------+------+------+------+--------------+'/) !/MPIT 9018 FORMAT ( ' MPIT WMIOEG : NRQBPT:',I10/) !/MPIT 9019 FORMAT ( ' MPIT WMIOEG : RECEIVES FINISHED :',F6.1,'%') ! !/T 9020 FORMAT ( ' TEST WMIOEG : PROCESSING DATA GRID BY GRID') !/T 9021 FORMAT ( ' NATIVE GRID ',I3,' DATA :',I6) !/T 9022 FORMAT ( ' RECEIVING GRID ',I3,' DATA :',I6) !/T 9023 FORMAT ( ' AVERAGE SPECTRA') !/T 9024 FORMAT ( ' CONVERTING SPECTRA') !/ !/ End of WMIOEG ----------------------------------------------------- / !/ END SUBROUTINE WMIOEG !/ ------------------------------------------------------------------- / SUBROUTINE WMIOEF ( IMOD ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 25-May-2006 ! !/ +-----------------------------------+ !/ !/ 25-May-2006 : Origination. ( version 3.09 ) !/ ! 1. Purpose : ! ! Finalize staging of internal same-rank data in the data ! structure EQSTGE (MPI only). ! ! 2. Method : ! ! Post appropriate 'wait' functions to assure that the ! communication has finished. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number of grid from which data has ! been staged. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WMWAVE Subr WMWAVEMD Multi-grid wave model. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! 7. Remarks : ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/SHRD Shared/distributed memory models. ! !/DIST ! !/MPI ! ! !/S Enable subroutine tracing. ! !/T Test output. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / ! USE WMMDATMD ! !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/MPI INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: J !/MPI INTEGER :: IERR_MPI !/MPI INTEGER, POINTER :: NRQ, IRQ(:) !/MPI INTEGER, ALLOCATABLE :: STATUS(:,:) !/S INTEGER, SAVE :: IENT = 0 !/ !/S CALL STRACE (IENT, 'WMIOEF') ! ! -------------------------------------------------------------------- / ! 0. Initializations ! !/T WRITE (MDST,9000) IMOD ! ! -------------------------------------------------------------------- / ! 1. Loop over grids ! DO J=1, NRGRD ! !/MPI NRQ => EQSTGE(J,IMOD)%NRQEQS ! ! 1.a Nothing to finalize ! !/MPI IF ( NRQ .EQ. 0 ) CYCLE !/MPI IRQ => EQSTGE(J,IMOD)%IRQEQS ! ! 1.b Wait for communication to end ! !/MPI ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) !/MPI CALL MPI_WAITALL ( NRQ, IRQ, STATUS, IERR_MPI ) !/MPI DEALLOCATE ( STATUS ) ! ! 1.c Reset arrays and counter ! !/MPI DEALLOCATE ( EQSTGE(J,IMOD)%IRQEQS, & !/MPI EQSTGE(J,IMOD)%TSTORE, & !/MPI EQSTGE(J,IMOD)%OUTDAT ) !/MPI NRQ = 0 ! !/T WRITE (MDST,9010) J ! END DO ! RETURN ! ! Formats ! !/T 9000 FORMAT ( ' TEST WMIOEF : FINALIZE STAGING DATA FROM GRID ',I3) !/T 9010 FORMAT ( ' TEST WMIOEF : FINISHED WITH TARGET ',I3) !/ !/ End of WMIOEF ----------------------------------------------------- / !/ END SUBROUTINE WMIOEF !/ !/ End of module WMINIOMD -------------------------------------------- / !/ END MODULE WMINIOMD