!> @file
!> @brief Contains program W3TRCK for converting track output.
!>
!> @author H. L. Tolman @date 05-Mar-2014
!
#include "w3macros.h"
!/ ------------------------------------------------------------------- /
!> @brief Convert direct access track output file to free-format
!> readable sequential file.
!>
!> @details Info read from track_o.ww3, written to track.ww3.
!>
!> @author H. L. Tolman @date 05-Mar-2014
PROGRAM W3TRCK
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | H. L. Tolman |
!/ | FORTRAN 90 |
!/ | Last update : 05-Mar-2014 |
!/ +-----------------------------------+
!/
!/ 14-Jan-1999 : Final FORTRAN 77 ( version 1.18 )
!/ 21-Jan-2000 : Upgrade to FORTRAN 90 ( version 2.00 )
!/ 25-Jan-2001 : Flat grid version ( version 2.06 )
!/ 20-Aug-2003 : Sequential file version ( version 3.04 )
!/ 29-Jun-2006 : Adding file name preamble. ( version 3.09 )
!/ 29-May-2009 : Preparing distribution version. ( version 3.14 )
!/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 )
!/ (W. E. Rogers & T. J. Campbell, NRL)
!/ 05-Mar-2014 : Now calls W3SETG for pointer def. ( version 4.18 )
!/
!/ 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 :
!
! Convert direct access track output file to free-format
! readable sequential file.
!
! 2. Method :
!
! Info read from track_o.ww3, written to track.ww3.
!
! 3. Parameters :
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! W3NMOD Subr. W3GDATMD Set number of model.
! W3NOUT Subr. W3ODATMD Set number of model for output.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! None, stand-alone program.
!
! 6. Error messages :
!
! 7. Remarks :
!
! 8. Structure :
!
! See source code.
!
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
USE W3GDATMD, ONLY : W3NMOD, W3SETG, FLAGLL, XFR
USE W3ODATMD, ONLY : W3NOUT, W3SETO, FNMPRE
USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE
#ifdef W3_S
USE W3SERVMD, ONLY : STRACE
#endif
USE W3TIMEMD, ONLY : STME21
!
USE W3ODATMD, ONLY: NDSO, NDSE, NDST
use constants, only: file_endian
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
CHARACTER*34, PARAMETER :: &
IDTST = 'WAVEWATCH III TRACK OUTPUT SPECTRA'
!
INTEGER :: NDSI, NDSINP, &
NDSOUT, NDSTRC, NTRACE, NK, NTH, &
NSPEC, IERR, MK, MTH, &
NREC, ILOC, ISPEC, TIME(2), TTST(2), &
ILAST, NZERO, IK, ITH, IWZERO, ICH, &
IWDTH, J
#ifdef W3_S
INTEGER, SAVE :: IENT = 0
#endif
INTEGER :: LINELN = 81
REAL :: TH1, DTH, X, Y, DW, CX, CY, WX, WY, &
UST, AS, VALUE
REAL :: SCALE = 0.001
REAL :: FACTOR
REAL, ALLOCATABLE :: SIG(:), DSIP(:), SPEC(:,:)
CHARACTER :: COMSTR*1, IDSTR*34, TSTSTR*3, &
STIME*23, STRING*81, EMPTY*81, &
PART*9, ZEROS*9, TRCKID*32
!
DATA EMPTY(01:40) / ' ' /
DATA EMPTY(41:81) / ' ' /
!/
!/ ------------------------------------------------------------------- /
!/
!
! 1.a Initialize data structure
!
CALL W3NMOD ( 1, 6, 6 )
CALL W3SETG ( 1, 6, 6 )
CALL W3NOUT ( 6, 6 )
CALL W3SETO ( 1, 6, 6 )
!
! 1.b IO set-up.
!
NDSI = 10
NDSINP = 11
NDSOUT = 51
!
NDSTRC = 6
NTRACE = 10
CALL ITRACE ( NDSTRC, NTRACE )
!
#ifdef W3_S
CALL STRACE ( IENT, 'W3TRCK' )
#endif
!
WRITE (NDSO,900)
!
J = LEN_TRIM(FNMPRE)
OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_trck.inp',STATUS='OLD', &
ERR=805,IOSTAT=IERR)
READ (NDSI,'(A)',END=806,ERR=807) COMSTR
IF (COMSTR.EQ.' ') COMSTR = '$'
WRITE (NDSO,901) COMSTR
!
CALL NEXTLN ( COMSTR , NDSI , NDSE )
READ (NDSI,*,END=806,ERR=807) NK, NTH
NSPEC = NK * NTH
WRITE (NDSO,902) NK, NTH
!
!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 2. Open and test input data file
!
WRITE (NDSO,920)
!
OPEN (NDSINP,FILE=FNMPRE(:J)//'track_o.ww3',form='UNFORMATTED', convert=file_endian, &
STATUS='OLD',ERR=800,IOSTAT=IERR)
READ (NDSINP,ERR=801,IOSTAT=IERR) IDSTR, FLAGLL, MK, MTH, XFR
!
IF ( FLAGLL ) THEN
FACTOR = 1.
ELSE
FACTOR = 1.E-3
END IF
!
IF ( IDSTR .NE. IDTST ) GOTO 810
IF ( NK.NE.MK .OR. NTH.NE.MTH ) GOTO 811
ALLOCATE ( SIG(MK), DSIP(MK), SPEC(MK,MTH) )
!
READ (NDSINP,ERR=801,IOSTAT=IERR) TH1, DTH, SIG, DSIP
!
!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 3. Open output file and prepare
!
WRITE (NDSO,930)
!
OPEN (NDSOUT,FILE=FNMPRE(:J)//'track.ww3', &
FORM='FORMATTED',ERR=802,IOSTAT=IERR)
!
WRITE (NDSOUT,980,ERR=803,IOSTAT=IERR) IDSTR
WRITE (NDSOUT,981,ERR=803,IOSTAT=IERR) MK, MTH, TH1, DTH
WRITE (NDSOUT,982,ERR=803,IOSTAT=IERR) SIG
WRITE (NDSOUT,983,ERR=803,IOSTAT=IERR) DSIP
!
!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 4. Process data
!
ILOC = 0
ISPEC = 0
READ (NDSINP,END=444, ERR=801,IOSTAT=IERR) TTST
BACKSPACE (NDSINP)
WRITE (NDSO,940)
!
400 CONTINUE
!
! 4.a Read/write basic data
!
READ (NDSINP,END=444, ERR=801,IOSTAT=IERR) TIME, X, Y, TSTSTR, &
TRCKID
IF ( FLAGLL ) THEN
WRITE (NDSOUT,984,ERR=803,IOSTAT=IERR) &
TIME, FACTOR*X, FACTOR*Y, TSTSTR, TRCKID
ELSE
WRITE (NDSOUT,974,ERR=803,IOSTAT=IERR) &
TIME, FACTOR*X, FACTOR*Y, TSTSTR, TRCKID
END IF
!
IF ( TIME(1).EQ.TTST(1) .AND. TIME(2).EQ.TTST(2) ) THEN
ILOC = ILOC + 1
IF ( TSTSTR .EQ. 'SEA' ) ISPEC = ISPEC + 1
ENDIF
IF ( TIME(1).NE.TTST(1) .OR. TIME(2).NE.TTST(2) ) THEN
CALL STME21 ( TTST , STIME )
WRITE (NDSO,941) STIME, ILOC, ISPEC
ILOC = 1
ISPEC = 0
IF ( TSTSTR .EQ. 'SEA' ) ISPEC = ISPEC + 1
TTST(1) = TIME(1)
TTST(2) = TIME(2)
ENDIF
!
! 4.b Check if sea point
!
IF ( TSTSTR .NE. 'SEA' ) GOTO 400
!
! 4.c Read all data
!
READ (NDSINP,ERR=801,IOSTAT=IERR) DW, CX, CY, WX, WY, UST, AS, &
SPEC
IF ( UST .LT. 0. ) UST = -1.0
!
! 4.d Write the basic stuff
!
WRITE (NDSOUT,985,ERR=803,IOSTAT=IERR) &
DW, CX, CY, WX, WY, UST, AS, SCALE
!
! 4.e Start of integer packing
!
STRING = EMPTY
ILAST = 0
NZERO = 0
!
! 4.e.1 Loop over spectrum
!
DO IK=1, NK
DO ITH=1, NTH
VALUE = MAX ( 0.1 , 1.1*SPEC(IK,ITH)/SCALE )
IWDTH = 2 + MAX( 0 , INT( ALOG10(VALUE) ) )
!
! 4.e.2 Put value in string and test overflow
!
IF ( IWDTH .GT. 9 ) THEN
IWDTH = 9
PART = ' 99999999'
ELSE
WRITE (PART,987) NINT(SPEC(IK,ITH)/SCALE)
IF ( PART(11-IWDTH:11-IWDTH) .EQ. ' ' ) &
IWDTH = IWDTH - 1
ENDIF
!
! 4.e.3 It's a zero, wait with writing
!
IF ( PART(8:9) .EQ. ' 0' ) THEN
NZERO = NZERO + 1
ELSE
!
! 4.e.4 It's not a zero, write unwritten zeros
!
IF ( NZERO .NE. 0 ) THEN
IF ( NZERO .EQ. 1 ) THEN
ZEROS = ' 0'
IWZERO = 2
ELSE
WRITE (ZEROS,'(I7,A2)') NZERO, '*0'
IWZERO = 4
DO
ICH = 10 - IWZERO
IF ( ZEROS(ICH:ICH) .NE. ' ' ) THEN
IWZERO = IWZERO + 1
ELSE
EXIT
ENDIF
END DO
ENDIF
IF ( ILAST+IWZERO .GT. LINELN ) THEN
WRITE (NDSOUT,986,ERR=803,IOSTAT=IERR) &
STRING(2:ILAST)
STRING = EMPTY
ILAST = 0
ENDIF
STRING(ILAST+1:ILAST+IWZERO) = &
ZEROS(10-IWZERO:9)
ILAST = ILAST + IWZERO
NZERO = 0
ENDIF
!
! 4.e.5 It's not a zero, put in string
!
IF ( ILAST+IWDTH .GT. LINELN ) THEN
WRITE (NDSOUT,986,ERR=803,IOSTAT=IERR) &
STRING(2:ILAST)
STRING = EMPTY
ILAST = 0
ENDIF
!
STRING(ILAST+1:ILAST+IWDTH) = PART(10-IWDTH:9)
ILAST = ILAST + IWDTH
!
ENDIF
!
END DO
END DO
!
! ..... End of loop over spectrum (4.e.1)
!
! 4.e.6 Write trailing zeros
!
IF ( NZERO .NE. 0 ) THEN
IF ( NZERO .EQ. 1 ) THEN
ZEROS = ' 0'
IWZERO = 2
ELSE
WRITE (ZEROS,'(I7,A2)') NZERO, '*0'
IWZERO = 4
DO
ICH = 10 - IWZERO
IF ( ZEROS(ICH:ICH) .NE. ' ' ) THEN
IWZERO = IWZERO + 1
ELSE
EXIT
ENDIF
END DO
ENDIF
IF ( ILAST+IWZERO .GT. LINELN ) THEN
WRITE (NDSOUT,986,ERR=803,IOSTAT=IERR) &
STRING(2:ILAST)
STRING = EMPTY
ILAST = 0
ENDIF
STRING(ILAST+1:ILAST+IWZERO) = ZEROS(10-IWZERO:9)
ILAST = ILAST + IWZERO
NZERO = 0
ENDIF
!
! 4.e.7 Write last line
!
IF ( ILAST .NE. 0 ) THEN
WRITE (NDSOUT,986,ERR=803,IOSTAT=IERR) STRING(2:ILAST)
ENDIF
!
! ... Loop back to top
!
GOTO 400
!
! 4.f All data done, write last batch info
!
444 CONTINUE
!
CALL STME21 ( TTST , STIME )
WRITE (NDSO,941) STIME, ILOC, ISPEC
!
GOTO 888
!
! Escape locations read errors :
!
800 CONTINUE
WRITE (NDSE,1000) IERR
CALL EXTCDE ( 1 )
!
801 CONTINUE
WRITE (NDSE,1001) IERR
CALL EXTCDE ( 2 )
!
802 CONTINUE
WRITE (NDSE,1002) IERR
CALL EXTCDE ( 3 )
!
803 CONTINUE
WRITE (NDSE,1003) IERR
CALL EXTCDE ( 4 )
!
805 CONTINUE
WRITE (NDSE,1004) IERR
CALL EXTCDE ( 5 )
!
806 CONTINUE
WRITE (NDSE,1005) IERR
CALL EXTCDE ( 6 )
!
807 CONTINUE
WRITE (NDSE,1006) IERR
CALL EXTCDE ( 7 )
!
810 CONTINUE
WRITE (NDSE,1010) IDSTR, IDTST
CALL EXTCDE ( 5 )
!
811 CONTINUE
WRITE (NDSE,1011) MK, MTH, NK, NTH
CALL EXTCDE ( 6 )
!
888 CONTINUE
!
WRITE (NDSO,999)
!
! Formats
!
900 FORMAT (/15X,' *** WAVEWATCH III Track output post.*** '/ &
15X,'==============================================='/)
901 FORMAT ( ' Comment character is ''',A,''''/)
902 FORMAT ( ' Spectral grid size is ',I3,' by ',I3// &
' Opening files : '/ &
' -----------------------------------------------')
920 FORMAT ( ' Input file ...')
930 FORMAT ( ' Output file ...')
940 FORMAT (/' Processing data : '/ &
' -----------------------------------------------')
941 FORMAT ( ' ',A,' :',I6,' points and',I6,' spectra.')
!
980 FORMAT (A)
981 FORMAT (2I6,2E13.5)
982 FORMAT (7E11.4)
983 FORMAT (7E11.4)
984 FORMAT (I8.8,I7.6,2F9.3,2X,A3,2X,A32)
974 FORMAT (I8.8,I7.6,2(F9.2,'E3'),2X,A3,2X,A32)
985 FORMAT (F8.1,2F6.2,2F8.2,f9.5,f7.2,E12.5)
986 FORMAT (A)
987 FORMAT (I9)
!
999 FORMAT (/' End of program '/ &
' ========================================='/ &
' WAVEWATCH III Track output '/)
!
1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ &
' ERROR IN OPENING INPUT DATA FILE'/ &
' IOSTAT =',I5/)
!
1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ &
' ERROR IN READING FROM INPUT DATA FILE'/ &
' IOSTAT =',I5/)
!
1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ &
' ERROR IN OPENING OUTPUT DATA FILE'/ &
' IOSTAT =',I5/)
!
1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ &
' ERROR IN WRITING TO OUTPUT FILE'/ &
' IOSTAT =',I5/)
!
1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ &
' ERROR IN OPENING INPUT FILE'/ &
' IOSTAT =',I5/)
!
1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ &
' ERROR IN READING FROM INPUT FILE'/ &
' IOSTAT =',I5/)
!
1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ &
' ERROR IN OPENING OUTPUT FILE'/ &
' IOSTAT =',I5/)
!
1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ &
' UNEXPECTED ID STRING IN INPUT : ',A/ &
' SHOULD BE : ',A/)
!
1011 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ &
' UNEXPECTED SPECTRAL DIMENSIONS : ',2I4/ &
' SHOULD BE : ',2I4/)
!/
!/ End of W3TRCK ----------------------------------------------------- /
!/
END PROGRAM W3TRCK