Module for generating a single point output file for a multi- grid model implementation. More...

Functions/Subroutines
subroutine	wmiopp (NPT, XPT, YPT, PNAMES)
	Initialization for unified point output. More...

subroutine	wmiopo (TOUT)
	Gather and write unified point output. More...

Detailed Description

Module for generating a single point output file for a multi- grid model implementation.

Author: H. L. Tolman

Date: 06-Jun-2012

Function/Subroutine Documentation

◆ wmiopo()

subroutine wmiopomd::wmiopo ( integer, dimension(2), intent(in) TOUT )

Gather and write unified point output.

Per-grid point output is already gathered. All data are gathered in the proper storage, and written using the standard W3IOPO routint from grid number 0.

Parameters

[in] TOUT Time for output file.

Author: H. L. Tolman

Date: 16-Mar-2012

Definition at line 640 of file wmiopomd.F90.

     !/
     !/                  +-----------------------------------+
     !/                  | WAVEWATCH III           NOAA/NCEP |
     !/                  |           H. L. Tolman            |
     !/                  |                        FORTRAN 90 |
     !/                  | Last update :         16-Mar-2012 !
     !/                  +-----------------------------------+
     !/
     !/    09-Aug-2006 : Origination.                        ( version 3.10 )
     !/    21-Jun-2007 : Dedicated output processes.         ( version 3.11 )
     !/    16-Mar-2012 : Using MPI_COMM_NULL in checks.      ( version 3.14 )
     !/
     !  1. Purpose :
     !
     !     Gather and write unified point output.
     !
     !  2. Method :
     !
     !     Per-grid point output is already gathered. All data are gathered
     !     in the porper storage, and writen using the standard W3IOPO
     !     routint from grid number 0.
     !
     !  3. Parameters :
     !
     !     Parameter list
     !     ----------------------------------------------------------------
     !       TOUT    I.A.   I   Time for output file.
     !     ----------------------------------------------------------------
     !
     !  4. Subroutines used :
     !
     !      Name      Type  Module   Description
     !     ----------------------------------------------------------------
     !      W3SETG    Subr. W3GDATMD Point to model grid.
     !      W3SETW    Subr. W3WDATMD Point to model grid.
     !      W3SETO    Subr. W3ODATMD Point to model grid.
     !      WMSETM    Subr. WMMDATMD Point to model grid.
     !      W3CSPC    Subr. W3CSPCMD Spectral grid conversion.
     !      W3IOPO    Subr. W3IOPOMD Point output for single model.
     !      STRACE    Subr. W3SERVMD Subroutine tracing.
     !      MPI_SEND, MPI_RECV
     !                Subr.  mpif.h  Standard MPI library routines.
     !     ----------------------------------------------------------------
     !
     !  5. Called by :
     !
     !      Name      Type  Module   Description
     !     ----------------------------------------------------------------
     !      WMWAVE    Prog. WMWAVEMD Multi-grid wave model routine.
     !     ----------------------------------------------------------------
     !
     !  6. Error messages :
     !
     !  7. Remarks :
     !
     !  8. Structure :
     !
     !     See source code.
     !
     !  9. Switches :
     !
     !       !/MPI  Distributed memory model.
     !
     !       !/S    Enable subroutine tracing.
     !       !/T    Enable test output
     !       !/MPIT
     !
     ! 10. Source code :
     !
     !/ ------------------------------------------------------------------- /
     !     USE CONSTANTS
     !
     USE w3gdatmd, ONLY: w3setg
     USE w3wdatmd, ONLY: w3setw
     USE w3odatmd, ONLY: w3seto
     USE wmmdatmd, ONLY: wmsetm
     USE w3cspcmd, ONLY: w3cspc
     USE w3iopomd
     USE w3gdatmd, ONLY: nk, nth, nspec, xfr, fr1, th, sgrds
     USE w3wdatmd, ONLY: time
     USE w3odatmd, ONLY: iaproc, naproc, nappnt, nopts, spco, dpo,   &
          wao, wdo, aso, cao, cdo, outpts,            &
          iceo,iceho,icefo
     USE wmmdatmd, ONLY: mdst, mdse, improc, nmproc, nmpupt, nrgrd,  &
          respec, uptmap, mdsup
 #ifdef W3_ASCII
     USE wmmdatmd, ONLY: mdsupa
 #endif
 #ifdef W3_MPI
     USE wmmdatmd, ONLY: mpi_comm_mwave, mpi_comm_grd, allprc,  &
          mtag0
 #endif
 #ifdef W3_S
     USE w3servmd, ONLY: strace
 #endif
     !
     IMPLICIT NONE
     !
 #ifdef W3_MPI
     include "mpif.h"
 #endif
     !/
     !/ ------------------------------------------------------------------- /
     !/ Parameter list
     !/
     INTEGER, INTENT(IN)     :: TOUT(2)
     !/
     !/ ------------------------------------------------------------------- /
     !/ Local parameters
     !/
     INTEGER                 :: J, I, II, IT0, IT, ITARG, IFROM
 #ifdef W3_SHRD
     INTEGER                 :: MPI_COMM_GRD = 1, croot = 1
     INTEGER, PARAMETER      :: MPI_COMM_NULL = -1
 #endif
 #ifdef W3_MPI
     INTEGER                 :: IERR_MPI, NMPPNT
     INTEGER, ALLOCATABLE    :: STATUS(:,:)
 #endif
 #ifdef W3_S
     INTEGER, SAVE           :: IENT = 0
 #endif
     REAL, POINTER           :: SPEC(:,:)
 #ifdef W3_MPI
     REAL, POINTER           :: SPCR(:,:), DPR(:), WAR(:),      &
          WDR(:), ASR(:), CAR(:), CDR(:)
     REAL, POINTER           :: ICRO(:), ICRFO(:), ICRHO(:)
 #endif
     !/
 #ifdef W3_S
     CALL strace (ient, 'WMIOPO')
 #endif
     !
     ! -------------------------------------------------------------------- /
     ! 0.  Initializations
     !
 #ifdef W3_T
     WRITE (mdst,9000) nmpupt, improc
 #endif
     !
     IF ( improc .EQ. nmpupt ) THEN
       outpts(0)%OUT2%SPCO  = 0.
       outpts(0)%OUT2%DPO   = 1.
       outpts(0)%OUT2%WAO   = 0.
       outpts(0)%OUT2%WDO   = 0.
       outpts(0)%OUT2%ASO   = 0.
       outpts(0)%OUT2%CAO   = 0.
       outpts(0)%OUT2%CDO   = 0.
       outpts(0)%OUT2%ICEO  = 0.
       outpts(0)%OUT2%ICEFO = 0.
       outpts(0)%OUT2%ICEHO = 0.
     END IF
     !
     ! -------------------------------------------------------------------- /
     ! 1.  Loop over grids for processing local data
     !
     DO j=1, nrgrd
       !
       ! 1.a Set up loop
       !
       CALL w3seto ( j, mdse, mdst )
       CALL w3setg ( j, mdse, mdst )
       CALL wmsetm ( j, mdse, mdst )
       !
 #ifdef W3_T
       WRITE (mdst,9010) j, nopts, iaproc, nappnt
 #endif
       !
       ! 1.b Determine if action
       !
       IF ( mpi_comm_grd .EQ. mpi_comm_null ) THEN
 #ifdef W3_T
         WRITE (mdst,9011)
 #endif
         cycle
       END IF
       !
       IF ( nopts .EQ. 0 ) THEN
 #ifdef W3_T
         WRITE (mdst,9012)
 #endif
         cycle
       END IF
       !
       IF ( iaproc .NE. nappnt ) THEN
 #ifdef W3_T
         WRITE (mdst,9014)
 #endif
         cycle
       END IF
       !
       ! 1.c Data here, and to remain on present processor.
       !
       IF ( improc .EQ. nmpupt ) THEN
 #ifdef W3_T
         WRITE (mdst,9015)
 #endif
         !
         ! 1.c.1 Spectral conversion if needed
         !
         IF ( respec(0,j) ) THEN
 #ifdef W3_T
           WRITE (mdst,9016) 'YES'
 #endif
           ALLOCATE ( spec(sgrds(0)%NSPEC,nopts) )
           CALL w3cspc ( spco, nk, nth, xfr, fr1, th(1), spec,   &
                sgrds(0)%NK, sgrds(0)%NTH, sgrds(0)%XFR,         &
                sgrds(0)%FR1, sgrds(0)%TH(1), nopts, mdst, mdse, &
                sgrds(0)%FACHFE )
           !
           ! 1.c.2 Spectral conversion not needed
           !
         ELSE
 #ifdef W3_T
           WRITE (mdst,9016) 'NO'
 #endif
           spec   => spco
         END IF
         !
         ! 1.d Store data at grid 0
         !
 #ifdef W3_T
         WRITE (mdst,9017) j
 #endif
         !
         DO i=1, nopts
           ii     = uptmap(i)
           outpts(0)%OUT2%SPCO(:,ii)  = spec(:,i)
           outpts(0)%OUT2%DPO(ii)     = dpo(i)
           outpts(0)%OUT2%WAO(ii)     = wao(i)
           outpts(0)%OUT2%WDO(ii)     = wdo(i)
           outpts(0)%OUT2%ASO(ii)     = aso(i)
           outpts(0)%OUT2%CAO(ii)     = cao(i)
           outpts(0)%OUT2%CDO(ii)     = cdo(i)
           outpts(0)%OUT2%ICEO(ii)    = iceo(i)
           outpts(0)%OUT2%ICEFO(ii)   = icefo(i)
           outpts(0)%OUT2%ICEHO(ii)   = iceho(i)
         END DO
         !
         IF ( respec(0,j) ) DEALLOCATE ( spec )
         !
         ! 1.e Data here, and to be sent to other processor.
         !
 #ifdef W3_MPI
       ELSE
 #endif
         !
 #ifdef W3_MPIT
         WRITE (mdst,9018) j, improc, nmpupt
 #endif
         !
 #ifdef W3_MPI
         it0    = mtag0 - 7*nrgrd - 1
         it     = it0 + (j-1)*7
         itarg  = nmpupt - 1
 #endif
         !
 #ifdef W3_MPI
         it     = it + 1
         CALL mpi_send ( spco(1,1), nspec*nopts, mpi_real,    &
              itarg, it, mpi_comm_mwave, ierr_mpi )
 #endif
 #ifdef W3_MPIT
         WRITE (mdst,9019) it-it0, 'SPECTRA'
 #endif
 #ifdef W3_MPI
         it     = it + 1
         CALL mpi_send ( dpo(1), nopts, mpi_real, itarg, it,  &
              mpi_comm_mwave, ierr_mpi )
 #endif
 #ifdef W3_MPIT
         WRITE (mdst,9019) it-it0, 'WATER DEPTHS'
 #endif
 #ifdef W3_MPI
         it     = it + 1
         CALL mpi_send ( wao(1), nopts, mpi_real, itarg, it,  &
              mpi_comm_mwave, ierr_mpi )
 #endif
 #ifdef W3_MPIT
         WRITE (mdst,9019) it-it0, 'WIND SPEED'
 #endif
 #ifdef W3_MPI
         it     = it + 1
         CALL mpi_send ( wdo(1), nopts, mpi_real, itarg, it,  &
              mpi_comm_mwave, ierr_mpi )
 #endif
 #ifdef W3_MPIT
         WRITE (mdst,9019) it-it0, 'WIND DIRECTION'
 #endif
 #ifdef W3_MPI
         it     = it + 1
         CALL mpi_send ( aso(1), nopts, mpi_real, itarg, it,  &
              mpi_comm_mwave, ierr_mpi )
 #endif
 #ifdef W3_MPIT
         WRITE (mdst,9019) it-it0, 'AIR_SEA TEMP DIFF'
 #endif
 #ifdef W3_MPI
         it     = it + 1
         CALL mpi_send ( cao(1), nopts, mpi_real, itarg, it,  &
              mpi_comm_mwave, ierr_mpi )
 #endif
 #ifdef W3_MPIT
         WRITE (mdst,9019) it-it0, 'CURRENT VELOCITY'
 #endif
 #ifdef W3_MPI
         it     = it + 1
         CALL mpi_send ( cdo(1), nopts, mpi_real, itarg, it,  &
              mpi_comm_mwave, ierr_mpi )
 #endif
 #ifdef W3_MPIT
         WRITE (mdst,9019) it-it0, 'CURRENT DIRECTION'
 #endif
         !JDM: The below should be added for points using partitioned processors
         ! for multigrid, however I am unsure if the IT0 (7 to 10?) should be changed so
         ! this is being left here commented out for now.
         ! There is a corresponding section to this below
         !!/MPI            IT     = IT + 1
         !!/MPI            CALL MPI_SEND ( ICEO(1), NOPTS, MPI_REAL, ITARG, IT,  &
         !!/MPI                            MPI_COMM_MWAVE, IERR_MPI )
         !!/MPIT            WRITE (MDST,9019) IT-IT0, 'ICEO'
         !!/MPI            IT     = IT + 1
         !!/MPI            CALL MPI_SEND ( ICEFO(1), NOPTS, MPI_REAL, ITARG, IT,  &
         !!/MPI                            MPI_COMM_MWAVE, IERR_MPI )
         !!/MPIT            WRITE (MDST,9019) IT-IT0, 'ICEFO'
         !!/MPI            IT     = IT + 1
         !!/MPI            CALL MPI_SEND ( ICEHO(1), NOPTS, MPI_REAL, ITARG, IT,  &
         !!/MPI                            MPI_COMM_MWAVE, IERR_MPI )
         !!/MPIT            WRITE (MDST,9019) IT-IT0, 'ICEHO'
         !
       END IF
       !
     END DO
     !
     ! -------------------------------------------------------------------- /
     ! 2.  Check if this is output processor, otherwise exit
     !
     IF ( improc .NE. nmpupt ) THEN
 #ifdef W3_T
       WRITE (mdst,9020)
 #endif
       RETURN
     END IF
     !
     ! -------------------------------------------------------------------- /
     ! 3.  Loop over grids for processing remote data
     !
 #ifdef W3_MPIT
     WRITE (mdst,9030)
 #endif
     !
     ! 3.a Loop setup
     !
 #ifdef W3_MPI
     DO j=1, nrgrd
 #endif
       !
 #ifdef W3_MPI
       CALL w3seto ( j, mdse, mdst )
       CALL w3setg ( j, mdse, mdst )
       CALL wmsetm ( j, mdse, mdst )
 #endif
       !
 #ifdef W3_MPI
       DO nmppnt= nmproc, 1, -1
         IF ( allprc(nmppnt,j) .EQ. nappnt ) EXIT
       END DO
 #endif
       !
 #ifdef W3_MPIT
       WRITE (mdst,9031) j, nopts, nmppnt
 #endif
 #ifdef W3_MPI
       IF ( nmppnt.EQ.nmpupt .OR. nopts.EQ.0 ) THEN
 #endif
 #ifdef W3_MPIT
         WRITE (mdst,9032)
 #endif
 #ifdef W3_MPI
         cycle
       END IF
 #endif
       !
       ! 3.b Receive data
       !
 #ifdef W3_MPI
       it0    = mtag0 - 7*nrgrd - 1
       it     = it0 + (j-1)*7
       ifrom  = nmppnt - 1
       ALLOCATE ( spcr(nspec,nopts), status(mpi_status_size,1),  &
            dpr(nopts), war(nopts), wdr(nopts), asr(nopts),&
            car(nopts), cdr(nopts), icro(nopts),           &
            icrfo(nopts), icrho(nopts) )
 #endif
       !
 #ifdef W3_MPI
       it     = it + 1
       CALL mpi_recv ( spcr(1,1), nspec*nopts, mpi_real, ifrom,  &
            it, mpi_comm_mwave, status, ierr_mpi )
 #endif
 #ifdef W3_MPIT
       WRITE (mdst,9019) it-it0, 'SPECTRA'
 #endif
 #ifdef W3_MPI
       it     = it + 1
       CALL mpi_recv ( dpr(1), nspec*nopts, mpi_real, ifrom,     &
            it, mpi_comm_mwave, status, ierr_mpi )
 #endif
 #ifdef W3_MPIT
       WRITE (mdst,9019) it-it0, 'WATER DEPTHS'
 #endif
 #ifdef W3_MPI
       it     = it + 1
       CALL mpi_recv ( war(1), nspec*nopts, mpi_real, ifrom,     &
            it, mpi_comm_mwave, status, ierr_mpi )
 #endif
 #ifdef W3_MPIT
       WRITE (mdst,9019) it-it0, 'WIND SPEED'
 #endif
 #ifdef W3_MPI
       it     = it + 1
       CALL mpi_recv ( wdr(1), nspec*nopts, mpi_real, ifrom,     &
            it, mpi_comm_mwave, status, ierr_mpi )
 #endif
 #ifdef W3_MPIT
       WRITE (mdst,9019) it-it0, 'WIND DIRECTION'
 #endif
 #ifdef W3_MPI
       it     = it + 1
       CALL mpi_recv ( asr(1), nspec*nopts, mpi_real, ifrom,     &
            it, mpi_comm_mwave, status, ierr_mpi )
 #endif
 #ifdef W3_MPIT
       WRITE (mdst,9019) it-it0, 'AIR_SEA TEMP DIFF'
 #endif
 #ifdef W3_MPI
       it     = it + 1
       CALL mpi_recv ( car(1), nspec*nopts, mpi_real, ifrom,     &
            it, mpi_comm_mwave, status, ierr_mpi )
 #endif
 #ifdef W3_MPIT
       WRITE (mdst,9019) it-it0, 'CURRENT VELOCITY'
 #endif
 #ifdef W3_MPI
       it     = it + 1
       CALL mpi_recv ( cdr(1), nspec*nopts, mpi_real, ifrom,     &
            it, mpi_comm_mwave, status, ierr_mpi )
 #endif
 #ifdef W3_MPIT
       WRITE (mdst,9019) it-it0, 'CURRENT DIRECTION'
 #endif
       !JDM: The below should be added for points using partitioned processors
       ! for multigrid, however I am unsure if the IT0 (7 to 10?) should be changed so
       ! this is being left here commented out for now.
       ! There is a corresponding section to this above
       !!/MPI         IT     = IT + 1
       !!/MPI         CALL MPI_RECV ( ICRO(1), NSPEC*NOPTS, MPI_REAL, IFROM,   &
       !!/MPI                        IT, MPI_COMM_MWAVE, STATUS, IERR_MPI )
       !!/MPIT         WRITE (MDST,9019) IT-IT0, 'ICEO'
       !!/MPI         IT     = IT + 1
       !!/MPI         CALL MPI_RECV (ICRFO(1), NSPEC*NOPTS, MPI_REAL, IFROM,   &
       !!/MPI                        IT, MPI_COMM_MWAVE, STATUS, IERR_MPI )
       !!/MPIT         WRITE (MDST,9019) IT-IT0, 'ICEFO'
       !!/MPI         IT     = IT + 1
       !!/MPI         CALL MPI_SEND (ICRHO(1), NSPEC*NOPTS, MPI_REAL, IFROM,   &
       !!/MPI                        IT, MPI_COMM_MWAVE, STATUS, IERR_MPI )
       !!/MPIT            WRITE (MDST,9019) IT-IT0, 'ICEHO'
       !
       ! 3.c Convert if necessary
       !
 #ifdef W3_MPI
       IF ( respec(0,j) ) THEN
 #endif
 #ifdef W3_MPIT
         WRITE (mdst,9016) 'YES'
 #endif
 #ifdef W3_MPI
         ALLOCATE ( spec(sgrds(0)%NSPEC,nopts) )
         CALL w3cspc ( spcr, nk, nth, xfr, fr1, th(1), spec,   &
              sgrds(0)%NK, sgrds(0)%NTH, sgrds(0)%XFR,         &
              sgrds(0)%FR1, sgrds(0)%TH(1), nopts, mdst, mdse, &
              sgrds(0)%FACHFE )
       ELSE
 #endif
 #ifdef W3_MPIT
         WRITE (mdst,9016) 'NO'
 #endif
 #ifdef W3_MPI
         spec   => spcr
       END IF
 #endif
       !
       ! 3.d Store data at grid 0
       !
 #ifdef W3_MPIT
       WRITE (mdst,9117) j
 #endif
       !
 #ifdef W3_MPI
       DO i=1, nopts
         ii     = uptmap(i)
         outpts(0)%OUT2%SPCO(:,ii)  = spec(:,i)
         outpts(0)%OUT2%DPO(ii)     = dpr(i)
         outpts(0)%OUT2%WAO(ii)     = war(i)
         outpts(0)%OUT2%WDO(ii)     = wdr(i)
         outpts(0)%OUT2%ASO(ii)     = asr(i)
         outpts(0)%OUT2%CAO(ii)     = car(i)
         outpts(0)%OUT2%CDO(ii)     = cdr(i)
         outpts(0)%OUT2%ICEO(ii)    = iceo(i)
         outpts(0)%OUT2%ICEFO(ii)    = icefo(i)
         outpts(0)%OUT2%ICEHO(ii)    = iceho(i)
       END DO
 #endif
       !
 #ifdef W3_MPI
       IF ( respec(0,j) ) DEALLOCATE ( spec )
       DEALLOCATE ( spcr, dpr, war, wdr, asr, car, cdr, status )
 #endif
       !        !JDM add deallocates here and check the itag stuff.. really not
       !        sure aabout that
 #ifdef W3_MPI
       DEALLOCATE (icro, icrfo, icrho)
     END DO
 #endif
     !
     ! -------------------------------------------------------------------- /
     ! 4.  Output data
     !
 #ifdef W3_T
     WRITE (mdst,9040)
 #endif
     !
     CALL w3seto ( 0, mdse, mdst )
     CALL w3setg ( 0, mdse, mdst )
     CALL w3setw ( 0, mdse, mdst )
     !
     time   = tout
     !
 #ifdef W3_BIN2NC
     CALL w3iopon ( 'WRITE', mdsup, ii, 0)
 #else
     CALL w3iopo ( 'WRITE', mdsup, ii, 0 &
 #ifdef W3_ASCII
             ,mdsupa                     &
 #endif
             )
 #endif 
     !
     RETURN
     !
     ! Formats
     !
 #ifdef W3_T
 9000 FORMAT ( ' TEST WMIOPO : OUTPUT/ACTUAL PROCESS    : ',2i6)
 9010 FORMAT ( ' TEST WMIOPO : PROCESSING GRID          : ',i6/    &
          '               OUTPUT POINTS            : ',i6/    &
          '               ACTUAL/OUTPUT PROCESS    : ',2i6)
 9011 FORMAT ( '       CYCLE : GRID NOT ON PROCESS')
 9012 FORMAT ( '       CYCLE : GRID WITHOUT OUTPUT POINTS')
 9014 FORMAT ( '       CYCLE : DATA NOT ON PRESENT PROCESS')
 9015 FORMAT ( ' TEST WMIOPO : PROCESSING DATA LOCALLY')
 9016 FORMAT ( ' TEST WMIOPO : NEED FOR SPECTRAL CONVERSION : ',a)
 9017 FORMAT ( ' TEST WMIOPO : STORING DATA FROM GRID',i4,         &
          ' IN GRID 0')
 #endif
 #ifdef W3_MPIT
 9117 FORMAT ( ' TEST WMIOPO : STORING DATA FROM GRID',i4,      &
          ' IN GRID 0')
 9018 FORMAT ( ' TEST WMIOPO : GRID',i4,' SEND FROM',i4,' TO',i4)
 9019 FORMAT ( '                 IT = ',i4,'  PAR = ',a)
 #endif
     !
 #ifdef W3_T
 9020 FORMAT ( ' TEST WMIOPO : DONE AT THIS PROCESSOR')
 #endif
     !
 #ifdef W3_MPIT
 9030 FORMAT ( ' TEST WMIOPO : LOOP OVER GRIDS FOR REMOTE DATA')
 9031 FORMAT ( ' TEST WMIOPO : GRID',i4,',',i4,' POINTS FROM',i4)
 9032 FORMAT ( '               NOTHING TO RECEIVE')
 #endif
     !
 9040 FORMAT ( ' TEST WMIOPO : PERFORM OUTPUT')
     !/
     !/ End of WMIOPO ----------------------------------------------------- /
     !/

References wmmdatmd::allprc, w3odatmd::aso, w3odatmd::dpo, w3gdatmd::fr1, w3odatmd::iaproc, wmmdatmd::improc, include(), wmmdatmd::mdse, wmmdatmd::mdst, wmmdatmd::mdsup, wmmdatmd::mdsupa, wmmdatmd::mpi_comm_grd, wmmdatmd::mpi_comm_mwave, wmmdatmd::mtag0, w3odatmd::nappnt, w3odatmd::naproc, w3gdatmd::nk, wmmdatmd::nmproc, wmmdatmd::nmpupt, w3odatmd::nopts, wmmdatmd::nrgrd, w3gdatmd::nspec, w3gdatmd::nth, w3odatmd::outpts, wmmdatmd::respec, w3gdatmd::sgrds, w3servmd::strace(), w3gdatmd::th, w3wdatmd::time, wmmdatmd::uptmap, w3cspcmd::w3cspc(), w3iopomd::w3iopo(), w3iopomd::w3iopon(), w3gdatmd::w3setg(), w3odatmd::w3seto(), w3wdatmd::w3setw(), w3odatmd::wao, w3odatmd::wdo, wmmdatmd::wmsetm(), and w3gdatmd::xfr.

Referenced by wmwavemd::wmwave().

◆ wmiopp()

subroutine wmiopomd::wmiopp	(	integer, intent(in)	NPT,
		real, dimension(npt), intent(in), optional	XPT,
		real, dimension(npt), intent(in), optional	YPT,
		character(len=40), dimension(npt), intent(in), optional	PNAMES
	)

Initialization for unified point output.

Find highest resolution grid for each point.

Parameters

[in]	NPT	Number of output points in input.
[in]	XPT	(longitude) coordinates of output points.
[in]	YPT	(latitude) coordinates of output points.
[in]	PNAMES	Names of output points.

Author: H. L. Tolman

Date: 01-Sep-2012

Definition at line 110 of file wmiopomd.F90.

     !/
     !/                  +-----------------------------------+
     !/                  | WAVEWATCH III           NOAA/NCEP |
     !/                  |           H. L. Tolman            |
     !/                  |                        FORTRAN 90 |
     !/                  | Last update :         01-Sep-2012 !
     !/                  +-----------------------------------+
     !/
     !/    09-Aug-2006 : Origination.                        ( version 3.10 )
     !/    01-May-2007 : Addd diagnostic output O7a,b        ( version 3.11 )
     !/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
     !/                  (W. E. Rogers & T. J. Campbell, NRL)
     !/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
     !/                  specify index closure for a grid.   ( version 3.14 )
     !/                  (T. J. Campbell, NRL)
     !/    16-Mar-2012 : Using MPI_COMM_NULL in checks.      ( version 4.07 )
     !/    06-Jun-2012 : Porting bugfixes from 3.14 to 4.07  ( version 4.07 )
     !/    01-Sep-2012 : Added tests for unstructured grid   ( version 4.07 )
     !/                  (M. Dutour Sikiric, IRB & Aron Roland, Z&P)
     !/
     !  1. Purpose :
     !
     !     Initialization for unified point output.
     !
     !  2. Method :
     !
     !     Find highest resolution grid for each point.
     !
     !  3. Parameters :
     !
     !     Parameter list
     !     ----------------------------------------------------------------
     !       NPT     Int.   I   Number of output points in input.
     !       XPT     R.A.   I   X (longitude) coordinates of output points.
     !       YPT     R.A.   I   Id. Y.
     !       PNAMES  C*40   I   Names of output points.
     !     ----------------------------------------------------------------
     !       Note: all are optional, and should be given on the first call
     !             only, will be taken from storage after that.
     !             NPT needs to be ginve always, but can be dummy after
     !             first call.
     !
     !  4. Subroutines used :
     !
     !      Name      Type  Module   Description
     !     ----------------------------------------------------------------
     !      W3SETG    Subr  W3GDATMD Point to model grid.
     !      W3SETW    Subr  W3WDATMD Point to model grid.
     !      W3SETA    Subr  W3ADATMD Point to model grid.
     !      W3SETO    Subr  W3ODATMD Point to model grid.
     !      W3DMO2    Subr     Id.   Dimension model grids output 2.
     !      WMSETM    Subr  WMMDATMD Point to model grid.
     !      W3MPIP    Subr  W3INITMD Model intiailization.
     !      W3IOPP    Sunr  W3IOPOMD Point output for single model.
     !      STRACE    Subr  W3SERVMD Subroutine tracing.
     !      EXTCDE    Subr     Id.   Program abort.
     !     ----------------------------------------------------------------
     !
     !  5. Called by :
     !
     !      Name      Type  Module   Description
     !     ----------------------------------------------------------------
     !      WMINIT    Subr. WMINITMD Wave model initialization routine.
     !     ----------------------------------------------------------------
     !
     !  6. Error messages :
     !
     !  7. Remarks :
     !
     !     - The algorithm used to decide if the pont is in the grid needs
     !       to be strictly consistent with W3IOPP.
     !     - MPI communication is set up separately from W3MPIO to assure
     !       that data are gathered in a single processor even if this
     !       procesor is not part of the communicator of the individual
     !       model.
     !     - In section 2.b the soring of the grids by rand is utilized.
     !
     !  8. Structure :
     !
     !     See source code.
     !
     !  9. Switches :
     !
     !       !/SHRD Distributed memory model.
     !       !/MPI
     !
     !       !O7a   Disgnostic output to NMPSCR.
     !       !O7b
     !
     !       !/S    Enable subroutine tracing.
     !       !/T    Enable test output
     !
     ! 10. Source code :
     !
     !/ ------------------------------------------------------------------- /
     !
     USE w3gsrumd
     USE w3gdatmd, ONLY: w3setg
     USE w3adatmd, ONLY: w3seta
     USE w3wdatmd, ONLY: w3setw
     USE w3odatmd, ONLY: w3seto, w3dmo2
     USE wmmdatmd, ONLY: wmsetm
 #ifdef W3_MPI
     USE w3initmd, ONLY: w3mpip
 #endif
     USE w3iopomd, ONLY: w3iopp
     USE w3servmd, ONLY: extcde
 #ifdef W3_S
     USE w3servmd, ONLY: strace
 #endif
     !
     USE w3gdatmd, ONLY: nx, ny, x0, y0, sx, mapsta, grids,            &
          flagll, iclose, iclose_none, gtype, ungtype,  &
          clgtype, gsu
     USE w3gdatmd, ONLY: trigp, maxx, maxy, dxymax  ! unstructured grids
     USE w3odatmd, ONLY: o2init, nopts, ptloc, ptnme, grdid, outpts
 #ifdef W3_MPI
     USE w3odatmd, ONLY: o2irqi
 #endif
     USE wmmdatmd, ONLY: mdse, mdst, nrgrd, mdatas, improc, nmpscr,  &
          nmperr, mdss
     USE w3triamd
 #ifdef W3_MPI
     USE wmmdatmd, ONLY: mpi_comm_grd, mpi_comm_mwave
 #endif
     !
     IMPLICIT NONE
     !
 #ifdef W3_MPI
     include "mpif.h"
 #endif
     !/
     !/ ------------------------------------------------------------------- /
     !/ Parameter list
     !/
     INTEGER, INTENT(IN)                    :: NPT
     REAL, INTENT(IN), OPTIONAL             :: XPT(NPT), YPT(NPT)
     CHARACTER(LEN=40),INTENT(IN), OPTIONAL :: PNAMES(NPT)
     !/
     !/ ------------------------------------------------------------------- /
     !/ Local parameters
     !/
     INTEGER                 :: IPT, J, II
     INTEGER                 :: IX(4), IY(4)         ! created by w3grmp
     REAL                    :: RD(4)                ! created by w3grmp
     INTEGER                 :: itout, I1, I2, I3    ! unstructured grids
 #ifdef W3_S
     INTEGER, SAVE           :: IENT = 0
 #endif
     INTEGER                 :: IERR_MPI
     REAL                    :: RX, RY, RDX, RDY
     REAL, PARAMETER         :: ACC = 0.05
     REAL, ALLOCATABLE       :: XP(:), YP(:)
     REAL                    :: FACTOR
     LOGICAL, ALLOCATABLE    :: INGRID(:,:)
     LOGICAL, SAVE           :: SETUP = .false., flgo7a = .false.
     CHARACTER(LEN=40), ALLOCATABLE :: PN(:)
     !/
 #ifdef W3_S
     CALL strace (ient, 'WMIOPP')
 #endif
     !
     ! -------------------------------------------------------------------- /
     ! 0.  Initializations
     !
     CALL w3seto ( 0, mdse, mdst )
     !
 #ifdef W3_T
     WRITE (mdst,9000) o2init, npt, PRESENT(xpt),                 &
          PRESENT(ypt), PRESENT(pnames)
 #endif
 #ifdef W3_O7a
     flgo7a = .true.
 #endif
     !
     ! -------------------------------------------------------------------- /
     ! 1.  Initialize if necessary and possible
     !
     IF ( .NOT. o2init ) THEN
       !
 #ifdef W3_T
       WRITE (mdst,9010)
 #endif
       !
       IF ( .NOT.PRESENT(xpt) .OR. .NOT.PRESENT(ypt) .OR.          &
            .NOT.PRESENT(pnames) ) THEN
         WRITE (mdse,1000)
         CALL extcde (1)
       END IF
       !
       CALL w3dmo2 ( 0, mdse, mdst, npt )
       !
       nopts      = npt
       ptloc(1,:) = xpt
       ptloc(2,:) = ypt
       ptnme      = pnames
       grdid      = 'none'
       !
     END IF
     !
     ! -------------------------------------------------------------------- /
     ! 2.  Locate points in grids
     ! 2.a Check all points for all grids
     !
 #ifdef W3_T
     WRITE (mdst,9020)
 #endif
     !
     IF ( flagll ) THEN
       factor = 1.
     ELSE
       factor = 1.e-3
     END IF
     !
     ALLOCATE ( ingrid(nrgrd,nopts), xp(nopts), yp(nopts) )
     !
     ingrid = .false.
     xp     = ptloc(1,:)
     yp     = ptloc(2,:)
     !
     DO j=1, nrgrd
       !
       CALL w3setg ( j, mdse, mdst )
       !
       ! Loop over output points
       !
       ! notes.....Here, we have pulled coding for UNGTYPE and CLGTYPE from w3iopomd.ftn
       ! ..........in w3iopomd.ftn, it is "DO IPT=1, NPT" but otherwise very similar
       DO ipt=1, nopts
         !
         !     Check if point within grid
         !
         IF (gtype .NE. ungtype) THEN
           ingrid(j,ipt) = w3grmp( gsu, xpt(ipt), ypt(ipt), ix, iy, rd )
           IF ( .NOT.ingrid(j,ipt) ) THEN
             cycle
           END IF
         ELSE
           CALL is_in_ungrid(j, dble(xpt(ipt)), dble(ypt(ipt)), itout, ix, iy, rd )
           IF (itout.eq.0) THEN
             ingrid(j,ipt)=.false.
           END IF
         END IF
         !
         !     Check if point not on land
         !
         IF ( mapsta(iy(1),ix(1)) .EQ. 0 .AND. &
              mapsta(iy(2),ix(2)) .EQ. 0 .AND. &
              mapsta(iy(3),ix(3)) .EQ. 0 .AND. &
              mapsta(iy(4),ix(4)) .EQ. 0 ) THEN
           ingrid(j,ipt) = .false.
           cycle
         END IF
  
         !.........If we've gotten to this point, then we are satisfied that
         !................the point is in this grid.
  
       END DO !        DO IPT=1, NOPTS
       !
     END DO !      DO J=1, NRGRD
     !
     DEALLOCATE ( xp, yp )
     !
     ! 2.b Select a grid for each point
     !     start from last, which is supposedly higher resolution
     !
     mdatas(:)%NRUPTS = 0
     !
     DO ipt=1, nopts
       grdid(ipt) = '...none...'
       DO j= nrgrd, 1, -1
         IF ( ingrid(j,ipt) ) THEN
           grdid(ipt) = grids(j)%FILEXT
           mdatas(j)%NRUPTS = mdatas(j)%NRUPTS + 1
           EXIT
         END IF
       END DO
     END DO
     !
     ! 2.c Diagnostic output
     !
 #ifdef W3_O7b
     IF ( improc .EQ. nmpscr ) THEN
       WRITE (mdss,920)
       DO ipt=1, nopts
         DO j=1, nrgrd
           IF ( grids(j)%FILEXT .EQ. grdid(ipt) ) EXIT
         END DO
         IF ( j .GT. nrgrd ) THEN
           WRITE (mdss,921) ptnme(ipt), ptloc(:,ipt)*factor
         ELSE
           WRITE (mdss,922) ptnme(ipt), ptloc(:,ipt)*factor, &
                grids(j)%FILEXT
         END IF
       END DO
       WRITE (mdss,929)
     END IF
 #endif
     !
     ! 2.d Test output
     !
 #ifdef W3_T
     DO ipt=1, nopts
       WRITE (mdst,9021) ipt, ptnme(ipt), grdid(ipt)
     END DO
 #endif
     !
 #ifdef W3_T
     ipt      = nopts
     WRITE (mdst,9022)
     DO j=1, nrgrd
       WRITE (mdst,9023) j, mdatas(j)%NRUPTS, grids(j)%FILEXT
       ipt      = ipt - mdatas(j)%NRUPTS
     END DO
     WRITE (mdst,9024) ipt
 #endif
     !
     DEALLOCATE ( ingrid )
     !
     ! -------------------------------------------------------------------- /
     ! 3.  Initialize individual grids
     ! 3.a Loop over grids
     !
     DO j=1, nrgrd
       !
 #ifdef W3_T
       WRITE (mdst,9030) j
 #endif
       !
       ! 3.b (De)allocate map arrays
       !
       ipt      = max( 1 , mdatas(j)%NRUPTS )
       IF ( setup ) DEALLOCATE ( mdatas(j)%UPTMAP )
       ALLOCATE ( mdatas(j)%UPTMAP(ipt) )
       !
       IF ( mdatas(j)%NRUPTS .EQ. 0 ) cycle
       !
       ALLOCATE ( xp(ipt), yp(ipt), pn(ipt) )
       !
       ! 3.c Set up mapping and point arrays
       !
       ipt      = 0
       DO ii=1, nopts
         IF ( grdid(ii) .NE. grids(j)%FILEXT ) cycle
         ipt      = ipt + 1
         mdatas(j)%UPTMAP(ipt) = ii
         xp(ipt)  = ptloc(1,ii)
         yp(ipt)  = ptloc(2,ii)
         pn(ipt)  = ptnme(ii)
       END DO
       !
 #ifdef W3_T
       DO ipt=1, mdatas(j)%NRUPTS
         WRITE (mdst,9031) ipt, mdatas(j)%UPTMAP(ipt),xp(ipt),yp(ipt),pn(ipt)
       END DO
 #endif
       !
 #ifdef W3_MPI
       IF ( flgo7a ) CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )
 #endif
 #ifdef W3_O7a
       IF ( improc.EQ.nmpscr ) WRITE (mdss,930)               &
            j, grids(j)%FILEXT, ipt
 #endif
       !
       ! 3.d Preprocessing for output
       !
 #ifdef W3_T
       WRITE (mdst,9032)
 #endif
       !
       ! 3.d.1 Shared memory version
       !
 #ifdef W3_SHRD
       CALL w3seto ( j, mdse, mdst )
       CALL w3setg ( j, mdse, mdst )
 #endif
       !
 #ifdef W3_SHRD
       IF ( o2init ) THEN
         DEALLOCATE ( outpts(j)%OUT2%IPTINT,               &
              outpts(j)%OUT2%IL   , outpts(j)%OUT2%IW    ,  &
              outpts(j)%OUT2%II   , outpts(j)%OUT2%PTIFAC,  &
              outpts(j)%OUT2%PTNME, outpts(j)%OUT2%GRDID ,  &
              outpts(j)%OUT2%DPO  , outpts(j)%OUT2%WAO   ,  &
              outpts(j)%OUT2%WDO  , outpts(j)%OUT2%ASO   ,  &
              outpts(j)%OUT2%CAO  , outpts(j)%OUT2%CDO   ,  &
              outpts(j)%OUT2%SPCO , outpts(j)%OUT2%PTLOC )
         o2init = .false.
       END IF
 #endif
       !
 #ifdef W3_SHRD
       CALL w3iopp ( mdatas(j)%NRUPTS, xp, yp, pn, j )
 #endif
       !
       ! 3.d.2 Distributed memory version
       !
 #ifdef W3_MPI
       CALL wmsetm ( j, mdse, mdst )
 #endif
       !
 #ifdef W3_MPI
       IF ( mpi_comm_grd .NE. mpi_comm_null ) THEN
 #endif
         !
 #ifdef W3_MPI
         CALL w3seto ( j, mdse, mdst )
         CALL w3setg ( j, mdse, mdst )
         CALL w3seta ( j, mdse, mdst )
         CALL w3setw ( j, mdse, mdst )
 #endif
         !
 #ifdef W3_MPI
         IF ( o2init ) THEN
           DEALLOCATE ( outpts(j)%OUT2%IPTINT,               &
                outpts(j)%OUT2%IL   , outpts(j)%OUT2%IW    ,  &
                outpts(j)%OUT2%II   , outpts(j)%OUT2%PTIFAC,  &
                outpts(j)%OUT2%PTNME, outpts(j)%OUT2%GRDID ,  &
                outpts(j)%OUT2%DPO  , outpts(j)%OUT2%WAO   ,  &
                outpts(j)%OUT2%WDO  , outpts(j)%OUT2%ASO   ,  &
                outpts(j)%OUT2%CAO  , outpts(j)%OUT2%CDO   ,  &
                outpts(j)%OUT2%SPCO , outpts(j)%OUT2%PTLOC )
           o2init = .false.
         END IF
 #endif
         !
 #ifdef W3_MPI
         CALL w3iopp ( mdatas(j)%NRUPTS, xp, yp, pn, j )
 #endif
         !
 #ifdef W3_MPI
         IF ( o2irqi ) THEN
           DEALLOCATE (outpts(j)%OUT2%IRQPO1,                &
                outpts(j)%OUT2%IRQPO2 )
           o2irqi = .false.
         END IF
 #endif
         !
 #ifdef W3_MPI
         CALL w3mpip ( j )
 #endif
         !
 #ifdef W3_MPI
       END IF
 #endif
       !
       ! This barrier is needed to straighten out output.
       !
 #ifdef W3_O7a
       IF ( improc.EQ.nmpscr ) WRITE (mdss,939)
 #endif
       !
       ! 3.e Reset pointers and clean up
       !
       CALL w3seto ( 0, mdse, mdst )
       DEALLOCATE ( xp, yp, pn )
       !
     END DO
     !
 #ifdef W3_MPI
     IF ( flgo7a ) CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )
 #endif
     !
     ! -------------------------------------------------------------------- /
     ! 4.  Finalize
     !
     setup  = .true.
     !
     RETURN
     !
     ! Formats
     !
 #ifdef W3_O7b
 920 FORMAT (/'       Diagnostic test output for output points :'/ &
          '       -------------------------------------------------')
 921 FORMAT ( '          ',a,' (',2f8.2,') NO GRID FOUND')
 922 FORMAT ( '          ',a,' (',2f8.2,') grid ',a)
 929 FORMAT ( ' ')
 #endif
     !
 #ifdef W3_O7a
 930 FORMAT (/'       Grid ',i3,' [',a,']',i4,' points :'/    &
          '       -------------------------------------------------')
 939 FORMAT ( ' ')
 #endif
     !
 1000 FORMAT (/' *** ERROR WMIOPP : INITALIZATION DATA NOT',          &
          ' AVAILABLE *** '/)
     !
 #ifdef W3_T
 9000 FORMAT ( ' TEST WMIOPP : O2INIT   :',l2/                     &
          '               PAR LIST :',i4,3l2)
 #endif
     !
 #ifdef W3_T
 9010 FORMAT ( ' TEST WMIOPP : INITIALIZING DATA GRID 0')
 #endif
     !
 #ifdef W3_T
 9020 FORMAT ( ' TEST WMIOPP : FINDING POINTS IN GRID')
 9021 FORMAT ( '               ',i4,2x,a,2x,a)
 9022 FORMAT ( ' TEST WMIOPP : OUTPUT POINTS PER GRID')
 9023 FORMAT ( '                  GRID',i3,' HAS',i4,' OUTPUT ',   &
          'POINTS, NAME = ',a)
 9024 FORMAT ( '                  UNALLOCATED POINTS :',i4)
 #endif
     !
 #ifdef W3_T
 9030 FORMAT ( ' TEST WMIOPP : PREPPING GRID',i3)
 9031 FORMAT ( '             ',2i5,2e12.3,2x,a)
 9032 FORMAT ( ' TEST WMIOPP : RUNNING W3IOPP / W3MPIP')
 #endif
     !/
     !/ End of WMIOPP ----------------------------------------------------- /
     !/

References w3gdatmd::clgtype, w3gdatmd::dxymax, w3gdatmd::flagll, w3odatmd::grdid, w3gdatmd::grids, w3gdatmd::gsu, w3gdatmd::gtype, w3gdatmd::iclose, w3gdatmd::iclose_none, wmmdatmd::improc, include(), w3triamd::is_in_ungrid(), w3gdatmd::mapsta, w3gdatmd::maxx, w3gdatmd::maxy, wmmdatmd::mdatas, wmmdatmd::mdse, wmmdatmd::mdss, wmmdatmd::mdst, wmmdatmd::mpi_comm_grd, wmmdatmd::mpi_comm_mwave, wmmdatmd::nmperr, wmmdatmd::nmpscr, w3odatmd::nopts, wmmdatmd::nrgrd, w3gdatmd::nx, w3gdatmd::ny, w3odatmd::o2init, w3odatmd::o2irqi, w3odatmd::outpts, w3odatmd::ptloc, w3odatmd::ptnme, w3servmd::strace(), w3gdatmd::sx, w3gdatmd::trigp, w3gdatmd::ungtype, w3odatmd::w3dmo2(), w3iopomd::w3iopp(), w3initmd::w3mpip(), w3adatmd::w3seta(), w3gdatmd::w3setg(), w3odatmd::w3seto(), w3wdatmd::w3setw(), wmmdatmd::wmsetm(), w3gdatmd::x0, and w3gdatmd::y0.

Referenced by wminitmd::wminit(), and wminitmd::wminitnml().

Functions/Subroutines

Detailed Description

Function/Subroutine Documentation

◆ wmiopo()

◆ wmiopp()