#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, DIMP 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(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 !/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