Module W3BULLMD. More...

Functions/Subroutines
subroutine	w3bull (NPART, XPART, DIMXP, UABS, UD, IPNT, IOUT, TIMEV)
	Read a WAVEWATCH-III version 1.17 point output data file and produces a table of mean parameters for all individual wave systems. More...

Variables
integer, parameter	nptab = 6

integer, parameter	nfld = 50

integer, parameter	npmax = 80

real, parameter	bhsmin = 0.15

real, parameter	bhsdrop = 0.05

real, dimension(nptab, 2)	hst

real, dimension(nptab, 2)	tpt

real, dimension(nptab, 2)	dmt

character(len=129)	ascbline

character(len=664)	csvbline

character(len=67)	cascbline

logical, dimension(npmax)	iyy

Detailed Description

Module W3BULLMD.

Author: J. H. Alves; H. L. Tolman

Date: 26-Dec-2012

Copyright: Copyright 2009-2022 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.

Function/Subroutine Documentation

◆ w3bull()

subroutine w3bullmd::w3bull	(	integer, intent(in)	NPART,
		real, dimension(dimp,0:dimxp), intent(in)	XPART,
		integer, intent(in)	DIMXP,
		real, intent(in)	UABS,
		real, intent(in)	UD,
		integer	IPNT,
		integer, intent(in)	IOUT,
		integer, dimension(2), intent(inout)	TIMEV
	)

Read a WAVEWATCH-III version 1.17 point output data file and produces a table of mean parameters for all individual wave systems.

Partitioning is made using the built-in module w3partmd. Partitions are ranked and organized into coherent sequences that are then written as tables to output files. Input options for generating tables are defined in ww3_outp.inp. This module sorts the table data, output to file is controlled by WW3_OUTP.

Parameters

[in]	NPART
[in]	XPART
[in]	DIMXP
[in]	UABS
[in]	UD
	IPNT
[in]	IOUT
[in,out]	TIMEV

Author: J. H. Alves; H. L. Tolman

Date: 11-Mar-2013

Definition at line 91 of file w3bullmd.F90.

     !/
     !/                  +-----------------------------------+
     !/                  | WAVEWATCH-III           NOAA/NCEP |
     !/                  |           J. H. Alves             |
     !/                  |           H. L. Tolman            |
     !/                  |                        FORTRAN 90 |
     !/                  | Last update :         11-Mar-2013 !
     !/                  +-----------------------------------+
     !/
     !/    01-Apr-2010 : Origination.                        ( version 3.14 )
     !/    26-Dec-2012 : Modified obsolete declarations.     ( version 4.11 )
     !/    15-Aug-2011 : Adjustments to version 4.05         ( version 4.05 )
     !/    11-Mar-2013 : Minor cleanup                       ( version 4.09 )
     !/
     !  1. Purpose :
     !
     !     Read a WAVEWATCH-III version 1.17 point output data file and
     !     produces a table of mean parameters for all individual wave
     !     systems.
     !
     !  2. Method :
     !
     !     Partitioning is made using the built-in module w3partmd. Partitions
     !     are ranked and organized into coherent sequences that are then
     !     written as tables to output files. Input options for generating
     !     tables are defined in ww3_outp.inp. This module sorts the table
     !     data, output to file is controlled by WW3_OUTP.
     !
     !  3. Parameters :
     !
     !     Parameter list
     !     ----------------------------------------------------------------
     !       DHSMAX  Real   Max. change in Hs for system to be considered
     !                      related to previous time.
     !       DTPMAX  Real   Id. Tp.
     !       DDMMAX  Real   Id. Dm.
     !       DDWMAX  Real   Maximum differences in wind and wave direction
     !                      for marking of system as under the influence
     !                      of the local wind,
     !       AGEMIN  Real   Id. wave age.
     !     ----------------------------------------------------------------
     !
     !  4. Subroutines used :
     !
     !      Name      Type  Module   Description
     !     ----------------------------------------------------------------
     !      STRACE    Sur.  W3SERVMD Subroutine tracing.
     !     ----------------------------------------------------------------
     !
     !  5. Called by :
     !
     !     WW3_OUTP
     !
     !  6. Error messages :
     !
     !     Error control made in WW3_OUTP.
     !
     !  7. Remarks :
     !
     !     Current version does not allow generating tables for multiple
     !     points.
     !
     !  8. Structure :
     !
     !  9. Switches :
     !
     !     !/S    Enable subroutine tracing.
     !     !/T    Enable test output
     !
     ! 10. Source code :
     !
     !/ ------------------------------------------------------------------- /
     !     USE CONSTANTS
 #ifdef W3_S
     USE w3servmd, ONLY: strace
 #endif
     !
     IMPLICIT NONE
     !
     !/
     !/ ------------------------------------------------------------------- /
     !/ Parameter list
     !/
     !/
     !/ ------------------------------------------------------------------- /
     !/ Local parameters
     !/
     !/
     !
     ! -------------------------------------------------------------------- /
     ! 1.  Initializations
     !
 #ifdef W3_S
     INTEGER, SAVE           :: IENT = 0
 #endif
     REAL                    :: DHSMAX, DTPMAX,        &
          DDMMAX, DDWMAX, AGEMIN
     parameter( dhsmax =   1.50 )
     parameter( dtpmax =   1.50 )
     parameter( ddmmax =  15.   )
     parameter( ddwmax =  30.   )
     parameter( agemin =   0.8  )
     INTEGER, INTENT(IN)     :: NPART, DIMXP, IOUT
     INTEGER, INTENT(INOUT)  :: TIMEV(2)
     REAL, INTENT(IN)        :: UABS,    &
          UD, XPART(DIMP,0:DIMXP)
     INTEGER                 :: IPG1,IPI(NPMAX), ILEN(NPMAX), IP,     &
          IPNOW, IFLD, INOTAB, IPNT, ITAB,      &
          DOUTP, FCSTI, NZERO
     REAL                    :: AFR, AGE, DDMMAXR, DELDM, DELDMR,     &
          DELDW, DELHS, DELTP, DHSMAXR,  &
          DTPMAXR, HMAX, HSTOT, TP, UDIR, FACT
     REAL                    :: HSP(NPMAX), TPP(NPMAX), &
          DMP(NPMAX), WNP(NPMAX), HSD(NPMAX),   &
          TPD(NPMAX), WDD(NPMAX)
     LOGICAL                 :: FLAG(NPMAX)
     CHARACTER(LEN=129)      :: BLANK, TAIL !, ASCBLINE
 #ifdef W3_NCO
     CHARACTER(LEN=67)       :: CBLANK, CTAIL !, CASCBLINE
 #endif
     CHARACTER(LEN=15)       :: PART
 #ifdef W3_NCO
     CHARACTER(LEN=9)        :: CPART
 #endif
     CHARACTER(LEN=664)      :: BLANK2 !,CSVBLINE
     CHARACTER               :: STIME*8,FORM*20,FORM1*2
     CHARACTER(LEN=16)       :: PART2
     !/
     !/ ------------------------------------------------------------------- /
     !
 #ifdef W3_S
     CALL strace (ient, 'XXXXXX')
 #endif
     !
     ! 1.a Constants etc.
     !
     ! Set FACT to proper scaling according to spherical or cartesian
     IF ( flagll ) THEN
       fact = 1.
     ELSE
       fact = 1.e-3
     ENDIF
     !
     ! Convert wind direction to azimuthal reference
     udir   = mod( ud+180., 360. )
     !
     tail(  1: 40) = '+-------+-----------+-----------------+-'
     tail( 41: 80) = '----------------+-----------------+-----'
     tail( 81:120) = '------------+-----------------+---------'
     tail(120:129) = '---------+'
     blank(  1: 40) = '| nn nn |      nn   |                 | '
     blank( 41: 80) = '                |                 |     '
     blank( 81:120) = '            |                 |         '
     blank(120:129) = '         |'
     ascbline       = blank
 #ifdef W3_NCO
     ctail( 1:40) = '----------------------------------------'
     ctail(41:67) = '---------------------------'
     cblank( 1:40) = '                                        '
     cblank(41:67) = '                           '
     cascbline       = cblank
 #endif
     !
     blank2(  1: 40)='    ,    ,  ,  ,  ,     ,   ,     ,     '
     blank2( 41: 88)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2( 89:136)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2(137:184)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2(185:232)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2(233:280)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2(281:328)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2(329:376)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2(377:424)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2(425:472)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2(473:520)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2(521:568)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2(569:616)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     blank2(617:664)=',     ,     ,   ,     ,     ,   ,     ,     ,   '
     !
     csvbline      = blank2
     !
     ipg1 = 0
     IF (iout .EQ. 1) THEN
       DO ip=1, nptab
         hst(ip,1) = -99.9
         tpt(ip,1) = -99.9
         dmt(ip,1) = -99.9
       ENDDO
       DO ip=1, npmax
         iyy(ip) = .false.
         ipi(ip)=1
         ilen(ip)=0
       ENDDO
     ENDIF
     !
     ! 3.  Get overall wave height ---------------------------------------- *
     !
     hstot  = xpart(1,0)
     tp     = xpart(2,0)
     DO ip=1, npart
       hsp(ip) = xpart(1,ip)
       tpp(ip) = xpart(2,ip)
       wnp(ip) = tpi / xpart(3,ip)
       dmp(ip) = mod( xpart(4,ip) + 180., 360.)
     ENDDO
  
     nzero = 0
     nzero = count( hsp <= bhsmin .AND. hsp /= 0.  )
     !
     ! 4.  Process all partial fields ------------------------------------- *
     !
     DO ip=npart+1, npmax
       hsp(ip) =    0.00
       tpp(ip) = -999.99
       dmp(ip) = -999.99
     ENDDO
  
     DO ip=1, nptab
       hst(ip,2) = hst(ip,1)
       tpt(ip,2) = tpt(ip,1)
       dmt(ip,2) = dmt(ip,1)
       hst(ip,1) = -1.
       tpt(ip,1) = -1.
       dmt(ip,1) = -1.
     ENDDO
     !
     ! 5.  Generate output table ------------------------------------------ *
     ! 5.a Time and overall wave height to string
     !
     ascbline = blank
     csvbline = blank2
 #ifdef W3_NCO
     cascbline = cblank
 #endif
     !
     ! Fill the variable forecast time with hrs relative to reference time
     IF ( timev(1) .LE. 0 ) timev = time
     fcsti = dsec21(timev, time) / 3600
     WRITE(csvbline(1:4),'(I4)')fcsti
     !
     DO ifld=1,nptab
       iyy(ifld)=.false.
     ENDDO
     !
     ! ... write the time labels for current table line
     WRITE (csvbline(6:9),'(I4)') int(time(1)/10000)
     WRITE (csvbline(11:12),'(I2)')                                  &
          int(time(1)/100)-100*int(time(1)/10000)
     WRITE (csvbline(14:15),'(I2)') mod(time(1),100)
     WRITE (csvbline(17:18),'(I2)') time(2)/10000
     WRITE (csvbline(20:24),'(F5.2)') uabs
     WRITE (csvbline(26:28),'(I3)') int(udir)
     IF ( hstot .GT. 0. ) WRITE (csvbline(30:34),'(F5.2)') hstot
     IF ( hstot .GT. 0. ) WRITE (csvbline(36:40),'(F5.2)') tp
     !
     WRITE (ascbline(3:4),'(I2)') mod(time(1),100)
     WRITE (ascbline(6:7),'(I2)') time(2)/10000
     !
     IF ( hstot .GT. 0. ) WRITE (ascbline(10:14),'(F5.2)') hstot
     WRITE (ascbline(16:17),'(I2)') npart - nzero
     !
 #ifdef W3_NCO
     WRITE (cascbline(1:2),'(I2.2)') mod(time(1),100)
     WRITE (cascbline(3:4),'(I2.2)') time(2)/10000
     IF ( hstot .GT. 0. ) WRITE (cascbline(6:7),'(I2)') nint(hstot/0.3048)
 #endif
     !
     IF ( npart.EQ.0 .OR. hstot.LT.0.1 ) GOTO 699
     !
     ! 5.b Switch off peak with too low wave height
     !
     DO ip=1, npart
       flag(ip) = hsp(ip) .GT. bhsmin
     ENDDO
     !
     ! 5.c Find next highest wave height
     !
     inotab   = 0
     !
 601 CONTINUE
     !
     hmax   = 0.
     ipnow  = 0
     DO ip=1, npart
       IF ( hsp(ip).GT.hmax .AND. flag(ip) ) THEN
         ipnow  = ip
         hmax   = hsp(ip)
       ENDIF
     ENDDO
     !
     ! 5.d No more peaks, skip to output
     !
     IF ( ipnow .EQ. 0 ) GOTO 699
     !
     ! 5.e Find matching field
     !
     itab   = 0
     !
     DO ip=1, nptab
       IF ( tpt(ip,2) .GT. 0. ) THEN
         !
         delhs  = abs( hst(ip,2) - hsp(ipnow) )
         deltp  = abs( tpt(ip,2) - tpp(ipnow) )
         deldm  = abs( dmt(ip,2) - dmp(ipnow) )
         IF ( deldm .GT. 180. ) deldm = 360. - deldm
         IF ( delhs.LT.dhsmax .AND. &
              deltp.LT.dtpmax .AND. &
              deldm.LT.ddmmax ) itab = ip
         !
       ENDIF
     ENDDO
     !
     ! 5.f No matching field, find empty fields
     !
     IF ( itab .EQ. 0 ) THEN
       DO ip=nptab, 1, -1
         IF ( tpt(ip,1).LT.0. .AND. tpt(ip,2).LT.0. )    &
              itab = ip
       ENDDO
     ENDIF
     !
     ! 5.g Slot in table found, write
     !
     ! Remove clear windseas
     !
     IF ( itab .NE. 0 ) THEN
       !
       WRITE (part,'(1X,F5.2,F5.1,I4)')                             &
            hsp(ipnow), tpp(ipnow), nint(dmp(ipnow))
 #ifdef W3_NCO
       WRITE (cpart,'(I2,1X,I2.2,1X,I3.3)')                         &
            nint(hsp(ipnow)/0.3048),                              &
            nint(tpp(ipnow)),                                     &
            nint(mod(dmp(ipnow)+180.,360.))
 #endif
       deldw  = mod( abs( udir - dmp(ipnow) ) , 360. )
       IF ( deldw .GT. 180. ) deldw = 360. - deldw
       afr    = 2.*pi/tpp(ipnow)
       age    = uabs * wnp(ipnow) / afr
       IF ( deldw.LT.ddwmax .AND. age.GT.agemin ) part(1:1) = '*'
       !
       ascbline(5+itab*18:19+itab*18) = part
 #ifdef W3_NCO
       cascbline(itab*10-1:itab*10+7) = cpart
 #endif
       !
       DO ifld=1,nptab
         IF(itab.EQ.ifld)THEN
           iyy(ifld)=.true.
           hsd(ifld)=hsp(ipnow)
           tpd(ifld)=tpp(ipnow)
           wdd(ifld)=nint(dmp(ipnow))
         ENDIF
       ENDDO
       !
       hst(itab,1) = hsp(ipnow)
       tpt(itab,1) = tpp(ipnow)
       dmt(itab,1) = dmp(ipnow)
  
       !
       ! 5.h No slot in table found, write
       !
     ELSE
       !
       inotab   = inotab + 1
       WRITE (ascbline(19:19),'(I1)') inotab
       !
     ENDIF
     !
     flag(ipnow) = .false.
     GOTO 601
     !
     ! 5.i End of processing, write line in table
     !
 699 CONTINUE
     !
     DO ifld=1,nptab
       IF(iyy(ifld))THEN
         ilen(ifld)=ilen(ifld)+1
         IF (ilen(ifld).EQ.1)THEN
           ipi(ifld)=ipg1+1
           ipg1=ipg1+1
         ENDIF
         WRITE (part2,'(",",F5.2,",",F5.2,",",I3)')                   &
              hsd(ifld), tpd(ifld), nint(wdd(ifld))
         csvbline(25+ipi(ifld)*16:40+ipi(ifld)*16) = part2
       ELSE
         ilen(ifld)=0
       ENDIF
     ENDDO
     !
     RETURN
     !/
     !/ End of W3BULL ----------------------------------------------------- /
     !/

References ascbline, bhsmin, cascbline, csvbline, dmt, w3timemd::dsec21(), w3gdatmd::flagll, hst, iyy, nptab, constants::pi, w3servmd::strace(), w3wdatmd::time, constants::tpi, and tpt.

Referenced by w3expo().

Variable Documentation

◆ ascbline

character(len=129) w3bullmd::ascbline

Definition at line 50 of file w3bullmd.F90.

50 CHARACTER(LEN=129) :: ASCBLINE

Referenced by w3bull(), and w3outp().

◆ bhsdrop

real, parameter w3bullmd::bhsdrop = 0.05

Definition at line 47 of file w3bullmd.F90.

Referenced by w3outp().

◆ bhsmin

real, parameter w3bullmd::bhsmin = 0.15

Definition at line 47 of file w3bullmd.F90.

47 REAL, PARAMETER :: BHSMIN = 0.15, bhsdrop = 0.05

Referenced by w3bull(), and w3outp().

◆ cascbline

character(len=67) w3bullmd::cascbline

Definition at line 53 of file w3bullmd.F90.

53 CHARACTER(LEN=67) :: CASCBLINE

Referenced by w3bull(), and w3outp().

◆ csvbline

character(len=664) w3bullmd::csvbline

Definition at line 51 of file w3bullmd.F90.

51 CHARACTER(LEN=664) :: CSVBLINE

Referenced by w3bull(), and w3outp().

◆ dmt

real, dimension(nptab,2) w3bullmd::dmt

Definition at line 48 of file w3bullmd.F90.

Referenced by w3bull(), and w3outp().

◆ hst

real, dimension(nptab,2) w3bullmd::hst

Definition at line 48 of file w3bullmd.F90.

48 REAL :: HST(NPTAB,2), TPT(NPTAB,2), &

49 DMT(NPTAB,2)

Referenced by w3bull(), and w3outp().

◆ iyy

logical, dimension(npmax) w3bullmd::iyy

Definition at line 55 of file w3bullmd.F90.

55 LOGICAL :: IYY(NPMAX)

Referenced by w3bull(), and w3outp().

◆ nfld

integer, parameter w3bullmd::nfld = 50

Definition at line 45 of file w3bullmd.F90.

Referenced by w3outp().

◆ npmax

integer, parameter w3bullmd::npmax = 80

Definition at line 45 of file w3bullmd.F90.

Referenced by w3outp().

◆ nptab

integer, parameter w3bullmd::nptab = 6

Definition at line 45 of file w3bullmd.F90.

45 INTEGER, PARAMETER :: NPTAB = 6, nfld = 50, npmax = 80

Referenced by w3bull(), and w3outp().

◆ tpt

real, dimension(nptab,2) w3bullmd::tpt

Definition at line 48 of file w3bullmd.F90.

Referenced by w3bull(), and w3outp().

Functions/Subroutines

Variables

Detailed Description

Function/Subroutine Documentation

◆ w3bull()

Variable Documentation

◆ ascbline

◆ bhsdrop

◆ bhsmin

◆ cascbline

◆ csvbline

◆ dmt

◆ hst

◆ iyy

◆ nfld

◆ npmax

◆ nptab

◆ tpt