#include "w3macros.h" !/ ------------------------------------------------------------------- / MODULE W3IOTRMD !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 26-Dec-2012 | !/ +-----------------------------------+ ! !/ See subroutine for update history. !/ ! 1. Purpose : ! ! Generate track output. ! ! 2. Variables and types : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! VERTRK C*10 Private Version number of routine. ! IDSTRI C*34 Private ID string input file. ! IDSTRO C*34 Private ID string output file. ! ---------------------------------------------------------------- ! ! 3. Subroutines and functions : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! W3IOTR Subr. Public Track output subroutine. ! ---------------------------------------------------------------- ! ! 4. Subroutines and functions used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SETO Subr. W3ODATMD Point to data structure. ! W3SETG Subr. W3GDATMD Point to data structure. ! W3SETW Subr. W3WDATMD Point to data structure. ! W3SETA Subr. W3ADATMD Point to data structure. ! W3DMO3 Subr. W3ODATMD Allocate work arrays. ! STRACE Subr. W3SERVMD Subroutine tracing. ! TICK21 Subr. W3TIMEMD Increment time. ! DSEC21 Func. W3TIMEMD Time difference. ! MPI_SEND, MPI_RECV, MPI_STARTALL, MPI_WAITALL ! MPI send and recieve routines ! ---------------------------------------------------------------- ! ! 5. Remarks : ! ! 6. Switches : ! ! See documentation of W3IOTR. ! ! 7. Source code : ! !/ ------------------------------------------------------------------- / !/ !/ Private parameter statements (ID strings) !/ CHARACTER(LEN=10), PARAMETER, PRIVATE :: VERTRK = 'III 1.02 ' CHARACTER(LEN=34), PARAMETER, PRIVATE :: & IDSTRI = 'WAVEWATCH III TRACK LOCATIONS DATA', & IDSTRO = 'WAVEWATCH III TRACK OUTPUT SPECTRA' !/ CONTAINS !/ ------------------------------------------------------------------- / SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 08-Jun-2018 | !/ +-----------------------------------+ !/ !/ 22-Dec-1998 : Final FORTRAN 77 ( version 1.18 ) !/ 27-Dec-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) !/ 24-Jan-2001 : Flat grid version ( version 2.06 ) !/ 20-Aug-2003 : Output through NAPTRK, seq. file. ( version 3.04 ) !/ 24-Nov-2004 : Multiple grid version. ( version 3.06 ) !/ 04-May-2005 : Change to MPI_COMM_WAVE. ( version 3.07 ) !/ 27-Jun-2005 : Adding MAPST2, ( version 3.07 ) !/ 27-Jun-2006 : Adding file name preamble. ( version 3.09 ) !/ 17-May-2007 : Adding NTPROC/NAPROC separation. ( version 3.11 ) !/ 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) !/ 30-Oct-2009 : Implement curvilinear grid type. ( 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) !/ 26-Dec-2012 : Initialize ASPTRK. ( version 4.11 ) !/ 12-Dec-2014 : Modify instanciation of NRQTR ( version 5.04 ) !/ 08-Jun-2018 : use W3PARALL/INIT_GET_JSEA_ISPROC ( version 6.04 ) !/ !/ Copyright 2009-2014 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 : ! ! Perform output of spectral information along provided tracks. ! ! 2. Method : ! ! Time and location data for the track is read from the file ! track_i.FILEXT, and output spectra additional information are ! written to track_o.FILEXT. ! ! The spectrum dumped is the frequency-direction spectrum in ! m**2/Hz/rad. ! ! The output spectra are energy density spectra in terms of the ! true frequency and a direction in radians. The corresponding ! band widths are part of the file header. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! NDSINP Int. I Unit number of input file track_i.FILEXT ! If negative, file is unformatted and v.v. ! NDSOUT Int. I Unit number of output file track_o.FILEXT ! A R.A. I Spectra (shape conversion through par list). ! IMOD Int. I Model grid number. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! See module documentation. ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3WAVE Subr. W3WAVEMD Actual wave model routine. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! - If input file not found, a warning is printed and output ! type is disabled. ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/SHRD Switch for shared / distributed memory architecture. ! !/DIST Id. ! !/MPI MPI interface routines. ! ! !/S Enable subroutine tracing. ! !/T General test output. ! !/T1 Test output on track point status. ! !/T2 Test output of mask arrays. ! !/T3 Test output for writing of file. ! ! 10. Remarks : ! ! Regarding section 3.e.2 "Optimize: omit points that are not ! strictly required.". This optimization saves disk space but ! results in output files that are more difficult to use. For ! example, matlab built-in function "griddata" requires all four ! bounding points. This means that a post-processing code must ! have extra logic do deal with cases without all four bounding ! points (interpolation along a line, or nearest neighbor). ! A namelist variable has been add to make this feature optional. ! Default, original behavior: TRCKCMPR = T (in /MISC/ namelist). ! Save all points: TRCKCMPR = F (in /MISC/ namelist). ! Within the present routine, the logical is named "CMPRTRCK". ! ! 11. Source code : ! !/ ------------------------------------------------------------------- / USE CONSTANTS !/ USE W3GDATMD, ONLY: W3SETG, CMPRTRCK USE W3WDATMD, ONLY: W3SETW USE W3ADATMD, ONLY: W3SETA USE W3ODATMD, ONLY: W3SETO, W3DMO3 !/ USE W3GDATMD, ONLY: NK, NTH, NSPEC, NSEA, NSEAL, NX, NY, & FLAGLL, ICLOSE, XGRD, YGRD, GSU, & DPDX, DPDY, DQDX, DQDY, MAPSTA, MAPST2, & MAPFS, TH, DTH, SIG, DSIP, XFR, FILEXT USE W3GSRUMD, ONLY: W3GFCL !/T USE W3GSRUMD, ONLY: W3GSUP USE W3GDATMD, ONLY: XYB, MAXX, MAXY, GTYPE, UNGTYPE USE W3WDATMD, ONLY: TIME, UST USE W3ADATMD, ONLY: CG, DW, CX, CY, UA, UD, AS !/MPI USE W3ADATMD, ONLY: MPI_COMM_WAVE USE W3ODATMD, ONLY: NDST, NDSE, IAPROC, NAPROC, NAPTRK, NAPERR, & IPASS => IPASS3, ATOLAST => TOLAST, & ADTOUT => DTOUT, O3INIT, STOP, MASK1, & MASK2, TRCKID, FNMPRE !/MPI USE W3ODATMD, ONLY: IT0TRK, NRQTR, IRQTR !/ USE W3TIMEMD USE W3PARALL, ONLY : INIT_GET_JSEA_ISPROC USE w3SERVMD, ONLY : STRSPLIT !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/MPI INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: NDSINP, NDSOUT, IMOD REAL, INTENT(IN) :: A(NTH,NK,0:NSEAL) !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER, PARAMETER :: OTYPE = 3 INTEGER :: NDSTI, NDSTO, ISPROC, IERR, & IK, ITH, IX, IY, TIMEB(2), TIMEE(2), & TTIME(2), IX1, IX2, IY1, IY2, & IXX(4), IYY(4), I, J, ISEA, JSEA, & TOLAST(2) !/S INTEGER, SAVE :: IENT = 0 !/T INTEGER :: NREAD, NTRACK, NSPECO, NLOCO !/T3 INTEGER :: ISPT !/MPI INTEGER :: IT, IROOT, IFROM, IERR_MPI !/MPI INTEGER, ALLOCATABLE :: STATUS(:,:) REAL :: XN, YN, XT, YT, RD, X, Y, WX, WY, & SPEC(NK,NTH), FACTOR, ASPTRK(NTH,NK),& DTOUT, XX(4), YY(4) REAL, SAVE :: RDCHCK = 0.05, RTCHCK = 0.05 LOGICAL :: FORMI, FLAG1, FLAG2, INGRID CHARACTER :: TRCKT*32, LINE*1024, TSTSTR*3, IDTST*34 CHARACTER(LEN=100) :: LIST(5) !/T1 CHARACTER(LEN=17), SAVE :: TSTLOC = ' ' !/T2 CHARACTER(LEN=1) :: MAPSTR(NX) ! EQUIVALENCE (IXX(1),IX1) , (IXX(2),IX2) , & (IYY(1),IY1) , (IYY(3),IY2) !/ !/ ------------------------------------------------------------------- / !/ !/S CALL STRACE (IENT, 'W3IOTR') ! CALL W3SETO ( IMOD, NDSE, NDST ) CALL W3SETG ( IMOD, NDSE, NDST ) CALL W3SETA ( IMOD, NDSE, NDST ) CALL W3SETW ( IMOD, NDSE, NDST ) ! TOLAST = ATOLAST(:,OTYPE) DTOUT = ADTOUT(OTYPE) ! IF ( .NOT. O3INIT ) CALL W3DMO3 ( IMOD, NDSE, NDST ) ! FORMI = NDSINP .GT. 0 NDSTI = ABS(NDSINP) NDSTO = ABS(NDSOUT) IF (GTYPE .EQ. UNGTYPE) THEN XN = MAXX YN = MAXY ENDIF ! ISPROC = IAPROC IPASS = IPASS + 1 ! IF ( FLAGLL ) THEN FACTOR = 1. ELSE FACTOR = 1.E-3 END IF ! ASPTRK = 0. ! !/T WRITE (NDST,9000) TIME ! !/MPI IF ( NRQTR .NE. 0 ) THEN !/MPI CALL MPI_STARTALL ( NRQTR, IRQTR, IERR_MPI ) !/MPI ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQTR) ) !/MPI CALL MPI_WAITALL ( NRQTR, IRQTR , STATUS, IERR_MPI ) !/MPI DEALLOCATE ( STATUS ) !/MPI END IF ! ! 1. First pass through routine ------------------------------------- * ! IF ( IPASS .EQ. 1 ) THEN ! !/T WRITE (NDST,9010) TOLAST, DTOUT, NDSTI, NDSTO, FORMI ! Removed by F.A. 2010/12/24 /T CALL W3GSUP ( GSU, NDST ) ! I = LEN_TRIM(FILEXT) J = LEN_TRIM(FNMPRE) ! ! 1.a Open input file ! IF ( FORMI ) THEN !/T WRITE (NDST,9011) FNMPRE(:J)//'track_i.'//FILEXT(:I), & !/T 'FORMATTED' OPEN (NDSTI,FILE=FNMPRE(:J)//'track_i.'//FILEXT(:I), & STATUS='OLD',ERR=800,FORM='FORMATTED',IOSTAT=IERR) READ (NDSTI,'(A)',ERR=801,END=802,IOSTAT=IERR) IDTST ELSE !/T WRITE (NDST,9011) FNMPRE(:J)//'track_i.'//FILEXT(:I), & !/T 'UNFORMATTED' OPEN (NDSTI,FILE=FNMPRE(:J)//'track_i.'//FILEXT(:I), & STATUS='OLD',ERR=800,FORM='UNFORMATTED',IOSTAT=IERR) READ (NDSTI,ERR=801,END=802,IOSTAT=IERR) IDTST END IF ! IF ( IDTST .NE. IDSTRI ) GOTO 803 ! ! 1.b Open output file ! IF ( IAPROC .EQ. NAPTRK ) THEN !/T WRITE (NDST,9012) FNMPRE(:J)//'track_o.'//FILEXT(:I), & !/T 'UNFORMATTED' OPEN (NDSTO,FILE=FNMPRE(:J)//'track_o.'//FILEXT(:I), & FORM='UNFORMATTED',ERR=810,IOSTAT=IERR) WRITE (NDSTO,ERR=811,IOSTAT=IERR) IDSTRO, FLAGLL, NK, & NTH, XFR WRITE (NDSTO,ERR=811,IOSTAT=IERR) 0.5*PI-TH(1), -DTH, & (SIG(IK)*TPIINV,IK=1,NK), & (DSIP(IK)*TPIINV,IK=1,NK) END IF ! ! 1.c Initialize maps ! !/T WRITE (NDST,9015) ! MASK2 = .FALSE. TRCKID = '' ! END IF ! ! 2. Preparations --------------------------------------------------- * ! 2.a Shift mask arrays ! !/T WRITE (NDST,9020) ! MASK1 = MASK2 MASK2 = .FALSE. ! ! 2.b Set time frame ! TIMEB = TIME TIMEE = TIME CALL TICK21 ( TIMEE , DTOUT ) ! IF ( DSEC21(TIMEE,TOLAST) .LT. 0. ) THEN TIMEE = TOLAST !/T WRITE (NDST,9022) END IF ! !/T WRITE (NDST,9021) TIMEB, TIMEE ! ! 3. Loop over input points ----------------------------------------- * ! !/T NREAD = 0 !/T NTRACK = 0 ! ! 3.a Read new track point (infinite loop) ! IF ( STOP ) THEN TOLAST = TIME !/T WRITE (NDST,9034) GOTO 399 END IF ! !/T1 WRITE (NDST,9030) ! DO ! IF ( FORMI ) THEN READ (NDSTI,'(A)',ERR=801,END=390,IOSTAT=IERR) LINE LIST(:)='' CALL STRSPLIT(LINE,LIST) READ(LIST(1),'(I8)') TTIME(1) READ(LIST(2),'(I6)') TTIME(2) READ(LIST(3),*) XT READ(LIST(4),*) YT IF(SIZE(LIST).GE.5) TRCKT=LIST(5) ELSE READ (NDSTI, ERR=801,END=390,IOSTAT=IERR) TTIME, XT, YT, TRCKT END IF !/T NREAD = NREAD + 1 ! ! 3.b Point before time interval ! IF ( DSEC21(TIMEB,TTIME) .LT. 0. ) THEN !/T1 WRITE (NDST,9031) TTIME,FACTOR*XT,FACTOR*YT,'TOO EARLY' CYCLE END IF ! ! 3.c Point after time interval ! IF ( DSEC21(TIMEE,TTIME) .GT. 0. ) THEN BACKSPACE (NDSTI) !/T NREAD = NREAD - 1 !/T1 WRITE (NDST,9031) TTIME,FACTOR*XT,FACTOR*YT,'TOO LATE' GOTO 399 END IF ! ! 3.d Check time in interval ! FLAG1 = DSEC21(TTIME,TIMEE) .GT. RTCHCK*DTOUT FLAG2 = DSEC21(TIMEB,TTIME) .GT. RTCHCK*DTOUT ! ! 3.e Check point coordinates ! ! 3.e.1 Initial identification of computational grid points to include. ! ! Find cell that encloses target point (note that the returned ! cell corner indices are adjusted for global wrapping and the ! coordinates are adjusted to avoid branch cut crossings) INGRID = W3GFCL( GSU, XT, YT, IXX, IYY, XX, YY ) IF ( .NOT. INGRID ) THEN !/T1 WRITE (NDST,9031) TTIME, FACTOR*XT, FACTOR*YT, & !/T1 'OUT OF GRID' CYCLE END IF ! ! Change cell-corners from counter-clockwise to column-major order IX = IXX(4); IY = IYY(4); IXX(4) = IXX(3); IYY(4) = IYY(3); IXX(3) = IX; IYY(3) = IY; ! ! 3.e.2 Optimize: omit points that are not strictly required. ! See "Remarks" IF(CMPRTRCK)THEN ! perform track compression ! Project onto I-axis RD = DPDX(IYY(1),IXX(1))*(XT-XX(1)) & + DPDY(IYY(1),IXX(1))*(YT-YY(1)) ! ! Collapse to left or right if within tolerance IF ( RD .LT. RDCHCK ) THEN IXX(2) = IXX(1) IXX(4) = IXX(3) ELSE IF ( RD .GT. 1.-RDCHCK ) THEN IXX(1) = IXX(2) IXX(3) = IXX(4) END IF ! ! Project onto J-axis RD = DQDX(IYY(1),IXX(1))*(XT-XX(1)) & + DQDY(IYY(1),IXX(1))*(YT-YY(1)) ! ! Collapse to top or bottom if within tolerance IF ( RD .LT. RDCHCK ) THEN IYY(3) = IYY(1) IYY(4) = IYY(2) ELSE IF ( RD .GT. 1.-RDCHCK ) THEN IYY(1) = IYY(3) IYY(2) = IYY(4) END IF END IF ! IF(CMPRTRCK)THEN ! ! 3.f Mark the four corner points ! DO J=1, 4 ! IX = IXX(J) IY = IYY(J) IF(GTYPE .EQ. UNGTYPE) THEN X = XYB(IX,1) Y = XYB(IX,2) ENDIF MASK1(IY,IX) = MASK1(IY,IX) .OR. FLAG1 MASK2(IY,IX) = MASK2(IY,IX) .OR. FLAG2 TRCKID(IY,IX) = TRCKT ! !/T1 IF ( MAPSTA(IY,IX) .EQ. 0 ) THEN !/T1 IF ( MAPST2(IY,IX) .EQ. 0 ) THEN !/T1 TSTLOC(4*J-3:4*J-1) = 'LND' !/T1 ELSE !/T1 TSTLOC(4*J-3:4*J-1) = 'XCL' !/T1 END IF !/T1 ELSE IF ( MAPSTA(IY,IX) .LT. 0 ) THEN !/T1 IF ( MAPST2(IY,IX) .EQ. 1 ) THEN !/T1 TSTLOC(4*J-3:4*J-1) = 'ICE' !/T1 ELSE IF ( MAPST2(IY,IX) .EQ. 2 ) THEN !/T1 TSTLOC(4*J-3:4*J-1) = 'DRY' !/T1 ELSE !/T1 TSTLOC(4*J-3:4*J-1) = 'DIS' !/T1 END IF !/T1 ELSE IF ( MAPSTA(IY,IX) .GT. 0 ) THEN !/T1 TSTLOC(4*J-3:4*J-1) = 'SEA' !/T1 END IF ! END DO ! !/T1 WRITE (NDST,9031) TTIME, FACTOR*XT, FACTOR*YT, TSTLOC, & !/T1 IXX(1), IXX(2), IYY(1), IYY(3), FLAG1, FLAG2 ! !/T NTRACK = NTRACK + 1 ! END DO ! ! 3.g End of input file escape location ! 390 CONTINUE !/T WRITE (NDST,9033) STOP = .TRUE. ! ! 3.h Read end escape location ! 399 CONTINUE ! ! 3.h Mask test output ! !/T2 WRITE (NDST,9035) !/T2 DO IY=NY,1,-1 !/T2 DO IX=1, NX !/T2 IF ( MASK1(IY,IX) ) THEN !/T2 MAPSTR(IX) = 'X' !/T2 ELSE IF ( MASK2(IY,IX) ) THEN !/T2 MAPSTR(IX) = 'x' !/T2 ELSE !/T2 MAPSTR(IX) = '.' !/T2 END IF !/T2 END DO !/T2 WRITE (NDST,9036) MAPSTR !/T2 END DO ! ! 4. Write data for flagged locations ------------------------------- * ! !/T NLOCO = 0 !/T NSPECO = 0 !/MPI IT = IT0TRK !/MPI IROOT = NAPTRK - 1 !/MPI ALLOCATE ( STATUS(MPI_STATUS_SIZE,1) ) ! DO IY=1, NY DO IX=1, NX IF ( MASK1(IY,IX) ) THEN ! IF(GTYPE .EQ. UNGTYPE) THEN X = XYB(IX,1) Y = XYB(IX,2) ELSE X = XGRD(IY,IX) Y = YGRD(IY,IX) ENDIF !/MPI IT = IT + 1 !/T NLOCO = NLOCO + 1 ! ! 4.a Status of point ! IF ( MAPSTA(IY,IX) .EQ. 0 ) THEN IF ( MAPST2(IY,IX) .EQ. 0 ) THEN TSTSTR = 'LND' ELSE TSTSTR = 'XCL' END IF ELSE IF ( MAPSTA(IY,IX) .LT. 0 ) THEN IF ( MAPST2(IY,IX) .EQ. 1 ) THEN TSTSTR = 'ICE' ELSE IF ( MAPST2(IY,IX) .EQ. 2 ) THEN TSTSTR = 'DRY' ELSE TSTSTR = 'DIS' END IF ELSE TSTSTR = 'SEA' END IF ! !/T IF ( TSTSTR .EQ. 'SEA' ) NSPECO = NSPECO + 1 ! ! 4.b Determine where point is stored ! ( land point assumed stored on IAPROC = NAPTRK ! set to -99 in test output ) ! ISEA = MAPFS(IY,IX) IF ( ISEA .EQ. 0 ) THEN ISPROC = NAPTRK !/T3 ISPT = -99 ELSE CALL INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) !/T3 ISPT = ISPROC END IF !/MPI IFROM = ISPROC - 1 ! 4.c Spectrum is at local processor, but this is not the NAPTRK ! Send the spectrum to NAPTRK IF ( ISPROC.EQ.IAPROC .AND. IAPROC.NE.NAPTRK ) THEN !/T3 WRITE (NDST,9040) IX, IY, ISEA, ISPT, 'SENDING' !/MPI CALL MPI_SEND ( A(1,1,JSEA), NSPEC, MPI_REAL, & !/MPI IROOT, IT, MPI_COMM_WAVE, IERR_MPI ) END IF ! ! 4.d This is NAPTRK, perform all output ! IF ( IAPROC .EQ. NAPTRK ) THEN ! ! 4.e Sea point, prepare data ! IF ( TSTSTR .EQ. 'SEA' ) THEN ! WX = UA(ISEA) * COS(UD(ISEA)) WY = UA(ISEA) * SIN(UD(ISEA)) ! ! ..... Local spectra ! IF ( IAPROC .EQ. ISPROC ) THEN DO IK=1, NK DO ITH=1, NTH SPEC(IK,ITH) = & TPI*A(ITH,IK,JSEA)*SIG(IK)/CG(IK,ISEA) END DO END DO ! ! ..... Non-local spectra ! ELSE !/T3 WRITE (NDST,9040) IX, IY, ISEA, ISPT, & !/T3 'RECEIVING' !/MPI CALL MPI_RECV (ASPTRK, NSPEC, MPI_REAL,& !/MPI IFROM, IT, MPI_COMM_WAVE, & !/MPI STATUS, IERR_MPI ) ! DO IK=1, NK DO ITH=1, NTH SPEC(IK,ITH) = & TPI*ASPTRK(ITH,IK)*SIG(IK)/CG(IK,ISEA) END DO END DO END IF ! ! 4.e Sea point, write general data + spectrum ! WRITE (NDSTO,ERR=811,IOSTAT=IERR) & TIME, X, Y, TSTSTR, TRCKID(IY,IX) WRITE (NDSTO,ERR=811,IOSTAT=IERR) & DW(ISEA), CX(ISEA), CY(ISEA), WX, WY, & UST(ISEA), AS(ISEA), SPEC ! ! 4.f Non-sea point, write ! ELSE WRITE (NDSTO,ERR=811,IOSTAT=IERR) & TIME, X, Y, TSTSTR, TRCKID(IY,IX) ! ! ..... Sea and non-sea points processed ! END IF ! ! ..... End of action at NAPTRK ! !/T3 WRITE (NDST,9040) IX, IY, ISEA, ISPT, 'WRITTEN', time END IF ! ! ..... Close IF for mask flag (top section 4) ! END IF ! ! ..... End of loop over map ! END DO END DO ! !/MPI DEALLOCATE ( STATUS ) ! !/T WRITE (NDST,9090) NTRACK, NREAD, NSPECO, NLOCO ! GOTO 888 ! ! Error Escape Locations ! 800 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) FILEXT(:I), IERR GOTO 880 ! 801 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1001) FILEXT(:I), IERR GOTO 880 ! 802 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1002) FILEXT(:I) GOTO 880 ! 803 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1003) FILEXT(:I), IDSTRI, IDTST GOTO 880 ! 810 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1010) FILEXT(:I), IERR GOTO 880 ! 811 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1011) FILEXT(:I), IERR ! ! Disabeling output ! 880 CONTINUE ATOLAST(:,3) = TIME !/T WRITE (NDST,9080) ! 888 CONTINUE ! RETURN ! ! Formats ! 1000 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/ & ' INPUT FILE WITH TRACK DATA NOT FOUND ', & '(FILE track_i.',A,' IOSTAT =',I6,')'/ & ' TRACK OUTPUT DISABLED '/) 1001 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/ & ' ERROR IN READING FILE track_i.',A,' IOSTAT =',I6/& ' (ADITIONAL) TRACK OUTPUT DISABLED '/) 1002 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/ & ' PREMATURE END OF FILE track_i.',A/ & ' TRACK OUTPUT DISABLED '/) 1003 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/ & ' UNEXPECTED CONTENTS OF OF FILE track_i.',A/ & ' EXPECTED : ',A/ & ' FOUND : ',A/ & ' TRACK OUTPUT DISABLED '/) 1010 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/ & ' ERROR IN OPENING OUTPUT FILE ', & '(FILE track_o.',A,' IOSTAT =',I6,')'/ & ' TRACK OUTPUT DISABLED '/) 1011 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOTR : '/ & ' ERROR IN WRITING TO FILE track_o.',A,' IOSTAT =',I6/ & ' (ADITIONAL) TRACK OUTPUT DISABLED '/) ! !/T 9000 FORMAT (' TEST W3IOTR : MODEL TIME : ',I8.8,I7.6) !/T 9010 FORMAT (' LAST OUTPUT TIME : ',I8.8,I7.6/ & !/T ' OUTPUT TIME INC, : ',F6.0/ & !/T ' UNIT NUMBERS : ',2I4/ & !/T ' FORMAT FLAGS : ',L4) !/T 9011 FORMAT (' TEST W3IOTR : OPENING INPUT : ',A,' [',A,']') !/T 9012 FORMAT (' TEST W3IOTR : OPENING OUTPUT : ',A,' [',A,']') !/T 9015 FORMAT (' TEST W3IOTR : PREPARING MASKS') ! !/T 9020 FORMAT (' TEST W3IOTR : SHIFTING MASKS') !/T 9021 FORMAT (' TEST W3IOTR : OUTPUT TIME FRAME: ',I8.8,I7.6/ & !/T ' ',I8.8,I7.6) !/T 9022 FORMAT (' TEST W3IOTR : ENDING TIME REACHED') ! !/T1 9030 FORMAT (' TEST W3IOTR : POINT-BY-POINT STATUS') !/T1 9031 FORMAT (' ',I8.8,I7.6,2F9.2,1X,A,1X,4I4,2L3) !/T 9033 FORMAT (' TEST W3IOTR : END OF INPUT FILE') !/T 9034 FORMAT (' TEST W3IOTR : OUTPUT TYPE DISABLED') !/T2 9035 FORMAT (' TEST W3IOTR : DUMP OF MAPS : ') !/T2 9036 FORMAT (132A1) ! !/T3 9040 FORMAT (' TEST W3IOTR : POINT',2I4,' (',I6,')', & !/T3 ' ON PROCESS',I4,2X,A,I10.8,I7.6) !/T 9090 FORMAT (' TEST W3IOTR : NUMBER OF TRACK P: ',I10, & !/T ' (OUT OF',I10,')'/ & !/T ' NUMBER OF SPECTRA: ',I10, & !/T ' (OUT OF',I10,')') ! !/T 9080 FORMAT (' TEST W3IOTR : OUTPUT TYPE DISABLED.') !/ !/ End of W3IOTR ----------------------------------------------------- / !/ END SUBROUTINE W3IOTR !/ !/ End of module W3IOTRMD -------------------------------------------- / !/ END MODULE W3IOTRMD