#include "w3macros.h"
!/ ------------------------------------------------------------------- /
      MODULE W3BULLMD
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH-III           NOAA/NCEP |
!/                  |           J. H. Alves             |
!/                  |           H. L. Tolman            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         26-Dec-2012 |
!/                  +-----------------------------------+
!/
!/    01-APR-2010 : Origination.                        ( version 3.14 )
!/    25-Jun-2011 : Temporary change of HSMIN           ( version 4.05 )
!/    15-Aug-2011 : Changing HSMIN to BHSMIN bugfix     ( version 4.05 )
!/    26-Dec-2012 : Modified obsolete declarations.     ( version 4.11 )
!/
!/ ------------------------------------------------------------------- /
      USE W3GDATMD, ONLY: GNAME, NK, NTH, NSPEC, FLAGLL
      USE W3ODATMD, ONLY: NOPTS, PTLOC, PTNME
      USE CONSTANTS, ONLY: PI, TPI
      USE W3WDATMD, ONLY: TIME
      USE W3TIMEMD, ONLY: DSEC21
      PUBLIC
      INTEGER, PARAMETER   :: NPTAB = 6, NFLD = 50, NPMAX = 80
!
      REAL, PARAMETER      :: BHSMIN = 0.15, BHSDROP = 0.05
      REAL                 :: HST(NPTAB,2), TPT(NPTAB,2),     &
                                      DMT(NPTAB,2)
      CHARACTER(LEN=129)   :: ASCBLINE 
      CHARACTER(LEN=664)   :: CSVBLINE 
!/NCO      CHARACTER(LEN=67)    :: CASCBLINE 
      LOGICAL              :: IYY(NPMAX)
!/    
!/ Conventional declarations
!/     
!/
!/ Private parameter statements (ID strings)
!/
!/
      CONTAINS
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3BULL                                                &
          ( NPART, XPART, DIMXP, UABS, UD, IPNT, IOUT, TIMEV ) 
!/
!/                  +-----------------------------------+
!/                  | 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
!/S      USE W3SERVMD, ONLY: STRACE
!
      IMPLICIT NONE
!
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
!/
!
! -------------------------------------------------------------------- /
! 1.  Initializations
!
!/S      INTEGER, SAVE           :: IENT = 0
      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(6,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
!/NCO      CHARACTER(LEN=67)       :: CBLANK, CTAIL !, CASCBLINE
      CHARACTER(LEN=15)       :: PART
!/NCO      CHARACTER(LEN=9)        :: CPART
      CHARACTER(LEN=664)      :: BLANK2 !,CSVBLINE
      CHARACTER               :: STIME*8,FORM*20,FORM1*2
      CHARACTER(LEN=16)       :: PART2
!/
!/ ------------------------------------------------------------------- /
!
!/S      CALL STRACE (IENT, 'XXXXXX')
!
! 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
!/NCO       CTAIL( 1:40) = '----------------------------------------'
!/NCO       CTAIL(41:67) = '---------------------------'
!/NCO       CBLANK( 1:40) = '                                        '
!/NCO       CBLANK(41:67) = '                           '
!/NCO       CASCBLINE       = CBLANK
!
      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
!
      IF (IOUT .EQ. 1) THEN
        IPG1 = 0
        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)
      HSP = XPART(1,1:NPART)
      TPP = XPART(2,1:NPART)
      WNP = TPI / XPART(3,1:NPART)
      DMP = MOD( XPART(4,1:NPART) + 180., 360.)

      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
!/NCO       CASCBLINE = CBLANK
!
! 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
!
!/NCO       WRITE (CASCBLINE(1:2),'(I2.2)') MOD(TIME(1),100)
!/NCO       WRITE (CASCBLINE(3:4),'(I2.2)') TIME(2)/10000
!/NCO       IF ( HSTOT .GT. 0. ) WRITE (CASCBLINE(6:7),'(I2)') NINT(HSTOT/0.3048)
!
      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))
!/NCO           WRITE (CPART,'(I2,1X,I2.2,1X,I3.3)')                         &
!/NCO                  NINT(HSP(IPNOW)/0.3048),                              &
!/NCO                  NINT(TPP(IPNOW)),                                     &
!/NCO                  NINT(MOD(DMP(IPNOW)+180.,360.))
          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
!/NCO           CASCBLINE(ITAB*10-1:ITAB*10+7) = CPART
!
          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 ----------------------------------------------------- /
!/
      END SUBROUTINE W3BULL
!/
!/ End of module W3BULLMD -------------------------------------------- /
!/
      END MODULE W3BULLMD

