Page 1 Source Listing W3QCK1 2014-09-16 16:49 w3uqckmd.f90 1 !/ ------------------------------------------------------------------- / 2 MODULE W3UQCKMD 3 !/ 4 !/ +-----------------------------------+ 5 !/ | WAVEWATCH III NOAA/NCEP | 6 !/ | H. L. Tolman | 7 !/ | FORTRAN 90 | 8 !/ | Last update : 30-Oct-2009 | 9 !/ +-----------------------------------+ 10 !/ 11 !/ 08-Feb-2001 : Origination of module. Routines ( version 2.08 ) 12 !/ taken out of w3pro2md.ftn 13 !/ 13-Nov-2001 : Version with obstacles added. ( version 2.14 ) 14 !/ 16-Oct-2002 : Fix par list W3QCK3. ( version 3.00 ) 15 !/ 05-Mar-2008 : Added NEC sxf90 compiler directives. 16 !/ (Chris Bunney, UK Met Office) ( version 3.13 ) 17 !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) 18 !/ 30-Oct-2009 : Fixed a couple of doc lines. ( version 3.14 ) 19 !/ (T. J. Campbell, NRL) 20 !/ 21 !/ Copyright 2009 National Weather Service (NWS), 22 !/ National Oceanic and Atmospheric Administration. All rights 23 !/ reserved. WAVEWATCH III is a trademark of the NWS. 24 !/ No unauthorized use without permission. 25 !/ 26 ! 1. Purpose : 27 ! 28 ! Portable ULTIMATE QUICKEST schemes. 29 ! 30 ! 2. Variables and types : 31 ! 32 ! None. 33 ! 34 ! 3. Subroutines and functions : 35 ! 36 ! Name Type Scope Description 37 ! ---------------------------------------------------------------- 38 ! W3QCK1 Subr. Public Original ULTIMATE QUICKEST scheme. 39 ! W3QCK2 Subr. Public UQ scheme for irregular grid. 40 ! W3QCK3 Subr. Public Original ULTIMATE QUICKEST with obst. 41 ! ---------------------------------------------------------------- 42 ! 43 ! 4. Subroutines and functions used : 44 ! 45 ! Name Type Module Description 46 ! ---------------------------------------------------------------- 47 ! STRACE Subr. W3SERVMD Subroutine tracing. 48 ! ---------------------------------------------------------------- 49 ! 50 ! 5. Remarks : 51 ! 52 ! - STRACE and !/S irrelevant for running code. The module is 53 ! therefore fully portable to any other model. 54 ! 55 ! 6. Switches : 56 ! 57 ! !/C90 Cray FORTRAN 90 compiler directives. Page 2 Source Listing W3QCK1 2014-09-16 16:49 w3uqckmd.f90 58 ! !/NEC NEC SXF90 compiler directives. 59 ! 60 ! !/S Enable subroutine tracing. 61 ! !/Tn Enable test output. 62 ! 63 ! 7. Source code : 64 ! 65 !/ ------------------------------------------------------------------- / 66 !/ 67 CONTAINS 68 !/ ------------------------------------------------------------------- / 69 SUBROUTINE W3QCK1 (MX, MY, NX, NY, CFLL, Q, CLOSE, INC, & 70 MAPACT, NACT, MAPBOU, NB0, NB1, NB2, & 71 NDSE, NDST ) 72 !/ 73 !/ +-----------------------------------+ 74 !/ | WAVEWATCH III NOAA/NCEP | 75 !/ | H. L. Tolman | 76 !/ | FORTRAN 90 | 77 !/ | Last update : 30-Oct-2009 | 78 !/ +-----------------------------------+ 79 !/ 80 !/ 11-Mar-1997 : Final FORTRAN 77 ( version 1.18 ) 81 !/ 15-Dec-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 82 !/ 15-Feb-2001 : Unit numbers added to par list. ( version 2.08 ) 83 !/ 05-Mar-2008 : Added NEC sxf90 compiler directives. 84 !/ (Chris Bunney, UK Met Office) ( version 3.13 ) 85 !/ 30-Oct-2009 : Fixed "Called by" doc line. ( version 3.14 ) 86 !/ (T. J. Campbell, NRL) 87 !/ 88 ! 1. Purpose : 89 ! 90 ! Preform one-dimensional propagation in a two-dimensional space 91 ! with irregular boundaries and regular grid. 92 ! 93 ! 2. Method : 94 ! 95 ! ULTIMATE QUICKEST scheme (see manual). 96 ! 97 ! Note that the check on monotonous behavior of QCN is performed 98 ! using weights CFAC, to avoid the need for IF statements. 99 ! 100 ! 3. Parameters : 101 ! 102 ! Parameter list 103 ! ---------------------------------------------------------------- 104 ! MX,MY Int. I Field dimensions, if grid is 'closed' or 105 ! circular, MX is the closed dimension. 106 ! NX,NY Int. I Part of field actually used. 107 ! CFLL R.A. I Local Courant numbers. (MY, MX+1) 108 ! Q R.A. I/O Propagated quantity. (MY,0:MX+2) 109 ! CLOSE Log. I Flag for closed 'X' dimension' 110 ! INC Int. I Increment in 1-D array corresponding to 111 ! increment in 2-D space. 112 ! MAPACT I.A. I List of active grid points. 113 ! NACT Int. I Size of MAPACT. 114 ! MAPBOU I.A. I Map with boundary information (see W3MAP2). Page 3 Source Listing W3QCK1 2014-09-16 16:49 w3uqckmd.f90 115 ! NBn Int. I Counters in MAPBOU. 116 ! NDSE Int. I Error output unit number. 117 ! NDST Int. I Test output unit number. 118 ! ---------------------------------------------------------------- 119 ! - CFLL amd Q need only bee filled in the (MY,MX) range, 120 ! extension is used internally for closure. 121 ! - CFLL and Q are defined as 1-D arrays internally. 122 ! 123 ! 4. Subroutines used : 124 ! 125 ! STRACE Service routine. 126 ! 127 ! 5. Called by : 128 ! 129 ! W3KTP2 Propagation in spectral space 130 ! 131 ! 6. Error messages : 132 ! 133 ! None. 134 ! 135 ! 7. Remarks : 136 ! 137 ! - This routine can be used independently from WAVEWATCH III. 138 ! 139 ! 8. Structure : 140 ! 141 ! ------------------------------------------------------ 142 ! 1. Initialize aux. array FLA. 143 ! 2. Fluxes for central points (3rd order + limiter). 144 ! 3. Fluxes boundary point above (1st order). 145 ! 4. Fluxes boundary point below (1st order). 146 ! 5. Closure of 'X' if required 147 ! 6. Propagate. 148 ! ------------------------------------------------------ 149 ! 150 ! 9. Switches : 151 ! 152 ! !/S Enable subroutine tracing. 153 ! !/T Enable test output. 154 ! !/T0 Test output input/output fields. 155 ! !/T1 Test output fluxes. 156 ! !/T2 Test output integration. 157 ! 158 ! 10. Source code : 159 ! 160 !/ ------------------------------------------------------------------- / 161 IMPLICIT NONE 162 !/ 163 !/ ------------------------------------------------------------------- / 164 !/ Parameter list 165 !/ 166 INTEGER, INTENT(IN) :: MX, MY, NX, NY, INC, MAPACT(MY*MX), & 167 NACT, MAPBOU(MY*MX), NB0, NB1, NB2, & 168 NDSE, NDST 169 REAL, INTENT(INOUT) :: CFLL(MY*(MX+1)), Q(1-MY:MY*(MX+2)) 170 LOGICAL, INTENT(IN) :: CLOSE 171 !/ Page 4 Source Listing W3QCK1 2014-09-16 16:49 w3uqckmd.f90 172 !/ ------------------------------------------------------------------- / 173 !/ Local parameters 174 !/ 175 INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, IX, & 176 IAD00, IAD02, IADN0, IADN1, IADN2 177 REAL :: CFL, QB, DQ, DQNZ, QCN, QBN, QBR, CFAC 178 REAL :: FLA(1-MY:MY*MX) 179 !/ 180 !/ ------------------------------------------------------------------- / 181 !/ 182 ! 183 ! 1. Initialize aux. array FLA and closure ------------------------- * 184 ! 185 FLA = 0. 186 ! 187 IF ( CLOSE ) THEN 188 IAD00 = -MY 189 IAD02 = MY 190 IADN0 = IAD00 + MY*NX 191 IADN1 = MY*NX 192 IADN2 = IAD02 + MY*NX 193 DO IY=1, NY 194 Q (IY+IAD00) = Q (IY+IADN0) 195 Q (IY+IADN1) = Q ( IY ) 196 Q (IY+IADN2) = Q (IY+IAD02) 197 CFLL(IY+IADN1) = CFLL( IY ) 198 END DO 199 END IF 200 ! 201 ! 2. Fluxes for central points ------------------------------------- * 202 ! ( 3rd order + limiter ) 203 ! 204 DO IP=1, NB0 205 ! 206 IXY = MAPBOU(IP) 207 CFL = 0.5 * ( CFLL(IXY) + CFLL(IXY+INC) ) 208 IXYC = IXY - INC * INT( MIN ( 0. , SIGN(1.1,CFL) ) ) 209 QB = 0.5 * ( (1.-CFL)*Q(IXY+INC) + (1.+CFL)*Q(IXY) ) & 210 - (1.-CFL**2)/6. * (Q(IXYC-INC)-2.*Q(IXYC)+Q(IXYC+INC)) 211 ! 212 IXYU = IXYC - INC * INT ( SIGN (1.1,CFL) ) 213 IXYD = 2*IXYC - IXYU 214 DQ = Q(IXYD) - Q(IXYU) 215 DQNZ = SIGN ( MAX(1.E-15,ABS(DQ)) , DQ ) 216 QCN = ( Q(IXYC) - Q(IXYU) ) / DQNZ 217 QCN = MIN ( 1.1, MAX ( -0.1 , QCN ) ) 218 ! 219 QBN = MAX ( (QB-Q(IXYU))/DQNZ , QCN ) 220 QBN = MIN ( QBN , 1. , QCN/MAX(1.E-10,ABS(CFL)) ) 221 QBR = Q(IXYU) + QBN*DQ 222 CFAC = REAL ( INT( 2. * ABS(QCN-0.5) ) ) 223 QB = (1.-CFAC)*QBR + CFAC*Q(IXYC) 224 ! 225 FLA(IXY) = CFL * QB 226 ! 227 END DO 228 ! Page 5 Source Listing W3QCK1 2014-09-16 16:49 w3uqckmd.f90 229 ! 3. Fluxes for points with boundary above ------------------------- * 230 ! ( 1st order without limiter ) 231 ! 232 DO IP=NB0+1, NB1 233 IXY = MAPBOU(IP) 234 CFL = CFLL(IXY) 235 IXYC = IXY - INC * INT( MIN ( 0. , SIGN(1.1,CFL) ) ) 236 FLA(IXY) = CFL * Q(IXYC) 237 END DO 238 ! 239 ! 4. Fluxes for points with boundary below ------------------------- * 240 ! ( 1st order without limiter ) 241 ! 242 DO IP=NB1+1, NB2 243 IXY = MAPBOU(IP) 244 CFL = CFLL(IXY+INC) 245 IXYC = IXY - INC * INT( MIN ( 0. , SIGN(1.1,CFL) ) ) 246 FLA(IXY) = CFL * Q(IXYC) 247 END DO 248 ! 249 ! 5. Global closure ----------------------------------------------- * 250 ! 251 IF ( CLOSE ) THEN 252 DO IY=1, NY 253 FLA (IY+IAD00) = FLA (IY+IADN0) 254 END DO 255 END IF 256 ! 257 ! 6. Propagation -------------------------------------------------- * 258 ! 259 DO IP=1, NACT 260 IXY = MAPACT(IP) 261 Q(IXY) = MAX ( 0. , Q(IXY) + FLA(IXY-INC) - FLA(IXY) ) 262 END DO 263 ! 264 RETURN 265 ! 266 ! Formats 267 ! 268 !/ 269 !/ End of W3QCK1 ----------------------------------------------------- / 270 !/ 271 END SUBROUTINE W3QCK1 Page 6 Source Listing W3QCK1 2014-09-16 16:49 Entry Points w3uqckmd.f90 ENTRY POINTS Name w3uqckmd_mp_w3qck1_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABS Func 215 scalar 215,220,222 CFAC Local 177 R(4) 4 scalar 222,223 CFL Local 177 R(4) 4 scalar 207,208,209,210,212,220,225,234,23 5,236,244,245,246 CFLL Dummy 69 R(4) 4 1 0 ARG,INOUT 197,207,234,244 CLOSE Dummy 69 L(4) 4 scalar ARG,IN 187,251 DQ Local 177 R(4) 4 scalar 214,215,221 DQNZ Local 177 R(4) 4 scalar 215,216,219 FLA Local 178 R(4) 4 1 0 185,225,236,246,253,261 IAD00 Local 176 I(4) 4 scalar 188,190,194,253 IAD02 Local 176 I(4) 4 scalar 189,192,196 IADN0 Local 176 I(4) 4 scalar 190,194,253 IADN1 Local 176 I(4) 4 scalar 191,195,197 IADN2 Local 176 I(4) 4 scalar 192,196 INC Dummy 69 I(4) 4 scalar ARG,IN 207,208,209,210,212,235,244,245,26 1 INT Func 208 scalar 208,212,222,235,245 IP Local 175 I(4) 4 scalar 204,206,232,233,242,243,259,260 IX Local 175 I(4) 4 scalar IXY Local 175 I(4) 4 scalar 206,207,208,209,225,233,234,235,23 6,243,244,245,246,260,261 IXYC Local 175 I(4) 4 scalar 208,210,212,213,216,223,235,236,24 5,246 IXYD Local 175 I(4) 4 scalar 213,214 IXYU Local 175 I(4) 4 scalar 212,213,214,216,219,221 IY Local 175 I(4) 4 scalar 193,194,195,196,197,252,253 MAPACT Dummy 70 I(4) 4 1 0 ARG,IN 260 MAPBOU Dummy 70 I(4) 4 1 0 ARG,IN 206,233,243 MAX Func 215 scalar 215,217,219,220,261 MIN Func 208 scalar 208,217,220,235,245 MX Dummy 69 I(4) 4 scalar ARG,IN 166,167,169,178 MY Dummy 69 I(4) 4 scalar ARG,IN 166,167,169,178,188,189,190,191,19 2 NACT Dummy 70 I(4) 4 scalar ARG,IN 259 NB0 Dummy 70 I(4) 4 scalar ARG,IN 204,232 NB1 Dummy 70 I(4) 4 scalar ARG,IN 232,242 NB2 Dummy 70 I(4) 4 scalar ARG,IN 242 NDSE Dummy 71 I(4) 4 scalar ARG,IN NDST Dummy 71 I(4) 4 scalar ARG,IN NX Dummy 69 I(4) 4 scalar ARG,IN 190,191,192 NY Dummy 69 I(4) 4 scalar ARG,IN 193,252 Q Dummy 69 R(4) 4 1 0 ARG,INOUT 194,195,196,209,210,214,216,219,22 1,223,236,246,261 QB Local 177 R(4) 4 scalar 209,219,223,225 Page 7 Source Listing W3QCK1 2014-09-16 16:49 Symbol Table w3uqckmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References QBN Local 177 R(4) 4 scalar 219,220,221 QBR Local 177 R(4) 4 scalar 221,223 QCN Local 177 R(4) 4 scalar 216,217,219,220,222 REAL Func 222 scalar 222 SIGN Func 208 scalar 208,212,215,235,245 W3QCK1 Subr 69 Page 8 Source Listing W3QCK1 2014-09-16 16:49 w3uqckmd.f90 272 !/ ------------------------------------------------------------------- / 273 SUBROUTINE W3QCK2 (MX, MY, NX, NY, VELO, DT, DX1, DX2, Q, CLOSE,& 274 INC, MAPACT, NACT, MAPBOU, NB0, NB1, NB2, & 275 NDSE, NDST ) 276 !/ 277 !/ +-----------------------------------+ 278 !/ | WAVEWATCH III NOAA/NCEP | 279 !/ | H. L. Tolman | 280 !/ | FORTRAN 90 | 281 !/ | Last update : 30-Oct-2009 | 282 !/ +-----------------------------------+ 283 !/ 284 !/ 07-Sep-1997 : Final FORTRAN 77 ( version 1.18 ) 285 !/ 16-Dec-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 286 !/ 14-Feb-2001 : Unit numbers added to par list. ( version 2.08 ) 287 !/ 05-Mar-2008 : Added NEC sxf90 compiler directives. 288 !/ (Chris Bunney, UK Met Office) ( version 3.13 ) 289 !/ 30-Oct-2009 : Fixed "Called by" doc line. ( version 3.14 ) 290 !/ (T. J. Campbell, NRL) 291 !/ 292 ! 1. Purpose : 293 ! 294 ! Like W3QCK1 with variable grid spacing. 295 ! 296 ! 3. Parameters : 297 ! 298 ! Parameter list 299 ! ---------------------------------------------------------------- 300 ! MX,MY Int. I Field dimensions, if grid is 'closed' or 301 ! circular, MX is the closed dimension. 302 ! NX,NY Int. I Part of field actually used. 303 ! VELO R.A. I Local velocities. (MY, MX+1) 304 ! DT Real I Time step. 305 ! DX1 R.A. I/O Band width at points. (MY, MX+1) 306 ! DX2 R.A. I/O Band width between points. (MY,0:MX+1) 307 ! (local counter and counter+INC) 308 ! Q R.A. I/O Propagated quantity. (MY,0:MX+2) 309 ! CLOSE Log. I Flag for closed 'X' dimension' 310 ! INC Int. I Increment in 1-D array corresponding to 311 ! increment in 2-D space. 312 ! MAPACT I.A. I List of active grid points. 313 ! NACT Int. I Size of MAPACT. 314 ! MAPBOU I.A. I Map with boundary information (see W3MAP2). 315 ! NBn Int. I Counters in MAPBOU. 316 ! NDSE Int. I Error output unit number. 317 ! NDST Int. I Test output unit number. 318 ! ---------------------------------------------------------------- 319 ! - VELO amd Q need only bee filled in the (MY,MX) range, 320 ! extension is used internally for closure. 321 ! - VELO and Q are defined as 1-D arrays internally. 322 ! 323 ! 4. Subroutines used : 324 ! 325 ! STRACE Service routine. 326 ! 327 ! 5. Called by : 328 ! Page 9 Source Listing W3QCK2 2014-09-16 16:49 w3uqckmd.f90 329 ! W3KTP2 Propagation in spectral space 330 ! 331 ! 6. Error messages : 332 ! 333 ! None. 334 ! 335 ! 7. Remarks : 336 ! 337 ! - This routine can be used independently from WAVEWATCH III. 338 ! 339 ! 8. Structure : 340 ! 341 ! ------------------------------------------------------ 342 ! 1. Initialize aux. array FLA. 343 ! 2. Fluxes for central points (3rd order + limiter). 344 ! 3. Fluxes boundary point above (1st order). 345 ! 4. Fluxes boundary point below (1st order). 346 ! 5. Closure of 'X' if required 347 ! 6. Propagate. 348 ! ------------------------------------------------------ 349 ! 350 ! 9. Switches : 351 ! 352 ! !/S Enable subroutine tracing. 353 ! !/T Enable test output. 354 ! !/T0 Test output input/output fields. 355 ! !/T1 Test output fluxes. 356 ! !/T2 Test output integration. 357 ! 358 ! 10. Source code : 359 ! 360 !/ ------------------------------------------------------------------- / 361 IMPLICIT NONE 362 !/ 363 !/ ------------------------------------------------------------------- / 364 !/ Parameter list 365 !/ 366 INTEGER, INTENT(IN) :: MX, MY, NX, NY, INC, MAPACT(MY*MX), & 367 NACT, MAPBOU(MY*MX), NB0, NB1, NB2, & 368 NDSE, NDST 369 REAL, INTENT(IN) :: DT 370 REAL, INTENT(INOUT) :: VELO(MY*(MX+1)), DX1(MY*(MX+1)), & 371 DX2(1-MY:MY*(MX+1)), Q(1-MY:MY*(MX+2)) 372 LOGICAL, INTENT(IN) :: CLOSE 373 !/ 374 !/ ------------------------------------------------------------------- / 375 !/ Local parameters 376 !/ 377 INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, IX, & 378 IAD00, IAD02, IADN0, IADN1, IADN2 379 REAL :: CFL, VEL, QB, DQ, DQNZ, QCN, QBN, & 380 QBR, CFAC, FLA(1-MY:MY*MX) 381 !/ 382 !/ ------------------------------------------------------------------- / 383 !/ 384 ! 385 ! 1. Initialize aux. array FLA and closure ------------------------- * Page 10 Source Listing W3QCK2 2014-09-16 16:49 w3uqckmd.f90 386 ! 387 FLA = 0. 388 ! 389 IF ( CLOSE ) THEN 390 IAD00 = -MY 391 IAD02 = MY 392 IADN0 = IAD00 + MY*NX 393 IADN1 = MY*NX 394 IADN2 = IAD02 + MY*NX 395 DO IY=1, NY 396 Q (IY+IAD00) = Q (IY+IADN0) 397 Q (IY+IADN1) = Q ( IY ) 398 Q (IY+IADN2) = Q (IY+IAD02) 399 VELO(IY+IADN1) = VELO( IY ) 400 DX1 (IY+IADN1) = DX1 ( IY ) 401 DX2 (IY+IAD00) = DX1 (IY+IADN0) 402 DX2 (IY+IADN1) = DX1 ( IY ) 403 END DO 404 END IF 405 ! 406 ! 2. Fluxes for central points ------------------------------------- * 407 ! ( 3rd order + limiter ) 408 ! 409 DO IP=1, NB0 410 ! 411 IXY = MAPBOU(IP) 412 VEL = 0.5 * ( VELO(IXY) + VELO(IXY+INC) ) 413 CFL = DT * VEL / DX2(IXY) 414 IXYC = IXY - INC * INT( MIN ( 0. , SIGN(1.1,CFL) ) ) 415 QB = 0.5 * ( (1.-CFL)*Q(IXY+INC) + (1.+CFL)*Q(IXY) ) & 416 - DX2(IXY)**2 / DX1(IXYC) * (1.-CFL**2) / 6. & 417 * ( (Q(IXYC+INC)-Q(IXYC))/DX2(IXYC) & 418 - (Q(IXYC)-Q(IXYC-INC))/DX2(IXYC-INC) ) 419 ! 420 IXYU = IXYC - INC * INT ( SIGN (1.1,CFL) ) 421 IXYD = 2*IXYC - IXYU 422 DQ = Q(IXYD) - Q(IXYU) 423 DQNZ = SIGN ( MAX(1.E-15,ABS(DQ)) , DQ ) 424 QCN = ( Q(IXYC) - Q(IXYU) ) / DQNZ 425 QCN = MIN ( 1.1, MAX ( -0.1 , QCN ) ) 426 ! 427 QBN = MAX ( (QB-Q(IXYU))/DQNZ , QCN ) 428 QBN = MIN ( QBN , 1. , QCN/MAX(1.E-10,ABS(CFL)) ) 429 QBR = Q(IXYU) + QBN*DQ 430 CFAC = REAL ( INT( 2. * ABS(QCN-0.5) ) ) 431 QB = (1.-CFAC)*QBR + CFAC*Q(IXYC) 432 ! 433 FLA(IXY) = VEL * QB 434 ! 435 END DO 436 ! 437 ! 3. Fluxes for points with boundary above ------------------------- * 438 ! ( 1st order without limiter ) 439 ! 440 DO IP=NB0+1, NB1 441 IXY = MAPBOU(IP) 442 VEL = VELO(IXY) Page 11 Source Listing W3QCK2 2014-09-16 16:49 w3uqckmd.f90 443 IXYC = IXY - INC * INT( MIN ( 0. , SIGN(1.1,VEL) ) ) 444 FLA(IXY) = VEL * Q(IXYC) 445 END DO 446 ! 447 ! 4. Fluxes for points with boundary below ------------------------- * 448 ! ( 1st order without limiter ) 449 ! 450 DO IP=NB1+1, NB2 451 IXY = MAPBOU(IP) 452 VEL = VELO(IXY+INC) 453 IXYC = IXY - INC * INT( MIN ( 0. , SIGN(1.1,VEL) ) ) 454 FLA(IXY) = VEL * Q(IXYC) 455 END DO 456 ! 457 ! 5. Global closure ----------------------------------------------- * 458 ! 459 IF ( CLOSE ) THEN 460 DO IY=1, NY 461 FLA (IY+IAD00) = FLA (IY+IADN0) 462 END DO 463 END IF 464 ! 465 ! 6. Propagation -------------------------------------------------- * 466 ! 467 DO IP=1, NACT 468 IXY = MAPACT(IP) 469 Q(IXY) = MAX ( 0. , Q(IXY) + DT/DX1(IXY) * & 470 (FLA(IXY-INC)-FLA(IXY)) ) 471 END DO 472 ! 473 RETURN 474 ! 475 ! Formats 476 ! 477 !/ 478 !/ End of W3QCK2 ----------------------------------------------------- / 479 !/ 480 END SUBROUTINE W3QCK2 Page 12 Source Listing W3QCK2 2014-09-16 16:49 Entry Points w3uqckmd.f90 ENTRY POINTS Name w3uqckmd_mp_w3qck2_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABS Func 423 scalar 423,428,430 CFAC Local 380 R(4) 4 scalar 430,431 CFL Local 379 R(4) 4 scalar 413,414,415,416,420,428 CLOSE Dummy 273 L(4) 4 scalar ARG,IN 389,459 DQ Local 379 R(4) 4 scalar 422,423,429 DQNZ Local 379 R(4) 4 scalar 423,424,427 DT Dummy 273 R(4) 4 scalar ARG,IN 413,469 DX1 Dummy 273 R(4) 4 1 0 ARG,INOUT 400,401,402,416,469 DX2 Dummy 273 R(4) 4 1 0 ARG,INOUT 401,402,413,416,417,418 FLA Local 380 R(4) 4 1 0 387,433,444,454,461,470 IAD00 Local 378 I(4) 4 scalar 390,392,396,401,461 IAD02 Local 378 I(4) 4 scalar 391,394,398 IADN0 Local 378 I(4) 4 scalar 392,396,401,461 IADN1 Local 378 I(4) 4 scalar 393,397,399,400,402 IADN2 Local 378 I(4) 4 scalar 394,398 INC Dummy 274 I(4) 4 scalar ARG,IN 412,414,415,417,418,420,443,452,45 3,470 INT Func 414 scalar 414,420,430,443,453 IP Local 377 I(4) 4 scalar 409,411,440,441,450,451,467,468 IX Local 377 I(4) 4 scalar IXY Local 377 I(4) 4 scalar 411,412,413,414,415,416,433,441,44 2,443,444,451,452,453,454,468,469, 470 IXYC Local 377 I(4) 4 scalar 414,416,417,418,420,421,424,431,44 3,444,453,454 IXYD Local 377 I(4) 4 scalar 421,422 IXYU Local 377 I(4) 4 scalar 420,421,422,424,427,429 IY Local 377 I(4) 4 scalar 395,396,397,398,399,400,401,402,46 0,461 MAPACT Dummy 274 I(4) 4 1 0 ARG,IN 468 MAPBOU Dummy 274 I(4) 4 1 0 ARG,IN 411,441,451 MAX Func 423 scalar 423,425,427,428,469 MIN Func 414 scalar 414,425,428,443,453 MX Dummy 273 I(4) 4 scalar ARG,IN 366,367,370,371,380 MY Dummy 273 I(4) 4 scalar ARG,IN 366,367,370,371,380,390,391,392,39 3,394 NACT Dummy 274 I(4) 4 scalar ARG,IN 467 NB0 Dummy 274 I(4) 4 scalar ARG,IN 409,440 NB1 Dummy 274 I(4) 4 scalar ARG,IN 440,450 NB2 Dummy 274 I(4) 4 scalar ARG,IN 450 NDSE Dummy 275 I(4) 4 scalar ARG,IN NDST Dummy 275 I(4) 4 scalar ARG,IN NX Dummy 273 I(4) 4 scalar ARG,IN 392,393,394 NY Dummy 273 I(4) 4 scalar ARG,IN 395,460 Page 13 Source Listing W3QCK2 2014-09-16 16:49 Symbol Table w3uqckmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References Q Dummy 273 R(4) 4 1 0 ARG,INOUT 396,397,398,415,417,418,422,424,42 7,429,431,444,454,469 QB Local 379 R(4) 4 scalar 415,427,431,433 QBN Local 379 R(4) 4 scalar 427,428,429 QBR Local 380 R(4) 4 scalar 429,431 QCN Local 379 R(4) 4 scalar 424,425,427,428,430 REAL Func 430 scalar 430 SIGN Func 414 scalar 414,420,423,443,453 VEL Local 379 R(4) 4 scalar 412,413,433,442,443,444,452,453,45 4 VELO Dummy 273 R(4) 4 1 0 ARG,INOUT 399,412,442,452 W3QCK2 Subr 273 Page 14 Source Listing W3QCK2 2014-09-16 16:49 w3uqckmd.f90 481 !/ ------------------------------------------------------------------- / 482 SUBROUTINE W3QCK3 (MX, MY, NX, NY, CFLL, TRANS, Q, CLOSE, & 483 INC, MAPACT, NACT, MAPBOU, NB0, NB1, NB2, & 484 NDSE, NDST ) 485 !/ 486 !/ +-----------------------------------+ 487 !/ | WAVEWATCH III NOAA/NCEP | 488 !/ | H. L. Tolman | 489 !/ | FORTRAN 90 | 490 !/ | Last update : 05-Mar-2008 | 491 !/ +-----------------------------------+ 492 !/ 493 !/ 13_nov-2001 : Origination. ( version 2.14 ) 494 !/ 16-Oct-2002 : Fix INTENT for TRANS. ( version 3.00 ) 495 !/ 05-Mar-2008 : Added NEC sxf90 compiler directives. 496 !/ (Chris Bunney, UK Met Office) ( version 3.13 ) 497 !/ 498 ! 1. Purpose : 499 ! 500 ! Like W3QCK1 with cell transparencies added. 501 ! 502 ! 2. Method : 503 ! 504 ! 3. Parameters : 505 ! 506 ! Parameter list 507 ! ---------------------------------------------------------------- 508 ! MX,MY Int. I Field dimensions, if grid is 'closed' or 509 ! circular, MX is the closed dimension. 510 ! NX,NY Int. I Part of field actually used. 511 ! CFLL R.A. I Local Courant numbers. (MY, MX+1) 512 ! Q R.A. I/O Propagated quantity. (MY,0:MX+2) 513 ! CLOSE Log. I Flag for closed 'X' dimension' 514 ! INC Int. I Increment in 1-D array corresponding to 515 ! increment in 2-D space. 516 ! MAPACT I.A. I List of active grid points. 517 ! NACT Int. I Size of MAPACT. 518 ! MAPBOU I.A. I Map with boundary information (see W3MAP2). 519 ! NBn Int. I Counters in MAPBOU. 520 ! NDSE Int. I Error output unit number. 521 ! NDST Int. I Test output unit number. 522 ! ---------------------------------------------------------------- 523 ! - CFLL amd Q need only bee filled in the (MY,MX) range, 524 ! extension is used internally for closure. 525 ! - CFLL and Q are defined as 1-D arrays internally. 526 ! 527 ! 4. Subroutines used : 528 ! 529 ! STRACE Service routine. 530 ! 531 ! 5. Called by : 532 ! 533 ! W3XYP2 Propagation in physical space 534 ! 535 ! 6. Error messages : 536 ! 537 ! None. Page 15 Source Listing W3QCK3 2014-09-16 16:49 w3uqckmd.f90 538 ! 539 ! 7. Remarks : 540 ! 541 ! - This routine can be used independently from WAVEWATCH III. 542 ! 543 ! 8. Structure : 544 ! 545 ! ------------------------------------------------------ 546 ! 1. Initialize aux. array FLA. 547 ! 2. Fluxes for central points (3rd order + limiter). 548 ! 3. Fluxes boundary point above (1st order). 549 ! 4. Fluxes boundary point below (1st order). 550 ! 5. Closure of 'X' if required 551 ! 6. Propagate. 552 ! ------------------------------------------------------ 553 ! 554 ! 9. Switches : 555 ! 556 ! !/S Enable subroutine tracing. 557 ! !/T Enable test output. 558 ! !/T0 Test output input/output fields. 559 ! !/T1 Test output fluxes. 560 ! !/T2 Test output integration. 561 ! 562 ! 10. Source code : 563 ! 564 !/ ------------------------------------------------------------------- / 565 IMPLICIT NONE 566 !/ 567 !/ ------------------------------------------------------------------- / 568 !/ Parameter list 569 !/ 570 INTEGER, INTENT(IN) :: MX, MY, NX, NY, INC, MAPACT(MY*MX), & 571 NACT, MAPBOU(MY*MX), NB0, NB1, NB2, & 572 NDSE, NDST 573 REAL, INTENT(IN) :: TRANS(MY*MX,-1:1) 574 REAL, INTENT(INOUT) :: CFLL(MY*(MX+1)), Q(1-MY:MY*(MX+2)) 575 LOGICAL, INTENT(IN) :: CLOSE 576 !/ 577 !/ ------------------------------------------------------------------- / 578 !/ Local parameters 579 !/ 580 INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, IX, & 581 IAD00, IAD02, IADN0, IADN1, IADN2, & 582 JN, JP 583 REAL :: CFL, QB, DQ, DQNZ, QCN, QBN, QBR, CFAC 584 REAL :: FLA(1-MY:MY*MX) 585 !/ 586 !/ ------------------------------------------------------------------- / 587 !/ 588 ! 589 ! 1. Initialize aux. array FLA and closure ------------------------- * 590 ! 591 FLA = 0. 592 ! 593 IF ( CLOSE ) THEN 594 IAD00 = -MY Page 16 Source Listing W3QCK3 2014-09-16 16:49 w3uqckmd.f90 595 IAD02 = MY 596 IADN0 = IAD00 + MY*NX 597 IADN1 = MY*NX 598 IADN2 = IAD02 + MY*NX 599 DO IY=1, NY 600 Q (IY+IAD00) = Q (IY+IADN0) 601 Q (IY+IADN1) = Q ( IY ) 602 Q (IY+IADN2) = Q (IY+IAD02) 603 CFLL(IY+IADN1) = CFLL( IY ) 604 END DO 605 END IF 606 ! 607 ! 2. Fluxes for central points ------------------------------------- * 608 ! ( 3rd order + limiter ) 609 ! 610 DO IP=1, NB0 611 ! 612 IXY = MAPBOU(IP) 613 CFL = 0.5 * ( CFLL(IXY) + CFLL(IXY+INC) ) 614 IXYC = IXY - INC * INT( MIN ( 0. , SIGN(1.1,CFL) ) ) 615 QB = 0.5 * ( (1.-CFL)*Q(IXY+INC) + (1.+CFL)*Q(IXY) ) & 616 - (1.-CFL**2)/6. * (Q(IXYC-INC)-2.*Q(IXYC)+Q(IXYC+INC)) 617 ! 618 IXYU = IXYC - INC * INT ( SIGN (1.1,CFL) ) 619 IXYD = 2*IXYC - IXYU 620 DQ = Q(IXYD) - Q(IXYU) 621 DQNZ = SIGN ( MAX(1.E-15,ABS(DQ)) , DQ ) 622 QCN = ( Q(IXYC) - Q(IXYU) ) / DQNZ 623 QCN = MIN ( 1.1, MAX ( -0.1 , QCN ) ) 624 ! 625 QBN = MAX ( (QB-Q(IXYU))/DQNZ , QCN ) 626 QBN = MIN ( QBN , 1. , QCN/MAX(1.E-10,ABS(CFL)) ) 627 QBR = Q(IXYU) + QBN*DQ 628 CFAC = REAL ( INT( 2. * ABS(QCN-0.5) ) ) 629 QB = (1.-CFAC)*QBR + CFAC*Q(IXYC) 630 ! 631 FLA(IXY) = CFL * QB 632 ! 633 END DO 634 ! 635 ! 3. Fluxes for points with boundary above ------------------------- * 636 ! ( 1st order without limiter ) 637 ! 638 DO IP=NB0+1, NB1 639 IXY = MAPBOU(IP) 640 CFL = CFLL(IXY) 641 IXYC = IXY - INC * INT( MIN ( 0. , SIGN(1.1,CFL) ) ) 642 FLA(IXY) = CFL * Q(IXYC) 643 END DO 644 ! 645 ! 4. Fluxes for points with boundary below ------------------------- * 646 ! ( 1st order without limiter ) 647 ! 648 DO IP=NB1+1, NB2 649 IXY = MAPBOU(IP) 650 CFL = CFLL(IXY+INC) 651 IXYC = IXY - INC * INT( MIN ( 0. , SIGN(1.1,CFL) ) ) Page 17 Source Listing W3QCK3 2014-09-16 16:49 w3uqckmd.f90 652 FLA(IXY) = CFL * Q(IXYC) 653 END DO 654 ! 655 ! 5. Global closure ----------------------------------------------- * 656 ! 657 IF ( CLOSE ) THEN 658 DO IY=1, NY 659 FLA (IY+IAD00) = FLA (IY+IADN0) 660 END DO 661 END IF 662 ! 663 ! 6. Propagation -------------------------------------------------- * 664 ! 665 DO IP=1, NACT 666 ! 667 IXY = MAPACT(IP) 668 IF ( FLA(IXY-INC) .GT. 0. ) THEN 669 JN = -1 670 ELSE 671 JN = 0 672 END IF 673 IF ( FLA(IXY ) .LT. 0. ) THEN 674 JP = 1 675 ELSE 676 JP = 0 677 END IF 678 ! 679 Q(IXY) = MAX ( 0. , Q(IXY) + TRANS(IXY,JN) * FLA(IXY-INC) & 680 - TRANS(IXY,JP) * FLA(IXY) ) 681 682 END DO 683 ! 684 RETURN 685 ! 686 ! Formats 687 ! 688 !/ 689 !/ End of W3QCK3 ----------------------------------------------------- / 690 !/ 691 END SUBROUTINE W3QCK3 Page 18 Source Listing W3QCK3 2014-09-16 16:49 Entry Points w3uqckmd.f90 ENTRY POINTS Name w3uqckmd_mp_w3qck3_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABS Func 621 scalar 621,626,628 CFAC Local 583 R(4) 4 scalar 628,629 CFL Local 583 R(4) 4 scalar 613,614,615,616,618,626,631,640,64 1,642,650,651,652 CFLL Dummy 482 R(4) 4 1 0 ARG,INOUT 603,613,640,650 CLOSE Dummy 482 L(4) 4 scalar ARG,IN 593,657 DQ Local 583 R(4) 4 scalar 620,621,627 DQNZ Local 583 R(4) 4 scalar 621,622,625 FLA Local 584 R(4) 4 1 0 591,631,642,652,659,668,673,679,68 0 IAD00 Local 581 I(4) 4 scalar 594,596,600,659 IAD02 Local 581 I(4) 4 scalar 595,598,602 IADN0 Local 581 I(4) 4 scalar 596,600,659 IADN1 Local 581 I(4) 4 scalar 597,601,603 IADN2 Local 581 I(4) 4 scalar 598,602 INC Dummy 483 I(4) 4 scalar ARG,IN 613,614,615,616,618,641,650,651,66 8,679 INT Func 614 scalar 614,618,628,641,651 IP Local 580 I(4) 4 scalar 610,612,638,639,648,649,665,667 IX Local 580 I(4) 4 scalar IXY Local 580 I(4) 4 scalar 612,613,614,615,631,639,640,641,64 2,649,650,651,652,667,668,673,679, 680 IXYC Local 580 I(4) 4 scalar 614,616,618,619,622,629,641,642,65 1,652 IXYD Local 580 I(4) 4 scalar 619,620 IXYU Local 580 I(4) 4 scalar 618,619,620,622,625,627 IY Local 580 I(4) 4 scalar 599,600,601,602,603,658,659 JN Local 582 I(4) 4 scalar 669,671,679 JP Local 582 I(4) 4 scalar 674,676,680 MAPACT Dummy 483 I(4) 4 1 0 ARG,IN 667 MAPBOU Dummy 483 I(4) 4 1 0 ARG,IN 612,639,649 MAX Func 621 scalar 621,623,625,626,679 MIN Func 614 scalar 614,623,626,641,651 MX Dummy 482 I(4) 4 scalar ARG,IN 570,571,573,574,584 MY Dummy 482 I(4) 4 scalar ARG,IN 570,571,573,574,584,594,595,596,59 7,598 NACT Dummy 483 I(4) 4 scalar ARG,IN 665 NB0 Dummy 483 I(4) 4 scalar ARG,IN 610,638 NB1 Dummy 483 I(4) 4 scalar ARG,IN 638,648 NB2 Dummy 483 I(4) 4 scalar ARG,IN 648 NDSE Dummy 484 I(4) 4 scalar ARG,IN NDST Dummy 484 I(4) 4 scalar ARG,IN NX Dummy 482 I(4) 4 scalar ARG,IN 596,597,598 Page 19 Source Listing W3QCK3 2014-09-16 16:49 Symbol Table w3uqckmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References NY Dummy 482 I(4) 4 scalar ARG,IN 599,658 Q Dummy 482 R(4) 4 1 0 ARG,INOUT 600,601,602,615,616,620,622,625,62 7,629,642,652,679 QB Local 583 R(4) 4 scalar 615,625,629,631 QBN Local 583 R(4) 4 scalar 625,626,627 QBR Local 583 R(4) 4 scalar 627,629 QCN Local 583 R(4) 4 scalar 622,623,625,626,628 REAL Func 628 scalar 628 SIGN Func 614 scalar 614,618,621,641,651 TRANS Dummy 482 R(4) 4 2 0 ARG,IN 679,680 W3QCK3 Subr 482 Page 20 Source Listing W3QCK3 2014-09-16 16:49 w3uqckmd.f90 692 !/ 693 !/ End of module W3UQCKMD -------------------------------------------- / 694 !/ 695 END MODULE W3UQCKMD SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References W3UQCKMD Module 2 Page 21 Source Listing W3QCK3 2014-09-16 16:49 Subprograms/Common Blocks w3uqckmd.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References W3QCK1 Subr 69 W3QCK2 Subr 273 W3QCK3 Subr 482 W3UQCKMD Module 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 cc_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 _OPENMP=201107 -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 Page 22 Source Listing W3QCK3 2014-09-16 16:49 w3uqckmd.f90 -fpscomp nogeneral -fpscomp noioformat -fpscomp noldio_spacing -fpscomp nologicals no -fpconstant -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 -openmp -O2 no -pad_source -real_size 32 no -recursive -reentrancy threaded 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 : /usrx/local/intel/composerxe/tbb/include/,/usr/include/,./,/usrx/local/intel/impi/4.0.3.008/intel64/include/, /usrx/local/intel/impi/4.0.3.008/intel64/include/,/usrx/local/intel/composerxe/mkl/include/,/usrx/local/intel/composerxe/tbb/include/, /gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/,/gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/, /usr/local/include/,/usr/lib/gcc/x86_64-redhat-linux/4.4.7/include/,/usr/include/,/usr/include/ -list filename : w3uqckmd.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100