Page 1 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 1 !/ ------------------------------------------------------------------- / 2 PROGRAM WAVEGRIB2 3 !/ 4 !/ +-----------------------------------+ 5 !/ | WAVEWATCH III NOAA/NCEP | 6 !/ | H. L. Tolman | 7 !/ | A. Chawla | 8 !/ | J.-H. Alves | 9 !/ | FORTRAN 90 | 10 !/ | Last update : 01-Mar-2013 | 11 !/ +-----------------------------------+ 12 !/ 13 !/ 01-Nov-1999 : Final FORTRAN 77 ( version 1.18 + error fix ) 14 !/ 24-Jan-2000 : Upgrade to FORTRAN 90 ( version 2.00 ) 15 !/ 25-Jan-2001 : Flat grid error exit added ( version 2.06 ) 16 !/ 29-Apr-2002 : Adding output fields 17-18. ( version 2.20 ) 17 !/ 08-May-2002 : Replace XLF switch with NCEP1. ( version 2.21 ) 18 !/ 13-Nov-2002 : Add stress vector. ( version 3.00 ) 19 !/ 24-Dec-2004 : Multiple grid version. ( version 3.06 ) 20 !/ 20-Jul-2005 : Additional output parameters. ( version 3.07 ) 21 !/ 11-Apr-2007 : Additional output parameters. ( version 3.11 ) 22 !/ 18-May-2007 : Update GRIB1 for partitioning. ( version 3.11 ) 23 !/ 16-Jul-2007 : Adding GRIB2 capability. ( version 3.11 ) 24 !/ (A. Chawla) 25 !/ 01-Aug-2007 : Update FLGRIB for GRIB2. ( version 3.11 ) 26 !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) 27 !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) 28 !/ (W. E. Rogers & T. J. Campbell, NRL) 29 !/ 05-Oct-2011 : Updating to the 53 output parameter ( version 4.05 ) 30 !/ (Arun Chawla) 31 !/ 01-Mar-2013 : Adding double-index output fields ( version 4.OF ) 32 !/ 08-Sep-2014 : Adding lambert conformal grid ( version 4.15 ) 33 !/ (J.H. Alves) 34 !/ 35 !/ Copyright 2009 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 multiwavegrib2.inp ( NDSI, output requests ). 48 ! Model definition and raw data files are read using WAVEWATCH III 49 ! subroutines. 50 ! GRIB packing is performed using NCEP's W3 library (not supplied). 51 ! 52 ! When adding new parameters to GRIB packing, keep in mind that 53 ! packing is done differently for scalar and vector quantities 54 ! 55 ! 3. Parameters : 56 ! 57 ! 4. Subroutines used : Page 2 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 58 ! 59 ! Name Type Module Description 60 ! ---------------------------------------------------------------- 61 ! W3NMOD Subr. W3GDATMD Set number of model. 62 ! W3SETG Subr. Id. Point to selected model. 63 ! W3NDAT Subr. W3WDATMD Set number of model for wave data. 64 ! W3SETW Subr. Id. Point to selected model for wave data. 65 ! W3NAUX Subr. W3ADATMD Set number of model for aux data. 66 ! W3SETA Subr. Id. Point to selected model for aux data. 67 ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. 68 ! STRACE Subr. Id. Subroutine tracing. 69 ! NEXTLN Subr. Id. Get next line from input filw 70 ! EXTCDE Subr. Id. Abort program as graceful as possible. 71 ! STME21 Subr. W3TIMEMD Convert time to string. 72 ! TICK21 Subr. Id. Advance time. 73 ! DSEC21 Func. Id. Difference between times. 74 ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file. 75 ! W3IOGO Subr. W3IOGOMD Reading/writing raw gridded data file. 76 ! W3READFLGRD Subr. W3IOGOMD Reading output fields flags. 77 ! W3EXGB Subr. Internal Execute grib output. 78 ! BAOPEN Subr. NCEP library routine. 79 ! BAOPENW Subr. NCEP library routine. 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 ! !/NCO NCEP NCO modifications for operational implementation. 101 ! 102 ! !/NOGRB No GRIB package included. 103 ! !/NCEP1 NCEP IBM links to GRIB1 packing routines. 104 ! !/NCEP2 NCEP IBM links to GRIB2 packing routines. 105 ! 106 ! 10. Source code : 107 ! 108 !/ ------------------------------------------------------------------- / 109 USE CONSTANTS 110 ! 111 ! USE W3GDATMD, ONLY: W3NMOD, W3SETG 112 USE W3WDATMD, ONLY: W3NDAT, W3SETW 113 ! USE W3ADATMD, ONLY: W3NAUX, W3SETA 114 USE W3ODATMD, ONLY: W3NOUT, W3SETO Page 3 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 115 USE W3IOGRMD, ONLY: W3IOGR 116 USE W3IOGOMD, ONLY: W3READFLGRD, W3IOGO 117 USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE 118 USE W3TIMEMD, ONLY: STME21, TICK21, DSEC21 119 ! 120 USE W3GDATMD 121 USE W3WDATMD, ONLY: TIME, WLV, ICE, UST, USTDIR 122 ! USE W3ADATMD, ONLY: DW, UA, UD, AS, CX, CY, HS, WLM, T0M1, THM, & 123 ! THS, FP0, THP0, FP1, THP1, DTDYN, FCUT, & 124 ! PHS, PTP, PLP, PTH, PSI, PWS, PWST, PNR, & 125 ! USERO 126 USE W3ADATMD 127 USE W3ODATMD, ONLY: NDSE, NDST, NDSO, NOGRP, NGRPP, IDOUT, UNDEF,& 128 FLOGRD, FNMPRE, NOSWLL, NOGE, FLOG 129 ! 130 IMPLICIT NONE 131 !/ 132 !/ ------------------------------------------------------------------- / 133 !/ Local variables 134 !/ 135 INTEGER :: NDSI, NDSM, NDSOG, NDSDAT, NDSTRC, & 136 NTRACE, IERR, IOTEST, I,J,K, IFI,IFJ,& 137 ISEA, IX, IY, TOUT(2), NOUT, TDUM(2),& 138 FTIME(2), CID, PID, GID, GDS, IOUT, & 139 GDTN 140 INTEGER, ALLOCATABLE :: IFIA(:),IFJA(:) 141 ! GRIB1 specific variables 142 ! GRIB2 specific variables 143 INTEGER :: KPDS(200), KGDS(200), IDRS(200) 144 INTEGER :: LISTSEC0(3), LISTSEC1(13),IGDS(5) 145 INTEGER :: IDEFLIST, IDEFNUM, KPDSNUM, NUMCOORD 146 INTEGER :: IBMP, LCGRIB, LENGRIB, IDRSNUM 147 REAL :: COORDLIST, XN 148 CHARACTER(LEN=1), ALLOCATABLE :: CGRIB(:) 149 INTEGER :: LATAN1, LONV, SCNMOD, LATIN1, & 150 LATIN2, LATSP, LONSP 151 REAL :: DSX, DSY 152 REAL :: YN, X0N, Y0N 153 REAL :: DTREQ, DTEST, RFTIME 154 LOGICAL :: FLREQ(NOGRP,NGRPP), FLGRIB(NOGRP,NGRPP) 155 CHARACTER :: COMSTR*1, IDTIME*23, IDDDAY*11 156 !/ 157 !/ ------------------------------------------------------------------- / 158 !/ 159 ! CALL W3TAGB('WAVEGRIB',1998,0007,0050,'NP21 ') 160 ! 161 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 162 ! 1. IO set-up. 163 ! 164 CALL W3NMOD ( 1, 6, 6 ) 165 CALL W3SETG ( 1, 6, 6 ) 166 CALL W3NDAT ( 6, 6 ) 167 CALL W3SETW ( 1, 6, 6 ) 168 CALL W3NAUX ( 6, 6 ) 169 CALL W3SETA ( 1, 6, 6 ) 170 CALL W3NOUT ( 6, 6 ) 171 CALL W3SETO ( 1, 6, 6 ) Page 4 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 172 ! 173 NDSI = 10 174 NDSM = 20 175 NDSOG = 20 176 NDSDAT = 50 177 ! 178 NDSTRC = 6 179 NTRACE = 10 180 ! 181 ! Redo according to NCO 182 ! 183 NDSI = 11 184 NDSO = 6 185 NDSE = NDSO 186 NDST = NDSO 187 NDSM = 12 188 NDSOG = 13 189 NDSDAT = 51 190 NDSTRC = NDSO 191 ! 192 WRITE (NDSO,900) 193 ! 194 CALL ITRACE ( NDSTRC, NTRACE ) 195 ! 196 OPEN (NDSI,FILE='multiwavegrib2.inp',STATUS='OLD',ERR=800,IOSTAT=IERR) 197 READ (NDSI,'(A)',END=801,ERR=802) COMSTR 198 IF (COMSTR.EQ.' ') COMSTR = '$' 199 WRITE (NDSO,901) COMSTR 200 ! 201 CALL BAOPENW (NDSDAT,'gribfile',IERR) 202 ! 203 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 204 ! 2. Read model definition file. 205 ! 206 CALL W3IOGR ( 'READ', NDSM ) 207 WRITE (NDSO,920) GNAME 208 ! 209 IF ( .NOT. FLAGLL ) GOTO 810 210 ! 211 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 212 ! 3. Read requests from input file. 213 ! Output times 214 ! 215 CALL NEXTLN ( COMSTR , NDSI , NDSE ) 216 READ (NDSI,*,END=801,ERR=802) TOUT, DTREQ, NOUT 217 DTREQ = MAX ( 0. , DTREQ ) 218 IF ( DTREQ.EQ.0 ) NOUT = 1 219 NOUT = MAX ( 1 , NOUT ) 220 ! 221 CALL STME21 ( TOUT , IDTIME ) 222 WRITE (NDSO,940) IDTIME 223 ! 224 TDUM(1) = 0 225 TDUM(2) = 0 226 CALL TICK21 ( TDUM , DTREQ ) 227 CALL STME21 ( TDUM , IDTIME ) 228 IF ( DTREQ .GE. 86400. ) THEN Page 5 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 229 WRITE (IDDDAY,'(I10,1X)') INT(DTREQ/86400.) 230 ELSE 231 IDDDAY = ' ' 232 END IF 233 IDTIME(1:11) = IDDDAY 234 IDTIME(21:23) = ' ' 235 WRITE (NDSO,941) IDTIME, NOUT 236 ! 237 ! ... Initialize FLGRD array 238 ! 239 FLREQ(:,:)=.FALSE. 240 ! 241 ! ... Call to interface for reading flags or namelists 242 ! 243 CALL W3READFLGRD ( NDSI, NDSO, 9, NDSE, COMSTR, FLOG, FLREQ, & 244 1, 1, IERR ) 245 ! 246 ! Inform user of parameters that were requested but failed to make the 247 ! grade, as they are not available for grib encoding, or are not 248 ! included presently 249 ! 250 WRITE (NDSO,944) 251 ! Reset flags for variables not yet implemented in grib output 252 ! interface 253 ! 254 IFI = 3 ! Entire group Frequency-dependent parameters 255 DO IFJ = 1,NOGE(IFI) 256 IF ( FLREQ(IFI,IFJ) ) THEN 257 WRITE (NDSO,946) IDOUT(IFI,IFJ), & 258 '*** NOT YET CODED INTO WW3_GRIB ***' 259 FLREQ(IFI,IFJ) = .FALSE. 260 END IF 261 END DO 262 ! 263 IFI = 5 ! Atm-waves layer, all except for friction velocity 264 DO IFJ = 2,10 265 IF ( FLREQ(IFI,IFJ) ) THEN 266 WRITE (NDSO,946) IDOUT(IFI,IFJ), & 267 '*** NOT YET CODED INTO WW3_GRIB ***' 268 FLREQ(IFI,IFJ) = .FALSE. 269 END IF 270 END DO 271 DO IFI = 6,8 ! Entire groups wave-ocean interaction, wave-bottom 272 ! layer and spectrum parameters 273 DO IFJ = 1,NOGE(IFI) 274 IF ( FLREQ(IFI,IFJ) ) THEN 275 WRITE (NDSO,946) IDOUT(IFI,IFJ), & 276 '*** NOT YET CODED INTO WW3_GRIB ***' 277 FLREQ(IFI,IFJ) = .FALSE. 278 END IF 279 END DO 280 END DO 281 IF ( FLREQ(9,5) ) THEN ! CFL number for K advection 282 WRITE (NDSO,946) IDOUT(9,5),'*** NOT YET CODED INTO WW3_GRIB ***' 283 FLREQ(9,5) = .FALSE. 284 END IF 285 IFI = 10 ! User defined parameters Page 6 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 286 DO IFJ = 1,NOGE(IFI) 287 IF ( FLREQ(IFI,IFJ) ) THEN 288 WRITE (NDSO,946) IDOUT(IFI,IFJ), & 289 '*** NOT YET CODED INTO WW3_GRIB ***' 290 FLREQ(IFI,IFJ) = .FALSE. 291 END IF 292 END DO 293 ! 294 ! Compatibility with NCEP operational codes, same effect as old FLGRIB 295 ! lists variables that have no code for variable names (not 100% 296 ! correct in old codes... ) 297 ! 298 ! Chage this as parameters become available in grib2 tables 299 ! 300 ALLOCATE ( IFIA (16), IFJA(16) ) 301 302 IFIA = (/ 1, 1, 2, 2, 2, 2, 4, 4, 4, 4, 4, 5, 9, 9, 9, 9 /) 303 IFJA = (/ 1, 4, 2 ,3, 5, 8, 3, 5, 6, 7, 8, 1, 1, 2, 3, 4 /) 304 DO I = 1, 16 305 FLREQ(IFIA(I),IFJA(I)) = .FALSE. ! Water depth 306 WRITE(NDSO,946) IDOUT(IFIA(I),IFJA(I)), & 307 '*** EXCLUDED FROM GRIB OUTPUT ***' 308 END DO 309 ! 310 ! Write to stdout parameters that have successfully been requested 311 ! 312 WRITE (NDSO,945) 313 DO I=1, NOGRP 314 DO J=1, NGRPP 315 IF ( FLREQ(I,J) ) WRITE (NDSO,931) IDOUT(I,J) 316 END DO 317 END DO 318 ! 319 ! ... GRIB specific parameters 320 ! 321 CALL NEXTLN ( COMSTR , NDSI , NDSE ) 322 READ (NDSI,*,END=801,ERR=802) FTIME, CID, PID, GID, GDS, GDTN 323 ! 324 ! Check if grid type is curvilinear, and only go on if Lambert conformal 325 ! 326 IF ( GTYPE .EQ. CLGTYPE ) THEN 327 IF ( GDTN .NE. 30 ) THEN 328 WRITE(NDSE,*)'PROGRAM WAVEGRIB2: CURVILINEAR GRID SUPPORT '// & 329 'FOR GRIB OUTPUT IS NOT YET IMPLEMENTED. NOW STOPPING' 330 CALL EXTCDE ( 1 ) 331 ENDIF 332 END IF 333 ! 334 ! Call addtional information if GDTN != 0 (rectiliner/regular) 335 ! Coded up to now only for Lamber conformal grids (GDTN=30) 336 ! For regular grids use GDTN=0 337 ! 338 IF ( GDTN .EQ. 30 ) THEN 339 CALL NEXTLN ( COMSTR , NDSI , NDSE ) 340 READ (NDSI,*,END=801,ERR=802) LATAN1, LONV, DSX, DSY, & 341 SCNMOD, LATIN1, LATIN2, LATSP, LONSP 342 ENDIF Page 7 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 343 ! 344 CALL STME21 ( FTIME , IDTIME ) 345 WRITE (NDSO,948) IDTIME, CID, PID, GID, GDS 346 ! 347 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 348 ! 4. Read general data and first fields from file 349 ! 4.a Read file. 350 ! 351 CALL W3IOGO ( 'READ', NDSOG, IOTEST ) 352 ! 353 ! 4.b Output fields in file 354 ! 355 WRITE (NDSO,930) 356 DO I=1, NOGRP 357 DO J=1, NGRPP 358 IF ( FLOGRD(I,J) ) WRITE (NDSO,931) IDOUT(I,J) 359 END DO 360 END DO 361 ! 362 IF ( GDTN .EQ. 0 ) THEN 363 ! 4.c Flip MAPSF for REGULAR/RECTILINEAR grids 364 ! 365 DO ISEA=1, NSEA 366 IX = MAPSF(ISEA,1) 367 IY = MAPSF(ISEA,2) 368 MAPSF(ISEA,2) = NY + 1 - IY 369 MAPSF(ISEA,3) = IY +( IX-1)*NY 370 END DO 371 ENDIF 372 ! 373 !--- - - - - - - - - - - - - - - - - - - - - - - - - - 374 ! 5. Set grib encoding parameter Sections 375 ! 376 ! ... Initialize KPDS and KGDS (for both NCEP1 and NCEP2) 377 ! 378 KPDS = 0 379 KGDS = 0 380 ! 381 ! ... Set PDS GRIB1 elements 382 ! 383 ! ( 1) ID OF CENTER 384 ! ( 2) GENERATING PROCESS ID NUMBER 385 ! ( 3) GRID DEFINITION 386 ! ( 4) GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) 387 ! ** ( 5) INDICATOR OF PARAMETER 388 ! ( 6) TYPE OF LEVEL 389 ! ( 7) HEIGHT/PRESSURE , ETC OF LEVEL 390 ! * ( 8) YEAR of century 391 ! * ( 9) MONTH OF YEAR 392 ! * (10) DAY OF MONTH 393 ! * (11) HOUR OF DAY 394 ! (12) MINUTE OF HOUR 395 ! (13) INDICATOR OF FORECAST TIME UNIT 396 ! * (14) TIME RANGE 1 397 ! (15) TIME RANGE 2 398 ! (16) TIME RANGE FLAG 399 ! (17) NUMBER INCLUDED IN AVERAGE Page 8 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 400 ! (18) VERSION NR OF GRIB SPECIFICATION 401 ! (19) VERSION NR OF PARAMETER TABLE 402 ! (20) NR MISSING FROM AVERAGE/ACCUMULATION 403 ! * (21) CENTURY OF REFERENCE TIME OF DATA 404 ! (22) UNITS DECIMAL SCALE FACTOR 405 ! (23) SUBCENTER NUMBER 406 ! (24) PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS 407 ! (25) PDS BYTE 30, NOT USED 408 ! 409 ! * : Changing on the fly in main program 410 ! ** : Changing on the fly in W3EXGB 411 ! 412 ! ... Set GDS GRIB1 elements 413 ! 414 ! ( 1) DATA REPRESENTATION TYPE 415 ! ( 2) N(I) NR POINTS ON LATITUDE CIRCLE 416 ! ( 3) N(J) NR POINTS ON LONGITUDE MERIDIAN 417 ! ( 4) LA(1) LATITUDE OF ORIGIN 418 ! ( 5) LO(1) LONGITUDE OF ORIGIN 419 ! ( 6) RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) 420 ! ( 7) LA(2) LATITUDE OF EXTREME POINT 421 ! ( 8) LO(2) LONGITUDE OF EXTREME POINT 422 ! ( 9) DI LONGITUDINAL DIRECTION OF INCREMENT 423 ! (10) DJ LATITUDINAL DIRECTION INCREMENT 424 ! (11) SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) 425 ! (19) NUMBER OF VERTICAL COORDINATE PARAMETERS 426 ! (20) OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE 427 ! PARAMETERS OR OCTET NUMBER OF THE LIST OF NUMBERS 428 ! OF POINTS IN EACH ROW OR 255 IF NEITHER ARE PRESENT 429 ! (21) FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID 430 ! (22) NUMBER OF WORDS IN EACH ROW 431 ! 432 ! ... Set GRIB2 packing arrays 433 ! 434 LCGRIB = 4*NX*NY 435 ALLOCATE(CGRIB(LCGRIB)) 436 ! 437 ! ... Set GRIB2 Indicator Section 438 ! ( 1) Discipline-GRIB Master Table Number (see Code Table 0.0) 439 ! 0 = Metereological; 10 = Oceanographic 440 ! ( 2) GRIB Edition Number 441 ! ( 3) 442 LISTSEC0 = 0 443 LISTSEC0(1) = 10 444 LISTSEC0(2) = 2 445 ! 446 ! ... Set GRIB2 Identification Section 447 ! ( 1) ID OF CENTER 448 ! ( 2) ID OF SUB-CENTER 449 ! ( 3) GRIB Master Tables Version Number (Code Table 1.0) 450 ! ( 4) GRIB Local Tables Version Number (Code Table 1.0) 451 ! ( 5) Significance of Reference Time (Code Table 1.2) 452 ! * ( 6) YEAR (4 digits) 453 ! * ( 7) MONTH OF YEAR 454 ! * ( 8) DAY OF MONTH 455 ! * ( 9) HOUR OF DAY 456 ! (10) MINUTE OF HOUR Page 9 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 457 ! (11) SECOND OF MINUTE 458 ! (12) Production status of data (Code Table 1.3) 459 ! (13) Type of processed data (Code Table 1.4) 460 ! 461 LISTSEC1 = 0 462 LISTSEC1(1) = CID 463 LISTSEC1(3) = 2 464 LISTSEC1(4) = 1 465 LISTSEC1(5) = 1 466 LISTSEC1(13) = 1 467 ! 468 ! ... Set GRIB2 IGDS elements 469 ! ( 1) Source of grid definition (Code Table 3.0) 470 ! ( 2) Number of grid points 471 ! ( 3) Number of octets needed for each additional grid points definition 472 ! ( 4) Interpretation of list for optional points definition (Code Table 3.11) 473 ! ( 5) Grid definition template number (Code Table 3.1) 474 ! 475 IF ( GDTN .EQ. 30 .AND. GTYPE .EQ. CLGTYPE ) THEN 476 IGDS = 0 ! Defined in code 477 IGDS(2) = NX*NY 478 IGDS(5)=GDTN 479 IDEFNUM = 1 480 IDEFLIST = 0 481 ELSEIF ( GDTN .EQ. 0 ) THEN 482 IGDS = 0 483 IGDS(2) = NX*NY 484 IDEFNUM = 0 485 IDEFLIST = 0 486 ELSE 487 WRITE(NDSE,*)'PROGRAM WAVEGRIB2: SUPPORT FOR CHOSEN '// & 488 'GRIB2 GRID DEFINITION TEMPLATE NOT YET IMPLEMENTED' 489 CALL EXTCDE ( 2 ) 490 ENDIF 491 ! 492 ! ... Set GRIB2 KGDS elements 493 ! ( 1) Coordinate system (6 = spherical coordinate system with radius of 6,371,229 m) 494 ! ( 2) 495 ! ( 3) 496 ! ( 4) 497 ! ( 5) 498 ! ( 6) 499 ! ( 7) 500 ! ( 8) Number of points along parallel 501 ! ( 9) Number of points along meridian 502 ! (10) 503 ! (11) 504 ! (12) Latitude of first grid point 505 ! (13) Longitude of first grid point 506 ! (14) Res and comp flags 507 ! (15) Latitude of last grid point 508 ! (16) Longitude of last grid point 509 ! (17) Increment of longitude 510 ! (18) Increment of latitude 511 ! (19) Scanning mode 512 ! 513 KGDS( 1) = 6 Page 10 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 514 KGDS( 8) = NX 515 KGDS( 9) = NY 516 517 IF ( GDTN .EQ. 30 ) THEN 518 X0 = MOD(XGRD(1,1) + 360.,360.) 519 XN = MOD(XGRD(NY,NX) + 360., 360.) 520 X0N = MOD(XGRD(NY,1) + 360., 360.) 521 KGDS(11)=NINT(1000000._8*X0) 522 Y0 = YGRD(1,1) 523 YN = YGRD(NY,NX) 524 Y0N = YGRD(NY,1) 525 KGDS(10)=NINT(1000000._8*Y0) 526 KGDS(12)=0 527 KGDS(13)=1000000._8*LATAN1 528 KGDS(14)=1000000._8*LONV 529 KGDS(15)=NINT(1000000._8*DSX) 530 KGDS(16)=NINT(1000000._8*DSY) 531 KGDS(17)=0 532 KGDS(18)=SCNMOD 533 KGDS(19)=1000000._8*LATIN1 534 KGDS(20)=1000000._8*LATIN2 535 KGDS(21)=1000000._8*LATSP 536 KGDS(22)=1000000._8*LONSP 537 ELSEIF (GDTN .EQ. 0 ) THEN 538 KGDS(12) = NINT(1000000._8*(Y0+(REAL(NY-1)*SY))) 539 X0 = MOD(X0 + 360.,360.) 540 KGDS(13) = NINT(1000000._8*X0) 541 KGDS(14) = 48 542 KGDS(15) = NINT(1000000._8*Y0) 543 XN = MOD(X0+REAL(NX-1)*SX + 360., 360.) 544 KGDS(16) = NINT(1000000._8*XN) 545 KGDS(17) = NINT(1000000._8*SX) 546 KGDS(18) = NINT(1000000._8*SY) 547 ENDIF 548 ! 549 ! ... Set GRIB2 PDS elements 550 ! KPDSNUM (0 indicates forecast at a horizontal level) 551 ! ( 1) Parameter category (Code Table 4.1) 552 ! For oceanographic products -- 0 = waves; 1 = currents; 2 = ice 553 ! For atmospheric products -- 2 = momentum 554 ! ( 2) Parameter number (Code Table 4.2) 555 ! ( 3) Generating process (Code Table 4.3) 556 ! ( 4) Background generating process identifier (center specific) 557 ! ( 5) Process or model number 558 ! ( 6) Hours of observational data cutoff after reference time 559 ! ( 7) Minutes of observational data cutoff after reference time 560 ! ( 8) Indicator of forecast time unit (Code Table 4.4) 561 ! ( 9) Time range 562 ! (10) Type of level (Code Table 4.5) 1st level 563 ! (11) Scaled factor of (10) 564 ! (12) Scaled value of (10) 565 ! (13) Type of level (Code Table 4.5) 2nd level 566 ! (14) Scaled factor of (13) 567 ! (15) Scaled value of (13) 568 ! 569 KPDSNUM = 0 570 KPDS( 3) = 2 Page 11 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 571 KPDS( 4) = 0 572 KPDS( 5) = PID 573 KPDS( 8) = 1 574 KPDS(10) = 1 575 KPDS(12) = 1 576 KPDS(13) = 255 577 ! 578 ! ... Set GRIB2 vertical layer information 579 ! 580 NUMCOORD = 0 581 COORDLIST = 0.0 582 ! 583 ! ... Set GRIB2 bitmap information 584 ! 0 Bitmap is provided 585 ! 586 IBMP = GDS 587 ! 588 ! ... Set GRIB2 Data Representation Template Number (Code Table 5.0) 589 ! 590 IDRSNUM = 40 !jpeg2000 *** SEGFAULTS in some linux 591 ! clusters with Intel compiler *** 592 !IDRSNUM = 0 !simple packing 593 !IDRSNUM = 41 !png packing 594 !IDRSNUM = 2 !Complex Packing (Grid Point Data) 595 ! 596 ! ... Set GRIB2 IDRS elements 597 ! ( 1) Reference value (R) (IEEE 32-bit floating-point value) 598 ! ( 2) Binary Scale Factor (E) 599 ! ( 3) Decimal Scale Factor (D) 600 ! ( 4) Number of bits used for each packed value 601 ! ( 5) Type of original field values (Code Table 5.1) 602 ! 603 IDRS = 0 604 IDRS(3) = 2 605 ! 606 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 607 ! 6. Time management. 608 ! 609 IOUT = 0 610 WRITE (NDSO,970) 611 ! 612 DO 613 DTEST = DSEC21 ( TIME , TOUT ) 614 IF ( DTEST .GT. 0. ) THEN 615 CALL W3IOGO ( 'READ', NDSOG, IOTEST ) 616 IF ( IOTEST .EQ. -1 ) THEN 617 WRITE (NDSO,942) 618 GOTO 888 619 END IF 620 CYCLE 621 END IF 622 IF ( DTEST .LT. 0. ) THEN 623 CALL TICK21 ( TOUT , DTREQ ) 624 CYCLE 625 END IF 626 ! 627 IOUT = IOUT + 1 Page 12 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 628 CALL STME21 ( TOUT , IDTIME ) 629 ! 630 RFTIME = DSEC21 ( FTIME , TIME ) / 3600. 631 IF ( RFTIME .LT. 0. ) THEN 632 LISTSEC1( 6) = TIME(1)/10000 633 LISTSEC1( 7) = MOD(TIME(1),10000) / 100 634 LISTSEC1( 8) = MOD(TIME(1),100) 635 LISTSEC1( 9) = TIME(2) / 10000 636 KPDS( 9) = 0 637 WRITE (NDSO,972) IDTIME 638 ELSE 639 LISTSEC1( 6) = FTIME(1)/10000 640 LISTSEC1( 7) = MOD(FTIME(1),10000) / 100 641 LISTSEC1( 8) = MOD(FTIME(1),100) 642 LISTSEC1( 9) = FTIME(2) / 10000 643 KPDS( 9) = NINT(RFTIME) 644 WRITE (NDSO,971) IDTIME, NINT(RFTIME) 645 END IF 646 ! 647 CALL W3EXGB ( NX, NY, NSEA ) 648 CALL TICK21 ( TOUT , DTREQ ) 649 IF ( IOUT .GE. NOUT ) EXIT 650 END DO 651 ! 652 GOTO 888 653 ! 654 ! Escape locations read errors : 655 ! 656 800 CONTINUE 657 WRITE (NDSE,1000) IERR 658 CALL EXTCDE ( 3 ) 659 ! 660 801 CONTINUE 661 WRITE (NDSE,1001) 662 CALL EXTCDE ( 4 ) 663 ! 664 802 CONTINUE 665 WRITE (NDSE,1002) IERR 666 CALL EXTCDE ( 5 ) 667 ! 668 810 CONTINUE 669 IF ( .NOT. FLAGLL ) THEN 670 WRITE (NDSE,1010) 671 CALL EXTCDE ( 10 ) 672 END IF 673 ! 674 888 CONTINUE 675 WRITE (NDSO,999) 676 ! 677 ! CALL W3TAGE('WAVEGRIB') 678 ! 679 ! Formats 680 ! 681 900 FORMAT (/15X,' *** WAVEWATCH III GRIB output postp. *** '/ & 682 15X,'=============================================='/) 683 901 FORMAT ( ' Comment character is ''',A,''''/) 684 902 FORMAT (/' *** WARNING : NO GRIB PACKAGE LINKED ***'/) Page 13 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 685 ! 686 920 FORMAT ( ' Grid name : ',A/) 687 ! 688 930 FORMAT ( ' Fields in file : '/ & 689 ' --------------------------') 690 931 FORMAT ( ' ',A) 691 ! 692 940 FORMAT (/' Output time data : '/ & 693 ' -----------------------------------------------------'/ & 694 ' First time : ',A) 695 941 FORMAT ( ' Interval : ',A/ & 696 ' Number of requests : ',I4) 697 942 FORMAT (/' End of file reached '/) 698 ! 699 944 FORMAT (/' Requested output fields not yet available: '/ & 700 ' -----------------------------------------------------') 701 ! 702 945 FORMAT (/' Successfully requested output fields : '/ & 703 ' -----------------------------------------------------') 704 946 FORMAT ( ' ',A,1X,A) 705 ! 706 948 FORMAT (/' Additional GRIB parameters : '/ & 707 ' -----------------------------------------------------'/ & 708 ' Run time : ',A/ & 709 ' GRIB center ID : ',I4/ & 710 ' GRIB gen. proc. ID : ',I4/ & 711 ' GRIB grid ID : ',I4/ & 712 ' GRIB GDS parameter : ',I4) 713 ! 714 970 FORMAT (//' Generating file '/ & 715 ' -----------------------------------------------------') 716 971 FORMAT ( ' Data for ',A,' ',I3,'H forecast.') 717 972 FORMAT ( ' Data for ',A,' hindcast.') 718 ! 719 999 FORMAT (/' End of program '/ & 720 ' ========================================='/ & 721 ' WAVEWATCH III GRIB output '/) 722 ! 723 1000 FORMAT (/' *** WAVEWATCH III ERROR IN WAVEGRIB2 : '/ & 724 ' ERROR IN OPENING INPUT FILE'/ & 725 ' IOSTAT =',I5/) 726 ! 727 1001 FORMAT (/' *** WAVEWATCH III ERROR IN WAVEGRIB2 : '/ & 728 ' PREMATURE END OF INPUT FILE'/) 729 ! 730 1002 FORMAT (/' *** WAVEWATCH III ERROR IN WAVEGRIB2 : '/ & 731 ' ERROR IN READING FROM INPUT FILE'/ & 732 ' IOSTAT =',I5/) 733 ! 734 1005 FORMAT (/' *** WAVEWATCH III ERROR IN WAVEGRIB2 : '/ & 735 ' OUTPUT REQUESTED FOR FIELDS THAT SHARE KPDS(5)'/ & 736 ' FIRST FIELD : ',A/ & 737 ' SECOND FIELD : ',A/) 738 ! 739 1010 FORMAT (/' *** WAVEWATCH-III ERROR IN WAVEGRIB2 : '/ & 740 ' GRIB REQUIRES SPHERICAL GRID'/) 741 !/ Page 14 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 742 !/ Internal subroutine W3EXGB ---------------------------------------- / 743 !/ 744 CONTAINS 745 !/ ------------------------------------------------------------------- / 746 SUBROUTINE W3EXGB ( NX, NY, NSEA ) 747 !/ 748 !/ +-----------------------------------+ 749 !/ | WAVEWATCH III NOAA/NCEP | 750 !/ | H. L. Tolman | 751 !/ | A. Chawla | 752 !/ | FORTRAN 90 | 753 !/ | Last update : 16-Jul-2007 | 754 !/ +-----------------------------------+ 755 !/ 756 !/ 10-Jun-1999 : Final FORTRAN 77 ( version 1.18 ) 757 !/ 24-Jan-2000 : Upgrade to FORTRAN 90 ( version 2.00 ) 758 !/ Massive changes to logistics. 759 !/ 29-Apr-2002 : Adding output fields 17-18. ( version 2.20 ) 760 !/ 24-Dec-2004 : Multiple grid version. ( version 3.06 ) 761 !/ 18-May-2007 : Update GRIB1 for partitioning. ( version 3.11 ) 762 !/ 16-Jul-2007 : Adding GRIB2 capability ( version 3.11 ) 763 !/ (A. Chawla) 764 !/ 765 ! 1. Purpose : 766 ! 767 ! Perform actual GRIB output. 768 ! 769 ! 3. Parameters : 770 ! 771 ! Parameter list 772 ! ---------------------------------------------------------------- 773 ! NX, NY, NSEA 774 ! Int. I Array dimensions. 775 ! ---------------------------------------------------------------- 776 ! 777 ! Internal parameters 778 ! ---------------------------------------------------------------- 779 ! X1, X2, XX, XY 780 ! R.A. Output fields 781 ! BITMAP L.A. Data / no data bitmap 782 ! ---------------------------------------------------------------- 783 ! 784 ! 4. Subroutines used : 785 ! 786 ! Name Type Module Description 787 ! ---------------------------------------------------------------- 788 ! STRACE Subr. W3SERVMD Subroutine tracing. 789 ! EXTCDE Subr. Id. Abort program as graceful as possible. 790 ! W3S2XY Subr. Id. Convert from storage to spatial grid. 791 ! PUTGB Subr. NCEP GRIB1 library routine. 792 ! GRIBCREATE Subr. NCEP GRIB2 library routine. 793 ! ADDGRID Subr. NCEP GRIB2 library routine. 794 ! ADDFIELD Subr. NCEP GRIB2 library routine. 795 ! GRIBEND Subr. NCEP GRIB2 library routine. 796 ! WRYTE Subr. NCEP GRIB2 library routine. 797 ! ---------------------------------------------------------------- 798 ! Page 15 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 799 ! 5. Called by : 800 ! 801 ! Program in which it is contained. 802 ! 803 ! 6. Error messages : 804 ! 805 ! None. 806 ! 807 ! 7. Remarks : 808 ! 809 ! - Note that arrays CX and CY of the main program now contain 810 ! the absolute current speed and direction respectively. 811 ! 812 ! 8. Structure : 813 ! 814 ! See source code. 815 ! 816 ! 9. Switches : 817 ! 818 ! !/S Enable subroutine tracing. 819 ! !/T Enable test output. 820 ! !/NCEP1 NCEP IBM calls to GRIB1 packer. 821 ! !/NCEP2 NCEP IBM calls to GRIB2 packer (follows updated grib2 822 ! tables under verification as of 02/10/2012). 823 ! 824 ! 10. Source code : 825 ! 826 !/ ------------------------------------------------------------------- / 827 USE W3SERVMD, ONLY : W3S2XY 828 !/ 829 !/ ------------------------------------------------------------------- / 830 !/ Parameter list 831 !/ 832 INTEGER, INTENT(IN) :: NX, NY, NSEA 833 !/ 834 !/ ------------------------------------------------------------------- / 835 !/ Local parameters 836 !/ 837 INTEGER :: J, IXY, NDATA 838 INTEGER :: IO 839 REAL :: X1(NX*NY), X2(NX*NY), XX(NX*NY), & 840 XY(NX*NY), CABS, UABS, & 841 YY(NX*NY,0:NOSWLL), KPDS5A, KPDS5B 842 LOGICAL*1 :: BITMAP(NX*NY) 843 LOGICAL :: FLONE, FLTWO, FLDIR, FLTRI, FLPRT 844 !/ 845 !/ ------------------------------------------------------------------- / 846 !/ 847 ! 848 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 849 ! 1. Preparations 850 ! 851 X1 = UNDEF 852 X2 = UNDEF 853 XX = UNDEF 854 XY = UNDEF 855 YY = UNDEF Page 16 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 856 ! 857 !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 858 ! 2. Loop over output fields. 859 ! 860 DO IFI=1, NOGRP 861 DO IFJ=1, NGRPP 862 IF ( FLREQ(IFI,IFJ) ) THEN 863 864 865 ! 866 ! Initialize array dimension flags 867 ! 868 FLONE = .FALSE. 869 FLTWO = .FALSE. 870 FLDIR = .FALSE. 871 FLTRI = .FALSE. 872 FLPRT = .FALSE. 873 ! 874 ! 2.a Set output arrays and parameters 875 ! 876 ! Water depth 877 ! 878 IF ( IFI .EQ. 1 .AND. IFJ .EQ. 1 ) THEN 879 FLONE = .TRUE. 880 KPDS(2) = 255 881 KPDS(1) = 255 882 CALL W3S2XY ( NSEA, NSEA, NX, NY, DW(1:NSEA) & 883 , MAPSF, X1 ) 884 ! 885 ! Current 886 ! 887 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 2 ) THEN 888 FLTWO = .TRUE. 889 KPDS(2) = 1 890 KPDS(1) = 1 891 CALL W3S2XY ( NSEA, NSEA, NX, NY, CX(1:NSEA) & 892 , MAPSF, XX ) 893 CALL W3S2XY ( NSEA, NSEA, NX, NY, CY(1:NSEA) & 894 , MAPSF, XY ) 895 DO ISEA=1, NSEA 896 IF (CX(ISEA) .NE. UNDEF) THEN 897 CABS = SQRT(CX(ISEA)**2+CY(ISEA)**2) 898 IF ( CABS .GT. 0.001 ) THEN 899 CY(ISEA) = MOD ( 630. - & 900 RADE*ATAN2(CY(ISEA),CX(ISEA)) , 360. ) 901 ELSE 902 CY(ISEA) = 0. 903 END IF 904 ELSE 905 CABS = UNDEF 906 CY(ISEA) = UNDEF 907 END IF 908 CX(ISEA) = CABS 909 END DO 910 CALL W3S2XY ( NSEA, NSEA, NX, NY, CX(1:NSEA) & 911 , MAPSF, X1 ) 912 CALL W3S2XY ( NSEA, NSEA, NX, NY, CY(1:NSEA) & Page 17 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 913 , MAPSF, X2 ) 914 ! 915 ! Wind speed 916 ! 917 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 3 ) THEN 918 FLTWO = .TRUE. 919 KPDS(2) = 1 920 KPDS(1) = 2 921 LISTSEC0(1) = 0 922 CALL W3S2XY ( NSEA, NSEA, NX, NY, UA(1:NSEA) & 923 , MAPSF, XX ) 924 CALL W3S2XY ( NSEA, NSEA, NX, NY, UD(1:NSEA) & 925 , MAPSF, XY ) 926 DO ISEA=1, NSEA 927 IF (UA(ISEA) .NE. UNDEF) THEN 928 UABS = SQRT(UA(ISEA)**2+UD(ISEA)**2) 929 IF ( UABS .GT. 0.001 ) THEN 930 UD(ISEA) = MOD ( 630. - & 931 RADE*ATAN2(UD(ISEA),UA(ISEA)) , 360. ) 932 ELSE 933 UD(ISEA) = 0. 934 END IF 935 ELSE 936 UABS = UNDEF 937 UD(ISEA) = UNDEF 938 END IF 939 UA(ISEA) = UABS 940 END DO 941 CALL W3S2XY ( NSEA, NSEA, NX, NY, UA(1:NSEA) & 942 , MAPSF, X1 ) 943 CALL W3S2XY ( NSEA, NSEA, NX, NY, UD(1:NSEA) & 944 , MAPSF, X2 ) 945 ! 946 ! Air-sea temp. dif. 947 ! 948 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 4 ) THEN 949 FLONE = .TRUE. 950 KPDS(2) = 255 951 KPDS(1) = 255 952 CALL W3S2XY ( NSEA, NSEA, NX, NY, AS(1:NSEA) & 953 , MAPSF, X1 ) 954 ! 955 ! Water level 956 ! 957 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 5 ) THEN 958 FLONE = .TRUE. 959 KPDS(2) = 1 960 KPDS(1) = 3 961 CALL W3S2XY ( NSEA, NSEA, NX, NY, WLV , MAPSF, X1 ) 962 ! 963 ! Ice concentration 964 ! 965 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 6 ) THEN 966 FLONE = .TRUE. 967 KPDS(2) = 0 968 KPDS(1) = 2 969 CALL W3S2XY ( NSEA, NSEA, NX, NY, ICE , MAPSF, X1 ) Page 18 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 970 ! 971 ! Significant wave height 972 ! 973 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 1 ) THEN 974 FLONE = .TRUE. 975 KPDS(2) = 3 976 CALL W3S2XY ( NSEA, NSEA, NX, NY, HS , MAPSF, X1 ) 977 ! 978 ! Mean wave length 979 ! 980 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 2 ) THEN 981 FLONE = .TRUE. 982 KPDS(2) = 255 983 CALL W3S2XY ( NSEA, NSEA, NX, NY, WLM , MAPSF, X1 ) 984 ! 985 ! Mean wave period (based on second moment) 986 ! 987 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 3 ) THEN 988 FLONE = .TRUE. 989 KPDS(2) = 255 990 CALL W3S2XY ( NSEA, NSEA, NX, NY, T02 , MAPSF, X1 ) 991 ! 992 ! Mean wave period (based on first moment) 993 ! 994 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 4 ) THEN 995 FLONE = .TRUE. 996 KPDS(2) = 15 997 CALL W3S2XY ( NSEA, NSEA, NX, NY, T0M1 , MAPSF, X1 ) 998 ! 999 ! Mean wave period (based on first inverse moment) 1000 ! 1001 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 5 ) THEN 1002 FLONE = .TRUE. 1003 KPDS(2) = 255 1004 CALL W3S2XY ( NSEA, NSEA, NX, NY, T01 , MAPSF, X1 ) 1005 ! 1006 ! Peak frequency 1007 ! 1008 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 6 ) THEN 1009 FLONE = .TRUE. 1010 KPDS(2) = 11 1011 DO ISEA=1, NSEA 1012 IF ( FP0(ISEA) .NE. UNDEF .AND. FP0(ISEA) .NE. 0 ) THEN 1013 FP0(ISEA) = 1. / FP0(ISEA) 1014 END IF 1015 END DO 1016 CALL W3S2XY ( NSEA, NSEA, NX, NY, FP0 , MAPSF, X1 ) 1017 ! 1018 ! Mean wave direction 1019 ! 1020 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 7 ) THEN 1021 FLONE = .TRUE. 1022 KPDS(2) = 255 1023 DO ISEA=1, NSEA 1024 IF ( THM(ISEA) .NE. UNDEF ) & 1025 THM(ISEA) = MOD ( 630. - RADE*THM(ISEA) , 360. ) 1026 END DO Page 19 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 1027 CALL W3S2XY ( NSEA, NSEA, NX, NY, THM , MAPSF, X1 ) 1028 ! 1029 ! Directional spread 1030 ! 1031 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 8 ) THEN 1032 FLONE = .TRUE. 1033 KPDS(2) = 255 1034 CALL W3S2XY ( NSEA, NSEA, NX, NY, THS , MAPSF, X1 ) 1035 ! 1036 ! Peak direction 1037 ! 1038 ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 9 ) THEN 1039 FLONE = .TRUE. 1040 KPDS(2) = 10 1041 DO ISEA=1, NSEA 1042 IF ( THP0(ISEA) .NE. UNDEF ) THEN 1043 THP0(ISEA) = MOD ( 630-RADE*THP0(ISEA) , 360. ) 1044 END IF 1045 END DO 1046 CALL W3S2XY ( NSEA, NSEA, NX, NY, THP0 , MAPSF, X1 ) 1047 ! 1048 ! Partitioned wave height 1049 ! 1050 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 1 ) THEN 1051 FLPRT = .TRUE. 1052 KPDS5A = 5 1053 KPDS5B = 8 1054 CALL W3S2XY & 1055 ( NSEA, NSEA, NX, NY, PHS(:,0), MAPSF, YY(:,0) ) 1056 DO I=1, NOSWLL 1057 CALL W3S2XY & 1058 ( NSEA, NSEA, NX, NY, PHS(:,I), MAPSF, YY(:,I) ) 1059 END DO 1060 ! 1061 ! Partitioned peak period 1062 ! 1063 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 2 ) THEN 1064 FLPRT = .TRUE. 1065 KPDS5A = 6 1066 KPDS5B = 9 1067 CALL W3S2XY & 1068 ( NSEA, NSEA, NX, NY, PTP(:,0), MAPSF, YY(:,0) ) 1069 DO I=1, NOSWLL 1070 CALL W3S2XY & 1071 ( NSEA, NSEA, NX, NY, PTP(:,I), MAPSF, YY(:,I) ) 1072 END DO 1073 ! 1074 ! Partitioned peak wave length 1075 ! 1076 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 3 ) THEN 1077 FLPRT = .TRUE. 1078 KPDS5A = 255 1079 KPDS5B = 255 1080 CALL W3S2XY & 1081 ( NSEA, NSEA, NX, NY, PLP(:,0), MAPSF, YY(:,0) ) 1082 DO I=1, NOSWLL 1083 CALL W3S2XY & Page 20 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 1084 ( NSEA, NSEA, NX, NY, PLP(:,I), MAPSF, YY(:,I) ) 1085 END DO 1086 ! 1087 ! Partitioned mean direction 1088 ! 1089 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 4 ) THEN 1090 FLPRT = .TRUE. 1091 KPDS5A = 4 1092 KPDS5B = 7 1093 DO ISEA = 1,NSEA 1094 DO I = 0,NOSWLL 1095 IF ( PTH(ISEA,I) .NE. UNDEF ) THEN 1096 PTH(ISEA,I) = MOD ( 630 - RADE*PTH(ISEA,I) , 360. ) 1097 END IF 1098 END DO 1099 END DO 1100 CALL W3S2XY & 1101 ( NSEA, NSEA, NX, NY, PTH(:,0), MAPSF, YY(:,0) ) 1102 DO I=1, NOSWLL 1103 CALL W3S2XY & 1104 ( NSEA, NSEA, NX, NY, PTH(:,I), MAPSF, YY(:,I) ) 1105 END DO 1106 ! 1107 ! Partitioned Directional spread 1108 ! 1109 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 5 ) THEN 1110 FLPRT = .TRUE. 1111 KPDS5A = 255 1112 KPDS5B = 255 1113 CALL W3S2XY & 1114 ( NSEA, NSEA, NX, NY, PSI(:,0), MAPSF, YY(:,0) ) 1115 DO I=1, NOSWLL 1116 CALL W3S2XY & 1117 ( NSEA, NSEA, NX, NY, PSI(:,I), MAPSF, YY(:,I) ) 1118 END DO 1119 ! 1120 ! Partitioned wind sea fraction 1121 ! 1122 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 6 ) THEN 1123 FLPRT = .TRUE. 1124 KPDS5A = 255 1125 KPDS5B = 255 1126 CALL W3S2XY & 1127 ( NSEA, NSEA, NX, NY, PWS(:,0), MAPSF, YY(:,0) ) 1128 DO I=1, NOSWLL 1129 CALL W3S2XY & 1130 ( NSEA, NSEA, NX, NY, PWS(:,I), MAPSF, YY(:,I) ) 1131 END DO 1132 ! 1133 ! Total wind sea fraction 1134 ! 1135 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 7 ) THEN 1136 FLONE = .TRUE. 1137 KPDS(2) = 255 1138 CALL W3S2XY ( NSEA, NSEA, NX, NY, PWST , MAPSF, X1 ) 1139 ! 1140 ! Number of fields in partition Page 21 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 1141 ! 1142 ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 8 ) THEN 1143 FLONE = .TRUE. 1144 KPDS(2) = 255 1145 CALL W3S2XY ( NSEA, NSEA, NX, NY, PNR , MAPSF, X1 ) 1146 ! 1147 ! Friction velocity 1148 ! 1149 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 1 ) THEN 1150 FLTWO = .TRUE. 1151 KPDS(2) = 255 1152 KPDS(1) = 1 1153 CALL W3S2XY ( NSEA, NSEA, NX, NY, UST(1:NSEA) & 1154 , MAPSF, X1 ) 1155 CALL W3S2XY ( NSEA, NSEA, NX, NY, USTDIR(1:NSEA) & 1156 , MAPSF, X2 ) 1157 ! 1158 ! Average source term time step 1159 ! 1160 ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN 1161 FLONE = .TRUE. 1162 KPDS(2) = 255 1163 DO ISEA=1, NSEA 1164 IF ( DTDYN(ISEA) .NE. UNDEF ) & 1165 DTDYN(ISEA) = DTDYN(ISEA) / 60. 1166 END DO 1167 CALL W3S2XY ( NSEA, NSEA, NX, NY, DTDYN , MAPSF, X1 ) 1168 ! 1169 ! Cut-off frequency 1170 ! 1171 ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 2 ) THEN 1172 FLONE = .TRUE. 1173 KPDS(2) = 255 1174 CALL W3S2XY ( NSEA, NSEA, NX, NY, FCUT , MAPSF, X1 ) 1175 ! 1176 ! CFL Maximum (in spatial space) 1177 ! 1178 ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 3 ) THEN 1179 FLONE = .TRUE. 1180 KPDS(2) = 255 1181 CALL W3S2XY ( NSEA, NSEA, NX, NY, CFLXYMAX , MAPSF, X1 ) 1182 ! 1183 ! CFL Maximum (in spectral space) 1184 ! 1185 ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 4 ) THEN 1186 FLONE = .TRUE. 1187 KPDS(2) = 255 1188 CALL W3S2XY ( NSEA, NSEA, NX, NY, CFLTHMAX , MAPSF, X1 ) 1189 ! 1190 ELSE 1191 WRITE (NDSE,999) 1192 CALL EXTCDE ( 1 ) 1193 ! 1194 END IF 1195 ! 1196 ! 3 Perform output 1197 ! Page 22 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 1198 NDATA = NX*NY 1199 ! 1200 ! 3.a Partitioned data 1201 ! 1202 IF ( FLPRT ) THEN 1203 ! 1204 KPDS(2) = KPDS5A 1205 DO IXY=1, NX*NY 1206 BITMAP(IXY) = YY(IXY,0) .NE. UNDEF 1207 END DO 1208 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) 1209 IF (IO .NE. 0) GOTO 810 1210 CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & 1211 IDEFNUM, IO) 1212 IF (IO .NE. 0) GOTO 820 1213 CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & 1214 COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 1215 200,YY(:,0), NDATA, IBMP, BITMAP, IO) 1216 IF (IO .NE. 0) GOTO 820 1217 CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) 1218 IF (IO .NE. 0) GOTO 830 1219 CALL WRYTE (NDSDAT, LENGRIB, CGRIB) 1220 ! 1221 KPDS(2) = KPDS5B 1222 KPDS(10) = 241 1223 DO I=1, NOSWLL 1224 KPDS(12) = I 1225 DO IXY=1, NX*NY 1226 BITMAP(IXY) = YY(IXY,I) .NE. UNDEF 1227 END DO 1228 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) 1229 IF (IO .NE. 0) GOTO 810 1230 CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & 1231 IDEFNUM, IO) 1232 IF (IO .NE. 0) GOTO 820 1233 CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & 1234 COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 1235 200,YY(:,I), NDATA, IBMP, BITMAP, IO) 1236 IF (IO .NE. 0) GOTO 820 1237 CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) 1238 IF (IO .NE. 0) GOTO 830 1239 CALL WRYTE (NDSDAT, LENGRIB, CGRIB) 1240 END DO 1241 KPDS(10) = 1 1242 KPDS(12) = 1 1243 ! 1244 ! 3.b Other data 1245 ! 1246 ELSE IF (FLONE) THEN 1247 ! 1248 DO IXY=1, NX*NY 1249 BITMAP(IXY) = X1(IXY) .NE. UNDEF 1250 END DO 1251 ! 1252 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) 1253 IF (IO .NE. 0) GOTO 810 1254 CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & Page 23 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 1255 IDEFNUM, IO) 1256 IF (IO .NE. 0) GOTO 820 1257 CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & 1258 COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 1259 200,X1, NDATA, IBMP, BITMAP, IO) 1260 IF (IO .NE. 0) GOTO 820 1261 CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) 1262 IF (IO .NE. 0) GOTO 830 1263 CALL WRYTE (NDSDAT, LENGRIB, CGRIB) 1264 ! 1265 ELSE IF ( FLTWO ) THEN 1266 ! 1267 DO IXY=1, NX*NY 1268 BITMAP(IXY) = X1(IXY) .NE. UNDEF 1269 END DO 1270 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) 1271 IF (IO .NE. 0) GOTO 810 1272 CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & 1273 IDEFNUM, IO) 1274 IF (IO .NE. 0) GOTO 820 1275 CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & 1276 COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 1277 200,X1, NDATA, IBMP, BITMAP, IO) 1278 IF (IO .NE. 0) GOTO 820 1279 CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) 1280 IF (IO .NE. 0) GOTO 830 1281 CALL WRYTE (NDSDAT, LENGRIB, CGRIB) 1282 1283 KPDS(2) = 0 1284 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) 1285 IF (IO .NE. 0) GOTO 810 1286 CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & 1287 IDEFNUM, IO) 1288 IF (IO .NE. 0) GOTO 820 1289 CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & 1290 COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 1291 200,X2, NDATA, IBMP, BITMAP, IO) 1292 IF (IO .NE. 0) GOTO 820 1293 CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) 1294 IF (IO .NE. 0) GOTO 830 1295 CALL WRYTE (NDSDAT, LENGRIB, CGRIB) 1296 KPDS(2) = 2 1297 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) 1298 IF (IO .NE. 0) GOTO 810 1299 CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & 1300 IDEFNUM, IO) 1301 IF (IO .NE. 0) GOTO 820 1302 CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & 1303 COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 1304 200,XX, NDATA, IBMP, BITMAP, IO) 1305 IF (IO .NE. 0) GOTO 820 1306 CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) 1307 IF (IO .NE. 0) GOTO 830 1308 CALL WRYTE (NDSDAT, LENGRIB, CGRIB) 1309 KPDS(2) = 3 1310 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) 1311 IF (IO .NE. 0) GOTO 810 Page 24 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 1312 CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & 1313 IDEFNUM, IO) 1314 IF (IO .NE. 0) GOTO 820 1315 CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & 1316 COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 1317 200,XY, NDATA, IBMP, BITMAP, IO) 1318 IF (IO .NE. 0) GOTO 820 1319 CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) 1320 IF (IO .NE. 0) GOTO 830 1321 CALL WRYTE (NDSDAT, LENGRIB, CGRIB) 1322 ! 1323 END IF 1324 LISTSEC0(1) = 10 1325 KPDS(1) = 0 1326 ! 1327 ! ... End of fields loop 1328 ! 1329 END IF 1330 END DO 1331 END DO 1332 ! 1333 RETURN 1334 ! 1335 ! Error escape locations 1336 ! 1337 800 CONTINUE 1338 WRITE (NDSE,1000) IERR 1339 CALL EXTCDE ( 10 ) 1340 810 CONTINUE 1341 WRITE (NDSE,1010) IO 1342 CALL EXTCDE ( 20 ) 1343 820 CONTINUE 1344 WRITE (NDSE,1020) IO 1345 CALL EXTCDE ( 30 ) 1346 830 CONTINUE 1347 WRITE (NDSE,1030) IO 1348 CALL EXTCDE ( 40 ) 1349 ! 1350 ! Formats 1351 ! 1352 940 FORMAT (1X,I8,3I3.2,2X,4E12.4) 1353 950 FORMAT (1X,A13,I9.8,I7.6,2(2F8.2,I4), & 1354 1X,A4,F8.4,1X,A10,2I2,1X,A11,I4) 1355 951 FORMAT (1X,2F10.5,2I8) 1356 ! 1357 999 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB :'/ & 1358 ' PLEASE UPDATE FIELDS !!! '/) 1359 ! 1360 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/ & 1361 ' ERROR IN OPENING OUTPUT FILE'/ & 1362 ' IOSTAT =',I5/) 1363 ! 1364 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/ & 1365 ' ERROR CREATING NEW GRIB2 FIELD'/ & 1366 ' IOSTAT =',I5/) 1367 ! 1368 1020 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/ & Page 25 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 1369 ' ERROR ADDING GRIB2 FIELD'/ & 1370 ' IOSTAT =',I5/) 1371 ! 1372 1030 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/ & 1373 ' ERROR ENDING GRIB2 MESSAGE'/ & 1374 ' IOSTAT =',I5/) 1375 ! 1376 !/ 1377 !/ End of W3EXGB ----------------------------------------------------- / 1378 !/ 1379 END SUBROUTINE W3EXGB ENTRY POINTS Name wavegrib2_IP_w3exgb_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1000 Label 1360 1338 1010 Label 1364 1341 1020 Label 1368 1344 1030 Label 1372 1347 800 Label 1337 810 Label 1340 1209,1229,1253,1271,1285,1298,1311 820 Label 1343 1212,1216,1232,1236,1256,1260,1274 ,1278,1288,1292,1301,1305,1314,131 8 830 Label 1346 1218,1238,1262,1280,1294,1307,1320 940 Label 1352 950 Label 1353 951 Label 1355 999 Label 1357 1191 ADDFIELD Subr 1213 1213,1233,1257,1275,1289,1302,1315 ADDGRID Subr 1210 1210,1230,1254,1272,1286,1299,1312 AS Local 952 R(4) 4 1 1 PTR 952 ATAN2 Func 900 scalar 900,931 BITMAP Local 842 L(1) 1 1 0 1206,1215,1226,1235,1249,1259,1268 ,1277,1291,1304,1317 CABS Local 840 R(4) 4 scalar 897,898,905,908 CFLTHMAX Local 1188 R(4) 4 1 1 PTR 1188 CFLXYMAX Local 1181 R(4) 4 1 1 PTR 1181 CGRIB Local 1208 CHAR 1 1 1 ALC 435,1208,1210,1213,1217,1219,1228, 1230,1233,1237,1239,1252,1254,1257 ,1261,1263,1270,1272,1275,1279,128 1,1284,1286,1289,1293,1295,1297,12 99,1302,1306,1308,1310,1312,1315,1 319,1321 COORDLIST Local 1214 R(4) 4 scalar 581,1214,1234,1258,1276,1290,1303, 1316 CX Local 891 R(4) 4 1 1 PTR 891,896,897,900,908,910 CY Local 893 R(4) 4 1 1 PTR 893,897,899,900,902,906,912 Page 26 Source Listing W3EXGB 2014-11-12 21:38 Symbol Table multiwavegrib2.f90 Name Object Declared Type Bytes Dimen Elements Attributes References DTDYN Local 1164 R(4) 4 1 1 PTR 1164,1165,1167 DW Local 882 R(4) 4 1 1 PTR 882 EXTCDE Subr 1192 117,330,489,658,662,666,671,1192,1 339,1342,1345,1348 FCUT Local 1174 R(4) 4 1 1 PTR 1174 FLDIR Local 843 L(4) 4 scalar 870 FLONE Local 843 L(4) 4 scalar 868,879,949,958,966,974,981,988,99 5,1002,1009,1021,1032,1039,1136,11 43,1161,1172,1179,1186,1246 FLPRT Local 843 L(4) 4 scalar 872,1051,1064,1077,1090,1110,1123, 1202 FLREQ Local 862 L(4) 4 2 200 239,243,256,259,265,268,274,277,28 1,283,287,290,305,315,862 FLTRI Local 843 L(4) 4 scalar 871 FLTWO Local 843 L(4) 4 scalar 869,888,918,1150,1265 FP0 Local 1012 R(4) 4 1 1 PTR 1012,1013,1016 GRIBCREATE Subr 1208 1208,1228,1252,1270,1284,1297,1310 GRIBEND Subr 1217 1217,1237,1261,1279,1293,1306,1319 HS Local 976 R(4) 4 1 1 PTR 976 I Local 1056 I(4) 4 scalar 304,305,306,313,315,356,358,1056,1 058,1069,1071,1082,1084,1094,1095, 1096,1102,1104,1115,1117,1128,1130 ,1223,1224,1226,1235 IBMP Local 1215 I(4) 4 scalar 586,1215,1235,1259,1277,1291,1304, 1317 ICE Local 969 R(4) 4 1 1 PTR 121,969 IDEFLIST Local 1210 I(4) 4 scalar 480,485,1210,1230,1254,1272,1286,1 299,1312 IDEFNUM Local 1211 I(4) 4 scalar 479,484,1211,1231,1255,1273,1287,1 300,1313 IDRS Local 1214 I(4) 4 1 200 603,604,1214,1234,1258,1276,1290,1 303,1316 IDRSNUM Local 1214 I(4) 4 scalar 590,1214,1234,1258,1276,1290,1303, 1316 IERR Local 1338 I(4) 4 scalar 196,201,244,657,665,1338 IFI Local 860 I(4) 4 scalar 254,255,256,257,259,263,265,266,26 8,271,273,274,275,277,285,286,287, 288,290,860,862,878,887,917,948,95 7,965,973,980,987,994,1001,1008,10 20,1031,1038,1050,1063,1076,1089,1 109,1122,1135,1142,1149,1160,1171, 1178,1185 IFJ Local 861 I(4) 4 scalar 255,256,257,259,264,265,266,268,27 3,274,275,277,286,287,288,290,861, 862,878,887,917,948,957,965,973,98 0,987,994,1001,1008,1020,1031,1038 ,1050,1063,1076,1089,1109,1122,113 5,1142,1149,1160,1171,1178,1185 IGDS Local 1210 I(4) 4 1 5 476,477,478,482,483,1210,1230,1254 ,1272,1286,1299,1312 IO Local 838 I(4) 4 scalar 1208,1209,1211,1212,1215,1216,1217 ,1218,1228,1229,1231,1232,1235,123 6,1237,1238,1252,1253,1255,1256,12 59,1260,1261,1262,1270,1271,1273,1 274,1277,1278,1279,1280,1284,1285, Page 27 Source Listing W3EXGB 2014-11-12 21:38 Symbol Table multiwavegrib2.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 1287,1288,1291,1292,1293,1294,1297 ,1298,1300,1301,1304,1305,1306,130 7,1310,1311,1313,1314,1317,1318,13 19,1320,1341,1344,1347 ISEA Local 895 I(4) 4 scalar 365,366,367,368,369,895,896,897,89 9,900,902,906,908,926,927,928,930, 931,933,937,939,1011,1012,1013,102 3,1024,1025,1041,1042,1043,1093,10 95,1096,1163,1164,1165 IXY Local 837 I(4) 4 scalar 1205,1206,1225,1226,1248,1249,1267 ,1268 J Local 837 I(4) 4 scalar KGDS Local 1210 I(4) 4 1 200 379,513,514,515,521,525,526,527,52 8,529,530,531,532,533,534,535,536, 538,540,541,542,544,545,546,1210,1 230,1254,1272,1286,1299,1312 KPDS Local 880 I(4) 4 1 200 378,570,571,572,573,574,575,576,63 6,643,880,881,889,890,919,920,950, 951,959,960,967,968,975,982,989,99 6,1003,1010,1022,1033,1040,1137,11 44,1151,1152,1162,1173,1180,1187,1 204,1213,1221,1222,1224,1233,1241, 1242,1257,1275,1283,1289,1296,1302 ,1309,1315,1325 KPDS5A Local 841 R(4) 4 scalar 1052,1065,1078,1091,1111,1124,1204 KPDS5B Local 841 R(4) 4 scalar 1053,1066,1079,1092,1112,1125,1221 KPDSNUM Local 1213 I(4) 4 scalar 569,1213,1233,1257,1275,1289,1302, 1315 LCGRIB Local 1208 I(4) 4 scalar 434,435,1208,1210,1213,1217,1228,1 230,1233,1237,1252,1254,1257,1261, 1270,1272,1275,1279,1284,1286,1289 ,1293,1297,1299,1302,1306,1310,131 2,1315,1319 LENGRIB Local 1217 I(4) 4 scalar 1217,1219,1237,1239,1261,1263,1279 ,1281,1293,1295,1306,1308,1319,132 1 LISTSEC0 Local 921 I(4) 4 1 3 442,443,444,921,1208,1228,1252,127 0,1284,1297,1310,1324 LISTSEC1 Local 1208 I(4) 4 1 13 461,462,463,464,465,466,632,633,63 4,635,639,640,641,642,1208,1228,12 52,1270,1284,1297,1310 MAPSF Local 883 I(4) 4 2 1 PTR 366,367,368,369,883,892,894,911,91 3,923,925,942,944,953,961,969,976, 983,990,997,1004,1016,1027,1034,10 46,1055,1058,1068,1071,1081,1084,1 101,1104,1114,1117,1127,1130,1138, 1145,1154,1156,1167,1174,1181,1188 MOD Func 899 scalar 518,519,520,539,543,633,634,640,64 1,899,930,1025,1043,1096 NDATA Local 837 I(4) 4 scalar 1198,1215,1235,1259,1277,1291,1304 ,1317 NDSDAT Local 1219 I(4) 4 scalar 176,189,201,1219,1239,1263,1281,12 95,1308,1321 NDSE Local 1191 I(4) 4 scalar PTR 127,185,215,243,321,328,339,487,65 7,661,665,670,1191,1338,1341,1344, Page 28 Source Listing W3EXGB 2014-11-12 21:38 Symbol Table multiwavegrib2.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 1347 NGRPP Param 861 I(4) 4 scalar 127,154,314,357,861 NOGRP Param 860 I(4) 4 scalar 127,154,313,356,860 NOSWLL Local 841 I(4) 4 scalar PTR 128,841,1056,1069,1082,1094,1102,1 115,1128,1223 NSEA Dummy 746 I(4) 4 scalar ARG,IN 882,891,893,895,910,912,922,924,92 6,941,943,952,961,969,976,983,990, 997,1004,1011,1016,1023,1027,1034, 1041,1046,1055,1058,1068,1071,1081 ,1084,1093,1101,1104,1114,1117,112 7,1130,1138,1145,1153,1155,1163,11 67,1174,1181,1188 NUMCOORD Local 1214 I(4) 4 scalar 580,1214,1234,1258,1276,1290,1303, 1316 NX Dummy 746 I(4) 4 scalar ARG,IN 839,840,841,842,882,891,893,910,91 2,922,924,941,943,952,961,969,976, 983,990,997,1004,1016,1027,1034,10 46,1055,1058,1068,1071,1081,1084,1 101,1104,1114,1117,1127,1130,1138, 1145,1153,1155,1167,1174,1181,1188 ,1198,1205,1225,1248,1267 NY Dummy 746 I(4) 4 scalar ARG,IN 839,840,841,842,882,891,893,910,91 2,922,924,941,943,952,961,969,976, 983,990,997,1004,1016,1027,1034,10 46,1055,1058,1068,1071,1081,1084,1 101,1104,1114,1117,1127,1130,1138, 1145,1153,1155,1167,1174,1181,1188 ,1198,1205,1225,1248,1267 PHS Local 1055 R(4) 4 2 1 PTR 1055,1058 PLP Local 1081 R(4) 4 2 1 PTR 1081,1084 PNR Local 1145 R(4) 4 1 1 PTR 1145 PSI Local 1114 R(4) 4 2 1 PTR 1114,1117 PTH Local 1095 R(4) 4 2 1 PTR 1095,1096,1101,1104 PTP Local 1068 R(4) 4 2 1 PTR 1068,1071 PWS Local 1127 R(4) 4 2 1 PTR 1127,1130 PWST Local 1138 R(4) 4 1 1 PTR 1138 RADE Param 900 R(4) 4 scalar 900,931,1025,1043,1096 SQRT Func 897 scalar 897,928 T01 Local 1004 R(4) 4 1 1 PTR 1004 T02 Local 990 R(4) 4 1 1 PTR 990 T0M1 Local 997 R(4) 4 1 1 PTR 997 THM Local 1024 R(4) 4 1 1 PTR 1024,1025,1027 THP0 Local 1042 R(4) 4 1 1 PTR 1042,1043,1046 THS Local 1034 R(4) 4 1 1 PTR 1034 UA Local 922 R(4) 4 1 1 PTR 922,927,928,931,939,941 UABS Local 840 R(4) 4 scalar 928,929,936,939 UD Local 924 R(4) 4 1 1 PTR 924,928,930,931,933,937,943 UNDEF Local 851 R(4) 4 scalar 127,851,852,853,854,855,896,905,90 6,927,936,937,1012,1024,1042,1095, 1164,1206,1226,1249,1268 UST Local 1153 R(4) 4 1 1 PTR 121,1153 USTDIR Local 1155 R(4) 4 1 1 PTR 121,1155 W3EXGB Subr 746 647 W3S2XY Subr 827 827,882,891,893,910,912,922,924,94 1,943,952,961,969,976,983,990,997, Page 29 Source Listing W3EXGB 2014-11-12 21:38 Symbol Table multiwavegrib2.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 1004,1016,1027,1034,1046,1054,1057 ,1067,1070,1080,1083,1100,1103,111 3,1116,1126,1129,1138,1145,1153,11 55,1167,1174,1181,1188 W3SERVMD Module 827 827 WLM Local 983 R(4) 4 1 1 PTR 983 WLV Local 961 R(4) 4 1 1 PTR 121,961 WRYTE Subr 1219 1219,1239,1263,1281,1295,1308,1321 X1 Local 839 R(4) 4 1 0 851,883,911,942,953,961,969,976,98 3,990,997,1004,1016,1027,1034,1046 ,1138,1145,1154,1167,1174,1181,118 8,1249,1259,1268,1277 X2 Local 839 R(4) 4 1 0 852,913,944,1156,1291 XX Local 839 R(4) 4 1 0 853,892,923,1304 XY Local 840 R(4) 4 1 0 854,894,925,1317 YY Local 841 R(4) 4 2 0 855,1055,1058,1068,1071,1081,1084, 1101,1104,1114,1117,1127,1130,1206 ,1215,1226,1235 Page 30 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.f90 1380 !/ 1381 !/ End of WAVEGRIB2 ----------------------------------------------------- / 1382 !/ 1383 END PROGRAM WAVEGRIB2 ENTRY POINTS Name MAIN__ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1000 Label 723 657 1001 Label 727 661 1002 Label 730 665 1005 Label 734 1010 Label 739 670 800 Label 656 196 801 Label 660 197,216,322,340 802 Label 664 197,216,322,340 810 Label 668 209 888 Label 674 618,652 900 Label 681 192 901 Label 683 199 902 Label 684 920 Label 686 207 930 Label 688 355 931 Label 690 315,358 940 Label 692 222 941 Label 695 235 942 Label 697 617 944 Label 699 250 945 Label 702 312 946 Label 704 257,266,275,282,288,306 948 Label 706 345 970 Label 714 610 971 Label 716 644 972 Label 717 637 999 Label 719 675 BAOPENW Subr 201 201 CID Local 138 I(4) 4 scalar 322,345,462 CLGTYPE Param 326 I(4) 4 scalar 326,475 COMSTR Local 155 CHAR 1 scalar 197,198,199,215,243,321,339 CONSTANTS Module 109 109 DSEC21 Func 118 R(4) 4 scalar 118,613,630 DSX Local 151 R(4) 4 scalar 340,529 DSY Local 151 R(4) 4 scalar 340,530 DTEST Local 153 R(4) 4 scalar 613,614,622 DTREQ Local 153 R(4) 4 scalar 216,217,218,226,228,229,623,648 FLAGLL Local 209 L(4) 4 scalar 209,669 FLGRIB Local 154 L(4) 4 2 200 FLOG Local 128 L(4) 4 1 1 PTR 128,243 Page 31 Source Listing W3EXGB 2014-11-12 21:38 Symbol Table multiwavegrib2.f90 Name Object Declared Type Bytes Dimen Elements Attributes References FLOGRD Local 128 L(4) 4 2 1 PTR 128,358 FNMPRE Local 128 CHAR 80 scalar 128 FTIME Local 138 I(4) 4 1 2 322,344,630,639,640,641,642 GDS Local 138 I(4) 4 scalar 322,345,586 GDTN Local 139 I(4) 4 scalar 322,327,338,362,475,478,481,517,53 7 GID Local 138 I(4) 4 scalar 322,345 GNAME Local 207 CHAR 30 scalar PTR 207 GTYPE Local 326 I(4) 4 scalar PTR 326,475 IDDDAY Local 155 CHAR 11 scalar 229,231,233 IDOUT Local 127 CHAR 20 2 200 127,257,266,275,282,288,306,315,35 8 IDTIME Local 155 CHAR 23 scalar 221,222,227,233,234,235,344,345,62 8,637,644 IFIA Local 140 I(4) 4 1 1 ALC 300,302,305,306 IFJA Local 140 I(4) 4 1 1 ALC 300,303,305,306 INT Func 229 scalar 229 IOTEST Local 136 I(4) 4 scalar 351,615,616 IOUT Local 138 I(4) 4 scalar 609,627,649 ITRACE Subr 117 117,194 IX Local 137 I(4) 4 scalar 366,369 IY Local 137 I(4) 4 scalar 367,368,369 J Local 136 I(4) 4 scalar 314,315,357,358 K Local 136 I(4) 4 scalar LATAN1 Local 149 I(4) 4 scalar 340,527 LATIN1 Local 149 I(4) 4 scalar 341,533 LATIN2 Local 150 I(4) 4 scalar 341,534 LATSP Local 150 I(4) 4 scalar 341,535 LONSP Local 150 I(4) 4 scalar 341,536 LONV Local 149 I(4) 4 scalar 340,528 MAX Func 217 scalar 217,219 NDSI Local 135 I(4) 4 scalar 173,183,196,197,215,216,243,321,32 2,339,340 NDSM Local 135 I(4) 4 scalar 174,187,206 NDSO Local 127 I(4) 4 scalar PTR 127,184,185,186,190,192,199,207,22 2,235,243,250,257,266,275,282,288, 306,312,315,345,355,358,610,617,63 7,644,675 NDSOG Local 135 I(4) 4 scalar 175,188,351,615 NDST Local 127 I(4) 4 scalar PTR 127,186 NDSTRC Local 135 I(4) 4 scalar 178,190,194 NEXTLN Subr 117 117,215,321,339 NINT Func 521 scalar 521,525,529,530,538,540,542,544,54 5,546,643,644 NOGE Local 128 I(4) 4 1 10 128,255,273,286 NOUT Local 137 I(4) 4 scalar 216,218,219,235,649 NSEA Local 365 I(4) 4 scalar PTR 365,647 NTRACE Local 136 I(4) 4 scalar 179,194 NX Local 434 I(4) 4 scalar PTR 434,477,483,514,519,523,543,647 NY Local 368 I(4) 4 scalar PTR 368,369,434,477,483,515,519,520,52 3,524,538,647 PID Local 138 I(4) 4 scalar 322,345,572 REAL Func 538 scalar 538,543 RFTIME Local 153 R(4) 4 scalar 630,631,643,644 SCNMOD Local 149 I(4) 4 scalar 341,532 Page 32 Source Listing W3EXGB 2014-11-12 21:38 Symbol Table multiwavegrib2.f90 Name Object Declared Type Bytes Dimen Elements Attributes References STME21 Subr 118 118,221,227,344,628 SX Local 543 R(4) 4 scalar PTR 543,545 SY Local 538 R(4) 4 scalar PTR 538,546 TDUM Local 137 I(4) 4 1 2 224,225,226,227 TICK21 Subr 118 118,226,623,648 TIME Local 121 I(4) 4 1 1 PTR 121,613,630,632,633,634,635 TOUT Local 137 I(4) 4 1 2 216,221,613,623,628,648 W3ADATMD Module 126 126 W3GDATMD Module 120 120 W3IOGO Subr 116 116,351,615 W3IOGOMD Module 116 116 W3IOGR Subr 115 115,206 W3IOGRMD Module 115 115 W3NAUX Subr 168 168 W3NDAT Subr 112 112,166 W3NMOD Subr 164 164 W3NOUT Subr 114 114,170 W3ODATMD Module 114 114,127 W3READFLGRD Subr 116 116,243 W3SERVMD Module 117 117 W3SETA Subr 169 169 W3SETG Subr 165 165 W3SETO Subr 114 114,171 W3SETW Subr 112 112,167 W3TIMEMD Module 118 118 W3WDATMD Module 112 112,121 WAVEGRIB2 Prog 2 X0 Local 518 R(4) 4 scalar PTR 518,521,539,540,543 X0N Local 152 R(4) 4 scalar 520 XGRD Local 518 R(4) 4 2 1 PTR 518,519,520 XN Local 147 R(4) 4 scalar 519,543,544 Y0 Local 522 R(4) 4 scalar PTR 522,525,538,542 Y0N Local 152 R(4) 4 scalar 524 YGRD Local 522 R(4) 4 2 1 PTR 522,523,524 YN Local 152 R(4) 4 scalar 523 Page 33 Source Listing W3EXGB 2014-11-12 21:38 Subprograms/Common Blocks multiwavegrib2.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References W3EXGB Subr 746 647 WAVEGRIB2 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 34 Source Listing W3EXGB 2014-11-12 21:38 multiwavegrib2.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 : multiwavegrib2.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100