#include "w3macros.h" !/ ------------------------------------------------------------------- / PROGRAM W3OUTF !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 12-Sep-2018 | !/ +-----------------------------------+ !/ !/ 19-Oct-1998 : Final FORTRAN 77 ( version 1.18 ) !/ 19-Jan-2000 : Upgrade to FORTRAN 90 ( version 2.00 ) !/ 24-Jan-2001 : Flat grid version ( version 2.06 ) !/ 23-Apr-2002 : Clean-up ( version 2.19 ) !/ 29-Apr-2002 : Adding output fields 17-18. ( version 2.20 ) !/ 13-Nov-2002 : Add stress vector. ( version 3.00 ) !/ 24-Dec-2004 : Multiple grid version. ( version 3.06 ) !/ 21-Jul-2005 : Adding output fields 19-21. ( version 3.07 ) !/ 28-Jun-2006 : Adding file name preamble. ( version 3.09 ) !/ 05-Jul-2006 : Consolidate stress arrays. ( version 3.09 ) !/ 28-Mar-2007 : Adding partitioned output. ( version 3.11 ) !/ Adding user slots for outputs. !/ 31-Jul-2007 : Fix file extension errors. ( version 3.12 ) !/ 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) !/ 12-Dec-2012 : SMC grid sea-point text output.JG_Li( version 4.08 ) !/ 25-Dec-2012 : New structure of output fields. ( version 4.11 ) !/ Minor bug fixes and clean up. !/ 11-Nov-2013 : SMC and rotated grid incorporated in the main !/ trunk ( version 4.13 ) !/ 27-Aug-2015 : ICEH and ICEF added as output ( version 5.10 ) !/ 12-Sep-2018 : Added new partitioned output fields ( version 6.06 ) !/ !/ Copyright 2009-2012 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 : ! ! Post-processing of grid output. ! ! 2. Method : ! ! Data is read from the grid output file out_grd.ww3 (raw data) ! and from the file ww3_outf.inp ( NDSI, output requests ). ! Model definition and raw data files are read using WAVEWATCH III ! subroutines. ! ! Output types : ! 1 : print plots ! 2 : field statistics ! 3 : transfer file ! 4 : text output at sea points (1:NSEA). ! ! 3. Parameters : ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3NMOD Subr. W3GDATMD Set number of model. ! W3SETG Subr. Id. Point to selected model. ! W3NDAT Subr. W3WDATMD Set number of model for wave data. ! W3SETW Subr. Id. Point to selected model for wave data. ! W2NAUX Subr. W3ADATMD Set number of model for aux data. ! W3SETA Subr. Id. Point to selected model for aux data. ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input file. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! STME21 Subr. W3TIMEMD Convert time to string. ! TICK21 Subr. Id. Advance time. ! DSEC21 Func. Id. Difference between times. ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file. ! W3IOGO Subr. W3IOGOMD Reading/writing raw gridded data file. ! W3EXGO Subr. Internal Execute grid output. ! W3TXTS Subr. Internal Text output at sea points only. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! None, stand-alone program. ! ! 6. Error messages : ! ! Checks on input, checks in W3IOxx. ! ! 7. Remarks : ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE CONSTANTS !/ ! USE W3GDATMD, ONLY: W3NMOD, W3SETG USE W3WDATMD, ONLY: W3NDAT, W3SETW USE W3ADATMD, ONLY: W3NAUX, W3SETA USE W3ODATMD, ONLY: W3NOUT, W3SETO USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE !/S USE W3SERVMD, ONLY : STRACE USE W3TIMEMD USE W3IOGRMD, ONLY: W3IOGR USE W3IOGOMD, ONLY: W3IOGO, W3READFLGRD !/ USE W3GDATMD USE W3WDATMD, ONLY: TIME, WLV, ICE, ICEH, ICEF, BERG, UST, USTDIR USE W3ADATMD, ONLY: DW, UA, UD, AS, CX, CY, HS, WLM, T0M1, THM, & THS, FP0, THP0, FP1, THP1, DTDYN, FCUT, & ABA, ABD, UBA, UBD, SXX, SYY, SXY, USERO, & PHS, PTP, PLP, PDIR, PSI, PWS, PWST, PNR, & PTM1, PT1, PT2, PEP, & PTHP0, PQP, PSW, PPE, PGW, QP, & TAUOX, TAUOY, TAUWIX,BHD, & TAUWIY, PHIAW, PHIOC, TUSX, TUSY, PRMS, TPMS,& USSX, USSY, MSSX, MSSY, MSCX, MSCY, CHARN, & TAUWNX, TAUWNY, TAUBBL, PHIBBL, CFLXYMAX, & CFLTHMAX, CFLKMAX, BEDFORMS, WHITECAP, T02, & CGE, T01, HSIG, STMAXE, STMAXD, HMAXE, & HCMAXE, HMAXD, HCMAXD, MSSD, MSCD, WBT USE W3ODATMD, ONLY: NDSO, NDSE, NDST, NOGRP, NGRPP, IDOUT, & UNDEF, FLOGRD, FNMPRE, NOSWLL, NOGE ! IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: NDSI, NDSM, NDSOG, NDSDAT, NDSDT, & NDSTRC, NTRACE, IERR, I, J, IFI, IFJ,& TOUT(2), TDUM(2), IOTEST, NOUT, & ITYPE, IX1, IXN, IXS, IY1, IYN, IYS, & IDLA, IDFM, IOUT, IPART !/S INTEGER, SAVE :: IENT = 0 REAL :: DTREQ, DTEST CHARACTER :: COMSTR*1, IDTIME*23, IDDDAY*11, & TABNME*9 LOGICAL :: FLREQ(NOGRP,NGRPP), FLOG(NOGRP), & SCALE, VECTOR, LTEMP(NGRPP) !/ !/ ------------------------------------------------------------------- / !/ ! 1. IO set-up. ! CALL W3NMOD ( 1, 6, 6 ) CALL W3SETG ( 1, 6, 6 ) CALL W3NDAT ( 6, 6 ) CALL W3SETW ( 1, 6, 6 ) CALL W3NAUX ( 6, 6 ) CALL W3SETA ( 1, 6, 6 ) CALL W3NOUT ( 6, 6 ) CALL W3SETO ( 1, 6, 6 ) ! NDSI = 10 NDSM = 20 NDSOG = 20 NDSDAT = 50 ! NDSTRC = 6 NTRACE = 10 CALL ITRACE ( NDSTRC, NTRACE ) ! !/S CALL STRACE (IENT, 'W3OUTF') ! WRITE (NDSO,900) ! J = LEN_TRIM(FNMPRE) OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_outf.inp',STATUS='OLD', & ERR=800,IOSTAT=IERR) READ (NDSI,'(A)',END=801,ERR=802) COMSTR IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 2. Read model definition file. ! CALL W3IOGR ( 'READ', NDSM ) WRITE (NDSO,920) GNAME ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Read general data and first fields from file ! CALL W3IOGO ( 'READ', NDSOG, IOTEST ) ! WRITE (NDSO,930) DO IFI=1, NOGRP DO IFJ=1, NGRPP IF ( FLOGRD(IFI,IFJ) ) WRITE (NDSO,931) IDOUT(IFI,IFJ) END DO END DO ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 4. Read requests from input file. ! Output times ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) READ (NDSI,*,END=801,ERR=802) TOUT, DTREQ, NOUT DTREQ = MAX ( 0. , DTREQ ) IF ( DTREQ.EQ.0. ) NOUT = 1 NOUT = MAX ( 1 , NOUT ) ! CALL STME21 ( TOUT , IDTIME ) WRITE (NDSO,940) IDTIME ! TDUM = 0 CALL TICK21 ( TDUM , DTREQ ) CALL STME21 ( TDUM , IDTIME ) IF ( DTREQ .GE. 86400. ) THEN WRITE (IDDDAY,'(I10,1X)') INT(DTREQ/86400.) ELSE IDDDAY = ' ' END IF IDTIME(1:11) = IDDDAY IDTIME(21:23) = ' ' WRITE (NDSO,941) IDTIME, NOUT ! ! ... Output fields ! CALL W3READFLGRD ( NDSI, NDSO, 9, NDSE, COMSTR, FLOG, & FLREQ, 1, 1, IERR ) IF (IERR.NE.0) GOTO 800 ! ! ... Output type ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) READ (NDSI,*,END=801,ERR=802) ITYPE, IPART !Li IF ( ITYPE.LT.0 .OR. ITYPE.GT.3 ) THEN IF ( ITYPE.LT.0 .OR. ITYPE.GT.4 ) THEN !Li Type 4 for text output at sea points. JGLi12Dec2012 WRITE (NDSE,1010) ITYPE CALL EXTCDE ( 1 ) END IF IPART = MAX ( 0 , MIN ( NOSWLL , IPART ) ) ! ! ... ITYPE = 0 ! IF ( ITYPE .EQ. 0 ) THEN WRITE (NDSO,942) ITYPE, 'Checking contents of file' DO CALL STME21 ( TIME , IDTIME ) WRITE (NDSO,943) IDTIME CALL W3IOGO ( 'READ', NDSOG, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,944) GOTO 888 END IF END DO ! ! ... ITYPE = 1 ! ELSE IF (ITYPE .EQ. 1) THEN WRITE (NDSO,942) ITYPE, 'Print plots' CALL NEXTLN ( COMSTR , NDSI , NDSE ) READ (NDSI,*,END=801,ERR=802) & IX1, IXN, IXS, IY1, IYN, IYS, SCALE, VECTOR IX1 = MAX ( IX1 , 1 ) IXN = MIN ( IXN , NX ) IXS = MAX ( IXS , 1 ) IY1 = MAX ( IY1 , 1 ) IYN = MIN ( IYN , NY ) IYS = MAX ( IYS , 1 ) WRITE (NDSO,1940) IX1, IXN, IXS, IY1, IYN, IYS IF ( SCALE ) WRITE (NDSO,1941) ! ! ... ITYPE = 2 ! ELSE IF (ITYPE .EQ. 2) THEN WRITE (NDSO,942) ITYPE, 'Field statistics' NDSDT = NDSDAT - 1 CALL NEXTLN ( COMSTR , NDSI , NDSE ) READ (NDSI,*,END=801,ERR=802) IX1, IXN, IY1, IYN IX1 = MAX ( IX1 , 1 ) IXN = MIN ( IXN , NX ) IY1 = MAX ( IY1 , 1 ) IYN = MIN ( IYN , NY ) WRITE (NDSO,2940) IX1, IXN, IY1, IYN ! ! ... ITYPE = 3 ! ELSE IF (ITYPE .EQ. 3) THEN WRITE (NDSO,942) ITYPE, 'Transfer files' CALL NEXTLN ( COMSTR , NDSI , NDSE ) READ (NDSI,*,END=801,ERR=802) & IX1, IXN, IY1, IYN, IDLA, IDFM IX1 = MAX ( IX1 , 1 ) IXN = MIN ( IXN , NX ) IY1 = MAX ( IY1 , 1 ) IYN = MIN ( IYN , NY ) IF (IDLA.LT.1 .OR. IDLA.GT.5) IDLA = 1 IF (IDFM.LT.1 .OR. IDFM.GT.3) IDFM = 1 VECTOR = .TRUE. WRITE (NDSO,3940) IX1, IXN, IY1, IYN, IDLA, IDFM ! !Li Added sea-point output type 4. JGLi12Dec2012 ! ! ... ITYPE = 4 ! ELSE IF (ITYPE .EQ. 4) THEN WRITE (NDSO,942) ITYPE, 'Full sea-point output.' CALL NEXTLN ( COMSTR , NDSI , NDSE ) READ (NDSI,*,END=801,ERR=802) & IX1, IXN, IY1, IYN, IDLA, IDFM !Li ! END IF ! ! ... Output of output fields ! IF ( ITYPE.NE.2 ) THEN WRITE (NDSO,945) ELSE WRITE (NDSO,2945) END IF ! DO IFI=1, NOGRP DO IFJ=1, NGRPP IF ( FLREQ(IFI,IFJ) ) THEN IF ( FLOGRD(IFI,IFJ) ) THEN IF ( ITYPE.NE.2 ) THEN WRITE (NDSO,946) IDOUT(IFI,IFJ), ' ' ELSE J = LEN_TRIM(FNMPRE) NDSDT = NDSDT + 1 WRITE (TABNME,'(A3,I2.2,A4)') 'tab', NDSDT, '.ww3' WRITE (NDSO,2946) TABNME, IDOUT(IFI,IFJ) OPEN (NDSDT,FILE=FNMPRE(:J)//TABNME) WRITE (NDSDT,2947) IDOUT(IFI,IFJ) END IF ELSE WRITE (NDSO,946) IDOUT(IFI,IFJ), '*** NOT AVAILABLE ***' FLREQ(IFI,IFJ) = .FALSE. END IF END IF END DO END DO ! IF ( FLOG(4) ) THEN IF ( IPART .EQ. 0 ) THEN WRITE (NDSO,948) ELSE WRITE (NDSO,949) IPART END IF END IF ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 5. Time management. ! IOUT = 0 IF (ITYPE.EQ.3) WRITE (NDSO,970) ! DO DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN CALL W3IOGO ( 'READ', NDSOG, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,944) GOTO 888 END IF CYCLE END IF IF ( DTEST .LT. 0. ) THEN CALL TICK21 ( TOUT , DTREQ ) CYCLE END IF ! IOUT = IOUT + 1 CALL STME21 ( TOUT , IDTIME ) IF (ITYPE.EQ.1) THEN WRITE (NDSO,950) IDTIME ELSE IF (ITYPE.EQ.3) THEN WRITE (NDSO,971) IDTIME END IF ! CALL W3EXGO ( NX, NY, NSEA ) ! CALL TICK21 ( TOUT , DTREQ ) IF ( IOUT .GE. NOUT ) EXIT END DO ! IF (ITYPE.EQ.3) WRITE (NDSO,972) ! GOTO 888 ! ! Escape locations read errors : ! 800 CONTINUE WRITE (NDSE,1000) IERR CALL EXTCDE ( 10 ) ! 801 CONTINUE WRITE (NDSE,1001) CALL EXTCDE ( 11 ) ! 802 CONTINUE WRITE (NDSE,1002) IERR CALL EXTCDE ( 12 ) ! 888 CONTINUE WRITE (NDSO,999) ! ! Formats ! 900 FORMAT (/15X,' *** WAVEWATCH III Field output postp. *** '/ & 15X,'==============================================='/) 901 FORMAT ( ' Comment character is ''',A,''''/) ! 920 FORMAT ( ' Grid name : ',A/) ! 930 FORMAT ( ' Fields in file : '/ & ' --------------------------') 931 FORMAT ( ' ',A) ! 940 FORMAT (/' Output time data : '/ & ' --------------------------------------------------'/ & ' First time : ',A) 941 FORMAT ( ' Interval : ',A/ & ' Number of requests : ',I6) 942 FORMAT (/' Output type ',I2,' :'/ & ' --------------------------------------------------'/ & ' ',A/) 943 FORMAT ( ' Data for ',A) 944 FORMAT (/' End of file reached '/) ! 945 FORMAT (/' Requested output fields : '/ & ' --------------------------------------------------') 2945 FORMAT (/' Output files and fields : '/ & ' --------------------------------------------------') 946 FORMAT ( ' ',A,2X,A) 2946 FORMAT ( ' ',A,' : ',A) 2947 FORMAT ( ' Statitics of ',A/ & ' (time, min, max, avg, std)'/) 948 FORMAT (/' Partitioned field data for wind seas') 949 FORMAT (/' Partitioned field data for swell field',I2) ! 1940 FORMAT ( ' X range and interval : ',3I5/ & ' Y range and interval : ',3I5) 1941 FORMAT ( ' Data is normalized ') ! 2940 FORMAT ( ' X range : ',2I5/ & ' Y range : ',2I5) ! 3940 FORMAT ( ' X range : ',2I5/ & ' Y range : ',2I5/ & ' Layout indicator : ',I5/ & ' Format indicator : ',I5) ! 950 FORMAT (//' Output for ',A/ & ' --------------------------------------------------') ! 970 FORMAT (//' Generating files '/ & ' --------------------------------------------------') 971 FORMAT ( ' Files for ',A) 972 FORMAT ( ' ') ! 999 FORMAT (/' End of program '/ & ' ========================================='/ & ' WAVEWATCH III Field output '/) ! 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTF : '/ & ' ERROR IN OPENING INPUT FILE'/ & ' IOSTAT =',I5/) ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTF : '/ & ' PREMATURE END OF INPUT FILE'/) ! 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTF : '/ & ' ERROR IN READING FROM INPUT FILE'/ & ' IOSTAT =',I5/) ! 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTF : '/ & ' ILLEGAL TYPE, ITYPE =',I4/) !/ !/ Internal subroutine W3EXGO ---------------------------------------- / !/ CONTAINS !/ ------------------------------------------------------------------- / SUBROUTINE W3EXGO ( NX, NY, NSEA ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 25-Dec-2012 | !/ +-----------------------------------+ !/ !/ 26-Sep-1997 : Final FORTRAN 77 ( version 1.18 ) !/ 19-Jan-2000 : Upgrade to FORTRAN 90 ( version 2.00 ) !/ Massive changes to logistics !/ 24-Jan-2001 : Flat grid version ( version 2.06 ) !/ 23-Apr-2002 : Clean-up ( version 2.19 ) !/ 29-Apr-2002 : Adding output fields 17-18. ( version 2.20 ) !/ 16-Oct-2002 : Fix bound. error for stress output. ( version 3.00 ) !/ 16-Oct-2002 : Fix statistical output for UNDEF. ( version 3.00 ) !/ 13-Nov-2002 : Add stress vector. ( version 3.00 ) !/ 24-Dec-2004 : Multiple grid version. ( version 3.06 ) !/ 21-Jul-2005 : Adding output fields 19-21. ( version 3.07 ) !/ 28-Jun-2006 : Adding file name preamble. ( version 3.09 ) !/ 05-Jul-2006 : Consolidate stress arrays. ( version 3.09 ) !/ 28-Mar-2007 : Adding partitioned output. ( version 3.11 ) !/ Adding user slots for outputs. !/ 31-Jul-2007 : Fix file extension errors. ( version 3.12 ) !/ 25-Dec-2012 : New structure of output fields. ( version 4.11 ) !/ 25-Jun-2013 : Add type 4 sea point text output. ( version 4.11 ) !/ ! 1. Purpose : ! ! Perform actual grid output. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! NX/Y Int. I Grid dimensions. ! NSEA Int. I Number of sea points. ! ---------------------------------------------------------------- ! ! Internal parameters ! ---------------------------------------------------------------- ! FLONE Log. Flags for one-dimensional field. ! FLTWO Log. Flags for two-dimensional field X Y. ! FLDIR Log. Flags for two-dimensional, directional field. ! FLTRI Log. Flags for three dimensional field. ! X1, X2, XX, XY ! R.A. Output fields ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! W3S2XY Subr. Id. Convert from storage to spatial grid. ! PRTBLK Subr. W3ARRYMD Print plot of array. ! OUTA2I Subr. Id. Print array of INTEGERS. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Main program in which it is contained. ! ! 6. Error messages : ! ! None. ! ! 7. Remarks : ! ! - Note that arrays CX and CY of the main program now contain ! the absolute current speed and direction respectively. ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! !/T Enable test output. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY : W3S2XY !/RTD USE W3SERVMD, ONLY : W3THRTN, W3XYRTN USE W3ARRYMD, ONLY : OUTA2I, PRTBLK !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER :: NX, NY, NSEA !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: NXMAX, NXTOT, NBLOK, IH, IM, IS, & MFILL, J, ISEA, IX, IY, IXB, IB, & IXA, NINGRD, JJ, IFI, IFJ INTEGER :: MAP(NX+1,NY), MP2(NX+1,NY), & MX1(NX,NY), MXX(NX,NY), MYY(NX,NY), & MXY(NX,NY) INTEGER, SAVE :: IPASS ! INTEGER, SAVE :: NCOL = 80 INTEGER, SAVE :: NCOL = 132 !/S INTEGER, SAVE :: IENT = 0 REAL :: FSC, CABS, UABS, FSCA, XMIN, XMAX, & XAVG, XSTD, YGBX, XGBX, AABS REAL :: X1(NX+1,NY), X2(NX+1,NY), & XX(NX+1,NY), XY(NX+1,NY), DPTMAX(1) !!Li Type 4 sea point only text output variables. JGLi25Jun2013 REAL, Dimension(NSEA) :: XS1, XS2, XS3, XS4 !!Li DOUBLE PRECISION :: XDS, XDSQ LOGICAL :: FLONE, FLTWO, FLDIR, FLTRI !/T LOGICAL :: LTEMP(NGRPP) CHARACTER :: OLDTID*8, FNAME*32, ENAME*7, & FORMG*12, FORMF*11, UNITS*10, FSCS*7 CHARACTER, SAVE :: TIMEID*8 = '00000000' CHARACTER, SAVE :: FILEID*13 = 'WAVEWATCH III' !/BT4 REAL, PARAMETER :: LOG2=LOG(2.) !/ !/ ------------------------------------------------------------------- / !/ !/S CALL STRACE (IENT, 'W3EXGO') ! !/T DO IFI=1, NOGRP !/T LTEMP = FLREQ(IFI,:) !/T WRITE (NDST,9000) IFI, LTEMP !/T END DO !/T WRITE (NDST,9001) ITYPE, IX1, IXN, IXS, IY1, IYN, IYS, & !/T SCALE, VECTOR, NDSDAT ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 1. Preparations ! X1 = UNDEF X2 = UNDEF XX = UNDEF XY = UNDEF !!Li Type 4 sea point only variables XS1 = UNDEF XS2 = UNDEF XS3 = UNDEF XS4 = UNDEF ! ! Number of print-plots ! IF ( ITYPE .EQ. 1 ) THEN IF ( SCALE ) THEN NXMAX = ( NCOL - 10 ) / 2 ELSE NXMAX = ( NCOL - 10 ) / 5 END IF NXTOT = 1 + (IXN-IX1)/IXS NBLOK = 1 + (NXTOT-1)/NXMAX !/T WRITE (NDST,9012) NXMAX, NXTOT, NBLOK END IF ! ! Output file unit number ! IF ( ITYPE .EQ. 2 ) THEN NDSDT = NDSDAT - 1 IH = TIME(2) / 10000 IM = MOD ( TIME(2) , 10000 ) / 100 IS = MOD ( TIME(2) , 100 ) END IF ! ! Set-up transfer files ! !!Li Type 4 share filename with type 3 JGLi25Jun2013 !! IF ( ITYPE .EQ. 3 ) THEN IF ( ITYPE .EQ. 3 .OR. ITYPE .EQ. 4 ) THEN MFILL = -999 OLDTID = TIMEID WRITE (TIMEID,'(I6.6,I2.2)') MOD( TIME(1) , 1000000 ), & TIME(2)/10000 FNAME(05:12) = TIMEID FNAME(13:13) = '.' IF ( TIMEID .NE. OLDTID ) THEN FNAME(1:4) = 'ww3.' IPASS = 1 ELSE WRITE (ENAME,'(A1,I2.2,A1)') 'e', IPASS, '.' FNAME(1:4) = ENAME IPASS = IPASS + 1 END IF !/T WRITE (NDST,9014) FNAME(1:13) FORMG = '((10G12.2))' END IF ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 2. Loop over output fields. ! DO IFI=1, NOGRP DO IFJ=1, NGRPP IF ( FLREQ(IFI,IFJ) ) THEN ! FORMF = '(1X,32I4)' !/T WRITE (NDST,9020) IDOUT(IFI,IFJ) ! ! 2.a Set output arrays and parameters FLONE = .FALSE. FLTWO = .FALSE. FLDIR = .FALSE. FLTRI = .FALSE. ! IF ( IFI .EQ. 1 .AND. IFJ .EQ. 1 ) THEN FLONE = .TRUE. DPTMAX = MAXVAL ( DW(1:NSEA) ) FSC = 1. IF ( DPTMAX(1) .GT. 999. ) THEN FSC = 0.1 ELSE IF ( DPTMAX(1) .GT. 99.9 ) THEN FSC = 0.1 ELSE IF ( DPTMAX(1) .GT. 9.99 ) THEN FSC = 0.01 END IF IF ( ITYPE .EQ. 3 ) FSC = 0.01 UNITS = 'm' ENAME = '.dpt' FORMF = '(1X,17I7)' IF ( ITYPE .EQ. 4 ) THEN XS1 = DW(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, DW(1:NSEA) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 2 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 0.01 ENAME = '.cur' UNITS = 'm s-1' FORMF = '(1X,17I7)' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, CX, CY, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = CX(1:NSEA) XS2 = CY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CX(1:NSEA) & , MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CY(1:NSEA) & , MAPSF, XY ) ENDIF DO ISEA=1, NSEA CABS = SQRT(CX(ISEA)**2+CY(ISEA)**2) IF ( CABS .GT. 0.05 ) THEN CY(ISEA) = MOD ( 630. - & RADE*ATAN2(CY(ISEA),CX(ISEA)) , 360. ) ELSE CY(ISEA) = UNDEF END IF CX(ISEA) = CABS END DO IF ( ITYPE .EQ. 4 ) THEN XS3 = CX(1:NSEA) XS4 = CY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CX(1:NSEA) & , MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CY(1:NSEA) & , MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 3 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 0.1 ENAME = '.wnd' UNITS = 'm s-1' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, UA, UD, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = UA(1:NSEA) XS2 = UD(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UA(1:NSEA) & , MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UD(1:NSEA) & , MAPSF, XY ) ENDIF DO ISEA=1, NSEA UABS = SQRT(UA(ISEA)**2+UD(ISEA)**2) IF ( UABS .GT. 1.0 ) THEN UD(ISEA) = MOD ( 630. - & RADE*ATAN2(UD(ISEA),UA(ISEA)) , 360. ) ELSE UD(ISEA) = UNDEF END IF UA(ISEA) = UABS END DO IF ( ITYPE .EQ. 4 ) THEN XS3 = UA(1:NSEA) XS4 = UD(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UA(1:NSEA) & , MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UD(1:NSEA) & , MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 4 ) THEN FLONE = .TRUE. FSC = 0.1 ENAME = '.ast' UNITS = 'K' IF ( ITYPE .EQ. 4 ) THEN XS1 = AS(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, AS(1:NSEA) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 5 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = 'm' ENAME = '.wlv' IF ( ITYPE .EQ. 4 ) THEN XS1 = WLV ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WLV , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 6 ) THEN FLONE = .TRUE. FSC = 0.001 UNITS = '1' ENAME = '.ice' IF ( ITYPE .EQ. 4 ) THEN XS1 = ICE ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, ICE , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 7 ) THEN FLONE = .TRUE. FSC = 0.0002 UNITS = 'km-1' ENAME = '.ibg' WHERE ( BERG.NE.UNDEF) BERG = BERG*0.1 IF ( ITYPE .EQ. 4 ) THEN XS1 = BERG ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BERG , MAPSF, X1 ) ENDIF ! !/BT4 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 8 ) THEN !/BT4 FLONE = .TRUE. !/BT4 FSC = 0.01 !/BT4 UNITS = 'Krumbein phi scale' !/BT4 ENAME = '.d50' !/BT4 WHERE ( SED_D50.NE.UNDEF) SED_D50 = -LOG(SED_D50/0.001)/LOG2 !/BT4 IF ( ITYPE .EQ. 4 ) THEN !/BT4 XS1 = SED_D50 !/BT4 ELSE !/BT4 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, SED_D50 , MAPSF, X1 ) !/BT4 ENDIF ! !/IS2 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 9 ) THEN !/IS2 FLONE = .TRUE. !/IS2 FSC = 0.001 !/IS2 UNITS = 'm' !/IS2 ENAME = '.ic1' !/IS2 IF ( ITYPE .EQ. 4) THEN !/IS2 XS1 = ICEH !/IS2 ELSE !/IS2 CALL W3S2XY (NSEA, NSEA, NX+1, NY, ICEH, MAPSF, X1 ) !/IS2 ENDIF ! !/IS2 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 10) THEN !/IS2 FLONE = .TRUE. !/IS2 FSC = 0.001 !/IS2 UNITS = 'm' !/IS2 ENAME = '.ic5' !/IS2 IF ( ITYPE .EQ. 4) THEN !/IS2 XS1 = ICEF !/IS2 ELSE !/IS2 CALL W3S2XY (NSEA, NSEA, NX+1, NY, ICEF, MAPSF, X1 ) !/IS2 ENDIF ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 1 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = 'm' ENAME = '.hs' IF ( ITYPE .EQ. 4 ) THEN XS1 = HS ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, HS , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 2 ) THEN FLONE = .TRUE. FSC = 1. UNITS = 'm' ENAME = '.lm' IF ( ITYPE .EQ. 4 ) THEN XS1 = WLM ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WLM , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 3 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = 's' ENAME = '.t02' IF ( ITYPE .EQ. 4 ) THEN XS1 = T02 ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, T02 , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 4 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = 's' ENAME = '.t0m1' IF ( ITYPE .EQ. 4 ) THEN XS1 = T0M1 ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, T0M1 , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 5 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = 's' ENAME = '.t01' IF ( ITYPE .EQ. 4 ) THEN XS1 = T01 ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, T01 , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 6 ) THEN FLONE = .TRUE. FSC = 0.001 UNITS = 's-1' ENAME = '.fp' IF ( ITYPE .EQ. 4 ) THEN XS1 = FP0 ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, FP0 , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 7 ) THEN FLONE = .TRUE. FSC = 1. UNITS = 'degree' ENAME = '.dir' !/RTD ! Rotate direction back to standard pole !/RTD IF ( FLAGUNR ) CALL W3THRTN(NSEA, THM, AnglD, .FALSE.) DO ISEA=1, NSEA IF ( THM(ISEA) .NE. UNDEF ) & THM(ISEA) = MOD ( 630. - RADE*THM(ISEA) , 360. ) END DO IF ( ITYPE .EQ. 4 ) THEN XS1 = THM ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, THM , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 8 ) THEN FLONE = .TRUE. FSC = 0.1 UNITS = 'degree' ENAME = '.spr' IF ( ITYPE .EQ. 4 ) THEN XS1 = THS ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, THS , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 9 ) THEN FLONE = .TRUE. FSC = 1. UNITS = 'degree' ENAME = '.dp' !/RTD ! Rotate direction back to standard pole !/RTD IF ( FLAGUNR ) CALL W3THRTN(NSEA, THP0, AnglD, .FALSE.) DO ISEA=1, NSEA IF ( THP0(ISEA) .NE. UNDEF ) THEN THP0(ISEA) = MOD ( 630-RADE*THP0(ISEA) , 360. ) END IF END DO IF ( ITYPE .EQ. 4 ) THEN XS1 = THP0 ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, THP0 , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 10 ) THEN FLONE = .TRUE. FSC = 0.001 UNITS = 'm' ENAME = '.hig' IF ( ITYPE .EQ. 4 ) THEN XS1 = HSIG ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, HSIG , MAPSF, X1 ) END IF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 11 ) THEN FLONE = .TRUE. FSC = 0.002 UNITS = 'm' ENAME = '.emc' IF ( ITYPE .EQ. 4 ) THEN XS1 = STMAXE ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, STMAXE, MAPSF, X1 ) END IF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 12 ) THEN FLONE = .TRUE. FSC = 0.002 UNITS = 'm' ENAME = '.smc' IF ( ITYPE .EQ. 4 ) THEN XS1 = STMAXD ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, STMAXD, MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 13 ) THEN FLONE = .TRUE. FSC = 0.002 UNITS = 'm' ENAME = '.emh' IF ( ITYPE .EQ. 4 ) THEN XS1 = HMAXE ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, HMAXE, MAPSF, X1 ) END IF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 14 ) THEN FLONE = .TRUE. FSC = 0.002 UNITS = 'm' ENAME = '.eml' IF ( ITYPE .EQ. 4 ) THEN XS1 = HCMAXE ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, HCMAXE, MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 15 ) THEN FLONE = .TRUE. FSC = 0.002 UNITS = 'm' ENAME = '.smh' IF ( ITYPE .EQ. 4 ) THEN XS1 = HMAXD ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, HMAXD, MAPSF, X1 ) END IF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 16 ) THEN FLONE = .TRUE. FSC = 0.002 UNITS = 'm' ENAME = '.sml' IF ( ITYPE .EQ. 4 ) THEN XS1 = HCMAXD ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, HCMAXD, MAPSF, X1) ENDIF ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 17 ) THEN FLONE = .TRUE. FSC = 0.001 UNITS = '1' ENAME = '.wbt' IF ( ITYPE .EQ. 4 ) THEN XS1 = WBT ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WBT, MAPSF, X1) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 1 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = 'm' ENAME = '.phs' IF ( ITYPE .EQ. 4 ) THEN XS1 = PHS(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PHS(:,IPART) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 2 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = 's' ENAME = '.ptp' IF ( ITYPE .EQ. 4 ) THEN XS1 = PTP(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PTP(:,IPART) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 3 ) THEN FLONE = .TRUE. FSC = 1. UNITS = 'm' ENAME = '.plp' IF ( ITYPE .EQ. 4 ) THEN XS1 = PLP(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PLP(:,IPART) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 4 ) THEN FLONE = .TRUE. FSC = 1. UNITS = 'degree' ENAME = '.pdir' !/RTD ! Rotate direction back to standard pole !/RTD IF ( FLAGUNR ) CALL W3THRTN(NSEA, PDIR(:,IPART), AnglD, .FALSE.) DO ISEA=1, NSEA IF ( PDIR(ISEA,IPART) .NE. UNDEF ) THEN PDIR(ISEA,IPART) = & MOD ( 630-RADE*PDIR(ISEA,IPART) , 360. ) END IF END DO IF ( ITYPE .EQ. 4 ) THEN XS1 = PDIR(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PDIR(:,IPART) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 5 ) THEN FLONE = .TRUE. FSC = 0.1 UNITS = 'degree' ENAME = '.pspr' IF ( ITYPE .EQ. 4 ) THEN XS1 = PSI(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PSI(:,IPART) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 6 ) THEN FLONE = .TRUE. FSC = 0.001 UNITS = '1' ENAME = '.pws' IF ( ITYPE .EQ. 4 ) THEN XS1 = PWS(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PWS(:,IPART) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 7 ) THEN FLONE = .TRUE. FSC = 1.0 UNITS = 'degree' ENAME = '.pdp' !/RTD ! Rotate direction back to standard pole !/RTD IF ( FLAGUNR ) CALL W3THRTN(NSEA, PTHP0(:,IPART), AnglD, .FALSE.) DO ISEA=1, NSEA IF ( PTHP0(ISEA,IPART) .NE. UNDEF ) THEN PTHP0(ISEA,IPART) = & MOD ( 630-RADE*PTHP0(ISEA,IPART) , 360. ) END IF END DO IF ( ITYPE .EQ. 4 ) THEN XS1 = PTHP0(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PTHP0(:,IPART), & MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 8 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = '1' ENAME = '.pqp' IF ( ITYPE .EQ. 4 ) THEN XS1 = PQP(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PQP(:,IPART), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 9 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = '1' ENAME = '.ppe' IF ( ITYPE .EQ. 4 ) THEN XS1 = PPE(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PPE(:,IPART), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 10 ) THEN FLONE = .TRUE. FSC = 0.0001 UNITS = 's-1' ENAME = '.pgw' IF ( ITYPE .EQ. 4 ) THEN XS1 = PGW(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PGW(:,IPART), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 11 ) THEN FLONE = .TRUE. FSC = 0.0001 UNITS = '1' ENAME = '.psw' IF ( ITYPE .EQ. 4 ) THEN XS1 = PSW(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PSW(:,IPART), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 12 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = 's' ENAME = '.ptm10' IF ( ITYPE .EQ. 4 ) THEN XS1 = PTM1(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PTM1(:,IPART), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 13 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = 's' ENAME = '.pt01' IF ( ITYPE .EQ. 4 ) THEN XS1 = PT1(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PT1(:,IPART), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 14 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = 's' ENAME = '.pt02' IF ( ITYPE .EQ. 4 ) THEN XS1 = PT2(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PT2(:,IPART), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 15 ) THEN FLONE = .TRUE. FSC = 0.02 UNITS = 'm2 s rad-1' ENAME = '.pep' IF ( ITYPE .EQ. 4 ) THEN XS1 = PEP(:,IPART) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PEP(:,IPART), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 16 ) THEN FLONE = .TRUE. FSC = 0.001 UNITS = '1' ENAME = '.tws' IF ( ITYPE .EQ. 4 ) THEN XS1 = PWST(:) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PWST(:), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 17 ) THEN FLONE = .TRUE. FSC = 1. UNITS = '1' ENAME = '.pnr' IF ( ITYPE .EQ. 4 ) THEN XS1 = PNR(:) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PNR(:), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 1 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 0.001 ENAME = '.ust' FORMF = '(1X,20I6)' UNITS = 'm s-1' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, UST, USTDIR, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = UST (1:NSEA) XS2 = USTDIR(1:NSEA) ELSE CALL W3S2XY (NSEA,NSEA,NX+1,NY, UST (1:NSEA) & , MAPSF, XX ) CALL W3S2XY (NSEA,NSEA,NX+1,NY, USTDIR(1:NSEA) & , MAPSF, XY ) ENDIF DO ISEA=1, NSEA UABS = SQRT(UST(ISEA)**2+USTDIR(ISEA)**2) IF ( UST(ISEA) .EQ. UNDEF ) THEN USTDIR(ISEA) = UNDEF UABS = UNDEF ELSE IF ( UABS .GT. 0.05 ) THEN USTDIR(ISEA) = MOD ( 630. - & RADE*ATAN2(USTDIR(ISEA),UST(ISEA)) , 360. ) ELSE USTDIR(ISEA) = UNDEF END IF UST(ISEA) = UABS END DO IF ( ITYPE .EQ. 4 ) THEN XS3 = UST (1:NSEA) XS4 = USTDIR(1:NSEA) ELSE CALL W3S2XY (NSEA,NSEA,NX+1,NY, UST (1:NSEA) & , MAPSF, X1 ) CALL W3S2XY (NSEA,NSEA,NX+1,NY, USTDIR(1:NSEA) & , MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 2 ) THEN FLONE = .TRUE. FSC = 1.E-6 UNITS = '1' ENAME = '.cha' IF ( ITYPE .EQ. 4 ) THEN XS1 = CHARN(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CHARN(1:NSEA) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 3 ) THEN FLONE = .TRUE. FSC = 0.1 !0.01 UNITS = 'kW m-1' ENAME = '.cge' DO ISEA=1, NSEA IF ( CGE(ISEA) .NE. UNDEF ) & CGE(ISEA) = 0.001 * CGE(ISEA) END DO IF ( ITYPE .EQ. 4 ) THEN XS1 = CGE(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CGE(1:NSEA) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 4 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = 'W m-2' ENAME = '.faw' DO ISEA=1, NSEA PHIAW(ISEA)=MIN(99.98,PHIAW(ISEA)) END DO IF ( ITYPE .EQ. 4 ) THEN XS1 = PHIAW(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PHIAW(1:NSEA) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 5 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 1.E-6 UNITS = 'm2 s-2' ENAME = '.taw' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUWIX, TAUWIY, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = TAUWIX(1:NSEA) XS2 = TAUWIY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIX(1:NSEA) & , MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIY(1:NSEA) & , MAPSF, XY ) ENDIF DO ISEA=1, NSEA CABS = SQRT(TAUWIX(ISEA)**2+TAUWIY(ISEA)**2) IF ( TAUWIX(ISEA) .EQ. UNDEF ) THEN TAUWIY(ISEA) = UNDEF CABS = UNDEF ELSE IF ( TAUWIX(ISEA) .EQ. 0. .AND. & TAUWIY(ISEA) .EQ. 0. ) THEN TAUWIY(ISEA) = UNDEF ELSE TAUWIY(ISEA) = MOD ( 630. - & RADE*ATAN2(TAUWIY(ISEA),TAUWIX(ISEA)) , 360. ) END IF TAUWIX(ISEA) = CABS END DO IF ( ITYPE .EQ. 4 ) THEN XS3 = TAUWIX(1:NSEA) XS4 = TAUWIY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIX(1:NSEA) & , MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIY(1:NSEA) & , MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 6 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 1.E-6 UNITS = 'm2 s-2' ENAME = '.twa' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUWNX, TAUWNY, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = TAUWNX(1:NSEA) XS2 = TAUWNY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWNX(1:NSEA) & , MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWNY(1:NSEA) & , MAPSF, XY ) ENDIF DO ISEA=1, NSEA CABS = SQRT(TAUWNX(ISEA)**2+TAUWNY(ISEA)**2) IF ( TAUWNX(ISEA) .EQ. UNDEF ) THEN TAUWNY(ISEA) = UNDEF CABS = UNDEF ELSE IF ( TAUWNX(ISEA) .EQ. 0. .AND. & TAUWNY(ISEA) .EQ. 0. ) THEN TAUWNY(ISEA) = UNDEF ELSE TAUWNY(ISEA) = MOD ( 630. - & RADE*ATAN2(TAUWNY(ISEA),TAUWNX(ISEA)) , 360. ) END IF TAUWNX(ISEA) = CABS END DO IF ( ITYPE .EQ. 4 ) THEN XS3 = TAUWNX(1:NSEA) XS4 = TAUWNY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWNX(1:NSEA) & , MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWNY(1:NSEA) & , MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 7 ) THEN FLONE = .TRUE. FSC = 0.001 UNITS = '1' ENAME = '.wcc' IF ( ITYPE .EQ. 4 ) THEN XS1 = WHITECAP(1:NSEA,1) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,1) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 8 ) THEN FLONE = .TRUE. FSC = 0.1 UNITS = 'm' ENAME = '.wcf' IF ( ITYPE .EQ. 4 ) THEN XS1 = WHITECAP(1:NSEA,2) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,2) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 9 ) THEN FLONE = .TRUE. FSC = 0.1 UNITS = 'm' ENAME = '.wch' IF ( ITYPE .EQ. 4 ) THEN XS1 = WHITECAP(1:NSEA,3) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,3) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 10 ) THEN FLONE = .TRUE. FSC = 0.1 UNITS = '1' ENAME = '.wcm' IF ( ITYPE .EQ. 4 ) THEN XS1 = WHITECAP(1:NSEA,4) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,4) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 1 ) THEN FLTRI = .TRUE. FSC = 10. UNITS = 'N m-1' ENAME = '.sxy' !/RTD ! Radition stress components are always left on rotated pole !/RTD ! at present - need to confirm how to de-rotate (A. Saulter) IF ( ITYPE .EQ. 4 ) THEN XS1 = SXX(1:NSEA) XS2 = SYY(1:NSEA) XS3 = SXY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, SXX(1:NSEA) & , MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, SYY(1:NSEA) & , MAPSF, X2 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, SXY(1:NSEA) & , MAPSF, XY ) ENDIF ! ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 2 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 1.E-6 UNITS = 'm2 s-2' ENAME = '.two' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUOX, TAUOY, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = TAUOX(1:NSEA) XS2 = TAUOY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUOX(1:NSEA) & , MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUOY(1:NSEA) & , MAPSF, XY ) ENDIF DO ISEA=1, NSEA UABS = SQRT(TAUOX(ISEA)**2+TAUOY(ISEA)**2) IF ( TAUOX(ISEA) .EQ. UNDEF ) THEN TAUOY(ISEA) = UNDEF UABS = UNDEF ELSE IF ( UABS .GT. 1.E-8 ) THEN TAUOY(ISEA) = MOD ( 630. - & RADE*ATAN2(TAUOY(ISEA),TAUOX(ISEA)) , 360. ) ELSE TAUOY(ISEA) = UNDEF END IF TAUOX(ISEA) = UABS END DO IF ( ITYPE .EQ. 4 ) THEN XS3 = TAUOX(1:NSEA) XS4 = TAUOY(1:NSEA) ELSE CALL W3S2XY (NSEA,NSEA,NX+1,NY, TAUOX(1:NSEA) & , MAPSF, X1 ) CALL W3S2XY (NSEA,NSEA,NX+1,NY, TAUOY(1:NSEA) & , MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ.3 ) THEN FLONE = .TRUE. FSC = 0.001 UNITS = 'N m-1' ENAME = '.bhd' IF ( ITYPE .EQ. 4 ) THEN XS1 = BHD(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BHD(1:NSEA) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 4 ) THEN FLONE = .TRUE. FSC = 0.1 UNITS = 'W m-2' ENAME = '.foc' DO ISEA=1, NSEA PHIOC(ISEA)=MIN(99.98,PHIOC(ISEA)) END DO IF ( ITYPE .EQ. 4 ) THEN XS1 = PHIOC(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PHIOC(1:NSEA) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 5 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 0.001 UNITS = 'm2 s-1' ENAME = '.tus' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TUSX, TUSY, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = TUSX(1:NSEA) XS2 = TUSY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TUSX(1:NSEA) & , MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TUSY(1:NSEA) & , MAPSF, XY ) ENDIF DO ISEA=1, NSEA CABS = SQRT(TUSX(ISEA)**2+TUSY(ISEA)**2) IF ( TUSX(ISEA) .NE. UNDEF ) THEN TUSY(ISEA) = MOD ( 630. - & RADE*ATAN2(TUSY(ISEA),TUSX(ISEA)) , 360. ) ELSE TUSY(ISEA) = UNDEF CABS = UNDEF END IF TUSX(ISEA) = CABS END DO IF ( ITYPE .EQ. 4 ) THEN XS3 = TUSX(1:NSEA) XS4 = TUSY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY,TUSX,MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY,TUSY,MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 6 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 0.001 UNITS = 'm s-1' ENAME = '.uss' DO ISEA=1, NSEA IF (USSX(ISEA) .NE. UNDEF ) THEN USSX(ISEA)=MAX(-0.9998,MIN(0.9998,USSX(ISEA))) USSY(ISEA)=MAX(-0.9998,MIN(0.9998,USSY(ISEA))) END IF END DO !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, USSX, USSY, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = USSX(1:NSEA) XS2 = USSY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, USSX(1:NSEA) & , MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, USSY(1:NSEA) & , MAPSF, XY ) ENDIF DO ISEA=1, NSEA CABS = SQRT(USSX(ISEA)**2+USSY(ISEA)**2) IF ( USSX(ISEA) .NE. UNDEF ) THEN USSY(ISEA) = MOD ( 630. - & RADE*ATAN2(USSY(ISEA),USSX(ISEA)) , 360. ) ELSE USSY(ISEA) = UNDEF CABS = UNDEF END IF USSX(ISEA) = CABS END DO IF ( ITYPE .EQ. 4 ) THEN XS3 = USSX(1:NSEA) XS4 = USSY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, USSX(1:NSEA), & MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, USSY(1:NSEA), & MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 7 ) THEN FLTWO = .TRUE. FSC = 0.01 ENAME = '.p2s' UNITS = 'm4' DO ISEA=1, NSEA PRMS(ISEA)=PRMS(ISEA) END DO IF ( ITYPE .EQ. 4 ) THEN XS1 = PRMS(1:NSEA) XS2 = TPMS(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1,NY,PRMS,MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1,NY,TPMS,MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 1 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 0.01 ENAME = '.abr' UNITS = 'm' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, ABA, ABD, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = ABA(1:NSEA) XS2 = ABD(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, ABA(1:NSEA) & , MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, ABD(1:NSEA) & , MAPSF, XY ) ENDIF DO ISEA=1, NSEA IF ( ABA(ISEA) .NE. UNDEF ) THEN AABS = SQRT(ABA(ISEA)**2+ABD(ISEA)**2) IF ( AABS .GT. 0.005 ) THEN ABD(ISEA) = MOD ( 630. - & RADE*ATAN2(ABD(ISEA),ABA(ISEA)) , 360. ) ELSE ABD(ISEA) = UNDEF END IF ABA(ISEA) = AABS END IF END DO IF ( ITYPE .EQ. 4 ) THEN XS3 = ABA(1:NSEA) XS4 = ABD(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, ABA(1:NSEA) & , MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, ABD(1:NSEA) & , MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 2 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 0.01 ENAME = '.ubr' UNITS = 'm s-1' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, UBA, UBD, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = UBA(1:NSEA) XS2 = UBD(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UBA(1:NSEA) & , MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UBD(1:NSEA) & , MAPSF, XY ) ENDIF DO ISEA=1, NSEA IF ( UBA(ISEA) .NE. UNDEF ) THEN UABS = SQRT(UBA(ISEA)**2+UBD(ISEA)**2) IF ( UABS .GT. 0.005 ) THEN UBD(ISEA) = MOD ( 630. - & RADE*ATAN2(UBD(ISEA),UBA(ISEA)) , 360. ) ELSE UBD(ISEA) = UNDEF END IF UBA(ISEA) = UABS END IF END DO IF ( ITYPE .EQ. 4 ) THEN XS3 = UBA(1:NSEA) XS4 = UBD(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UBA(1:NSEA) & , MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UBD(1:NSEA) & , MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 3 ) THEN FLTRI = .TRUE. FSC = 1.E-2 UNITS = 'm' ENAME = '.bed' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, BEDFORMS(1:NSEA,2), & !/RTD BEDFORMS(1:NSEA,3), AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = BEDFORMS(1:NSEA,1) XS2 = BEDFORMS(1:NSEA,2) XS3 = BEDFORMS(1:NSEA,3) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDFORMS(1:NSEA,1) & , MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDFORMS(1:NSEA,2) & , MAPSF, X2 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDFORMS(1:NSEA,3) & , MAPSF, XY ) ENDIF ! ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 4 ) THEN FLONE = .TRUE. FSC = 0.1 UNITS = 'W m-2' ENAME = '.fbb' IF ( ITYPE .EQ. 4 ) THEN XS1 = PHIBBL(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PHIBBL(1:NSEA) & , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 5 ) THEN FLTWO = .TRUE. FSC = 1.E-6 UNITS = 'm2 s-2' ENAME = '.tbb' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUBBL(1:NSEA,1), & !/RTD TAUBBL(1:NSEA,2), AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = TAUBBL(1:NSEA,1) XS2 = TAUBBL(1:NSEA,2) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUBBL(1:NSEA,1) & , MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUBBL(1:NSEA,2) & , MAPSF, XY ) ENDIF ! ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 1 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 1.E-6 ENAME = '.mss' FORMF = '(1X,20I6)' UNITS = '1' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, MSSX, MSSY, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = MSSX(1:NSEA) XS2 = MSSY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSSX(1:NSEA), & MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY ,MSSY(1:NSEA), & MAPSF, XY ) ENDIF ! ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 2 ) THEN IF ( VECTOR ) THEN FLTWO = .TRUE. ELSE FLDIR = .TRUE. END IF FSC = 0.00001 ENAME = '.msc' UNITS = '1' !/RTD ! Rotate x,y vector back to standard pole !/RTD IF ( FLAGUNR ) CALL W3XYRTN(NSEA, MSCX, MSCY, AnglD) IF ( ITYPE .EQ. 4 ) THEN XS1 = MSCX(1:NSEA) XS2 = MSCY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSCX(1:NSEA), & MAPSF, XX ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSCY(1:NSEA), & MAPSF, XY ) ENDIF DO ISEA=1, NSEA CABS = SQRT(MSCX(ISEA)**2+MSCY(ISEA)**2) IF ( MSCX(ISEA) .EQ. UNDEF ) THEN MSCY(ISEA) = UNDEF CABS = UNDEF ELSE IF ( MSCX(ISEA) .EQ. 0. .AND. & MSCY(ISEA) .EQ. 0. ) THEN MSCY(ISEA) = UNDEF ELSE MSCY(ISEA) = MOD ( 630. - & RADE*ATAN2(MSCY(ISEA),MSCX(ISEA)) , 360. ) END IF MSCX(ISEA) = CABS END DO IF ( ITYPE .EQ. 4 ) THEN XS3 = MSCX(1:NSEA) XS4 = MSCY(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSCX(1:NSEA), & MAPSF, X1 ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSCY(1:NSEA), & MAPSF, X2 ) ENDIF ! ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 3 ) THEN FLONE = .TRUE. FSC = 0.1 UNITS = 'degree' ENAME = '.msd' !/RTD ! Rotate direction back to standard pole !/RTD IF ( FLAGUNR ) CALL W3THRTN(NSEA, MSSD, AnglD, .FALSE.) DO ISEA=1, NSEA IF ( MSSD(ISEA) .NE. UNDEF ) THEN MSSD(ISEA) = MOD ( 630. - RADE*MSSD(ISEA) , 180. ) END IF END DO IF ( ITYPE .EQ. 4 ) THEN XS1 = MSSD(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSSD(1:NSEA), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 4 ) THEN FLONE = .TRUE. FSC = 0.1 UNITS = 'degree' ENAME = '.mcd' !/RTD ! Rotate direction back to standard pole !/RTD IF ( FLAGUNR ) CALL W3THRTN(NSEA, MSCD, AnglD, .FALSE.) DO ISEA=1, NSEA IF ( MSCD(ISEA) .NE. UNDEF ) THEN MSCD(ISEA) = MOD ( 630. - RADE*MSCD(ISEA) , 180. ) END IF END DO IF ( ITYPE .EQ. 4 ) THEN XS1 = MSCD(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSCD(1:NSEA), MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN FLONE = .TRUE. FSC = 0.01 UNITS = '1' ENAME = '.qp' IF ( ITYPE .EQ. 4 ) THEN XS1 = QP ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, QP, MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN FLONE = .TRUE. FSC = 0.1 UNITS = 'min.' ENAME = '.dtd' DO ISEA=1, NSEA IF ( DTDYN(ISEA) .NE. UNDEF ) & DTDYN(ISEA) = DTDYN(ISEA) / 60. END DO IF ( ITYPE .EQ. 4 ) THEN XS1 = DTDYN(1:NSEA) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, DTDYN , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 2 ) THEN FLONE = .TRUE. FSC = 0.001 UNITS = 's-1' ENAME = '.fc' IF ( ITYPE .EQ. 4 ) THEN XS1 = FCUT ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, FCUT , MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 3 ) THEN FLONE = .TRUE. FSC = 0.001 FSC = 1. UNITS = '1' ENAME = '.cfx' IF ( ITYPE .EQ. 4 ) THEN XS1 = CFLXYMAX ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CFLXYMAX, MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 4 ) THEN FLONE = .TRUE. FSC = 0.001 UNITS = '1' ENAME = '.cfd' IF ( ITYPE .EQ. 4 ) THEN XS1 = CFLTHMAX ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CFLTHMAX, MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 5 ) THEN FLONE = .TRUE. FSC = 0.001 UNITS = '1' ENAME = '.cfk' IF ( ITYPE .EQ. 4 ) THEN XS1 = CFLKMAX ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CFLKMAX, MAPSF, X1 ) ENDIF ! ELSE IF ( IFI .EQ. 10 ) THEN FLONE = .TRUE. FSC = 1. UNITS = 'TBD' WRITE (ENAME,'(A2,I2.2)') '.u', IFJ IF ( ITYPE .EQ. 4 ) THEN XS1 = USERO(:,IFJ) ELSE CALL W3S2XY ( NSEA, NSEA, NX+1, NY, USERO(:,IFJ) & , MAPSF, X1 ) ENDIF ! ELSE WRITE (NDSE,990) IFI,IFJ WRITE (NDSE,999) CALL EXTCDE ( 1 ) ! END IF ! ! 2.b Make map ! DO IX=1, NX DO IY=1, NY IF ( MAPSTA(IY,IX) .EQ. 0 ) THEN X1(IX,IY) = UNDEF X2(IX,IY) = UNDEF XX(IX,IY) = UNDEF XY(IX,IY) = UNDEF END IF IF ( X1(IX,IY) .EQ. UNDEF ) THEN MAP(IX,IY) = 0 ELSE MAP(IX,IY) = 1 END IF IF ( X2(IX,IY) .EQ. UNDEF ) THEN MP2(IX,IY) = 0 ELSE MP2(IX,IY) = 1 END IF END DO END DO ! ! 2.c Perform output type 1 ( print plots ) ! IF ( ITYPE .EQ. 1 ) THEN ! IF ( SCALE ) THEN FSC = 0. FSCA = 0. ELSE FSCA = 1. END IF IXB = IX1 - IXS ! DO IB=1, NBLOK IXA = IXB + IXS IXB = IXA + (NXMAX-1)*IXS IXB = MIN ( IXB , IXN ) IF ( FLTRI ) THEN CALL PRTBLK (NDSO, NX, NY, NX+1, X1, MAP, 0, & FSC, IXA, IXB, IXS, IY1, IYN, IYS, & IDOUT(IFI,IFJ), UNITS) CALL PRTBLK (NDSO, NX, NY, NX+1, X2, MAP, 0, & FSC, IXA, IXB, IXS, IY1, IYN, IYS, & IDOUT(IFI,IFJ), UNITS) CALL PRTBLK (NDSO, NX, NY, NX+1, XY, MAP, 0, & FSC, IXA, IXB, IXS, IY1, IYN, IYS, & IDOUT(IFI,IFJ), UNITS) ELSE IF ( FLONE ) THEN CALL PRTBLK (NDSO, NX, NY, NX+1, X1, MAP, 0, & FSC, IXA, IXB, IXS, IY1, IYN, IYS, & IDOUT(IFI,IFJ), UNITS) ELSE IF ( FLTWO ) THEN CALL PRTBLK (NDSO, NX, NY, NX+1, XX, MAP, 0, & FSC, IXA, IXB, IXS, IY1, IYN, IYS, & IDOUT(IFI,IFJ), UNITS) CALL PRTBLK (NDSO, NX, NY, NX+1, XY, MAP, 0, & FSC, IXA, IXB, IXS, IY1, IYN, IYS, & IDOUT(IFI,IFJ), UNITS) ELSE IF ( FLDIR ) THEN CALL PRTBLK (NDSO, NX, NY, NX+1, X1, MAP, 0, & FSC, IXA, IXB, IXS, IY1, IYN, IYS, & IDOUT(IFI,IFJ), UNITS) CALL PRTBLK (NDSO, NX, NY, NX+1, X2, MP2, 0, & FSCA, IXA, IXB, IXS, IY1, IYN, IYS, & IDOUT(IFI,IFJ), 'Deg.') END IF END DO ! ! 2.d Perform output type 2 ( statistics ) ! ELSE IF ( ITYPE .EQ. 2 ) THEN XMIN = 1.E20 XMAX = -1.E20 XDS = 0.D0 XDSQ = 0.D0 NINGRD = 0 ! DO IX=IX1, IXN DO IY=IY1, IYN IF ( MAPSTA(IY,IX) .GT. 0 .AND. & X1(IX,IY) .NE. UNDEF ) THEN NINGRD = NINGRD + 1 XMIN = MIN ( XMIN , X1(IX,IY) ) XMAX = MAX ( XMAX , X1(IX,IY) ) XDS = XDS + DBLE(X1(IX,IY)) XDSQ = XDSQ + DBLE(X1(IX,IY))**2 END IF END DO END DO ! NDSDT = NDSDT + 1 ! IF ( NINGRD .EQ. 0 ) THEN WRITE (NDSDT,940) TIME(1), IH, IM, IS ELSE IF ( NINGRD .LE. 2 ) THEN XAVG = REAL ( XDS / DBLE(NINGRD) ) WRITE (NDSDT,940) TIME(1), IH, IM, IS, & XMIN, XMAX ELSE XAVG = REAL ( XDS / DBLE(NINGRD) ) XSTD = REAL ( ( XDSQ - XDS**2/DBLE(NINGRD) ) & / DBLE(NINGRD-1) ) XSTD = SQRT ( MAX ( XSTD , 0. ) ) WRITE (NDSDT,940) TIME(1), IH, IM, IS, & XMIN, XMAX, XAVG, XSTD END IF ! ! 2.e Perform output type 3 ( file ) ! ELSE IF ( ITYPE .EQ. 3 ) THEN ! FNAME(13:) = ENAME IF ( IDFM .EQ. 3 ) THEN IF(GTYPE .NE. UNGTYPE) THEN JJ = LEN_TRIM(FNMPRE) OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME, & FORM='UNFORMATTED',ERR=800,IOSTAT=IERR) WRITE (NDSDAT) FILEID, TIME, & MINVAL(XGRD(IY1:IYN,IX1:IXN)), & MAXVAL(XGRD(IY1:IYN,IX1:IXN)), IXN-IX1+1, & MINVAL(YGRD(IY1:IYN,IX1:IXN)), & MAXVAL(YGRD(IY1:IYN,IX1:IXN)), IYN-IY1+1, & ENAME, FSC, UNITS, IDLA, IDFM, FORMF, MFILL ELSE OPEN (NDSDAT,FILE=FNAME, & FORM='UNFORMATTED',ERR=800,IOSTAT=IERR) WRITE (NDSDAT) FILEID, TIME, & X0,MAXX,NX, & Y0,MAXY,NY, & ENAME, FSC, UNITS, IDLA, IDFM, FORMF, MFILL ENDIF ELSE IF(GTYPE .NE. UNGTYPE) THEN JJ = LEN_TRIM(FNMPRE) OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME,ERR=800, & IOSTAT=IERR) IF (FSC.LT.1E-4) THEN WRITE(FSCS,'(G7.1)') FSC ELSE WRITE(FSCS,'(F7.4)') FSC END IF IF ( FLAGLL ) THEN WRITE (NDSDAT,950) FILEID, TIME, & MINVAL(XGRD(IY1:IYN,IX1:IXN)), & MAXVAL(XGRD(IY1:IYN,IX1:IXN)), IXN-IX1+1, & MINVAL(YGRD(IY1:IYN,IX1:IXN)), & MAXVAL(YGRD(IY1:IYN,IX1:IXN)), IYN-IY1+1, & ENAME, FSCS, UNITS, IDLA, IDFM, FORMF, MFILL ELSE WRITE (NDSDAT,960) FILEID, TIME, & MINVAL(XGRD(IY1:IYN,IX1:IXN)), & MAXVAL(XGRD(IY1:IYN,IX1:IXN)), IXN-IX1+1, & MINVAL(YGRD(IY1:IYN,IX1:IXN)), & MAXVAL(YGRD(IY1:IYN,IX1:IXN)), IYN-IY1+1, & ENAME, FSCS, UNITS, IDLA, IDFM, FORMF, MFILL END IF ELSE OPEN (NDSDAT,FILE=FNAME, & ERR=800,IOSTAT=IERR) WRITE (NDSDAT, 949) FILEID, TIME, & X0,MAXX,NX, & Y0,MAXY,NY, & ENAME, FSC, UNITS, IDLA, IDFM, FORMF, MFILL ENDIF END IF ! IF ( FLTRI ) THEN DO IX=IX1, IXN DO IY=IY1, IYN IF ( MAPSTA(IY,IX) .LE. 0 .OR. & XX(IX,IY) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL MXY(IX,IY) = MFILL ELSE MXX(IX,IY) = NINT(X1(IX,IY)/FSC) MYY(IX,IY) = NINT(X2(IX,IY)/FSC) MXY(IX,IY) = NINT(XY(IX,IY)/FSC) END IF END DO END DO IF ( IDLA .NE. 5 ) THEN CALL OUTA2I ( MXX, NX, NY, IX1, IXN, IY1, IYN, & NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1, 0 ) CALL OUTA2I ( MYY, NX, NY, IX1, IXN, IY1, IYN, & NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1, 0 ) CALL OUTA2I ( MXY, NX, NY, IX1, IXN, IY1, IYN, & NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1, 0 ) ELSE DO IY=IY1,IYN YGBX = Y0 + REAL(IY-1)*SY DO IX=IX1, IXN XGBX = X0 + REAL(IX-1)*SX IF ( MXX(IX,IY) .NE. MFILL ) THEN IF ( IDFM .EQ. 3 ) THEN WRITE (NDSDAT) & XGBX, YGBX, MXX(IX,IY), MYY(IX,IY) ELSE WRITE (NDSDAT,951) & XGBX, YGBX, MXX(IX,IY), MYY(IX,IY) END IF END IF END DO END DO END IF ELSE IF ( FLTWO .OR. FLDIR ) THEN DO IX=IX1, IXN DO IY=IY1, IYN IF ( MAPSTA(IY,IX) .LE. 0 .OR. & XX(IX,IY) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL ELSE MXX(IX,IY) = NINT(XX(IX,IY)/FSC) MYY(IX,IY) = NINT(XY(IX,IY)/FSC) END IF END DO END DO IF ( IDLA .NE. 5 ) THEN CALL OUTA2I ( MXX, NX, NY, IX1, IXN, IY1, IYN, & NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1,0) CALL OUTA2I ( MYY, NX, NY, IX1, IXN, IY1, IYN, & NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1,0) ELSE DO IY=IY1,IYN DO IX=IX1, IXN YGBX = YGRD(IY,IX) XGBX = XGRD(IY,IX) IF ( MXX(IX,IY) .NE. MFILL ) THEN IF ( IDFM .EQ. 3 ) THEN WRITE (NDSDAT) & XGBX, YGBX, MXX(IX,IY), MYY(IX,IY) ELSE IF ( FLAGLL ) THEN WRITE (NDSDAT,951) XGBX, YGBX, & MXX(IX,IY), MYY(IX,IY) ELSE WRITE (NDSDAT,961) XGBX, YGBX, & MXX(IX,IY), MYY(IX,IY) END IF END IF END IF END DO END DO END IF ELSE DO IX=IX1, IXN DO IY=IY1, IYN IF ( MAPSTA(IY,IX) .LE. 0 .OR. & X1(IX,IY) .EQ. UNDEF ) THEN MX1(IX,IY) = MFILL ELSE MX1(IX,IY) = NINT(X1(IX,IY)/FSC) END IF END DO END DO IF ( IDLA .NE. 5 ) THEN CALL OUTA2I ( MX1, NX, NY, IX1, IXN, IY1, IYN, & NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1,0) ELSE DO IY=IY1,IYN DO IX=IX1, IXN YGBX = YGRD(IY,IX) XGBX = XGRD(IY,IX) IF ( MX1(IX,IY) .NE. MFILL ) THEN IF ( IDFM .EQ. 3 ) THEN WRITE (NDSDAT) & XGBX, YGBX, MX1(IX,IY) ELSE IF ( FLAGLL ) THEN WRITE (NDSDAT,951) XGBX, YGBX, & MX1(IX,IY) ELSE WRITE (NDSDAT,961) XGBX, YGBX, & MX1(IX,IY) END IF END IF END IF END DO END DO END IF END IF END IF ! CLOSE (NDSDAT) ! ELSE IF ( ITYPE .EQ. 4 ) THEN ! FNAME(13:) = ENAME JJ = LEN_TRIM(FNMPRE) OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME,ERR=800, & IOSTAT=IERR) WRITE (6,*) FNAME(1:16) ! IF ( FLTRI ) THEN WRITE (NDSDAT,980) FILEID, TIME, NSEA, 3, & FSC, ENAME, UNITS, GNAME WRITE(NDSDAT, 113) XS1 WRITE(NDSDAT, 113) XS2 WRITE(NDSDAT, 113) XS3 ENDIF IF ( FLTWO .OR. FLDIR ) THEN WRITE (NDSDAT,980) FILEID, TIME, NSEA, 2, & FSC, ENAME, UNITS, GNAME WRITE(NDSDAT, 113) XS1 WRITE(NDSDAT, 113) XS2 ENDIF IF ( FLONE ) THEN WRITE (NDSDAT,980) FILEID, TIME, NSEA, 1, & FSC, ENAME, UNITS, GNAME WRITE(NDSDAT, 113) XS1 ENDIF ! CLOSE (NDSDAT) ! END IF ! ! ... End of fields loop ! END IF END DO END DO ! RETURN ! ! Error escape locations ! 800 CONTINUE WRITE (NDSE,1000) IERR CALL EXTCDE (2) ! ! Formats ! 113 FORMAT ((10ES11.3)) 980 FORMAT (1X,A13,I9.8,I7.6,I9,I3,ES10.2,1X,A4,1X,A10,1X,A30) 940 FORMAT (1X,I8,3I3.2,2X,4E12.4) 949 FORMAT (1X,A13,I9.8,I7.6,2(2F8.2,I8), & 1X,A4,F8.4,1X,A10,2I2,1X,A11,I4) 950 FORMAT (1X,A13,1X,I9.8,1X,I7.6,2(1X,2F8.2,1X,I4), & 1X,A4,1X,A7,1X,A10,1X,2I2,1X,A11,1X,I4) 951 FORMAT (1X,2F10.5,2I8) 960 FORMAT (1X,A13,I9.8,I7.6,2(2E11.3,I4), & 1X,A4,1X,A7,1X,A10,2I2,1X,A11,I4) 961 FORMAT (1X,2E12.4,2I8) ! 990 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGO :'/ & ' GROUP',I2,' PARAMETER',I3,' NOT LISTED ' ) 999 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGO :'/ & ' PLEASE UPDATE FIELDS !!! '/) ! 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGO : '/ & ' ERROR IN OPENING OUTPUT FILE'/ & ' IOSTAT =',I5/) ! !/T 9000 FORMAT (' TEST W3EXGO : FLAGS :',I3,2X,20L2) !/T 9001 FORMAT (' TEST W3EXGO : ITPYE :',I4/ & !/T ' IX1/N/S :',3I4/ & !/T ' IY1/N/S :',3I4/ & !/T ' SCALE, VECTOR :',2L2/ & !/T ' NDSDAT :',I4) ! !/T 9012 FORMAT (' TEST W3EXGO : BLOK PARS : ',3I4) !/T 9014 FORMAT (' BASE NAME : ',A) ! !/T 9020 FORMAT (' TEST W3EXGO : OUTPUT FIELD : ',A) !/ !/ End of W3EXGO ----------------------------------------------------- / !/ END SUBROUTINE W3EXGO !/ ! !/ End of W3OUTF ----------------------------------------------------- / !/ END PROGRAM W3OUTF