Page 1 Source Listing 2014-09-16 16:51 multiwaveflds.f90 multiwaveflds.f90(1833): remark #8291: Recommended relationship between field width 'W' and the number of fractional digits 'D' i... WRITE(FSCS,'(G7.1)') FSC -------------------------------------^ Page 2 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1 !/ ------------------------------------------------------------------- / 2 PROGRAM WAVEFLDS 3 !/ 4 !/ +-----------------------------------+ 5 !/ | WAVEWATCH III NOAA/NCEP | 6 !/ | H. L. Tolman | 7 !/ | FORTRAN 90 | 8 !/ | Last update : 11-Nov-2013 | 9 !/ +-----------------------------------+ 10 !/ 11 !/ 19-Oct-1998 : Final FORTRAN 77 ( version 1.18 ) 12 !/ 19-Jan-2000 : Upgrade to FORTRAN 90 ( version 2.00 ) 13 !/ 24-Jan-2001 : Flat grid version ( version 2.06 ) 14 !/ 23-Apr-2002 : Clean-up ( version 2.19 ) 15 !/ 29-Apr-2002 : Adding output fields 17-18. ( version 2.20 ) 16 !/ 13-Nov-2002 : Add stress vector. ( version 3.00 ) 17 !/ 24-Dec-2004 : Multiple grid version. ( version 3.06 ) 18 !/ 21-Jul-2005 : Adding output fields 19-21. ( version 3.07 ) 19 !/ 28-Jun-2006 : Adding file name preamble. ( version 3.09 ) 20 !/ 05-Jul-2006 : Consolidate stress arrays. ( version 3.09 ) 21 !/ 28-Mar-2007 : Adding partitioned output. ( version 3.11 ) 22 !/ Adding user slots for outputs. 23 !/ 31-Jul-2007 : Fix file extension errors. ( version 3.12 ) 24 !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) 25 !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) 26 !/ (W. E. Rogers & T. J. Campbell, NRL) 27 !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 ) 28 !/ (W. E. Rogers & T. J. Campbell, NRL) 29 !/ 12-Dec-2012 : SMC grid sea-point text output.JG_Li( version 4.08 ) 30 !/ 25-Dec-2012 : New structure of output fields. ( version 4.11 ) 31 !/ Minor bug fixes and clean up. 32 !/ 11-Nov-2013 : SMC and rotated grid incorporated in the main 33 !/ trunk ( version 4.13 ) 34 !/ 35 !/ Copyright 2009-2012 National Weather Service (NWS), 36 !/ National Oceanic and Atmospheric Administration. All rights 37 !/ reserved. WAVEWATCH III is a trademark of the NWS. 38 !/ No unauthorized use without permission. 39 !/ 40 ! 1. Purpose : 41 ! 42 ! Post-processing of grid output. 43 ! 44 ! 2. Method : 45 ! 46 ! Data is read from the grid output file out_grd.ww3 (raw data) 47 ! and from the file multiwaveflds.inp ( NDSI, output requests ). 48 ! Model definition and raw data files are read using WAVEWATCH III 49 ! subroutines. 50 ! 51 ! Output types : 52 ! 1 : print plots 53 ! 2 : field statistics 54 ! 3 : transfer file 55 ! 4 : text output at sea points (1:NSEA). 56 ! 57 ! 3. Parameters : Page 3 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 58 ! 59 ! 4. Subroutines used : 60 ! 61 ! Name Type Module Description 62 ! ---------------------------------------------------------------- 63 ! W3NMOD Subr. W3GDATMD Set number of model. 64 ! W3SETG Subr. Id. Point to selected model. 65 ! W3NDAT Subr. W3WDATMD Set number of model for wave data. 66 ! W3SETW Subr. Id. Point to selected model for wave data. 67 ! W2NAUX Subr. W3ADATMD Set number of model for aux data. 68 ! W3SETA Subr. Id. Point to selected model for aux data. 69 ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. 70 ! STRACE Subr. Id. Subroutine tracing. 71 ! NEXTLN Subr. Id. Get next line from input file. 72 ! EXTCDE Subr. Id. Abort program as graceful as possible. 73 ! STME21 Subr. W3TIMEMD Convert time to string. 74 ! TICK21 Subr. Id. Advance time. 75 ! DSEC21 Func. Id. Difference between times. 76 ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file. 77 ! W3IOGO Subr. W3IOGOMD Reading/writing raw gridded data file. 78 ! W3EXGO Subr. Internal Execute grid output. 79 ! W3TXTS Subr. Internal Text output at sea points only. 80 ! ---------------------------------------------------------------- 81 ! 82 ! 5. Called by : 83 ! 84 ! None, stand-alone program. 85 ! 86 ! 6. Error messages : 87 ! 88 ! Checks on input, checks in W3IOxx. 89 ! 90 ! 7. Remarks : 91 ! 92 ! 8. Structure : 93 ! 94 ! See source code. 95 ! 96 ! 9. Switches : 97 ! 98 ! !/S Enable subroutine tracing. 99 ! 100 ! 10. Source code : 101 ! 102 !/ ------------------------------------------------------------------- / 103 USE CONSTANTS 104 !/ 105 ! USE W3GDATMD, ONLY: W3NMOD, W3SETG 106 USE W3WDATMD, ONLY: W3NDAT, W3SETW 107 USE W3ADATMD, ONLY: W3NAUX, W3SETA 108 USE W3ODATMD, ONLY: W3NOUT, W3SETO 109 USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE 110 USE W3TIMEMD 111 USE W3IOGRMD, ONLY: W3IOGR 112 USE W3IOGOMD, ONLY: W3IOGO, W3READFLGRD 113 !/ 114 USE W3GDATMD Page 4 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 115 USE W3WDATMD, ONLY: TIME, WLV, ICE, BERG, UST, USTDIR 116 USE W3ADATMD, ONLY: DW, UA, UD, AS, CX, CY, HS, WLM, T0M1, THM, & 117 THS, FP0, THP0, FP1, THP1, DTDYN, FCUT, & 118 ABA, ABD, UBA, UBD, SXX, SYY, SXY, USERO, & 119 PHS, PTP, PLP, PTH, PSI, PWS, PWST, PNR, & 120 TAUOX, TAUOY, TAUWIX,BHD, & 121 TAUWIY, PHIAW, PHIOC, TUSX, TUSY, PRMS, TPMS,& 122 USSX, USSY, MSSX, MSSY, MSCX, MSCY, CHARN, & 123 TAUWNX, TAUWNY, TAUBBL, PHIBBL, CFLXYMAX, & 124 CFLTHMAX, CFLKMAX, BEDFORMS, WHITECAP, T02, & 125 CGE, T01 126 USE W3ODATMD, ONLY: NDSO, NDSE, NDST, NOGRP, NGRPP, IDOUT, & 127 UNDEF, FLOGRD, FNMPRE, NOSWLL, NOGE 128 ! 129 IMPLICIT NONE 130 !/ 131 !/ ------------------------------------------------------------------- / 132 !/ Local parameters 133 !/ 134 INTEGER :: NDSI, NDSM, NDSOG, NDSDAT, NDSDT, & 135 NDSTRC, NTRACE, IERR, I, J, IFI, IFJ,& 136 TOUT(2), TDUM(2), IOTEST, NOUT, & 137 ITYPE, IX1, IXN, IXS, IY1, IYN, IYS, & 138 IDLA, IDFM, IOUT, IPART 139 REAL :: DTREQ, DTEST 140 CHARACTER :: COMSTR*1, IDTIME*23, IDDDAY*11, & 141 TABNME*9 142 LOGICAL :: FLREQ(NOGRP,NGRPP), FLOG(NOGRP), & 143 SCALE, VECTOR, LTEMP(NGRPP) 144 !/ 145 !/ ------------------------------------------------------------------- / 146 !/ 147 ! 1. IO set-up. 148 ! 149 CALL W3NMOD ( 1, 6, 6 ) 150 CALL W3SETG ( 1, 6, 6 ) 151 CALL W3NDAT ( 6, 6 ) 152 CALL W3SETW ( 1, 6, 6 ) 153 CALL W3NAUX ( 6, 6 ) 154 CALL W3SETA ( 1, 6, 6 ) 155 CALL W3NOUT ( 6, 6 ) 156 CALL W3SETO ( 1, 6, 6 ) 157 ! 158 NDSI = 10 159 NDSM = 20 160 NDSOG = 20 161 NDSDAT = 50 162 ! 163 NDSTRC = 6 164 NTRACE = 10 165 CALL ITRACE ( NDSTRC, NTRACE ) 166 ! 167 WRITE (NDSO,900) 168 ! 169 J = LEN_TRIM(FNMPRE) 170 OPEN (NDSI,FILE=FNMPRE(:J)//'multiwaveflds.inp',STATUS='OLD', & 171 ERR=800,IOSTAT=IERR) Page 5 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 172 READ (NDSI,'(A)',END=801,ERR=802) COMSTR 173 IF (COMSTR.EQ.' ') COMSTR = '$' 174 WRITE (NDSO,901) COMSTR 175 ! 176 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 177 ! 2. Read model definition file. 178 ! 179 CALL W3IOGR ( 'READ', NDSM ) 180 WRITE (NDSO,920) GNAME 181 ! 182 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 183 ! 3. Read general data and first fields from file 184 ! 185 CALL W3IOGO ( 'READ', NDSOG, IOTEST ) 186 ! 187 WRITE (NDSO,930) 188 DO IFI=1, NOGRP 189 DO IFJ=1, NGRPP 190 IF ( FLOGRD(IFI,IFJ) ) WRITE (NDSO,931) IDOUT(IFI,IFJ) 191 END DO 192 END DO 193 ! 194 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 195 ! 4. Read requests from input file. 196 ! Output times 197 ! 198 CALL NEXTLN ( COMSTR , NDSI , NDSE ) 199 READ (NDSI,*,END=801,ERR=802) TOUT, DTREQ, NOUT 200 DTREQ = MAX ( 0. , DTREQ ) 201 IF ( DTREQ.EQ.0. ) NOUT = 1 202 NOUT = MAX ( 1 , NOUT ) 203 ! 204 CALL STME21 ( TOUT , IDTIME ) 205 WRITE (NDSO,940) IDTIME 206 ! 207 TDUM = 0 208 CALL TICK21 ( TDUM , DTREQ ) 209 CALL STME21 ( TDUM , IDTIME ) 210 IF ( DTREQ .GE. 86400. ) THEN 211 WRITE (IDDDAY,'(I10,1X)') INT(DTREQ/86400.) 212 ELSE 213 IDDDAY = ' ' 214 END IF 215 IDTIME(1:11) = IDDDAY 216 IDTIME(21:23) = ' ' 217 WRITE (NDSO,941) IDTIME, NOUT 218 ! 219 ! ... Output fields 220 ! 221 CALL W3READFLGRD ( NDSI, NDSO, 9, NDSE, COMSTR, FLOG, & 222 FLREQ, 1, 1, IERR ) 223 IF (IERR.NE.0) GOTO 800 224 225 ! 226 ! ... Output type 227 ! 228 CALL NEXTLN ( COMSTR , NDSI , NDSE ) Page 6 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 229 READ (NDSI,*,END=801,ERR=802) ITYPE, IPART 230 !Li IF ( ITYPE.LT.0 .OR. ITYPE.GT.3 ) THEN 231 IF ( ITYPE.LT.0 .OR. ITYPE.GT.4 ) THEN 232 !Li Type 4 for text output at sea points. JGLi12Dec2012 233 WRITE (NDSE,1010) ITYPE 234 CALL EXTCDE ( 1 ) 235 END IF 236 IPART = MAX ( 0 , MIN ( NOSWLL , IPART ) ) 237 ! 238 ! ... ITYPE = 0 239 ! 240 IF ( ITYPE .EQ. 0 ) THEN 241 WRITE (NDSO,942) ITYPE, 'Checking contents of file' 242 DO 243 CALL STME21 ( TIME , IDTIME ) 244 WRITE (NDSO,943) IDTIME 245 CALL W3IOGO ( 'READ', NDSOG, IOTEST ) 246 IF ( IOTEST .EQ. -1 ) THEN 247 WRITE (NDSO,944) 248 GOTO 888 249 END IF 250 END DO 251 ! 252 ! ... ITYPE = 1 253 ! 254 ELSE IF (ITYPE .EQ. 1) THEN 255 WRITE (NDSO,942) ITYPE, 'Print plots' 256 CALL NEXTLN ( COMSTR , NDSI , NDSE ) 257 READ (NDSI,*,END=801,ERR=802) & 258 IX1, IXN, IXS, IY1, IYN, IYS, SCALE, VECTOR 259 IX1 = MAX ( IX1 , 1 ) 260 IXN = MIN ( IXN , NX ) 261 IXS = MAX ( IXS , 1 ) 262 IY1 = MAX ( IY1 , 1 ) 263 IYN = MIN ( IYN , NY ) 264 IYS = MAX ( IYS , 1 ) 265 WRITE (NDSO,1940) IX1, IXN, IXS, IY1, IYN, IYS 266 IF ( SCALE ) WRITE (NDSO,1941) 267 ! 268 ! ... ITYPE = 2 269 ! 270 ELSE IF (ITYPE .EQ. 2) THEN 271 WRITE (NDSO,942) ITYPE, 'Field statistics' 272 NDSDT = NDSDAT - 1 273 CALL NEXTLN ( COMSTR , NDSI , NDSE ) 274 READ (NDSI,*,END=801,ERR=802) IX1, IXN, IY1, IYN 275 IX1 = MAX ( IX1 , 1 ) 276 IXN = MIN ( IXN , NX ) 277 IY1 = MAX ( IY1 , 1 ) 278 IYN = MIN ( IYN , NY ) 279 WRITE (NDSO,2940) IX1, IXN, IY1, IYN 280 ! 281 ! ... ITYPE = 3 282 ! 283 ELSE IF (ITYPE .EQ. 3) THEN 284 WRITE (NDSO,942) ITYPE, 'Transfer files' 285 CALL NEXTLN ( COMSTR , NDSI , NDSE ) Page 7 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 286 READ (NDSI,*,END=801,ERR=802) & 287 IX1, IXN, IY1, IYN, IDLA, IDFM 288 IX1 = MAX ( IX1 , 1 ) 289 IXN = MIN ( IXN , NX ) 290 IY1 = MAX ( IY1 , 1 ) 291 IYN = MIN ( IYN , NY ) 292 IF (IDLA.LT.1 .OR. IDLA.GT.5) IDLA = 1 293 IF (IDFM.LT.1 .OR. IDFM.GT.3) IDFM = 1 294 VECTOR = .TRUE. 295 WRITE (NDSO,3940) IX1, IXN, IY1, IYN, IDLA, IDFM 296 ! 297 !Li Added sea-point output type 4. JGLi12Dec2012 298 ! 299 ! ... ITYPE = 4 300 ! 301 ELSE IF (ITYPE .EQ. 4) THEN 302 WRITE (NDSO,942) ITYPE, 'Full sea-point output.' 303 CALL NEXTLN ( COMSTR , NDSI , NDSE ) 304 READ (NDSI,*,END=801,ERR=802) & 305 IX1, IXN, IY1, IYN, IDLA, IDFM 306 !Li 307 ! 308 END IF 309 ! 310 ! ... Output of output fields 311 ! 312 IF ( ITYPE.NE.2 ) THEN 313 WRITE (NDSO,945) 314 ELSE 315 WRITE (NDSO,2945) 316 END IF 317 ! 318 DO IFI=1, NOGRP 319 DO IFJ=1, NGRPP 320 IF ( FLREQ(IFI,IFJ) ) THEN 321 IF ( FLOGRD(IFI,IFJ) ) THEN 322 IF ( ITYPE.NE.2 ) THEN 323 WRITE (NDSO,946) IDOUT(IFI,IFJ), ' ' 324 ELSE 325 J = LEN_TRIM(FNMPRE) 326 NDSDT = NDSDT + 1 327 WRITE (TABNME,'(A3,I2.2,A4)') 'tab', NDSDT, '.ww3' 328 WRITE (NDSO,2946) TABNME, IDOUT(IFI,IFJ) 329 OPEN (NDSDT,FILE=FNMPRE(:J)//TABNME) 330 WRITE (NDSDT,2947) IDOUT(IFI,IFJ) 331 END IF 332 ELSE 333 WRITE (NDSO,946) IDOUT(IFI,IFJ), '*** NOT AVAILABLE ***' 334 FLREQ(IFI,IFJ) = .FALSE. 335 END IF 336 END IF 337 END DO 338 END DO 339 ! 340 IF ( FLOG(4) ) THEN 341 IF ( IPART .EQ. 0 ) THEN 342 WRITE (NDSO,948) Page 8 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 343 ELSE 344 WRITE (NDSO,949) IPART 345 END IF 346 END IF 347 ! 348 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 349 ! 5. Time management. 350 ! 351 IOUT = 0 352 IF (ITYPE.EQ.3) WRITE (NDSO,970) 353 ! 354 DO 355 DTEST = DSEC21 ( TIME , TOUT ) 356 IF ( DTEST .GT. 0. ) THEN 357 CALL W3IOGO ( 'READ', NDSOG, IOTEST ) 358 IF ( IOTEST .EQ. -1 ) THEN 359 WRITE (NDSO,944) 360 GOTO 888 361 END IF 362 CYCLE 363 END IF 364 IF ( DTEST .LT. 0. ) THEN 365 CALL TICK21 ( TOUT , DTREQ ) 366 CYCLE 367 END IF 368 ! 369 IOUT = IOUT + 1 370 CALL STME21 ( TOUT , IDTIME ) 371 IF (ITYPE.EQ.1) THEN 372 WRITE (NDSO,950) IDTIME 373 ELSE IF (ITYPE.EQ.3) THEN 374 WRITE (NDSO,971) IDTIME 375 END IF 376 ! 377 CALL W3EXGO ( NX, NY, NSEA ) 378 ! 379 CALL TICK21 ( TOUT , DTREQ ) 380 IF ( IOUT .GE. NOUT ) EXIT 381 END DO 382 ! 383 IF (ITYPE.EQ.3) WRITE (NDSO,972) 384 ! 385 GOTO 888 386 ! 387 ! Escape locations read errors : 388 ! 389 800 CONTINUE 390 WRITE (NDSE,1000) IERR 391 CALL EXTCDE ( 10 ) 392 ! 393 801 CONTINUE 394 WRITE (NDSE,1001) 395 CALL EXTCDE ( 11 ) 396 ! 397 802 CONTINUE 398 WRITE (NDSE,1002) IERR 399 CALL EXTCDE ( 12 ) Page 9 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 400 ! 401 888 CONTINUE 402 WRITE (NDSO,999) 403 ! 404 ! Formats 405 ! 406 900 FORMAT (/15X,' *** WAVEWATCH III Field output postp. *** '/ & 407 15X,'==============================================='/) 408 901 FORMAT ( ' Comment character is ''',A,''''/) 409 ! 410 920 FORMAT ( ' Grid name : ',A/) 411 ! 412 930 FORMAT ( ' Fields in file : '/ & 413 ' --------------------------') 414 931 FORMAT ( ' ',A) 415 ! 416 940 FORMAT (/' Output time data : '/ & 417 ' --------------------------------------------------'/ & 418 ' First time : ',A) 419 941 FORMAT ( ' Interval : ',A/ & 420 ' Number of requests : ',I4) 421 942 FORMAT (/' Output type ',I2,' :'/ & 422 ' --------------------------------------------------'/ & 423 ' ',A/) 424 943 FORMAT ( ' Data for ',A) 425 944 FORMAT (/' End of file reached '/) 426 ! 427 945 FORMAT (/' Requested output fields : '/ & 428 ' --------------------------------------------------') 429 2945 FORMAT (/' Output files and fields : '/ & 430 ' --------------------------------------------------') 431 946 FORMAT ( ' ',A,2X,A) 432 2946 FORMAT ( ' ',A,' : ',A) 433 2947 FORMAT ( ' Statitics of ',A/ & 434 ' (time, min, max, avg, std)'/) 435 948 FORMAT (/' Partitioned field data for wind seas') 436 949 FORMAT (/' Partitioned field data for swell field',I2) 437 ! 438 1940 FORMAT ( ' X range and interval : ',3I5/ & 439 ' Y range and interval : ',3I5) 440 1941 FORMAT ( ' Data is normalized ') 441 ! 442 2940 FORMAT ( ' X range : ',2I5/ & 443 ' Y range : ',2I5) 444 ! 445 3940 FORMAT ( ' X range : ',2I5/ & 446 ' Y range : ',2I5/ & 447 ' Layout indicator : ',I5/ & 448 ' Format indicator : ',I5) 449 ! 450 950 FORMAT (//' Output for ',A/ & 451 ' --------------------------------------------------') 452 ! 453 970 FORMAT (//' Generating files '/ & 454 ' --------------------------------------------------') 455 971 FORMAT ( ' Files for ',A) 456 972 FORMAT ( ' ') Page 10 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 457 ! 458 999 FORMAT (/' End of program '/ & 459 ' ========================================='/ & 460 ' WAVEWATCH III Field output '/) 461 ! 462 1000 FORMAT (/' *** WAVEWATCH III ERROR IN WAVEFLDS : '/ & 463 ' ERROR IN OPENING INPUT FILE'/ & 464 ' IOSTAT =',I5/) 465 ! 466 1001 FORMAT (/' *** WAVEWATCH III ERROR IN WAVEFLDS : '/ & 467 ' PREMATURE END OF INPUT FILE'/) 468 ! 469 1002 FORMAT (/' *** WAVEWATCH III ERROR IN WAVEFLDS : '/ & 470 ' ERROR IN READING FROM INPUT FILE'/ & 471 ' IOSTAT =',I5/) 472 ! 473 1010 FORMAT (/' *** WAVEWATCH III ERROR IN WAVEFLDS : '/ & 474 ' ILLEGAL TYPE, ITYPE =',I4/) 475 !/ 476 !/ Internal subroutine W3EXGO ---------------------------------------- / 477 !/ 478 CONTAINS 479 !/ ------------------------------------------------------------------- / 480 SUBROUTINE W3EXGO ( NX, NY, NSEA ) 481 !/ 482 !/ +-----------------------------------+ 483 !/ | WAVEWATCH III NOAA/NCEP | 484 !/ | H. L. Tolman | 485 !/ | FORTRAN 90 | 486 !/ | Last update : 25-Dec-2012 | 487 !/ +-----------------------------------+ 488 !/ 489 !/ 26-Sep-1997 : Final FORTRAN 77 ( version 1.18 ) 490 !/ 19-Jan-2000 : Upgrade to FORTRAN 90 ( version 2.00 ) 491 !/ Massive changes to logistics 492 !/ 24-Jan-2001 : Flat grid version ( version 2.06 ) 493 !/ 23-Apr-2002 : Clean-up ( version 2.19 ) 494 !/ 29-Apr-2002 : Adding output fields 17-18. ( version 2.20 ) 495 !/ 16-Oct-2002 : Fix bound. error for stress output. ( version 3.00 ) 496 !/ 16-Oct-2002 : Fix statistical output for UNDEF. ( version 3.00 ) 497 !/ 13-Nov-2002 : Add stress vector. ( version 3.00 ) 498 !/ 24-Dec-2004 : Multiple grid version. ( version 3.06 ) 499 !/ 21-Jul-2005 : Adding output fields 19-21. ( version 3.07 ) 500 !/ 28-Jun-2006 : Adding file name preamble. ( version 3.09 ) 501 !/ 05-Jul-2006 : Consolidate stress arrays. ( version 3.09 ) 502 !/ 28-Mar-2007 : Adding partitioned output. ( version 3.11 ) 503 !/ Adding user slots for outputs. 504 !/ 31-Jul-2007 : Fix file extension errors. ( version 3.12 ) 505 !/ 25-Dec-2012 : New structure of output fields. ( version 4.11 ) 506 !/ 25-Jun-2013 : Add type 4 sea point text output. ( version 4.11 ) 507 !/ 508 ! 1. Purpose : 509 ! 510 ! Perform actual grid output. 511 ! 512 ! 3. Parameters : 513 ! Page 11 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 514 ! Parameter list 515 ! ---------------------------------------------------------------- 516 ! NX/Y Int. I Grid dimensions. 517 ! NSEA Int. I Number of sea points. 518 ! ---------------------------------------------------------------- 519 ! 520 ! Internal parameters 521 ! ---------------------------------------------------------------- 522 ! FLONE Log. Flags for one-dimensional field. 523 ! FLTWO Log. Flags for two-dimensional field X Y. 524 ! FLDIR Log. Flags for two-dimensional, directional field. 525 ! FLTRI Log. Flags for three dimensional field. 526 ! X1, X2, XX, XY 527 ! R.A. Output fields 528 ! ---------------------------------------------------------------- 529 ! 530 ! 4. Subroutines used : 531 ! 532 ! Name Type Module Description 533 ! ---------------------------------------------------------------- 534 ! STRACE Subr. W3SERVMD Subroutine tracing. 535 ! EXTCDE Subr. Id. Abort program as graceful as possible. 536 ! W3S2XY Subr. Id. Convert from storage to spatial grid. 537 ! PRTBLK Subr. W3ARRYMD Print plot of array. 538 ! OUTA2I Subr. Id. Print array of INTEGERS. 539 ! ---------------------------------------------------------------- 540 ! 541 ! 5. Called by : 542 ! 543 ! Main program in which it is contained. 544 ! 545 ! 6. Error messages : 546 ! 547 ! None. 548 ! 549 ! 7. Remarks : 550 ! 551 ! - Note that arrays CX and CY of the main program now contain 552 ! the absolute current speed and direction respectively. 553 ! 554 ! 8. Structure : 555 ! 556 ! See source code. 557 ! 558 ! 9. Switches : 559 ! 560 ! !/S Enable subroutine tracing. 561 ! !/T Enable test output. 562 ! 563 ! 10. Source code : 564 ! 565 !/ ------------------------------------------------------------------- / 566 USE W3SERVMD, ONLY : W3S2XY 567 USE W3ARRYMD, ONLY : OUTA2I, PRTBLK 568 !/ 569 !/ ------------------------------------------------------------------- / 570 !/ Parameter list Page 12 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 571 !/ 572 INTEGER :: NX, NY, NSEA 573 !/ 574 !/ ------------------------------------------------------------------- / 575 !/ Local parameters 576 !/ 577 INTEGER :: NXMAX, NXTOT, NBLOK, IH, IM, IS, & 578 MFILL, J, ISEA, IX, IY, IXB, IB, & 579 IXA, NINGRD, JJ, IFI, IFJ 580 INTEGER :: MAP(NX+1,NY), MP2(NX+1,NY), & 581 MX1(NX,NY), MXX(NX,NY), MYY(NX,NY), & 582 MXY(NX,NY) 583 INTEGER, SAVE :: IPASS 584 ! INTEGER, SAVE :: NCOL = 80 585 INTEGER, SAVE :: NCOL = 132 586 REAL :: FSC, CABS, UABS, FSCA, XMIN, XMAX, & 587 XAVG, XSTD, YGBX, XGBX, AABS 588 REAL :: X1(NX+1,NY), X2(NX+1,NY), & 589 XX(NX+1,NY), XY(NX+1,NY), DPTMAX(1) 590 !!Li Type 4 sea point only text output variables. JGLi25Jun2013 591 REAL, Dimension(NSEA) :: XS1, XS2, XS3, XS4 592 !!Li 593 DOUBLE PRECISION :: XDS, XDSQ 594 LOGICAL :: FLONE, FLTWO, FLDIR, FLTRI 595 CHARACTER :: OLDTID*8, FNAME*16, ENAME*4, & 596 FORMG*12, FORMF*11, UNITS*10, FSCS*7 597 CHARACTER, SAVE :: TIMEID*8 = '00000000' 598 CHARACTER, SAVE :: FILEID*13 = 'WAVEWATCH III' 599 !/ 600 !/ ------------------------------------------------------------------- / 601 !/ 602 ! 603 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 604 ! 1. Preparations 605 ! 606 X1 = UNDEF 607 X2 = UNDEF 608 XX = UNDEF 609 XY = UNDEF 610 !!Li Type 4 sea point only variables 611 XS1 = UNDEF 612 XS2 = UNDEF 613 XS3 = UNDEF 614 XS4 = UNDEF 615 ! 616 ! Number of print-plots 617 ! 618 IF ( ITYPE .EQ. 1 ) THEN 619 IF ( SCALE ) THEN 620 NXMAX = ( NCOL - 10 ) / 2 621 ELSE 622 NXMAX = ( NCOL - 10 ) / 5 623 END IF 624 NXTOT = 1 + (IXN-IX1)/IXS 625 NBLOK = 1 + (NXTOT-1)/NXMAX 626 END IF 627 ! Page 13 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 628 ! Output file unit number 629 ! 630 IF ( ITYPE .EQ. 2 ) THEN 631 NDSDT = NDSDAT - 1 632 IH = TIME(2) / 10000 633 IM = MOD ( TIME(2) , 10000 ) / 100 634 IS = MOD ( TIME(2) , 100 ) 635 END IF 636 ! 637 ! Set-up transfer files 638 ! 639 !!Li Type 4 share filename with type 3 JGLi25Jun2013 640 !! IF ( ITYPE .EQ. 3 ) THEN 641 IF ( ITYPE .EQ. 3 .OR. ITYPE .EQ. 4 ) THEN 642 MFILL = -999 643 OLDTID = TIMEID 644 WRITE (TIMEID,'(I6.6,I2.2)') MOD( TIME(1) , 1000000 ), & 645 TIME(2)/10000 646 FNAME(05:12) = TIMEID 647 FNAME(13:13) = '.' 648 IF ( TIMEID .NE. OLDTID ) THEN 649 FNAME(1:4) = 'ww3.' 650 IPASS = 1 651 ELSE 652 WRITE (ENAME,'(A1,I2.2,A1)') 'e', IPASS, '.' 653 FNAME(1:4) = ENAME 654 IPASS = IPASS + 1 655 END IF 656 FORMG = '((10G12.2))' 657 END IF 658 ! 659 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 660 ! 2. Loop over output fields. 661 ! 662 DO IFI=1, NOGRP 663 DO IFJ=1, NGRPP 664 IF ( FLREQ(IFI,IFJ) ) THEN 665 ! 666 FORMF = '(1X,32I4)' 667 ! 668 ! 2.a Set output arrays and parameters 669 670 FLONE = .FALSE. 671 FLTWO = .FALSE. 672 FLDIR = .FALSE. 673 FLTRI = .FALSE. 674 ! 675 IF ( IFI .EQ. 1 .AND. IFJ .EQ. 1 ) THEN 676 FLONE = .TRUE. 677 DPTMAX = MAXVAL ( DW(1:NSEA) ) 678 FSC = 1. 679 IF ( DPTMAX(1) .GT. 999. ) THEN 680 FSC = 0.1 681 ELSE IF ( DPTMAX(1) .GT. 99.9 ) THEN 682 FSC = 0.1 683 ELSE IF ( DPTMAX(1) .GT. 9.99 ) THEN 684 FSC = 0.01 Page 14 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 685 END IF 686 IF ( ITYPE .EQ. 3 ) FSC = 0.01 687 UNITS = 'm' 688 ENAME = '.dpt' 689 FORMF = '(1X,17I7)' 690 IF ( ITYPE .EQ. 4 ) THEN 691 XS1 = DW(1:NSEA) 692 ELSE 693 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, DW(1:NSEA) & 694 , MAPSF, X1 ) 695 ENDIF 696 ! 697 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 2 ) THEN 698 IF ( VECTOR ) THEN 699 FLTWO = .TRUE. 700 ELSE 701 FLDIR = .TRUE. 702 END IF 703 FSC = 0.01 704 ENAME = '.cur' 705 UNITS = 'm s-1' 706 FORMF = '(1X,17I7)' 707 IF ( ITYPE .EQ. 4 ) THEN 708 XS1 = CX(1:NSEA) 709 XS2 = CY(1:NSEA) 710 ELSE 711 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CX(1:NSEA) & 712 , MAPSF, XX ) 713 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CY(1:NSEA) & 714 , MAPSF, XY ) 715 ENDIF 716 DO ISEA=1, NSEA 717 CABS = SQRT(CX(ISEA)**2+CY(ISEA)**2) 718 IF ( CABS .GT. 0.05 ) THEN 719 CY(ISEA) = MOD ( 630. - & 720 RADE*ATAN2(CY(ISEA),CX(ISEA)) , 360. ) 721 ELSE 722 CY(ISEA) = UNDEF 723 END IF 724 CX(ISEA) = CABS 725 END DO 726 IF ( ITYPE .EQ. 4 ) THEN 727 XS3 = CX(1:NSEA) 728 XS4 = CY(1:NSEA) 729 ELSE 730 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CX(1:NSEA) & 731 , MAPSF, X1 ) 732 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CY(1:NSEA) & 733 , MAPSF, X2 ) 734 ENDIF 735 ! 736 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 3 ) THEN 737 IF ( VECTOR ) THEN 738 FLTWO = .TRUE. 739 ELSE 740 FLDIR = .TRUE. 741 END IF Page 15 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 742 FSC = 0.1 743 ENAME = '.wnd' 744 UNITS = 'm s-1' 745 IF ( ITYPE .EQ. 4 ) THEN 746 XS1 = UA(1:NSEA) 747 XS2 = UD(1:NSEA) 748 ELSE 749 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UA(1:NSEA) & 750 , MAPSF, XX ) 751 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UD(1:NSEA) & 752 , MAPSF, XY ) 753 ENDIF 754 DO ISEA=1, NSEA 755 UABS = SQRT(UA(ISEA)**2+UD(ISEA)**2) 756 IF ( UABS .GT. 1.0 ) THEN 757 UD(ISEA) = MOD ( 630. - & 758 RADE*ATAN2(UD(ISEA),UA(ISEA)) , 360. ) 759 ELSE 760 UD(ISEA) = UNDEF 761 END IF 762 UA(ISEA) = UABS 763 END DO 764 IF ( ITYPE .EQ. 4 ) THEN 765 XS3 = UA(1:NSEA) 766 XS4 = UD(1:NSEA) 767 ELSE 768 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UA(1:NSEA) & 769 , MAPSF, X1 ) 770 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UD(1:NSEA) & 771 , MAPSF, X2 ) 772 ENDIF 773 ! 774 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 4 ) THEN 775 FLONE = .TRUE. 776 FSC = 0.1 777 ENAME = '.ast' 778 UNITS = 'K' 779 IF ( ITYPE .EQ. 4 ) THEN 780 XS1 = AS(1:NSEA) 781 ELSE 782 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, AS(1:NSEA) & 783 , MAPSF, X1 ) 784 ENDIF 785 ! 786 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 5 ) THEN 787 FLONE = .TRUE. 788 FSC = 0.01 789 UNITS = 'm' 790 ENAME = '.wlv' 791 IF ( ITYPE .EQ. 4 ) THEN 792 XS1 = WLV 793 ELSE 794 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WLV , MAPSF, X1 ) 795 ENDIF 796 ! 797 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 6 ) THEN 798 FLONE = .TRUE. Page 16 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 799 FSC = 0.001 800 UNITS = '1' 801 ENAME = '.ice' 802 IF ( ITYPE .EQ. 4 ) THEN 803 XS1 = ICE 804 ELSE 805 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, ICE , MAPSF, X1 ) 806 ENDIF 807 ! 808 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 7 ) THEN 809 FLONE = .TRUE. 810 FSC = 0.0002 811 UNITS = 'km-1' 812 ENAME = '.ibg' 813 WHERE ( BERG.NE.UNDEF) BERG = BERG*0.1 814 IF ( ITYPE .EQ. 4 ) THEN 815 XS1 = BERG 816 ELSE 817 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BERG , MAPSF, X1 ) 818 ENDIF 819 ! 820 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 1 ) THEN 821 FLONE = .TRUE. 822 FSC = 0.01 823 UNITS = 'm' 824 ENAME = '.hs' 825 IF ( ITYPE .EQ. 4 ) THEN 826 XS1 = HS 827 ELSE 828 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, HS , MAPSF, X1 ) 829 ENDIF 830 ! 831 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 2 ) THEN 832 FLONE = .TRUE. 833 FSC = 1. 834 UNITS = 'm' 835 ENAME = '.lm' 836 IF ( ITYPE .EQ. 4 ) THEN 837 XS1 = WLM 838 ELSE 839 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WLM , MAPSF, X1 ) 840 ENDIF 841 ! 842 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 3 ) THEN 843 FLONE = .TRUE. 844 FSC = 0.01 845 UNITS = 's' 846 ENAME = '.t02' 847 IF ( ITYPE .EQ. 4 ) THEN 848 XS1 = T02 849 ELSE 850 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, T02 , MAPSF, X1 ) 851 ENDIF 852 ! 853 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 4 ) THEN 854 FLONE = .TRUE. 855 FSC = 0.01 Page 17 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 856 UNITS = 's' 857 ENAME = '.t0m1' 858 IF ( ITYPE .EQ. 4 ) THEN 859 XS1 = T0M1 860 ELSE 861 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, T0M1 , MAPSF, X1 ) 862 ENDIF 863 ! 864 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 5 ) THEN 865 FLONE = .TRUE. 866 FSC = 0.01 867 UNITS = 's' 868 ENAME = '.t01' 869 IF ( ITYPE .EQ. 4 ) THEN 870 XS1 = T01 871 ELSE 872 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, T01 , MAPSF, X1 ) 873 ENDIF 874 ! 875 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 6 ) THEN 876 FLONE = .TRUE. 877 FSC = 0.001 878 UNITS = 's-1' 879 ENAME = '.fp' 880 IF ( ITYPE .EQ. 4 ) THEN 881 XS1 = FP0 882 ELSE 883 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, FP0 , MAPSF, X1 ) 884 ENDIF 885 ! 886 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 7 ) THEN 887 FLONE = .TRUE. 888 FSC = 1. 889 UNITS = 'degree' 890 ENAME = '.dir' 891 DO ISEA=1, NSEA 892 IF ( THM(ISEA) .NE. UNDEF ) & 893 THM(ISEA) = MOD ( 630. - RADE*THM(ISEA) , 360. ) 894 END DO 895 IF ( ITYPE .EQ. 4 ) THEN 896 XS1 = THM 897 ELSE 898 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, THM , MAPSF, X1 ) 899 ENDIF 900 ! 901 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 8 ) THEN 902 FLONE = .TRUE. 903 FSC = 0.1 904 UNITS = 'degree' 905 ENAME = '.spr' 906 IF ( ITYPE .EQ. 4 ) THEN 907 XS1 = THS 908 ELSE 909 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, THS , MAPSF, X1 ) 910 ENDIF 911 ! 912 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 9 ) THEN Page 18 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 913 FLONE = .TRUE. 914 FSC = 1. 915 UNITS = 'degree' 916 ENAME = '.dp' 917 DO ISEA=1, NSEA 918 IF ( THP0(ISEA) .NE. UNDEF ) THEN 919 THP0(ISEA) = MOD ( 630-RADE*THP0(ISEA) , 360. ) 920 END IF 921 END DO 922 IF ( ITYPE .EQ. 4 ) THEN 923 XS1 = THP0 924 ELSE 925 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, THP0 , MAPSF, X1 ) 926 ENDIF 927 ! 928 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 1 ) THEN 929 FLONE = .TRUE. 930 FSC = 0.01 931 UNITS = 'm' 932 ENAME = '.phs' 933 IF ( ITYPE .EQ. 4 ) THEN 934 XS1 = PHS(:,IPART) 935 ELSE 936 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PHS(:,IPART) & 937 , MAPSF, X1 ) 938 ENDIF 939 ! 940 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 2 ) THEN 941 FLONE = .TRUE. 942 FSC = 0.01 943 UNITS = 's' 944 ENAME = '.ptp' 945 IF ( ITYPE .EQ. 4 ) THEN 946 XS1 = PTP(:,IPART) 947 ELSE 948 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PTP(:,IPART) & 949 , MAPSF, X1 ) 950 ENDIF 951 ! 952 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 3 ) THEN 953 FLONE = .TRUE. 954 FSC = 1. 955 UNITS = 'm' 956 ENAME = '.plp' 957 IF ( ITYPE .EQ. 4 ) THEN 958 XS1 = PLP(:,IPART) 959 ELSE 960 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PLP(:,IPART) & 961 , MAPSF, X1 ) 962 ENDIF 963 ! 964 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 4 ) THEN 965 FLONE = .TRUE. 966 FSC = 1. 967 UNITS = 'degree' 968 ENAME = '.pdir' 969 DO ISEA=1, NSEA Page 19 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 970 IF ( PTH(ISEA,IPART) .NE. UNDEF ) THEN 971 PTH(ISEA,IPART) = & 972 MOD ( 630-RADE*PTH(ISEA,IPART) , 360. ) 973 END IF 974 END DO 975 IF ( ITYPE .EQ. 4 ) THEN 976 XS1 = PTH(:,IPART) 977 ELSE 978 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PTH(:,IPART) & 979 , MAPSF, X1 ) 980 ENDIF 981 ! 982 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 5 ) THEN 983 FLONE = .TRUE. 984 FSC = 0.1 985 UNITS = 'degree' 986 ENAME = '.pspr' 987 IF ( ITYPE .EQ. 4 ) THEN 988 XS1 = PSI(:,IPART) 989 ELSE 990 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PSI(:,IPART) & 991 , MAPSF, X1 ) 992 ENDIF 993 ! 994 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 6 ) THEN 995 FLONE = .TRUE. 996 FSC = 0.001 997 UNITS = '1' 998 ENAME = '.pws' 999 IF ( ITYPE .EQ. 4 ) THEN 1000 XS1 = PWS(:,IPART) 1001 ELSE 1002 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PWS(:,IPART) & 1003 , MAPSF, X1 ) 1004 ENDIF 1005 ! 1006 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 7 ) THEN 1007 FLONE = .TRUE. 1008 FSC = 0.001 1009 UNITS = '1' 1010 ENAME = '.tws' 1011 IF ( ITYPE .EQ. 4 ) THEN 1012 XS1 = PWST(:) 1013 ELSE 1014 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PWST(:), MAPSF, X1 ) 1015 ENDIF 1016 ! 1017 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 8 ) THEN 1018 FLONE = .TRUE. 1019 FSC = 1. 1020 UNITS = '1' 1021 ENAME = '.pnr' 1022 IF ( ITYPE .EQ. 4 ) THEN 1023 XS1 = PNR(:) 1024 ELSE 1025 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PNR(:), MAPSF, X1 ) 1026 ENDIF Page 20 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1027 ! 1028 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 1 ) THEN 1029 IF ( VECTOR ) THEN 1030 FLTWO = .TRUE. 1031 ELSE 1032 FLDIR = .TRUE. 1033 END IF 1034 FSC = 0.001 1035 ENAME = '.ust' 1036 FORMF = '(1X,20I6)' 1037 UNITS = 'm s-1' 1038 IF ( ITYPE .EQ. 4 ) THEN 1039 XS1 = UST (1:NSEA) 1040 XS2 = USTDIR(1:NSEA) 1041 ELSE 1042 CALL W3S2XY (NSEA,NSEA,NX+1,NY, UST (1:NSEA) & 1043 , MAPSF, XX ) 1044 CALL W3S2XY (NSEA,NSEA,NX+1,NY, USTDIR(1:NSEA) & 1045 , MAPSF, XY ) 1046 ENDIF 1047 DO ISEA=1, NSEA 1048 UABS = SQRT(UST(ISEA)**2+USTDIR(ISEA)**2) 1049 IF ( UST(ISEA) .EQ. UNDEF ) THEN 1050 USTDIR(ISEA) = UNDEF 1051 UABS = UNDEF 1052 ELSE IF ( UABS .GT. 0.05 ) THEN 1053 USTDIR(ISEA) = MOD ( 630. - & 1054 RADE*ATAN2(USTDIR(ISEA),UST(ISEA)) , 360. ) 1055 ELSE 1056 USTDIR(ISEA) = UNDEF 1057 END IF 1058 UST(ISEA) = UABS 1059 END DO 1060 IF ( ITYPE .EQ. 4 ) THEN 1061 XS3 = UST (1:NSEA) 1062 XS4 = USTDIR(1:NSEA) 1063 ELSE 1064 CALL W3S2XY (NSEA,NSEA,NX+1,NY, UST (1:NSEA) & 1065 , MAPSF, X1 ) 1066 CALL W3S2XY (NSEA,NSEA,NX+1,NY, USTDIR(1:NSEA) & 1067 , MAPSF, X2 ) 1068 ENDIF 1069 ! 1070 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 2 ) THEN 1071 FLONE = .TRUE. 1072 FSC = 1.E-6 1073 UNITS = '1' 1074 ENAME = '.cha' 1075 IF ( ITYPE .EQ. 4 ) THEN 1076 XS1 = CHARN(1:NSEA) 1077 ELSE 1078 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CHARN(1:NSEA) & 1079 , MAPSF, X1 ) 1080 ENDIF 1081 ! 1082 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 3 ) THEN 1083 FLONE = .TRUE. Page 21 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1084 FSC = 0.1 !0.01 1085 UNITS = 'kW m-1' 1086 ENAME = '.cge' 1087 DO ISEA=1, NSEA 1088 IF ( CGE(ISEA) .NE. UNDEF ) & 1089 CGE(ISEA) = 0.001 * CGE(ISEA) 1090 END DO 1091 IF ( ITYPE .EQ. 4 ) THEN 1092 XS1 = CGE(1:NSEA) 1093 ELSE 1094 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CGE(1:NSEA) & 1095 , MAPSF, X1 ) 1096 ENDIF 1097 ! 1098 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 4 ) THEN 1099 FLONE = .TRUE. 1100 FSC = 0.01 1101 UNITS = 'W m-2' 1102 ENAME = '.faw' 1103 DO ISEA=1, NSEA 1104 PHIAW(ISEA)=MIN(99.98,PHIAW(ISEA)) 1105 END DO 1106 IF ( ITYPE .EQ. 4 ) THEN 1107 XS1 = PHIAW(1:NSEA) 1108 ELSE 1109 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PHIAW(1:NSEA) & 1110 , MAPSF, X1 ) 1111 ENDIF 1112 ! 1113 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 5 ) THEN 1114 IF ( VECTOR ) THEN 1115 FLTWO = .TRUE. 1116 ELSE 1117 FLDIR = .TRUE. 1118 END IF 1119 FSC = 1.E-6 1120 UNITS = 'm2 s-2' 1121 ENAME = '.taw' 1122 IF ( ITYPE .EQ. 4 ) THEN 1123 XS1 = TAUWIX(1:NSEA) 1124 XS2 = TAUWIY(1:NSEA) 1125 ELSE 1126 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIX(1:NSEA) & 1127 , MAPSF, XX ) 1128 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIY(1:NSEA) & 1129 , MAPSF, XY ) 1130 ENDIF 1131 DO ISEA=1, NSEA 1132 CABS = SQRT(TAUWIX(ISEA)**2+TAUWIY(ISEA)**2) 1133 IF ( TAUWIX(ISEA) .EQ. UNDEF ) THEN 1134 TAUWIY(ISEA) = UNDEF 1135 CABS = UNDEF 1136 ELSE IF ( TAUWIX(ISEA) .EQ. 0. .AND. & 1137 TAUWIY(ISEA) .EQ. 0. ) THEN 1138 TAUWIY(ISEA) = UNDEF 1139 ELSE 1140 TAUWIY(ISEA) = MOD ( 630. - & Page 22 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1141 RADE*ATAN2(TAUWIY(ISEA),TAUWIX(ISEA)) , 360. ) 1142 END IF 1143 TAUWIX(ISEA) = CABS 1144 END DO 1145 IF ( ITYPE .EQ. 4 ) THEN 1146 XS3 = TAUWIX(1:NSEA) 1147 XS4 = TAUWIY(1:NSEA) 1148 ELSE 1149 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIX(1:NSEA) & 1150 , MAPSF, X1 ) 1151 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIY(1:NSEA) & 1152 , MAPSF, X2 ) 1153 ENDIF 1154 ! 1155 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 6 ) THEN 1156 IF ( VECTOR ) THEN 1157 FLTWO = .TRUE. 1158 ELSE 1159 FLDIR = .TRUE. 1160 END IF 1161 FSC = 1.E-6 1162 UNITS = 'm2 s-2' 1163 ENAME = '.twa' 1164 IF ( ITYPE .EQ. 4 ) THEN 1165 XS1 = TAUWNX(1:NSEA) 1166 XS2 = TAUWNY(1:NSEA) 1167 ELSE 1168 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWNX(1:NSEA) & 1169 , MAPSF, XX ) 1170 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWNY(1:NSEA) & 1171 , MAPSF, XY ) 1172 ENDIF 1173 DO ISEA=1, NSEA 1174 CABS = SQRT(TAUWNX(ISEA)**2+TAUWNY(ISEA)**2) 1175 IF ( TAUWNX(ISEA) .EQ. UNDEF ) THEN 1176 TAUWNY(ISEA) = UNDEF 1177 CABS = UNDEF 1178 ELSE IF ( TAUWNX(ISEA) .EQ. 0. .AND. & 1179 TAUWNY(ISEA) .EQ. 0. ) THEN 1180 TAUWNY(ISEA) = UNDEF 1181 ELSE 1182 TAUWNY(ISEA) = MOD ( 630. - & 1183 RADE*ATAN2(TAUWNY(ISEA),TAUWNX(ISEA)) , 360. ) 1184 END IF 1185 TAUWNX(ISEA) = CABS 1186 END DO 1187 IF ( ITYPE .EQ. 4 ) THEN 1188 XS3 = TAUWNX(1:NSEA) 1189 XS4 = TAUWNY(1:NSEA) 1190 ELSE 1191 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWNX(1:NSEA) & 1192 , MAPSF, X1 ) 1193 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWNY(1:NSEA) & 1194 , MAPSF, X2 ) 1195 ENDIF 1196 ! 1197 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 7 ) THEN Page 23 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1198 FLONE = .TRUE. 1199 FSC = 0.001 1200 UNITS = '1' 1201 ENAME = '.wcc' 1202 IF ( ITYPE .EQ. 4 ) THEN 1203 XS1 = WHITECAP(1:NSEA,1) 1204 ELSE 1205 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,1) & 1206 , MAPSF, X1 ) 1207 ENDIF 1208 ! 1209 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 8 ) THEN 1210 FLONE = .TRUE. 1211 FSC = 0.1 1212 UNITS = 'm' 1213 ENAME = '.wcf' 1214 IF ( ITYPE .EQ. 4 ) THEN 1215 XS1 = WHITECAP(1:NSEA,2) 1216 ELSE 1217 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,2) & 1218 , MAPSF, X1 ) 1219 ENDIF 1220 ! 1221 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 9 ) THEN 1222 FLONE = .TRUE. 1223 FSC = 0.1 1224 UNITS = 'm' 1225 ENAME = '.wch' 1226 IF ( ITYPE .EQ. 4 ) THEN 1227 XS1 = WHITECAP(1:NSEA,3) 1228 ELSE 1229 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,3) & 1230 , MAPSF, X1 ) 1231 ENDIF 1232 ! 1233 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 10 ) THEN 1234 FLONE = .TRUE. 1235 FSC = 0.1 1236 UNITS = '1' 1237 ENAME = '.wcm' 1238 IF ( ITYPE .EQ. 4 ) THEN 1239 XS1 = WHITECAP(1:NSEA,4) 1240 ELSE 1241 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,4) & 1242 , MAPSF, X1 ) 1243 ENDIF 1244 ! 1245 ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 1 ) THEN 1246 FLTRI = .TRUE. 1247 FSC = 10. 1248 UNITS = 'N m-1' 1249 ENAME = '.sxy' 1250 IF ( ITYPE .EQ. 4 ) THEN 1251 XS1 = SXX(1:NSEA) 1252 XS2 = SYY(1:NSEA) 1253 XS3 = SXY(1:NSEA) 1254 ELSE Page 24 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1255 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, SXX(1:NSEA) & 1256 , MAPSF, X1 ) 1257 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, SYY(1:NSEA) & 1258 , MAPSF, X2 ) 1259 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, SXY(1:NSEA) & 1260 , MAPSF, XY ) 1261 ENDIF 1262 ! 1263 ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 2 ) THEN 1264 IF ( VECTOR ) THEN 1265 FLTWO = .TRUE. 1266 ELSE 1267 FLDIR = .TRUE. 1268 END IF 1269 FSC = 1.E-6 1270 UNITS = 'm2 s-2' 1271 ENAME = '.two' 1272 IF ( ITYPE .EQ. 4 ) THEN 1273 XS1 = TAUOX(1:NSEA) 1274 XS2 = TAUOY(1:NSEA) 1275 ELSE 1276 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUOX(1:NSEA) & 1277 , MAPSF, XX ) 1278 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUOY(1:NSEA) & 1279 , MAPSF, XY ) 1280 ENDIF 1281 DO ISEA=1, NSEA 1282 UABS = SQRT(TAUOX(ISEA)**2+TAUOY(ISEA)**2) 1283 IF ( TAUOX(ISEA) .EQ. UNDEF ) THEN 1284 TAUOY(ISEA) = UNDEF 1285 UABS = UNDEF 1286 ELSE IF ( UABS .GT. 1.E-8 ) THEN 1287 TAUOY(ISEA) = MOD ( 630. - & 1288 RADE*ATAN2(TAUOY(ISEA),TAUOX(ISEA)) , 360. ) 1289 ELSE 1290 TAUOY(ISEA) = UNDEF 1291 END IF 1292 TAUOX(ISEA) = UABS 1293 END DO 1294 IF ( ITYPE .EQ. 4 ) THEN 1295 XS3 = TAUOX(1:NSEA) 1296 XS4 = TAUOY(1:NSEA) 1297 ELSE 1298 CALL W3S2XY (NSEA,NSEA,NX+1,NY, TAUOX(1:NSEA) & 1299 , MAPSF, X1 ) 1300 CALL W3S2XY (NSEA,NSEA,NX+1,NY, TAUOY(1:NSEA) & 1301 , MAPSF, X2 ) 1302 ENDIF 1303 ! 1304 ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ.3 ) THEN 1305 FLONE = .TRUE. 1306 FSC = 0.001 1307 UNITS = 'N m-1' 1308 ENAME = '.bhd' 1309 IF ( ITYPE .EQ. 4 ) THEN 1310 XS1 = BHD(1:NSEA) 1311 ELSE Page 25 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1312 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BHD(1:NSEA) & 1313 , MAPSF, X1 ) 1314 ENDIF 1315 ! 1316 ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 4 ) THEN 1317 FLONE = .TRUE. 1318 FSC = 0.1 1319 UNITS = 'W m-2' 1320 ENAME = '.foc' 1321 DO ISEA=1, NSEA 1322 PHIOC(ISEA)=MIN(99.98,PHIOC(ISEA)) 1323 END DO 1324 IF ( ITYPE .EQ. 4 ) THEN 1325 XS1 = PHIOC(1:NSEA) 1326 ELSE 1327 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PHIOC(1:NSEA) & 1328 , MAPSF, X1 ) 1329 ENDIF 1330 ! 1331 ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 5 ) THEN 1332 IF ( VECTOR ) THEN 1333 FLTWO = .TRUE. 1334 ELSE 1335 FLDIR = .TRUE. 1336 END IF 1337 FSC = 0.001 1338 UNITS = 'm2 s-1' 1339 ENAME = '.tus' 1340 IF ( ITYPE .EQ. 4 ) THEN 1341 XS1 = TUSX(1:NSEA) 1342 XS2 = TUSY(1:NSEA) 1343 ELSE 1344 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TUSX(1:NSEA) & 1345 , MAPSF, XX ) 1346 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TUSY(1:NSEA) & 1347 , MAPSF, XY ) 1348 ENDIF 1349 DO ISEA=1, NSEA 1350 CABS = SQRT(TUSX(ISEA)**2+TUSY(ISEA)**2) 1351 IF ( TUSX(ISEA) .NE. UNDEF ) THEN 1352 TUSY(ISEA) = MOD ( 630. - & 1353 RADE*ATAN2(TUSY(ISEA),TUSX(ISEA)) , 360. ) 1354 ELSE 1355 TUSY(ISEA) = UNDEF 1356 CABS = UNDEF 1357 END IF 1358 TUSX(ISEA) = CABS 1359 END DO 1360 IF ( ITYPE .EQ. 4 ) THEN 1361 XS3 = TUSX(1:NSEA) 1362 XS4 = TUSY(1:NSEA) 1363 ELSE 1364 CALL W3S2XY ( NSEA, NSEA, NX+1, NY,TUSX,MAPSF, X1 ) 1365 CALL W3S2XY ( NSEA, NSEA, NX+1, NY,TUSY,MAPSF, X2 ) 1366 ENDIF 1367 ! 1368 ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 6 ) THEN Page 26 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1369 IF ( VECTOR ) THEN 1370 FLTWO = .TRUE. 1371 ELSE 1372 FLDIR = .TRUE. 1373 END IF 1374 FSC = 0.001 1375 UNITS = 'm s-1' 1376 ENAME = '.uss' 1377 DO ISEA=1, NSEA 1378 IF (USSX(ISEA) .NE. UNDEF ) THEN 1379 USSX(ISEA)=MAX(-0.9998,MIN(0.9998,USSX(ISEA))) 1380 USSY(ISEA)=MAX(-0.9998,MIN(0.9998,USSY(ISEA))) 1381 END IF 1382 END DO 1383 IF ( ITYPE .EQ. 4 ) THEN 1384 XS1 = USSX(1:NSEA) 1385 XS2 = USSY(1:NSEA) 1386 ELSE 1387 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, USSX(1:NSEA) & 1388 , MAPSF, XX ) 1389 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, USSY(1:NSEA) & 1390 , MAPSF, XY ) 1391 ENDIF 1392 DO ISEA=1, NSEA 1393 CABS = SQRT(USSX(ISEA)**2+USSY(ISEA)**2) 1394 IF ( USSX(ISEA) .NE. UNDEF ) THEN 1395 USSY(ISEA) = MOD ( 630. - & 1396 RADE*ATAN2(USSY(ISEA),USSX(ISEA)) , 360. ) 1397 ELSE 1398 USSY(ISEA) = UNDEF 1399 CABS = UNDEF 1400 END IF 1401 USSX(ISEA) = CABS 1402 END DO 1403 IF ( ITYPE .EQ. 4 ) THEN 1404 XS3 = USSX(1:NSEA) 1405 XS4 = USSY(1:NSEA) 1406 ELSE 1407 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, USSX(1:NSEA), & 1408 MAPSF, X1 ) 1409 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, USSY(1:NSEA), & 1410 MAPSF, X2 ) 1411 ENDIF 1412 ! 1413 ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 7 ) THEN 1414 FLTWO = .TRUE. 1415 FSC = 0.01 1416 ENAME = '.p2s' 1417 UNITS = 'm4' 1418 DO ISEA=1, NSEA 1419 PRMS(ISEA)=PRMS(ISEA) 1420 END DO 1421 IF ( ITYPE .EQ. 4 ) THEN 1422 XS1 = PRMS(1:NSEA) 1423 XS2 = TPMS(1:NSEA) 1424 ELSE 1425 CALL W3S2XY ( NSEA, NSEA, NX+1,NY,PRMS,MAPSF, X1 ) Page 27 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1426 CALL W3S2XY ( NSEA, NSEA, NX+1,NY,TPMS,MAPSF, X2 ) 1427 ENDIF 1428 ! 1429 ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 1 ) THEN 1430 IF ( VECTOR ) THEN 1431 FLTWO = .TRUE. 1432 ELSE 1433 FLDIR = .TRUE. 1434 END IF 1435 FSC = 0.01 1436 ENAME = '.abr' 1437 UNITS = 'm' 1438 IF ( ITYPE .EQ. 4 ) THEN 1439 XS1 = ABA(1:NSEA) 1440 XS2 = ABD(1:NSEA) 1441 ELSE 1442 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, ABA(1:NSEA) & 1443 , MAPSF, XX ) 1444 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, ABD(1:NSEA) & 1445 , MAPSF, XY ) 1446 ENDIF 1447 DO ISEA=1, NSEA 1448 IF ( ABA(ISEA) .NE. UNDEF ) THEN 1449 AABS = SQRT(ABA(ISEA)**2+ABD(ISEA)**2) 1450 IF ( AABS .GT. 0.005 ) THEN 1451 ABD(ISEA) = MOD ( 630. - & 1452 RADE*ATAN2(ABD(ISEA),ABA(ISEA)) , 360. ) 1453 ELSE 1454 ABD(ISEA) = UNDEF 1455 END IF 1456 ABA(ISEA) = AABS 1457 END IF 1458 END DO 1459 IF ( ITYPE .EQ. 4 ) THEN 1460 XS3 = ABA(1:NSEA) 1461 XS4 = ABD(1:NSEA) 1462 ELSE 1463 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, ABA(1:NSEA) & 1464 , MAPSF, X1 ) 1465 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, ABD(1:NSEA) & 1466 , MAPSF, X2 ) 1467 ENDIF 1468 ! 1469 ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 2 ) THEN 1470 IF ( VECTOR ) THEN 1471 FLTWO = .TRUE. 1472 ELSE 1473 FLDIR = .TRUE. 1474 END IF 1475 FSC = 0.01 1476 ENAME = '.ubr' 1477 UNITS = 'm s-1' 1478 IF ( ITYPE .EQ. 4 ) THEN 1479 XS1 = UBA(1:NSEA) 1480 XS2 = UBD(1:NSEA) 1481 ELSE 1482 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UBA(1:NSEA) & Page 28 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1483 , MAPSF, XX ) 1484 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UBD(1:NSEA) & 1485 , MAPSF, XY ) 1486 ENDIF 1487 DO ISEA=1, NSEA 1488 IF ( UBA(ISEA) .NE. UNDEF ) THEN 1489 UABS = SQRT(UBA(ISEA)**2+UBD(ISEA)**2) 1490 IF ( UABS .GT. 0.005 ) THEN 1491 UBD(ISEA) = MOD ( 630. - & 1492 RADE*ATAN2(UBD(ISEA),UBA(ISEA)) , 360. ) 1493 ELSE 1494 UBD(ISEA) = UNDEF 1495 END IF 1496 UBA(ISEA) = UABS 1497 END IF 1498 END DO 1499 IF ( ITYPE .EQ. 4 ) THEN 1500 XS3 = UBA(1:NSEA) 1501 XS4 = UBD(1:NSEA) 1502 ELSE 1503 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UBA(1:NSEA) & 1504 , MAPSF, X1 ) 1505 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, UBD(1:NSEA) & 1506 , MAPSF, X2 ) 1507 ENDIF 1508 ! 1509 ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 3 ) THEN 1510 FLTRI = .TRUE. 1511 FSC = 1.E-2 1512 UNITS = 'm' 1513 ENAME = '.bed' 1514 IF ( ITYPE .EQ. 4 ) THEN 1515 XS1 = BEDFORMS(1:NSEA,1) 1516 XS2 = BEDFORMS(1:NSEA,2) 1517 XS3 = BEDFORMS(1:NSEA,3) 1518 ELSE 1519 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDFORMS(1:NSEA,1) & 1520 , MAPSF, X1 ) 1521 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDFORMS(1:NSEA,2) & 1522 , MAPSF, X2 ) 1523 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDFORMS(1:NSEA,3) & 1524 , MAPSF, XY ) 1525 ENDIF 1526 ! 1527 ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 4 ) THEN 1528 FLONE = .TRUE. 1529 FSC = 0.1 1530 UNITS = 'W m-2' 1531 ENAME = '.fbb' 1532 IF ( ITYPE .EQ. 4 ) THEN 1533 XS1 = PHIBBL(1:NSEA) 1534 ELSE 1535 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, PHIBBL(1:NSEA) & 1536 , MAPSF, X1 ) 1537 ENDIF 1538 ! 1539 ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 5 ) THEN Page 29 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1540 FLTWO = .TRUE. 1541 FSC = 1.E-6 1542 UNITS = 'm2 s-2' 1543 ENAME = '.tbb' 1544 IF ( ITYPE .EQ. 4 ) THEN 1545 XS1 = TAUBBL(1:NSEA,1) 1546 XS2 = TAUBBL(1:NSEA,2) 1547 ELSE 1548 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUBBL(1:NSEA,1) & 1549 , MAPSF, XX ) 1550 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUBBL(1:NSEA,2) & 1551 , MAPSF, XY ) 1552 ENDIF 1553 ! 1554 ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 1 ) THEN 1555 IF ( VECTOR ) THEN 1556 FLTWO = .TRUE. 1557 ELSE 1558 FLDIR = .TRUE. 1559 END IF 1560 FSC = 1.E-6 1561 ENAME = '.mss' 1562 FORMF = '(1X,20I6)' 1563 UNITS = '1' 1564 IF ( ITYPE .EQ. 4 ) THEN 1565 XS1 = MSSX(1:NSEA) 1566 XS2 = MSSY(1:NSEA) 1567 ELSE 1568 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSSX(1:NSEA), & 1569 MAPSF, XX ) 1570 CALL W3S2XY ( NSEA, NSEA, NX+1, NY ,MSSY(1:NSEA), & 1571 MAPSF, XY ) 1572 ENDIF 1573 ! 1574 ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 2 ) THEN 1575 IF ( VECTOR ) THEN 1576 FLTWO = .TRUE. 1577 ELSE 1578 FLDIR = .TRUE. 1579 END IF 1580 FSC = 0.00001 1581 ENAME = '.msc' 1582 UNITS = '1' 1583 IF ( ITYPE .EQ. 4 ) THEN 1584 XS1 = MSCX(1:NSEA) 1585 XS2 = MSCY(1:NSEA) 1586 ELSE 1587 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSCX(1:NSEA), & 1588 MAPSF, XX ) 1589 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSCY(1:NSEA), & 1590 MAPSF, XY ) 1591 ENDIF 1592 DO ISEA=1, NSEA 1593 CABS = SQRT(MSCX(ISEA)**2+MSCY(ISEA)**2) 1594 IF ( MSCX(ISEA) .EQ. UNDEF ) THEN 1595 MSCY(ISEA) = UNDEF 1596 CABS = UNDEF Page 30 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1597 ELSE IF ( MSCX(ISEA) .EQ. 0. .AND. & 1598 MSCY(ISEA) .EQ. 0. ) THEN 1599 MSCY(ISEA) = UNDEF 1600 ELSE 1601 MSCY(ISEA) = MOD ( 630. - & 1602 RADE*ATAN2(MSCY(ISEA),MSCX(ISEA)) , 360. ) 1603 END IF 1604 MSCX(ISEA) = CABS 1605 END DO 1606 IF ( ITYPE .EQ. 4 ) THEN 1607 XS3 = MSCX(1:NSEA) 1608 XS4 = MSCY(1:NSEA) 1609 ELSE 1610 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSCX(1:NSEA), & 1611 MAPSF, X1 ) 1612 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, MSCY(1:NSEA), & 1613 MAPSF, X2 ) 1614 ENDIF 1615 ! 1616 ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN 1617 FLONE = .TRUE. 1618 FSC = 0.1 1619 UNITS = 'min.' 1620 ENAME = '.dtd' 1621 DO ISEA=1, NSEA 1622 IF ( DTDYN(ISEA) .NE. UNDEF ) & 1623 DTDYN(ISEA) = DTDYN(ISEA) / 60. 1624 END DO 1625 IF ( ITYPE .EQ. 4 ) THEN 1626 XS1 = DTDYN(1:NSEA) 1627 ELSE 1628 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, DTDYN , MAPSF, X1 ) 1629 ENDIF 1630 ! 1631 ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 2 ) THEN 1632 FLONE = .TRUE. 1633 FSC = 0.001 1634 UNITS = 's-1' 1635 ENAME = '.fc' 1636 IF ( ITYPE .EQ. 4 ) THEN 1637 XS1 = FCUT 1638 ELSE 1639 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, FCUT , MAPSF, X1 ) 1640 ENDIF 1641 ! 1642 ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 3 ) THEN 1643 FLONE = .TRUE. 1644 FSC = 0.001 1645 FSC = 1. 1646 UNITS = '1' 1647 ENAME = '.cfx' 1648 IF ( ITYPE .EQ. 4 ) THEN 1649 XS1 = CFLXYMAX 1650 ELSE 1651 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CFLXYMAX, MAPSF, X1 ) 1652 ENDIF 1653 ! Page 31 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1654 ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 4 ) THEN 1655 FLONE = .TRUE. 1656 FSC = 0.001 1657 UNITS = '1' 1658 ENAME = '.cfd' 1659 IF ( ITYPE .EQ. 4 ) THEN 1660 XS1 = CFLTHMAX 1661 ELSE 1662 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CFLTHMAX, MAPSF, X1 ) 1663 ENDIF 1664 ! 1665 ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 5 ) THEN 1666 FLONE = .TRUE. 1667 FSC = 0.001 1668 UNITS = '1' 1669 ENAME = '.cfk' 1670 IF ( ITYPE .EQ. 4 ) THEN 1671 XS1 = CFLKMAX 1672 ELSE 1673 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, CFLKMAX, MAPSF, X1 ) 1674 ENDIF 1675 ! 1676 ELSE IF ( IFI .EQ. 10 ) THEN 1677 FLONE = .TRUE. 1678 FSC = 1. 1679 UNITS = 'TBD' 1680 WRITE (ENAME,'(A2,I2.2)') '.u', IFJ 1681 IF ( ITYPE .EQ. 4 ) THEN 1682 XS1 = USERO(:,IFJ) 1683 ELSE 1684 CALL W3S2XY ( NSEA, NSEA, NX+1, NY, USERO(:,IFJ) & 1685 , MAPSF, X1 ) 1686 ENDIF 1687 ! 1688 ELSE 1689 WRITE (NDSE,999) 1690 CALL EXTCDE ( 1 ) 1691 ! 1692 END IF 1693 ! 1694 ! 2.b Make map 1695 ! 1696 DO IX=1, NX 1697 DO IY=1, NY 1698 IF ( MAPSTA(IY,IX) .EQ. 0 ) THEN 1699 X1(IX,IY) = UNDEF 1700 X2(IX,IY) = UNDEF 1701 XX(IX,IY) = UNDEF 1702 XY(IX,IY) = UNDEF 1703 END IF 1704 IF ( X1(IX,IY) .EQ. UNDEF ) THEN 1705 MAP(IX,IY) = 0 1706 ELSE 1707 MAP(IX,IY) = 1 1708 END IF 1709 IF ( X2(IX,IY) .EQ. UNDEF ) THEN 1710 MP2(IX,IY) = 0 Page 32 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1711 ELSE 1712 MP2(IX,IY) = 1 1713 END IF 1714 END DO 1715 END DO 1716 ! 1717 ! 2.c Perform output type 1 ( print plots ) 1718 ! 1719 IF ( ITYPE .EQ. 1 ) THEN 1720 ! 1721 IF ( SCALE ) THEN 1722 FSC = 0. 1723 FSCA = 0. 1724 ELSE 1725 FSCA = 1. 1726 END IF 1727 IXB = IX1 - IXS 1728 ! 1729 DO IB=1, NBLOK 1730 IXA = IXB + IXS 1731 IXB = IXA + (NXMAX-1)*IXS 1732 IXB = MIN ( IXB , IXN ) 1733 IF ( FLTRI ) THEN 1734 CALL PRTBLK (NDSO, NX, NY, NX+1, X1, MAP, 0, & 1735 FSC, IXA, IXB, IXS, IY1, IYN, IYS, & 1736 IDOUT(IFI,IFJ), UNITS) 1737 CALL PRTBLK (NDSO, NX, NY, NX+1, X2, MAP, 0, & 1738 FSC, IXA, IXB, IXS, IY1, IYN, IYS, & 1739 IDOUT(IFI,IFJ), UNITS) 1740 CALL PRTBLK (NDSO, NX, NY, NX+1, XY, MAP, 0, & 1741 FSC, IXA, IXB, IXS, IY1, IYN, IYS, & 1742 IDOUT(IFI,IFJ), UNITS) 1743 ELSE IF ( FLONE ) THEN 1744 CALL PRTBLK (NDSO, NX, NY, NX+1, X1, MAP, 0, & 1745 FSC, IXA, IXB, IXS, IY1, IYN, IYS, & 1746 IDOUT(IFI,IFJ), UNITS) 1747 ELSE IF ( FLTWO ) THEN 1748 CALL PRTBLK (NDSO, NX, NY, NX+1, XX, MAP, 0, & 1749 FSC, IXA, IXB, IXS, IY1, IYN, IYS, & 1750 IDOUT(IFI,IFJ), UNITS) 1751 CALL PRTBLK (NDSO, NX, NY, NX+1, XY, MAP, 0, & 1752 FSC, IXA, IXB, IXS, IY1, IYN, IYS, & 1753 IDOUT(IFI,IFJ), UNITS) 1754 ELSE IF ( FLDIR ) THEN 1755 CALL PRTBLK (NDSO, NX, NY, NX+1, X1, MAP, 0, & 1756 FSC, IXA, IXB, IXS, IY1, IYN, IYS, & 1757 IDOUT(IFI,IFJ), UNITS) 1758 CALL PRTBLK (NDSO, NX, NY, NX+1, X2, MP2, 0, & 1759 FSCA, IXA, IXB, IXS, IY1, IYN, IYS, & 1760 IDOUT(IFI,IFJ), 'Deg.') 1761 END IF 1762 END DO 1763 ! 1764 ! 2.d Perform output type 2 ( statistics ) 1765 ! 1766 ELSE IF ( ITYPE .EQ. 2 ) THEN 1767 XMIN = 1.E20 Page 33 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1768 XMAX = -1.E20 1769 XDS = 0.D0 1770 XDSQ = 0.D0 1771 NINGRD = 0 1772 ! 1773 DO IX=IX1, IXN 1774 DO IY=IY1, IYN 1775 IF ( MAPSTA(IY,IX) .GT. 0 .AND. & 1776 X1(IX,IY) .NE. UNDEF ) THEN 1777 NINGRD = NINGRD + 1 1778 XMIN = MIN ( XMIN , X1(IX,IY) ) 1779 XMAX = MAX ( XMAX , X1(IX,IY) ) 1780 XDS = XDS + DBLE(X1(IX,IY)) 1781 XDSQ = XDSQ + DBLE(X1(IX,IY))**2 1782 END IF 1783 END DO 1784 END DO 1785 ! 1786 NDSDT = NDSDT + 1 1787 ! 1788 IF ( NINGRD .EQ. 0 ) THEN 1789 WRITE (NDSDT,940) TIME(1), IH, IM, IS 1790 ELSE IF ( NINGRD .LE. 2 ) THEN 1791 XAVG = REAL ( XDS / DBLE(NINGRD) ) 1792 WRITE (NDSDT,940) TIME(1), IH, IM, IS, & 1793 XMIN, XMAX 1794 ELSE 1795 XAVG = REAL ( XDS / DBLE(NINGRD) ) 1796 XSTD = REAL ( ( XDSQ - XDS**2/DBLE(NINGRD) ) & 1797 / DBLE(NINGRD-1) ) 1798 XSTD = SQRT ( MAX ( XSTD , 0. ) ) 1799 WRITE (NDSDT,940) TIME(1), IH, IM, IS, & 1800 XMIN, XMAX, XAVG, XSTD 1801 END IF 1802 ! 1803 ! 2.e Perform output type 3 ( file ) 1804 ! 1805 ELSE IF ( ITYPE .EQ. 3 ) THEN 1806 ! 1807 FNAME(13:16) = ENAME 1808 IF ( IDFM .EQ. 3 ) THEN 1809 IF(GTYPE .NE. UNGTYPE) THEN 1810 JJ = LEN_TRIM(FNMPRE) 1811 OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME, & 1812 FORM='UNFORMATTED',ERR=800,IOSTAT=IERR) 1813 WRITE (NDSDAT) FILEID, TIME, & 1814 MINVAL(XGRD(IY1:IYN,IX1:IXN)), & 1815 MAXVAL(XGRD(IY1:IYN,IX1:IXN)), IXN-IX1+1, & 1816 MINVAL(YGRD(IY1:IYN,IX1:IXN)), & 1817 MAXVAL(YGRD(IY1:IYN,IX1:IXN)), IYN-IY1+1, & 1818 ENAME, FSC, UNITS, IDLA, IDFM, FORMF, MFILL 1819 ELSE 1820 OPEN (NDSDAT,FILE=FNAME, & 1821 FORM='UNFORMATTED',ERR=800,IOSTAT=IERR) 1822 WRITE (NDSDAT) FILEID, TIME, & 1823 X0,MAXX,NX, & 1824 Y0,MAXY,NY, & Page 34 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1825 ENAME, FSC, UNITS, IDLA, IDFM, FORMF, MFILL 1826 ENDIF 1827 ELSE 1828 IF(GTYPE .NE. UNGTYPE) THEN 1829 JJ = LEN_TRIM(FNMPRE) 1830 OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME,ERR=800, & 1831 IOSTAT=IERR) 1832 IF (FSC.LT.1E-4) THEN 1833 WRITE(FSCS,'(G7.1)') FSC .....................................1 (1) Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edit descriptor is 'W>=D+7'. 1834 ELSE 1835 WRITE(FSCS,'(F7.4)') FSC 1836 END IF 1837 IF ( FLAGLL ) THEN 1838 WRITE (NDSDAT,950) FILEID, TIME, & 1839 MINVAL(XGRD(IY1:IYN,IX1:IXN)), & 1840 MAXVAL(XGRD(IY1:IYN,IX1:IXN)), IXN-IX1+1, & 1841 MINVAL(YGRD(IY1:IYN,IX1:IXN)), & 1842 MAXVAL(YGRD(IY1:IYN,IX1:IXN)), IYN-IY1+1, & 1843 ENAME, FSCS, UNITS, IDLA, IDFM, FORMF, MFILL 1844 ELSE 1845 WRITE (NDSDAT,960) FILEID, TIME, & 1846 MINVAL(XGRD(IY1:IYN,IX1:IXN)), & 1847 MAXVAL(XGRD(IY1:IYN,IX1:IXN)), IXN-IX1+1, & 1848 MINVAL(YGRD(IY1:IYN,IX1:IXN)), & 1849 MAXVAL(YGRD(IY1:IYN,IX1:IXN)), IYN-IY1+1, & 1850 ENAME, FSCS, UNITS, IDLA, IDFM, FORMF, MFILL 1851 END IF 1852 ELSE 1853 OPEN (NDSDAT,FILE=FNAME, & 1854 ERR=800,IOSTAT=IERR) 1855 WRITE (NDSDAT, 949) FILEID, TIME, & 1856 X0,MAXX,NX, & 1857 Y0,MAXY,NY, & 1858 ENAME, FSC, UNITS, IDLA, IDFM, FORMF, MFILL 1859 ENDIF 1860 END IF 1861 ! 1862 IF ( FLTRI ) THEN 1863 DO IX=IX1, IXN 1864 DO IY=IY1, IYN 1865 IF ( MAPSTA(IY,IX) .LE. 0 .OR. & 1866 XX(IX,IY) .EQ. UNDEF ) THEN 1867 MXX(IX,IY) = MFILL 1868 MYY(IX,IY) = MFILL 1869 MXY(IX,IY) = MFILL 1870 ELSE 1871 MXX(IX,IY) = NINT(X1(IX,IY)/FSC) 1872 MYY(IX,IY) = NINT(X2(IX,IY)/FSC) 1873 MXY(IX,IY) = NINT(XY(IX,IY)/FSC) 1874 END IF 1875 END DO 1876 END DO 1877 IF ( IDLA .NE. 5 ) THEN 1878 CALL OUTA2I ( MXX, NX, NY, IX1, IXN, IY1, IYN, & Page 35 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1879 NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1, 0 ) 1880 CALL OUTA2I ( MYY, NX, NY, IX1, IXN, IY1, IYN, & 1881 NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1, 0 ) 1882 CALL OUTA2I ( MXY, NX, NY, IX1, IXN, IY1, IYN, & 1883 NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1, 0 ) 1884 ELSE 1885 DO IY=IY1,IYN 1886 YGBX = Y0 + REAL(IY-1)*SY 1887 DO IX=IX1, IXN 1888 XGBX = X0 + REAL(IX-1)*SX 1889 IF ( MXX(IX,IY) .NE. MFILL ) THEN 1890 IF ( IDFM .EQ. 3 ) THEN 1891 WRITE (NDSDAT) & 1892 XGBX, YGBX, MXX(IX,IY), MYY(IX,IY) 1893 ELSE 1894 WRITE (NDSDAT,951) & 1895 XGBX, YGBX, MXX(IX,IY), MYY(IX,IY) 1896 END IF 1897 END IF 1898 END DO 1899 END DO 1900 END IF 1901 ELSE 1902 IF ( FLTWO .OR. FLDIR ) THEN 1903 DO IX=IX1, IXN 1904 DO IY=IY1, IYN 1905 IF ( MAPSTA(IY,IX) .LE. 0 .OR. & 1906 XX(IX,IY) .EQ. UNDEF ) THEN 1907 MXX(IX,IY) = MFILL 1908 MYY(IX,IY) = MFILL 1909 ELSE 1910 MXX(IX,IY) = NINT(XX(IX,IY)/FSC) 1911 MYY(IX,IY) = NINT(XY(IX,IY)/FSC) 1912 END IF 1913 END DO 1914 END DO 1915 IF ( IDLA .NE. 5 ) THEN 1916 CALL OUTA2I ( MXX, NX, NY, IX1, IXN, IY1, IYN, & 1917 NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1,0) 1918 CALL OUTA2I ( MYY, NX, NY, IX1, IXN, IY1, IYN, & 1919 NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1,0) 1920 ELSE 1921 DO IY=IY1,IYN 1922 DO IX=IX1, IXN 1923 YGBX = YGRD(IY,IX) 1924 XGBX = XGRD(IY,IX) 1925 IF ( MXX(IX,IY) .NE. MFILL ) THEN 1926 IF ( IDFM .EQ. 3 ) THEN 1927 WRITE (NDSDAT) & 1928 XGBX, YGBX, MXX(IX,IY), MYY(IX,IY) 1929 ELSE 1930 IF ( FLAGLL ) THEN 1931 WRITE (NDSDAT,951) XGBX, YGBX, & 1932 MXX(IX,IY), MYY(IX,IY) 1933 ELSE 1934 WRITE (NDSDAT,961) XGBX, YGBX, & 1935 MXX(IX,IY), MYY(IX,IY) Page 36 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1936 END IF 1937 END IF 1938 END IF 1939 END DO 1940 END DO 1941 END IF 1942 ELSE 1943 DO IX=IX1, IXN 1944 DO IY=IY1, IYN 1945 IF ( MAPSTA(IY,IX) .LE. 0 .OR. & 1946 X1(IX,IY) .EQ. UNDEF ) THEN 1947 MX1(IX,IY) = MFILL 1948 ELSE 1949 MX1(IX,IY) = NINT(X1(IX,IY)/FSC) 1950 END IF 1951 END DO 1952 END DO 1953 IF ( IDLA .NE. 5 ) THEN 1954 CALL OUTA2I ( MX1, NX, NY, IX1, IXN, IY1, IYN, & 1955 NDSDAT, NDST, NDSE, IDFM, FORMF, IDLA, 1,0) 1956 ELSE 1957 DO IY=IY1,IYN 1958 DO IX=IX1, IXN 1959 YGBX = YGRD(IY,IX) 1960 XGBX = XGRD(IY,IX) 1961 IF ( MX1(IX,IY) .NE. MFILL ) THEN 1962 IF ( IDFM .EQ. 3 ) THEN 1963 WRITE (NDSDAT) & 1964 XGBX, YGBX, MX1(IX,IY) 1965 ELSE 1966 IF ( FLAGLL ) THEN 1967 WRITE (NDSDAT,951) XGBX, YGBX, & 1968 MX1(IX,IY) 1969 ELSE 1970 WRITE (NDSDAT,961) XGBX, YGBX, & 1971 MX1(IX,IY) 1972 END IF 1973 END IF 1974 END IF 1975 END DO 1976 END DO 1977 END IF 1978 END IF 1979 END IF 1980 ! 1981 CLOSE (NDSDAT) 1982 ! 1983 ELSE IF ( ITYPE .EQ. 4 ) THEN 1984 ! 1985 FNAME(13:16) = ENAME 1986 JJ = LEN_TRIM(FNMPRE) 1987 OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME,ERR=800, & 1988 IOSTAT=IERR) 1989 WRITE (6,*) FNAME(1:16) 1990 ! 1991 IF ( FLTRI ) THEN 1992 WRITE (NDSDAT,980) FILEID, TIME, NSEA, 3, & Page 37 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 1993 FSC, ENAME, UNITS, GNAME 1994 WRITE(NDSDAT, 113) XS1 1995 WRITE(NDSDAT, 113) XS2 1996 WRITE(NDSDAT, 113) XS3 1997 ENDIF 1998 IF ( FLTWO .OR. FLDIR ) THEN 1999 WRITE (NDSDAT,980) FILEID, TIME, NSEA, 2, & 2000 FSC, ENAME, UNITS, GNAME 2001 WRITE(NDSDAT, 113) XS1 2002 WRITE(NDSDAT, 113) XS2 2003 ENDIF 2004 IF ( FLONE ) THEN 2005 WRITE (NDSDAT,980) FILEID, TIME, NSEA, 1, & 2006 FSC, ENAME, UNITS, GNAME 2007 WRITE(NDSDAT, 113) XS1 2008 ENDIF 2009 ! 2010 CLOSE (NDSDAT) 2011 ! 2012 END IF 2013 ! 2014 ! ... End of fields loop 2015 ! 2016 END IF 2017 END DO 2018 END DO 2019 ! 2020 RETURN 2021 ! 2022 ! Error escape locations 2023 ! 2024 800 CONTINUE 2025 WRITE (NDSE,1000) IERR 2026 CALL EXTCDE (2) 2027 ! 2028 ! Formats 2029 ! 2030 113 FORMAT ((10ES11.3)) 2031 980 FORMAT (1X,A13,I9.8,I7.6,I9,I3,ES10.2,1X,A4,1X,A10,1X,A30) 2032 2033 940 FORMAT (1X,I8,3I3.2,2X,4E12.4) 2034 949 FORMAT (1X,A13,I9.8,I7.6,2(2F8.2,I8), & 2035 1X,A4,F8.4,1X,A10,2I2,1X,A11,I4) 2036 950 FORMAT (1X,A13,I9.8,I7.6,2(2F8.2,I4), & 2037 1X,A4,1X,A7,1X,A10,2I2,1X,A11,I4) 2038 951 FORMAT (1X,2F10.5,2I8) 2039 960 FORMAT (1X,A13,I9.8,I7.6,2(2E11.3,I4), & 2040 1X,A4,1X,A7,1X,A10,2I2,1X,A11,I4) 2041 961 FORMAT (1X,2E12.4,2I8) 2042 ! 2043 999 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGO :'/ & 2044 ' PLEASE UPDATE FIELDS !!! '/) 2045 ! 2046 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGO : '/ & 2047 ' ERROR IN OPENING OUTPUT FILE'/ & 2048 ' IOSTAT =',I5/) 2049 ! Page 38 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 2050 !/ 2051 !/ End of W3EXGO ----------------------------------------------------- / 2052 !/ 2053 END SUBROUTINE W3EXGO ENTRY POINTS Name waveflds_IP_w3exgo_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1000 Label 2046 2025 113 Label 2030 1994,1995,1996,2001,2002,2007 800 Label 2024 1812,1821,1830,1854,1987 940 Label 2033 1789,1792,1799 949 Label 2034 1855 950 Label 2036 1838 951 Label 2038 1894,1931,1967 960 Label 2039 1845 961 Label 2041 1934,1970 980 Label 2031 1992,1999,2005 999 Label 2043 1689 AABS Local 587 R(4) 4 scalar 1449,1450,1456 ABA Local 1439 R(4) 4 1 1 PTR 118,1439,1442,1448,1449,1452,1456, 1460,1463 ABD Local 1440 R(4) 4 1 1 PTR 118,1440,1444,1449,1451,1452,1454, 1461,1465 AS Local 780 R(4) 4 1 1 PTR 116,780,782 ATAN2 Func 720 scalar 720,758,1054,1141,1183,1288,1353,1 396,1452,1492,1602 BEDFORMS Local 1515 R(4) 4 2 1 PTR 124,1515,1516,1517,1519,1521,1523 BERG Local 813 R(4) 4 1 1 PTR 115,813,815,817 BHD Local 1310 R(4) 4 1 1 PTR 120,1310,1312 CABS Local 586 R(4) 4 scalar 717,718,724,1132,1135,1143,1174,11 77,1185,1350,1356,1358,1393,1399,1 401,1593,1596,1604 CFLKMAX Local 1671 R(4) 4 1 1 PTR 124,1671,1673 CFLTHMAX Local 1660 R(4) 4 1 1 PTR 124,1660,1662 CFLXYMAX Local 1649 R(4) 4 1 1 PTR 123,1649,1651 CGE Local 1088 R(4) 4 1 1 PTR 125,1088,1089,1092,1094 CHARN Local 1076 R(4) 4 1 1 PTR 122,1076,1078 CX Local 708 R(4) 4 1 1 PTR 116,708,711,717,720,724,727,730 CY Local 709 R(4) 4 1 1 PTR 116,709,713,717,719,720,722,728,73 2 DBLE Func 1780 scalar 1780,1781,1791,1795,1796,1797 DPTMAX Local 589 R(4) 4 1 1 677,679,681,683 DTDYN Local 1622 R(4) 4 1 1 PTR 117,1622,1623,1626,1628 DW Local 677 R(4) 4 1 1 PTR 116,677,691,693 ENAME Local 595 CHAR 4 scalar 652,653,688,704,743,777,790,801,81 2,824,835,846,857,868,879,890,905, 916,932,944,956,968,986,998,1010,1 Page 39 Source Listing W3EXGO 2014-09-16 16:51 Symbol Table multiwaveflds.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 021,1035,1074,1086,1102,1121,1163, 1201,1213,1225,1237,1249,1271,1308 ,1320,1339,1376,1416,1436,1476,151 3,1531,1543,1561,1581,1620,1635,16 47,1658,1669,1680,1807,1818,1825,1 843,1850,1858,1985,1993,2000,2006 EXTCDE Subr 1690 109,234,391,395,399,1690,2026 FCUT Local 1637 R(4) 4 1 1 PTR 117,1637,1639 FILEID Local 598 CHAR 13 scalar 598,1813,1822,1838,1845,1855,1992, 1999,2005 FLAGLL Local 1837 L(4) 4 scalar 1837,1930,1966 FLDIR Local 594 L(4) 4 scalar 672,701,740,1032,1117,1159,1267,13 35,1372,1433,1473,1558,1578,1754,1 902,1998 FLONE Local 594 L(4) 4 scalar 670,676,775,787,798,809,821,832,84 3,854,865,876,887,902,913,929,941, 953,965,983,995,1007,1018,1071,108 3,1099,1198,1210,1222,1234,1305,13 17,1528,1617,1632,1643,1655,1666,1 677,1743,2004 FLREQ Local 664 L(4) 4 2 200 222,320,334,664 FLTRI Local 594 L(4) 4 scalar 673,1246,1510,1733,1862,1991 FLTWO Local 594 L(4) 4 scalar 671,699,738,1030,1115,1157,1265,13 33,1370,1414,1431,1471,1540,1556,1 576,1747,1902,1998 FNAME Local 595 CHAR 16 scalar 646,647,649,653,1807,1811,1820,183 0,1853,1985,1987,1989 FNMPRE Local 1810 CHAR 80 scalar 127,169,170,325,329,1810,1811,1829 ,1830,1986,1987 FORMF Local 596 CHAR 11 scalar 666,689,706,1036,1562,1818,1825,18 43,1850,1858,1879,1881,1883,1917,1 919,1955 FORMG Local 596 CHAR 12 scalar 656 FP0 Local 881 R(4) 4 1 1 PTR 117,881,883 FSC Local 586 R(4) 4 scalar 678,680,682,684,686,703,742,776,78 8,799,810,822,833,844,855,866,877, 888,903,914,930,942,954,966,984,99 6,1008,1019,1034,1072,1084,1100,11 19,1161,1199,1211,1223,1235,1247,1 269,1306,1318,1337,1374,1415,1435, 1475,1511,1529,1541,1560,1580,1618 ,1633,1644,1645,1656,1667,1678,172 2,1735,1738,1741,1745,1749,1752,17 56,1818,1825,1832,1833,1835,1858,1 871,1872,1873,1910,1911,1949,1993, 2000,2006 FSCA Local 586 R(4) 4 scalar 1723,1725,1759 FSCS Local 596 CHAR 7 scalar 1833,1835,1843,1850 GNAME Local 1993 CHAR 30 scalar PTR 180,1993,2000,2006 GTYPE Local 1809 I(4) 4 scalar PTR 1809,1828 HS Local 826 R(4) 4 1 1 PTR 116,826,828 IB Local 578 I(4) 4 scalar 1729 ICE Local 803 R(4) 4 1 1 PTR 115,803,805 IDFM Local 1808 I(4) 4 scalar 287,293,295,305,1808,1818,1825,184 3,1850,1858,1879,1881,1883,1890,19 Page 40 Source Listing W3EXGO 2014-09-16 16:51 Symbol Table multiwaveflds.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 17,1919,1926,1955,1962 IDLA Local 1818 I(4) 4 scalar 287,292,295,305,1818,1825,1843,185 0,1858,1877,1879,1881,1883,1915,19 17,1919,1953,1955 IDOUT Local 1736 CHAR 20 2 200 126,190,323,328,330,333,1736,1739, 1742,1746,1750,1753,1757,1760 IERR Local 1812 I(4) 4 scalar 171,222,223,390,398,1812,1821,1831 ,1854,1988,2025 IFI Local 579 I(4) 4 scalar 662,664,675,697,736,774,786,797,80 8,820,831,842,853,864,875,886,901, 912,928,940,952,964,982,994,1006,1 017,1028,1070,1082,1098,1113,1155, 1197,1209,1221,1233,1245,1263,1304 ,1316,1331,1368,1413,1429,1469,150 9,1527,1539,1554,1574,1616,1631,16 42,1654,1665,1676,1736,1739,1742,1 746,1750,1753,1757,1760 IFJ Local 579 I(4) 4 scalar 663,664,675,697,736,774,786,797,80 8,820,831,842,853,864,875,886,901, 912,928,940,952,964,982,994,1006,1 017,1028,1070,1082,1098,1113,1155, 1197,1209,1221,1233,1245,1263,1304 ,1316,1331,1368,1413,1429,1469,150 9,1527,1539,1554,1574,1616,1631,16 42,1654,1665,1680,1682,1684,1736,1 739,1742,1746,1750,1753,1757,1760 IH Local 577 I(4) 4 scalar 632,1789,1792,1799 IM Local 577 I(4) 4 scalar 633,1789,1792,1799 IPART Local 934 I(4) 4 scalar 229,236,341,344,934,936,946,948,95 8,960,970,971,972,976,978,988,990, 1000,1002 IPASS Local 583 I(4) 4 scalar 650,652,654 IS Local 577 I(4) 4 scalar 634,1789,1792,1799 ISEA Local 578 I(4) 4 scalar 716,717,719,720,722,724,754,755,75 7,758,760,762,891,892,893,917,918, 919,969,970,971,972,1047,1048,1049 ,1050,1053,1054,1056,1058,1087,108 8,1089,1103,1104,1131,1132,1133,11 34,1136,1137,1138,1140,1141,1143,1 173,1174,1175,1176,1178,1179,1180, 1182,1183,1185,1281,1282,1283,1284 ,1287,1288,1290,1292,1321,1322,134 9,1350,1351,1352,1353,1355,1358,13 77,1378,1379,1380,1392,1393,1394,1 395,1396,1398,1401,1418,1419,1447, 1448,1449,1451,1452,1454,1456,1487 ,1488,1489,1491,1492,1494,1496,159 2,1593,1594,1595,1597,1598,1599,16 01,1602,1604,1621,1622,1623 ITYPE Local 618 I(4) 4 scalar 229,231,233,240,241,254,255,270,27 1,283,284,301,302,312,322,352,371, 373,383,618,630,641,686,690,707,72 6,745,764,779,791,802,814,825,836, 847,858,869,880,895,906,922,933,94 5,957,975,987,999,1011,1022,1038,1 Page 41 Source Listing W3EXGO 2014-09-16 16:51 Symbol Table multiwaveflds.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 060,1075,1091,1106,1122,1145,1164, 1187,1202,1214,1226,1238,1250,1272 ,1294,1309,1324,1340,1360,1383,140 3,1421,1438,1459,1478,1499,1514,15 32,1544,1564,1583,1606,1625,1636,1 648,1659,1670,1681,1719,1766,1805, 1983 IX Local 578 I(4) 4 scalar 1696,1698,1699,1700,1701,1702,1704 ,1705,1707,1709,1710,1712,1773,177 5,1776,1778,1779,1780,1781,1863,18 65,1866,1867,1868,1869,1871,1872,1 873,1887,1888,1889,1892,1895,1903, 1905,1906,1907,1908,1910,1911,1922 ,1923,1924,1925,1928,1932,1935,194 3,1945,1946,1947,1949,1958,1959,19 60,1961,1964,1968,1971 IX1 Local 624 I(4) 4 scalar 258,259,265,274,275,279,287,288,29 5,305,624,1727,1773,1814,1815,1816 ,1817,1839,1840,1841,1842,1846,184 7,1848,1849,1863,1878,1880,1882,18 87,1903,1916,1918,1922,1943,1954,1 958 IXA Local 579 I(4) 4 scalar 1730,1731,1735,1738,1741,1745,1749 ,1752,1756,1759 IXB Local 578 I(4) 4 scalar 1727,1730,1731,1732,1735,1738,1741 ,1745,1749,1752,1756,1759 IXN Local 624 I(4) 4 scalar 258,260,265,274,276,279,287,289,29 5,305,624,1732,1773,1814,1815,1816 ,1817,1839,1840,1841,1842,1846,184 7,1848,1849,1863,1878,1880,1882,18 87,1903,1916,1918,1922,1943,1954,1 958 IXS Local 624 I(4) 4 scalar 258,261,265,624,1727,1730,1731,173 5,1738,1741,1745,1749,1752,1756,17 59 IY Local 578 I(4) 4 scalar 1697,1698,1699,1700,1701,1702,1704 ,1705,1707,1709,1710,1712,1774,177 5,1776,1778,1779,1780,1781,1864,18 65,1866,1867,1868,1869,1871,1872,1 873,1885,1886,1889,1892,1895,1904, 1905,1906,1907,1908,1910,1911,1921 ,1923,1924,1925,1928,1932,1935,194 4,1945,1946,1947,1949,1957,1959,19 60,1961,1964,1968,1971 IY1 Local 1735 I(4) 4 scalar 258,262,265,274,277,279,287,290,29 5,305,1735,1738,1741,1745,1749,175 2,1756,1759,1774,1814,1815,1816,18 17,1839,1840,1841,1842,1846,1847,1 848,1849,1864,1878,1880,1882,1885, 1904,1916,1918,1921,1944,1954,1957 IYN Local 1735 I(4) 4 scalar 258,263,265,274,278,279,287,291,29 5,305,1735,1738,1741,1745,1749,175 2,1756,1759,1774,1814,1815,1816,18 17,1839,1840,1841,1842,1846,1847,1 848,1849,1864,1878,1880,1882,1885, Page 42 Source Listing W3EXGO 2014-09-16 16:51 Symbol Table multiwaveflds.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 1904,1916,1918,1921,1944,1954,1957 IYS Local 1735 I(4) 4 scalar 258,264,265,1735,1738,1741,1745,17 49,1752,1756,1759 J Local 578 I(4) 4 scalar JJ Local 579 I(4) 4 scalar 1810,1811,1829,1830,1986,1987 LEN_TRIM Func 1810 scalar 169,325,1810,1829,1986 MAP Local 580 I(4) 4 2 0 1705,1707,1734,1737,1740,1744,1748 ,1751,1755 MAPSF Local 694 I(4) 4 2 1 PTR 694,712,714,731,733,750,752,769,77 1,783,794,805,817,828,839,850,861, 872,883,898,909,925,937,949,961,97 9,991,1003,1014,1025,1043,1045,106 5,1067,1079,1095,1110,1127,1129,11 50,1152,1169,1171,1192,1194,1206,1 218,1230,1242,1256,1258,1260,1277, 1279,1299,1301,1313,1328,1345,1347 ,1364,1365,1388,1390,1408,1410,142 5,1426,1443,1445,1464,1466,1483,14 85,1504,1506,1520,1522,1524,1536,1 549,1551,1569,1571,1588,1590,1611, 1613,1628,1639,1651,1662,1673,1685 MAPSTA Local 1698 I(4) 4 2 1 PTR 1698,1775,1865,1905,1945 MAX Func 1379 scalar 200,202,236,259,261,262,264,275,27 7,288,290,1379,1380,1779,1798 MAXVAL Func 677 scalar 677,1815,1817,1840,1842,1847,1849 MAXX Local 1823 R(4) 4 scalar PTR 1823,1856 MAXY Local 1824 R(4) 4 scalar PTR 1824,1857 MFILL Local 578 I(4) 4 scalar 642,1818,1825,1843,1850,1858,1867, 1868,1869,1889,1907,1908,1925,1947 ,1961 MIN Func 1104 scalar 236,260,263,276,278,289,291,1104,1 322,1379,1380,1732,1778 MINVAL Func 1814 scalar 1814,1816,1839,1841,1846,1848 MOD Func 633 scalar 633,634,644,719,757,893,919,972,10 53,1140,1182,1287,1352,1395,1451,1 491,1601 MP2 Local 580 I(4) 4 2 0 1710,1712,1758 MSCX Local 1584 R(4) 4 1 1 PTR 122,1584,1587,1593,1594,1597,1602, 1604,1607,1610 MSCY Local 1585 R(4) 4 1 1 PTR 122,1585,1589,1593,1595,1598,1599, 1601,1602,1608,1612 MSSX Local 1565 R(4) 4 1 1 PTR 122,1565,1568 MSSY Local 1566 R(4) 4 1 1 PTR 122,1566,1570 MX1 Local 581 I(4) 4 2 0 1947,1949,1954,1961,1964,1968,1971 MXX Local 581 I(4) 4 2 0 1867,1871,1878,1889,1892,1895,1907 ,1910,1916,1925,1928,1932,1935 MXY Local 582 I(4) 4 2 0 1869,1873,1882 MYY Local 581 I(4) 4 2 0 1868,1872,1880,1892,1895,1908,1911 ,1918,1928,1932,1935 NBLOK Local 577 I(4) 4 scalar 625,1729 NCOL Local 585 I(4) 4 scalar 585,620,622 NDSDAT Local 631 I(4) 4 scalar 161,272,631,1811,1813,1820,1822,18 30,1838,1845,1853,1855,1879,1881,1 883,1891,1894,1917,1919,1927,1931, 1934,1955,1963,1967,1970,1981,1987 Page 43 Source Listing W3EXGO 2014-09-16 16:51 Symbol Table multiwaveflds.f90 Name Object Declared Type Bytes Dimen Elements Attributes References ,1992,1994,1995,1996,1999,2001,200 2,2005,2007,2010 NDSDT Local 631 I(4) 4 scalar 272,326,327,329,330,631,1786,1789, 1792,1799 NDSE Local 1689 I(4) 4 scalar PTR 126,198,221,228,233,256,273,285,30 3,390,394,398,1689,1879,1881,1883, 1917,1919,1955,2025 NDSO Local 1734 I(4) 4 scalar PTR 126,167,174,180,187,190,205,217,22 1,241,244,247,255,265,266,271,279, 284,295,302,313,315,323,328,333,34 2,344,352,359,372,374,383,402,1734 ,1737,1740,1744,1748,1751,1755,175 8 NDST Local 1879 I(4) 4 scalar PTR 126,1879,1881,1883,1917,1919,1955 NGRPP Param 663 I(4) 4 scalar 126,142,143,189,319,663 NINGRD Local 579 I(4) 4 scalar 1771,1777,1788,1790,1791,1795,1796 ,1797 NINT Func 1871 scalar 1871,1872,1873,1910,1911,1949 NOGRP Param 662 I(4) 4 scalar 126,142,188,318,662 NSEA Dummy 480 I(4) 4 scalar ARG,INOUT 591,677,691,693,708,709,711,713,71 6,727,728,730,732,746,747,749,751, 754,765,766,768,770,780,782,794,80 5,817,828,839,850,861,872,883,891, 898,909,917,925,936,948,960,969,97 8,990,1002,1014,1025,1039,1040,104 2,1044,1047,1061,1062,1064,1066,10 76,1078,1087,1092,1094,1103,1107,1 109,1123,1124,1126,1128,1131,1146, 1147,1149,1151,1165,1166,1168,1170 ,1173,1188,1189,1191,1193,1203,120 5,1215,1217,1227,1229,1239,1241,12 51,1252,1253,1255,1257,1259,1273,1 274,1276,1278,1281,1295,1296,1298, 1300,1310,1312,1321,1325,1327,1341 ,1342,1344,1346,1349,1361,1362,136 4,1365,1377,1384,1385,1387,1389,13 92,1404,1405,1407,1409,1418,1422,1 423,1425,1426,1439,1440,1442,1444, 1447,1460,1461,1463,1465,1479,1480 ,1482,1484,1487,1500,1501,1503,150 5,1515,1516,1517,1519,1521,1523,15 33,1535,1545,1546,1548,1550,1565,1 566,1568,1570,1584,1585,1587,1589, 1592,1607,1608,1610,1612,1621,1626 ,1628,1639,1651,1662,1673,1684,199 2,1999,2005 NX Dummy 480 I(4) 4 scalar ARG,INOUT 580,581,582,588,589,693,711,713,73 0,732,749,751,768,770,782,794,805, 817,828,839,850,861,872,883,898,90 9,925,936,948,960,978,990,1002,101 4,1025,1042,1044,1064,1066,1078,10 94,1109,1126,1128,1149,1151,1168,1 170,1191,1193,1205,1217,1229,1241, 1255,1257,1259,1276,1278,1298,1300 ,1312,1327,1344,1346,1364,1365,138 Page 44 Source Listing W3EXGO 2014-09-16 16:51 Symbol Table multiwaveflds.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 7,1389,1407,1409,1425,1426,1442,14 44,1463,1465,1482,1484,1503,1505,1 519,1521,1523,1535,1548,1550,1568, 1570,1587,1589,1610,1612,1628,1639 ,1651,1662,1673,1684,1696,1734,173 7,1740,1744,1748,1751,1755,1758,18 23,1856,1878,1880,1882,1916,1918,1 954 NXMAX Local 577 I(4) 4 scalar 620,622,625,1731 NXTOT Local 577 I(4) 4 scalar 624,625 NY Dummy 480 I(4) 4 scalar ARG,INOUT 580,581,582,588,589,693,711,713,73 0,732,749,751,768,770,782,794,805, 817,828,839,850,861,872,883,898,90 9,925,936,948,960,978,990,1002,101 4,1025,1042,1044,1064,1066,1078,10 94,1109,1126,1128,1149,1151,1168,1 170,1191,1193,1205,1217,1229,1241, 1255,1257,1259,1276,1278,1298,1300 ,1312,1327,1344,1346,1364,1365,138 7,1389,1407,1409,1425,1426,1442,14 44,1463,1465,1482,1484,1503,1505,1 519,1521,1523,1535,1548,1550,1568, 1570,1587,1589,1610,1612,1628,1639 ,1651,1662,1673,1684,1697,1734,173 7,1740,1744,1748,1751,1755,1758,18 24,1857,1878,1880,1882,1916,1918,1 954 OLDTID Local 595 CHAR 8 scalar 643,648 OUTA2I Subr 567 567,1878,1880,1882,1916,1918,1954 PHIAW Local 1104 R(4) 4 1 1 PTR 121,1104,1107,1109 PHIBBL Local 1533 R(4) 4 1 1 PTR 123,1533,1535 PHIOC Local 1322 R(4) 4 1 1 PTR 121,1322,1325,1327 PHS Local 934 R(4) 4 2 1 PTR 119,934,936 PLP Local 958 R(4) 4 2 1 PTR 119,958,960 PNR Local 1023 R(4) 4 1 1 PTR 119,1023,1025 PRMS Local 1419 R(4) 4 1 1 PTR 121,1419,1422,1425 PRTBLK Subr 567 567,1734,1737,1740,1744,1748,1751, 1755,1758 PSI Local 988 R(4) 4 2 1 PTR 119,988,990 PTH Local 970 R(4) 4 2 1 PTR 119,970,971,972,976,978 PTP Local 946 R(4) 4 2 1 PTR 119,946,948 PWS Local 1000 R(4) 4 2 1 PTR 119,1000,1002 PWST Local 1012 R(4) 4 1 1 PTR 119,1012,1014 RADE Param 720 R(4) 4 scalar 720,758,893,919,972,1054,1141,1183 ,1288,1353,1396,1452,1492,1602 REAL Func 1791 scalar 1791,1795,1796,1886,1888 SCALE Local 619 L(4) 4 scalar 258,266,619,1721 SQRT Func 717 scalar 717,755,1048,1132,1174,1282,1350,1 393,1449,1489,1593,1798 SX Local 1888 R(4) 4 scalar PTR 1888 SXX Local 1251 R(4) 4 1 1 PTR 118,1251,1255 SXY Local 1253 R(4) 4 1 1 PTR 118,1253,1259 SY Local 1886 R(4) 4 scalar PTR 1886 SYY Local 1252 R(4) 4 1 1 PTR 118,1252,1257 T01 Local 870 R(4) 4 1 1 PTR 125,870,872 Page 45 Source Listing W3EXGO 2014-09-16 16:51 Symbol Table multiwaveflds.f90 Name Object Declared Type Bytes Dimen Elements Attributes References T02 Local 848 R(4) 4 1 1 PTR 124,848,850 T0M1 Local 859 R(4) 4 1 1 PTR 116,859,861 TAUBBL Local 1545 R(4) 4 2 1 PTR 123,1545,1546,1548,1550 TAUOX Local 1273 R(4) 4 1 1 PTR 120,1273,1276,1282,1283,1288,1292, 1295,1298 TAUOY Local 1274 R(4) 4 1 1 PTR 120,1274,1278,1282,1284,1287,1288, 1290,1296,1300 TAUWIX Local 1123 R(4) 4 1 1 PTR 120,1123,1126,1132,1133,1136,1141, 1143,1146,1149 TAUWIY Local 1124 R(4) 4 1 1 PTR 121,1124,1128,1132,1134,1137,1138, 1140,1141,1147,1151 TAUWNX Local 1165 R(4) 4 1 1 PTR 123,1165,1168,1174,1175,1178,1183, 1185,1188,1191 TAUWNY Local 1166 R(4) 4 1 1 PTR 123,1166,1170,1174,1176,1179,1180, 1182,1183,1189,1193 THM Local 892 R(4) 4 1 1 PTR 116,892,893,896,898 THP0 Local 918 R(4) 4 1 1 PTR 117,918,919,923,925 THS Local 907 R(4) 4 1 1 PTR 117,907,909 TIME Local 632 I(4) 4 1 1 PTR 115,243,355,632,633,634,644,645,17 89,1792,1799,1813,1822,1838,1845,1 855,1992,1999,2005 TIMEID Local 597 CHAR 8 scalar 597,643,644,646,648 TPMS Local 1423 R(4) 4 1 1 PTR 121,1423,1426 TUSX Local 1341 R(4) 4 1 1 PTR 121,1341,1344,1350,1351,1353,1358, 1361,1364 TUSY Local 1342 R(4) 4 1 1 PTR 121,1342,1346,1350,1352,1353,1355, 1362,1365 UA Local 746 R(4) 4 1 1 PTR 116,746,749,755,758,762,765,768 UABS Local 586 R(4) 4 scalar 755,756,762,1048,1051,1052,1058,12 82,1285,1286,1292,1489,1490,1496 UBA Local 1479 R(4) 4 1 1 PTR 118,1479,1482,1488,1489,1492,1496, 1500,1503 UBD Local 1480 R(4) 4 1 1 PTR 118,1480,1484,1489,1491,1492,1494, 1501,1505 UD Local 747 R(4) 4 1 1 PTR 116,747,751,755,757,758,760,766,77 0 UNDEF Local 606 R(4) 4 scalar 127,606,607,608,609,611,612,613,61 4,722,760,813,892,918,970,1049,105 0,1051,1056,1088,1133,1134,1135,11 38,1175,1176,1177,1180,1283,1284,1 285,1290,1351,1355,1356,1378,1394, 1398,1399,1448,1454,1488,1494,1594 ,1595,1596,1599,1622,1699,1700,170 1,1702,1704,1709,1776,1866,1906,19 46 UNGTYPE Param 1809 I(4) 4 scalar 1809,1828 UNITS Local 596 CHAR 10 scalar 687,705,744,778,789,800,811,823,83 4,845,856,867,878,889,904,915,931, 943,955,967,985,997,1009,1020,1037 ,1073,1085,1101,1120,1162,1200,121 2,1224,1236,1248,1270,1307,1319,13 38,1375,1417,1437,1477,1512,1530,1 542,1563,1582,1619,1634,1646,1657, 1668,1679,1736,1739,1742,1746,1750 ,1753,1757,1818,1825,1843,1850,185 Page 46 Source Listing W3EXGO 2014-09-16 16:51 Symbol Table multiwaveflds.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 8,1993,2000,2006 USERO Local 1682 R(4) 4 2 1 PTR 118,1682,1684 USSX Local 1378 R(4) 4 1 1 PTR 122,1378,1379,1384,1387,1393,1394, 1396,1401,1404,1407 USSY Local 1380 R(4) 4 1 1 PTR 122,1380,1385,1389,1393,1395,1396, 1398,1405,1409 UST Local 1039 R(4) 4 1 1 PTR 115,1039,1042,1048,1049,1054,1058, 1061,1064 USTDIR Local 1040 R(4) 4 1 1 PTR 115,1040,1044,1048,1050,1053,1054, 1056,1062,1066 VECTOR Local 698 L(4) 4 scalar 258,294,698,737,1029,1114,1156,126 4,1332,1369,1430,1470,1555,1575 W3ARRYMD Module 567 567 W3EXGO Subr 480 377 W3S2XY Subr 566 566,693,711,713,730,732,749,751,76 8,770,782,794,805,817,828,839,850, 861,872,883,898,909,925,936,948,96 0,978,990,1002,1014,1025,1042,1044 ,1064,1066,1078,1094,1109,1126,112 8,1149,1151,1168,1170,1191,1193,12 05,1217,1229,1241,1255,1257,1259,1 276,1278,1298,1300,1312,1327,1344, 1346,1364,1365,1387,1389,1407,1409 ,1425,1426,1442,1444,1463,1465,148 2,1484,1503,1505,1519,1521,1523,15 35,1548,1550,1568,1570,1587,1589,1 610,1612,1628,1639,1651,1662,1673, 1684 W3SERVMD Module 566 566 WHITECAP Local 1203 R(4) 4 2 1 PTR 124,1203,1205,1215,1217,1227,1229, 1239,1241 WLM Local 837 R(4) 4 1 1 PTR 116,837,839 WLV Local 792 R(4) 4 1 1 PTR 115,792,794 X0 Local 1823 R(4) 4 scalar PTR 1823,1856,1888 X1 Local 588 R(4) 4 2 0 606,694,731,769,783,794,805,817,82 8,839,850,861,872,883,898,909,925, 937,949,961,979,991,1003,1014,1025 ,1065,1079,1095,1110,1150,1192,120 6,1218,1230,1242,1256,1299,1313,13 28,1364,1408,1425,1464,1504,1520,1 536,1611,1628,1639,1651,1662,1673, 1685,1699,1704,1734,1744,1755,1776 ,1778,1779,1780,1781,1871,1946,194 9 X2 Local 588 R(4) 4 2 0 607,733,771,1067,1152,1194,1258,13 01,1365,1410,1426,1466,1506,1522,1 613,1700,1709,1737,1758,1872 XAVG Local 587 R(4) 4 scalar 1791,1795,1800 XDS Local 593 R(8) 8 scalar 1769,1780,1791,1795,1796 XDSQ Local 593 R(8) 8 scalar 1770,1781,1796 XGBX Local 587 R(4) 4 scalar 1888,1892,1895,1924,1928,1931,1934 ,1960,1964,1967,1970 XGRD Local 1814 R(4) 4 2 1 PTR 1814,1815,1839,1840,1846,1847,1924 ,1960 XMAX Local 586 R(4) 4 scalar 1768,1779,1793,1800 Page 47 Source Listing W3EXGO 2014-09-16 16:51 Symbol Table multiwaveflds.f90 Name Object Declared Type Bytes Dimen Elements Attributes References XMIN Local 586 R(4) 4 scalar 1767,1778,1793,1800 XS1 Local 591 R(4) 4 1 0 611,691,708,746,780,792,803,815,82 6,837,848,859,870,881,896,907,923, 934,946,958,976,988,1000,1012,1023 ,1039,1076,1092,1107,1123,1165,120 3,1215,1227,1239,1251,1273,1310,13 25,1341,1384,1422,1439,1479,1515,1 533,1545,1565,1584,1626,1637,1649, 1660,1671,1682,1994,2001,2007 XS2 Local 591 R(4) 4 1 0 612,709,747,1040,1124,1166,1252,12 74,1342,1385,1423,1440,1480,1516,1 546,1566,1585,1995,2002 XS3 Local 591 R(4) 4 1 0 613,727,765,1061,1146,1188,1253,12 95,1361,1404,1460,1500,1517,1607,1 996 XS4 Local 591 R(4) 4 1 0 614,728,766,1062,1147,1189,1296,13 62,1405,1461,1501,1608 XSTD Local 587 R(4) 4 scalar 1796,1798,1800 XX Local 589 R(4) 4 2 0 608,712,750,1043,1127,1169,1277,13 45,1388,1443,1483,1549,1569,1588,1 701,1748,1866,1906,1910 XY Local 589 R(4) 4 2 0 609,714,752,1045,1129,1171,1260,12 79,1347,1390,1445,1485,1524,1551,1 571,1590,1702,1740,1751,1873,1911 Y0 Local 1824 R(4) 4 scalar PTR 1824,1857,1886 YGBX Local 587 R(4) 4 scalar 1886,1892,1895,1923,1928,1931,1934 ,1959,1964,1967,1970 YGRD Local 1816 R(4) 4 2 1 PTR 1816,1817,1841,1842,1848,1849,1923 ,1959 Page 48 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 2054 !/ 2055 ! 2056 !/ End of WAVEFLDS ----------------------------------------------------- / 2057 !/ 2058 END PROGRAM WAVEFLDS ENTRY POINTS Name MAIN__ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1000 Label 462 390 1001 Label 466 394 1002 Label 469 398 1010 Label 473 233 1940 Label 438 265 1941 Label 440 266 2940 Label 442 279 2945 Label 429 315 2946 Label 432 328 2947 Label 433 330 3940 Label 445 295 800 Label 389 171,223 801 Label 393 172,199,229,257,274,286,304 802 Label 397 172,199,229,257,274,286,304 888 Label 401 248,360,385 900 Label 406 167 901 Label 408 174 920 Label 410 180 930 Label 412 187 931 Label 414 190 940 Label 416 205 941 Label 419 217 942 Label 421 241,255,271,284,302 943 Label 424 244 944 Label 425 247,359 945 Label 427 313 946 Label 431 323,333 948 Label 435 342 949 Label 436 344 950 Label 450 372 970 Label 453 352 971 Label 455 374 972 Label 456 383 999 Label 458 402 COMSTR Local 140 CHAR 1 scalar 172,173,174,198,221,228,256,273,28 5,303 CONSTANTS Module 103 103 DSEC21 Func 355 R(4) 4 scalar 355 DTEST Local 139 R(4) 4 scalar 355,356,364 Page 49 Source Listing W3EXGO 2014-09-16 16:51 Symbol Table multiwaveflds.f90 Name Object Declared Type Bytes Dimen Elements Attributes References DTREQ Local 139 R(4) 4 scalar 199,200,201,208,210,211,365,379 FLOG Local 142 L(4) 4 1 10 221,340 FLOGRD Local 127 L(4) 4 2 1 PTR 127,190,321 FP1 Local 117 R(4) 4 1 1 PTR 117 I Local 135 I(4) 4 scalar IDDDAY Local 140 CHAR 11 scalar 211,213,215 IDTIME Local 140 CHAR 23 scalar 204,205,209,215,216,217,243,244,37 0,372,374 IFI Local 135 I(4) 4 scalar 188,190,318,320,321,323,328,330,33 3,334 IFJ Local 135 I(4) 4 scalar 189,190,319,320,321,323,328,330,33 3,334 INT Func 211 scalar 211 IOTEST Local 136 I(4) 4 scalar 185,245,246,357,358 IOUT Local 138 I(4) 4 scalar 351,369,380 ITRACE Subr 109 109,165 J Local 135 I(4) 4 scalar 169,170,325,329 LTEMP Local 143 L(4) 4 1 20 NDSI Local 134 I(4) 4 scalar 158,170,172,198,199,221,228,229,25 6,257,273,274,285,286,303,304 NDSM Local 134 I(4) 4 scalar 159,179 NDSOG Local 134 I(4) 4 scalar 160,185,245,357 NDSTRC Local 135 I(4) 4 scalar 163,165 NEXTLN Subr 109 109,198,228,256,273,285,303 NOGE Local 127 I(4) 4 1 10 127 NOSWLL Local 127 I(4) 4 scalar PTR 127,236 NOUT Local 136 I(4) 4 scalar 199,201,202,217,380 NSEA Local 377 I(4) 4 scalar PTR 377 NTRACE Local 135 I(4) 4 scalar 164,165 NX Local 260 I(4) 4 scalar PTR 260,276,289,377 NY Local 263 I(4) 4 scalar PTR 263,278,291,377 STME21 Subr 204 204,209,243,370 TABNME Local 141 CHAR 9 scalar 327,328,329 TDUM Local 136 I(4) 4 1 2 207,208,209 THP1 Local 117 R(4) 4 1 1 PTR 117 TICK21 Subr 208 208,365,379 TOUT Local 136 I(4) 4 1 2 199,204,355,365,370,379 W3ADATMD Module 107 107,116 W3GDATMD Module 114 114 W3IOGO Subr 112 112,185,245,357 W3IOGOMD Module 112 112 W3IOGR Subr 111 111,179 W3IOGRMD Module 111 111 W3NAUX Subr 107 107,153 W3NDAT Subr 106 106,151 W3NMOD Subr 149 149 W3NOUT Subr 108 108,155 W3ODATMD Module 108 108,126 W3READFLGRD Subr 112 112,221 W3SERVMD Module 109 109 W3SETA Subr 107 107,154 W3SETG Subr 150 150 W3SETO Subr 108 108,156 W3SETW Subr 106 106,152 W3TIMEMD Module 110 110 Page 50 Source Listing W3EXGO 2014-09-16 16:51 Symbol Table multiwaveflds.f90 Name Object Declared Type Bytes Dimen Elements Attributes References W3WDATMD Module 106 106,115 WAVEFLDS Prog 2 Page 51 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 2059 Page 52 Source Listing W3EXGO 2014-09-16 16:51 Subprograms/Common Blocks multiwaveflds.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References W3EXGO Subr 480 377 WAVEFLDS Prog 2 COMPILER OPTIONS BEING USED -align nocommons -align nodcommons -align noqcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume byterecl -assume nocc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_unit_star -assume old_ldout_format -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume nostd_mod_proc_name -assume norealloc_lhs -assume underscore -assume no2underscores -auto no -auto_scalar no -bintext -ccdefault default -check noargs -check noarg_temp_created -check nobounds -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check power -check noshape -check nounderflow -check nouninitialized -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D _MT -D __INTEL_COMPILER_BUILD_DATE=20120612 -D __pentium4 -D __pentium4__ -D __tune_pentium4__ -D __SSE2__ -D __SSE3__ -D __SSSE3__ -D __SSE4_1__ -D __SSE4_2__ -D __SSE__ -D __MMX__ -D __AVX__ -double_size 64 no -d_lines no -Qdyncom -error_limit 30 no -f66 no -f77rtl no -fast -fpscomp nofilesfromcmd -fpscomp nogeneral -fpscomp noioformat -fpscomp noldio_spacing -fpscomp nologicals no -fpconstant Page 53 Source Listing W3EXGO 2014-09-16 16:51 multiwaveflds.f90 -fpe3 -fprm nearest no -ftz -fp_model noprecise -fp_model fast -fp_model nostrict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -heap_arrays 0 no -threadprivate_compat -free -g0 -iface nomixed_str_len_arg -iface nono_mixed_str_len_arg no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase no -noinclude -O2 no -pad_source -real_size 32 no -recursive -reentrancy none no -sharable_localsaves -vec=simd -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w noargument_checking -w nodeclarations -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage -includepath : /gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/,.f,./.f,/usrx/local/intel/composerxe/mkl/include/.f, /usrx/local/intel/composerxe/tbb/include/.f,/gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/.f, /gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/.f,/usr/local/include/.f,/usr/lib/gcc/x86_64-redhat-linux/4.4.7/include/.f, /usr/include/.f,/usr/include/.f -list filename : multiwaveflds.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100