Page 1 Source Listing ITRACE 2014-09-16 16:47 w3servmd.f90 1 !/ ------------------------------------------------------------------- / 2 MODULE W3SERVMD 3 !/ 4 !/ +-----------------------------------+ 5 !/ | WAVEWATCH III NOAA/NCEP | 6 !/ | H. L. Tolman | 7 !/ | FORTRAN 90 | 8 !/ | Last update : 11-Nov-2013 | 9 !/ +-----------------------------------+ 10 !/ 11 !/ For update log see individual subroutines. 12 !/ 12-Jun-2012 : Add /RTD option or rotated grid option. 13 !/ (Jian-Guo Li) ( version 4.06 ) 14 !/ 11-Nov-2013 : SMC and rotated grid incorporated in the main 15 !/ trunk ( version 4.13 ) 16 !/ 17 !/ Copyright 2009-2012 National Weather Service (NWS), 18 !/ National Oceanic and Atmospheric Administration. All rights 19 !/ reserved. WAVEWATCH III is a trademark of the NWS. 20 !/ No unauthorized use without permission. 21 !/ 22 ! 1. Purpose : 23 ! 24 ! In this module all WAVEWATCH specific service routines have 25 ! been gathered. 26 ! 27 ! 2. Variables and types : 28 ! 29 ! Name Type Scope Description 30 ! ---------------------------------------------------------------- 31 ! NDSTRC Int. Private Data set number for output of STRACE 32 ! (set in ITRACE). 33 ! NTRACE Int. Private Maximum number of trace prints in 34 ! strace (set in ITRACE). 35 ! 36 ! PRFTB Int. Private Base time for profiling. 37 ! FLPROF Log. Private Flag for profiling initialization. 38 ! ---------------------------------------------------------------- 39 ! 40 ! 3. Subroutines and functions : 41 ! 42 ! Name Type Scope Description 43 ! ---------------------------------------------------------------- 44 ! ITRACE Subr. Public (Re-) Initialization for STRACE. 45 ! STRACE Subr. Public Enable subroutine tracing, usually 46 ! activated with the !/S switch. 47 ! NEXTLN Subr. Public Get to next line in input command file. 48 ! W3S2XY Subr. Public Grid conversion routine. 49 ! EJ5P R.F. Public Five parameter JONSWAP spectrum. 50 ! WWDATE Subr. Public Get system date. 51 ! WWTIME Subr. Public Get system time. 52 ! EXTCDE Subr. Public Abort program with exit code. 53 ! PRINIT Subr. Public Initialize profiling. 54 ! PRTIME Subr. Public Get profiling time. 55 ! Four subs for rotated grid are appended to this module. As they 56 ! are shared with SMC grid, they are not quoted by option /RTD but 57 ! are available for general use. JGLi12Jun2012 Page 2 Source Listing ITRACE 2014-09-16 16:47 w3servmd.f90 58 ! W3SPECTN turns wave spectrum anti-clockwise by AnglD 59 ! W3ACTURN turns wave action(k,nth) anti-clockwise by AnglD. 60 ! W3LLTOEQ convert standard into rotated lat/lon, plus AnglD 61 ! W3EQTOLL revers of the LLTOEQ, but AnglD unchanged. 62 ! 63 ! ---------------------------------------------------------------- 64 ! 65 ! 4. Subroutines and functions used : 66 ! 67 ! None. 68 ! 69 ! 5. Remarks : 70 ! 71 ! 6. Switches 72 ! 73 ! !/S Enable subroutine tracing using STRACE in this module. 74 ! 75 ! !/F90 FORTRAN 90 specific switches. 76 ! 77 ! 7. Source code : 78 ! 79 !/ ------------------------------------------------------------------- / 80 PUBLIC 81 ! 82 INTEGER, PRIVATE :: NDSTRC = 6, NTRACE = 0, PRFTB 83 LOGICAL, PRIVATE :: FLPROF = .FALSE. 84 ! 85 CONTAINS 86 !/ ------------------------------------------------------------------- / 87 SUBROUTINE ITRACE (NDS, NMAX) 88 !/ 89 !/ +-----------------------------------+ 90 !/ | WAVEWATCH III NOAA/NCEP | 91 !/ | H. L. Tolman | 92 !/ | FORTRAN 90 | 93 !/ | Last update : 23-Nov-1999 | 94 !/ +-----------------------------------+ 95 !/ 96 !/ 23-Nov-1999 : First version of routine. ( version 2.00 ) 97 !/ 98 ! 1. Purpose : 99 ! 100 ! (Re-) initialization for module version of STRACE. 101 ! 102 ! 3. Parameter list 103 ! ---------------------------------------------------------------- 104 ! NDS Int. I Data set number ofr trace file. 105 ! NMAX Int. I Maximum number of traces per routine. 106 ! ---------------------------------------------------------------- 107 ! 108 ! Private to module : 109 ! ---------------------------------------------------------------- 110 ! NDSTRC Int. Output unit number for trace. ( from NDS ) 111 ! NTRACE Int. Maximum number of trace prints. ( from NMAX ) 112 ! ---------------------------------------------------------------- 113 ! 114 ! 4. Subroutines used : Page 3 Source Listing ITRACE 2014-09-16 16:47 w3servmd.f90 115 ! 116 ! None. 117 ! 118 ! 5. Called by : 119 ! 120 ! Any program, multiple calls allowed. 121 ! 122 ! 9. Switches : 123 ! 124 ! 10. Source code : 125 ! 126 !/ ------------------------------------------------------------------- / 127 IMPLICIT NONE 128 !/ 129 !/ ------------------------------------------------------------------- / 130 !/ Parameter list 131 !/ 132 INTEGER, INTENT(IN) :: NDS, NMAX 133 !/ 134 !/ ------------------------------------------------------------------- / 135 !/ 136 NTRACE = MAX ( 0 , NMAX ) 137 NDSTRC = NDS 138 ! 139 RETURN 140 !/ 141 !/ End of ITRACE ----------------------------------------------------- / 142 !/ 143 END SUBROUTINE ITRACE Page 4 Source Listing ITRACE 2014-09-16 16:47 Entry Points w3servmd.f90 ENTRY POINTS Name w3servmd_mp_itrace_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ITRACE Subr 87 MAX Func 136 scalar 136 NDS Dummy 87 I(4) 4 scalar ARG,IN 137 NDSTRC Local 137 I(4) 4 scalar PRIV 82,137,204,206 NMAX Dummy 87 I(4) 4 scalar ARG,IN 136 NTRACE Local 136 I(4) 4 scalar PRIV 82,136,200 Page 5 Source Listing ITRACE 2014-09-16 16:47 w3servmd.f90 144 !/ ------------------------------------------------------------------- / 145 SUBROUTINE STRACE (IENT, SNAME) 146 !/ 147 !/ +-----------------------------------+ 148 !/ | WAVEWATCH III NOAA/NCEP | 149 !/ | H. L. Tolman | 150 !/ | FORTRAN 90 | 151 !/ | Last update : 25-Jan-2000 | 152 !/ +-----------------------------------+ 153 !/ Original version by N. Booij, DUT 154 !/ 155 !/ 30-Mar-1993 : Final FORTRAN 77 ( version 1.18 ) 156 !/ 23-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 157 !/ 25-Jan-2000 : Force flushing of uniit. ( version 2.00 ) 158 !/ This was taken out around version 3.01. 159 !/ 160 ! 1. Purpose : 161 ! 162 ! Keep track of entered subroutines. 163 ! 164 ! 3. Parameter list 165 ! ---------------------------------------------------------------- 166 ! IENT Int. I/O Number of times that STRACE has been 167 ! called by the routine. 168 ! SNAME Char. I Name of the subroutine (max. 6 characters) 169 ! ---------------------------------------------------------------- 170 ! 171 ! Private to module : 172 ! ---------------------------------------------------------------- 173 ! NDSTRC Int. Output unit number for trace. 174 ! NTRACE Int. Maximum number of trace prints. 175 ! ---------------------------------------------------------------- 176 ! 177 ! 4. Subroutines used : 178 ! 179 ! None. 180 ! 181 ! 5. Called by : 182 ! 183 ! Any program, after private variables have been set by NTRACE. 184 ! 185 ! 9. Switches : 186 ! 187 ! 10. Source code : 188 ! 189 !/ ------------------------------------------------------------------- / 190 IMPLICIT NONE 191 !/ 192 !/ ------------------------------------------------------------------- / 193 !/ Parameter list 194 !/ 195 INTEGER, INTENT(INOUT) :: IENT 196 CHARACTER, INTENT(IN) :: SNAME*(*) 197 !/ 198 !/ ------------------------------------------------------------------- / 199 !/ 200 IF (NTRACE.EQ.0 .OR. IENT.GE.NTRACE) RETURN Page 6 Source Listing STRACE 2014-09-16 16:47 w3servmd.f90 201 ! 202 IENT = IENT + 1 203 IF (IENT.EQ.1) THEN 204 WRITE (NDSTRC,10) SNAME 205 ELSE 206 WRITE (NDSTRC,11) SNAME, IENT 207 END IF 208 ! 209 RETURN 210 ! 211 ! Formats 212 ! 213 10 FORMAT (' ---> TRACE SUBR : ',A6) 214 11 FORMAT (' ---> TRACE SUBR : ',A6,' ENTRY: ',I6) 215 !/ 216 !/ End of STRACE ----------------------------------------------------- / 217 !/ 218 END SUBROUTINE STRACE ENTRY POINTS Name w3servmd_mp_strace_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 10 Label 213 204 11 Label 214 206 IENT Dummy 145 I(4) 4 scalar ARG,INOUT 200,202,203,206 SNAME Dummy 145 CHAR scalar ARG,IN 204,206 STRACE Subr 145 Page 7 Source Listing STRACE 2014-09-16 16:47 w3servmd.f90 219 !/ ------------------------------------------------------------------- / 220 SUBROUTINE NEXTLN ( CHCKC , NDSI , NDSE ) 221 !/ 222 !/ +-----------------------------------+ 223 !/ | WAVEWATCH III NOAA/NCEP | 224 !/ | H. L. Tolman | 225 !/ | FORTRAN 90 | 226 !/ | Last update : 18-Nov-1999 | 227 !/ +-----------------------------------+ 228 !/ 229 !/ 15-Jan-1999 : Final FORTRAN 77 ( version 1.18 ) 230 !/ 18-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 231 !/ 232 ! 1. Purpose : 233 ! 234 ! Sets file pointer to next active line of input file, by skipping 235 ! lines starting with the character CHCKC. 236 ! 237 ! 3. Parameters : 238 ! 239 ! Parameter list 240 ! ---------------------------------------------------------------- 241 ! CHCKC C*1 I Check character for defining comment line. 242 ! NDSI Int. I Input dataset number. 243 ! NDSE Int. I Error output dataset number. 244 ! (No output if NDSE < 0). 245 ! ---------------------------------------------------------------- 246 ! 247 ! 4. Subroutines used : 248 ! 249 ! STRACE ( !/S switch ) 250 ! 251 ! 5. Called by : 252 ! 253 ! Any routine. 254 ! 255 ! 6. Error messages : 256 ! 257 ! - On EOF or error in input file. 258 ! 259 ! 9. Switches : 260 ! 261 ! !/S Enable subroutine tracing. 262 ! 263 ! 10. Source code : 264 ! 265 !/ ------------------------------------------------------------------- / 266 IMPLICIT NONE 267 !/ 268 !/ ------------------------------------------------------------------- / 269 !/ Parameter list 270 !/ 271 INTEGER, INTENT(IN) :: NDSI, NDSE 272 CHARACTER, INTENT(IN) :: CHCKC*1 273 !/ 274 !/ ------------------------------------------------------------------- / 275 !/ Local parameters Page 8 Source Listing NEXTLN 2014-09-16 16:47 w3servmd.f90 276 !/ 277 INTEGER :: IERR 278 CHARACTER :: TEST*1 279 !/ 280 !/ ------------------------------------------------------------------- / 281 !/ 282 ! 283 100 CONTINUE 284 READ (NDSI,900,END=800,ERR=801,IOSTAT=IERR) TEST 285 IF (TEST.EQ.CHCKC) THEN 286 GOTO 100 287 ELSE 288 BACKSPACE (NDSI,ERR=802,IOSTAT=IERR) 289 ENDIF 290 RETURN 291 ! 292 800 CONTINUE 293 IF ( NDSE .GE. 0 ) WRITE (NDSE,910) 294 CALL EXTCDE ( 1 ) 295 ! 296 801 CONTINUE 297 IF ( NDSE .GE. 0 ) WRITE (NDSE,911) IERR 298 CALL EXTCDE ( 2 ) 299 ! 300 802 CONTINUE 301 IF ( NDSE .GE. 0 ) WRITE (NDSE,911) IERR 302 CALL EXTCDE ( 3 ) 303 ! 304 ! Formats 305 ! 306 900 FORMAT (A) 307 910 FORMAT (/' *** WAVEWATCH III ERROR IN NEXTLN : '/ & 308 ' PREMATURE END OF INPUT FILE'/) 309 911 FORMAT (/' *** WAVEWATCH III ERROR IN NEXTLN : '/ & 310 ' ERROR IN READING FROM FILE'/ & 311 ' IOSTAT =',I5/) 312 912 FORMAT (/' *** WAVEWATCH III ERROR IN NEXTLN : '/ & 313 ' ERROR ON BACKSPACE'/ & 314 ' IOSTAT =',I5/) 315 !/ 316 !/ End of NEXTLN ----------------------------------------------------- / 317 !/ 318 END SUBROUTINE NEXTLN Page 9 Source Listing NEXTLN 2014-09-16 16:47 Entry Points w3servmd.f90 ENTRY POINTS Name w3servmd_mp_nextln_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 100 Label 283 286 800 Label 292 284 801 Label 296 284 802 Label 300 288 900 Label 306 284 910 Label 307 293 911 Label 309 297,301 912 Label 312 CHCKC Dummy 220 CHAR 1 scalar ARG,IN 285 IERR Local 277 I(4) 4 scalar 284,288,297,301 NDSE Dummy 220 I(4) 4 scalar ARG,IN 293,297,301 NDSI Dummy 220 I(4) 4 scalar ARG,IN 284,288 NEXTLN Subr 220 TEST Local 278 CHAR 1 scalar 284,285 Page 10 Source Listing NEXTLN 2014-09-16 16:47 w3servmd.f90 319 !/ ------------------------------------------------------------------- / 320 SUBROUTINE W3S2XY ( NSEA, MSEA, MX, MY, S, MAPSF, XY ) 321 !/ 322 !/ +-----------------------------------+ 323 !/ | WAVEWATCH III NOAA/NMC | 324 !/ | H. L. Tolman | 325 !/ | FORTRAN 90 | 326 !/ | Last update : 23-Nov-1999 | 327 !/ +-----------------------------------+ 328 !/ 329 !/ 11-Dec-1996 : Final FORTRAN 77 ( version 1.18 ) 330 !/ 23-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 331 !/ 332 ! 1. Purpose : 333 ! 334 ! Convert a data array on the storage grid to a data array on the 335 ! full spatial grid. Land and ice points in the full grid are 336 ! not touched. Output array of conventional type XY(IX,IY). 337 ! 338 ! 3. Parameters : 339 ! 340 ! Parameter list 341 ! ---------------------------------------------------------------- 342 ! NSEA Int. I Number of sea points. 343 ! MSEA, MX, MY 344 ! Int. I Array dimensions. 345 ! S R.A. I Data on storage grid. 346 ! MAPSF I.A. I Storage map for IX and IY, resp. 347 ! XY R.A. O Data on XY grid. 348 ! ---------------------------------------------------------------- 349 ! 350 ! 4. Subroutines used : 351 ! 352 ! None. 353 ! 354 ! 5. Called by : 355 ! 356 ! Any WAVEWATCH III routine. 357 ! 358 ! 9. Switches : 359 ! 360 ! None. 361 ! 362 ! 10. Source code : 363 ! 364 !/ ------------------------------------------------------------------- / 365 IMPLICIT NONE 366 !/ 367 !/ ------------------------------------------------------------------- / 368 !/ Parameter list 369 !/ 370 INTEGER, INTENT(IN) :: MSEA, NSEA, MX, MY, MAPSF(MSEA,2) 371 REAL, INTENT(IN) :: S(MSEA) 372 REAL, INTENT(OUT) :: XY(MX,MY) 373 !/ 374 !/ ------------------------------------------------------------------- / 375 !/ Local parameters Page 11 Source Listing W3S2XY 2014-09-16 16:47 w3servmd.f90 376 !/ 377 INTEGER :: ISEA, IX, IY 378 !/ 379 !/ ------------------------------------------------------------------- / 380 !/ 381 DO 100, ISEA=1, NSEA 382 IX = MAPSF(ISEA,1) 383 IY = MAPSF(ISEA,2) 384 XY(IX,IY) = S(ISEA) 385 100 CONTINUE 386 !/ 387 !/ End of W3S2XY ----------------------------------------------------- / 388 !/ 389 END SUBROUTINE W3S2XY ENTRY POINTS Name w3servmd_mp_w3s2xy_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 100 Label 385 381 ISEA Local 377 I(4) 4 scalar 381,382,383,384 IX Local 377 I(4) 4 scalar 382,384 IY Local 377 I(4) 4 scalar 383,384 MAPSF Dummy 320 I(4) 4 2 0 ARG,IN 382,383 MSEA Dummy 320 I(4) 4 scalar ARG,IN 370,371 MX Dummy 320 I(4) 4 scalar ARG,IN 372 MY Dummy 320 I(4) 4 scalar ARG,IN 372 NSEA Dummy 320 I(4) 4 scalar ARG,IN 381 S Dummy 320 R(4) 4 1 0 ARG,IN 384 W3S2XY Subr 320 XY Dummy 320 R(4) 4 2 0 ARG,OUT 384 Page 12 Source Listing W3S2XY 2014-09-16 16:47 w3servmd.f90 390 !/ ------------------------------------------------------------------- / 391 REAL FUNCTION EJ5P ( F, ALFA, FP, YLN, SIGA, SIGB ) 392 !/ 393 !/ +-----------------------------------+ 394 !/ | WAVEWATCH III NOAA/NCEP | 395 !/ | H. L. Tolman | 396 !/ | FORTRAN 90 | 397 !/ | Last update : 23-Nov-1999 | 398 !/ +-----------------------------------+ 399 !/ 400 !/ 23-AMy-1985 : Original by G. Ph. van Vledder. 401 !/ 23-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 402 !/ 403 ! 1. Purpose : 404 ! 405 ! Computation of spectral density using a 5-parameter 406 ! JONSWAP-spectrum 407 ! 408 ! 2. Method 409 ! 410 ! EJ5P(F) = A.EXP(B + LN(Y).EXP(C)) 411 ! 412 ! where: A = ALFA * 0.06175 * F**(-5) 413 ! B = -1.25*(FP/F)**4 414 ! C = -0.5 * ((F - FP)/(SIG * FP))**2 415 ! and 416 ! GRAV**2/(2.PI)**4 = 0.06175 417 ! 418 ! 3. Parameters : 419 ! 420 ! Parameter list 421 ! 422 ! ---------------------------------------------------------------- 423 ! F Real I Frequency in Hz 424 ! ALFA Real I Energy scaling factor 425 ! FP Real I Peak frequency in Hz 426 ! YLN Real I Peak overshoot factor, given by LN-value 427 ! SIGA Real I Spectral width, for F < FP 428 ! SIGB Real I Spectral width, FOR F > FP 429 ! ---------------------------------------------------------------- 430 ! 431 ! 4. Subroutines used : 432 ! 433 ! None. 434 ! 435 ! 5. Called by : 436 ! 437 ! Any. 438 ! 439 ! 6. Error messages : 440 ! 441 ! 7. Remarks : 442 ! 443 ! EXPMIN is a machine dependant constant such that 444 ! EXP(EXPMIN) can be successfully evaluated without 445 ! underflow by the compiler supllied EXP routine. 446 ! Page 13 Source Listing EJ5P 2014-09-16 16:47 w3servmd.f90 447 ! 8. Structure : 448 ! 449 ! See source code. 450 ! 451 ! 9. Switches : 452 ! 453 ! None. 454 ! 455 ! 10. Source code : 456 ! 457 !/ ------------------------------------------------------------------- / 458 IMPLICIT NONE 459 !/ 460 !/ ------------------------------------------------------------------- / 461 !/ Parameter list 462 !/ 463 REAL, INTENT(IN) :: F, ALFA, FP, YLN, SIGA, SIGB 464 !/ 465 !/ ------------------------------------------------------------------- / 466 !/ Local parameters 467 !/ 468 REAL :: SIG, A, B, C 469 REAL, SAVE :: EPS=1.E-4, EXPMIN=-180. 470 !/ 471 !/ ------------------------------------------------------------------- / 472 !/ 473 IF(F.LT.EPS) THEN 474 EJ5P = 0.0 475 RETURN 476 END IF 477 ! 478 A = ALFA * 0.06175 / F**5 479 B = -1.25 * (FP/F)**4 480 B = MAX(B,EXPMIN) 481 ! 482 IF (YLN.LT.EPS) THEN 483 EJ5P = A * EXP(B) 484 ELSE 485 IF( F.LE.FP) THEN 486 SIG = SIGA 487 ELSE 488 SIG = SIGB 489 END IF 490 C = -0.5 * ((F - FP)/(SIG * FP))**2 491 C = MAX(C,EXPMIN) 492 EJ5P = A * EXP(B + EXP(C) * YLN) 493 END IF 494 ! 495 RETURN 496 !/ 497 !/ End of NEXTLN ----------------------------------------------------- / 498 !/ 499 END FUNCTION Page 14 Source Listing EJ5P 2014-09-16 16:47 Entry Points w3servmd.f90 ENTRY POINTS Name w3servmd_mp_ej5p_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References A Local 468 R(4) 4 scalar 478,483,492 ALFA Dummy 391 R(4) 4 scalar ARG,IN 478 B Local 468 R(4) 4 scalar 479,480,483,492 C Local 468 R(4) 4 scalar 490,491,492 EJ5P Func 391 R(4) 4 scalar 474,483,492 EPS Local 469 R(4) 4 scalar 469,473,482 EXP Func 483 scalar 483,492 EXPMIN Local 469 R(4) 4 scalar 469,480,491 F Dummy 391 R(4) 4 scalar ARG,IN 473,478,479,485,490 FP Dummy 391 R(4) 4 scalar ARG,IN 479,485,490 MAX Func 480 scalar 480,491 SIG Local 468 R(4) 4 scalar 486,488,490 SIGA Dummy 391 R(4) 4 scalar ARG,IN 486 SIGB Dummy 391 R(4) 4 scalar ARG,IN 488 YLN Dummy 391 R(4) 4 scalar ARG,IN 482,492 Page 15 Source Listing EJ5P 2014-09-16 16:47 w3servmd.f90 500 !/ ------------------------------------------------------------------- / 501 SUBROUTINE WWDATE (STRNG) 502 !/ 503 !/ +-----------------------------------+ 504 !/ | WAVEWATCH III NOAA/NCEP | 505 !/ | H. L. Tolman | 506 !/ | FORTRAN 90 | 507 !/ | Last update : 26-Dec-2012 | 508 !/ +-----------------------------------+ 509 !/ 510 !/ 23-Dec-1998 : Final FORTRAN 77 ( version 1.18 ) 511 !/ 23-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 512 !/ 18-Sep-2000 : PGI switch added ( version 2.04 ) 513 !/ 13-Mar-2001 : LF95 switch added ( version 2.09 ) 514 !/ 08-May-2002 : Replace obsolete switches with F90 ( version 2.21 ) 515 !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.11 ) 516 !/ 517 ! 1. Purpose : 518 ! 519 ! Get date from machine dependent routine. 520 ! 521 ! 3. Parameters : 522 ! 523 ! Parameter list 524 ! ---------------------------------------------------------------- 525 ! STRNG C*10 O String with date in format YYYY/MM/DD 526 ! ---------------------------------------------------------------- 527 ! 528 ! 4. Subroutines used : 529 ! 530 ! Machine dependent. 531 ! 532 ! 5. Called by : 533 ! 534 ! Any routine. 535 ! 536 ! 9. Switches : 537 ! 538 ! !/DUM Dummy. 539 ! !/F90 FORTRAN 90 standard. 540 ! 541 ! 10. Source code : 542 ! 543 !/ ------------------------------------------------------------------- / 544 IMPLICIT NONE 545 !/ 546 !/ ------------------------------------------------------------------- / 547 !/ Parameter list 548 !/ 549 CHARACTER, INTENT(OUT) :: STRNG*10 550 !/ 551 !/ ------------------------------------------------------------------- / 552 !/ Local parameters 553 !/ 554 CHARACTER(LEN=8) :: DATE 555 CHARACTER(LEN=10) :: TIME 556 CHARACTER(LEN=5) :: ZONE Page 16 Source Listing WWDATE 2014-09-16 16:47 w3servmd.f90 557 INTEGER :: VALUES(8) 558 !/ 559 !/ ------------------------------------------------------------------- / 560 !/ 561 ! This is supposed to be standard F90 562 ! 563 STRNG = '----/--/--' 564 CALL DATE_AND_TIME ( DATE, TIME, ZONE, VALUES ) 565 STRNG(1:4) = DATE(1:4) 566 STRNG(6:7) = DATE(5:6) 567 STRNG(9:10) = DATE(7:8) 568 ! 569 ! Dummy alternative 570 ! 571 RETURN 572 !/ 573 !/ End of WWDATE ----------------------------------------------------- / 574 !/ 575 END SUBROUTINE WWDATE ENTRY POINTS Name w3servmd_mp_wwdate_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References DATE Local 554 CHAR 8 scalar 564,565,566,567 DATE_AND_TIME Intrin 564 564 STRNG Dummy 501 CHAR 10 scalar ARG,OUT 563,565,566,567 TIME Local 555 CHAR 10 scalar 564 VALUES Local 557 I(4) 4 1 8 564 WWDATE Subr 501 ZONE Local 556 CHAR 5 scalar 564 Page 17 Source Listing WWDATE 2014-09-16 16:47 w3servmd.f90 576 !/ ------------------------------------------------------------------- / 577 SUBROUTINE WWTIME (STRNG) 578 !/ 579 !/ +-----------------------------------+ 580 !/ | WAVEWATCH III NOAA/NCEP | 581 !/ | H. L. Tolman | 582 !/ | FORTRAN 90 | 583 !/ | Last update : 26-Dec-2012 | 584 !/ +-----------------------------------+ 585 !/ 586 !/ 23-Dec-1998 : Final FORTRAN 77 ( version 1.18 ) 587 !/ 23-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 588 !/ 18-Sep-2000 : PGI switch added ( version 2.04 ) 589 !/ 13-Mar-2001 : LF95 switch added ( version 2.09 ) 590 !/ 08-May-2002 : Replace obsolete switches with F90 ( version 2.21 ) 591 !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.11 ) 592 !/ 593 ! 1. Purpose : 594 ! 595 ! Get time from machine dependent routine. 596 ! 597 ! 2. Method : 598 ! 599 ! 3. Parameters : 600 ! 601 ! Parameter list 602 ! ---------------------------------------------------------------- 603 ! STRNG C*8 O String with time in format hh:mm:ss 604 ! ---------------------------------------------------------------- 605 ! 606 ! 4. Subroutines used : 607 ! 608 ! Machine dependent. 609 ! 610 ! 5. Called by : 611 ! 612 ! Any routine. 613 ! 614 ! 9. Switches : 615 ! 616 ! !/DUM Dummy. 617 ! !/F90 FORTRAN 90 standard. 618 ! 619 ! 10. Source code : 620 ! 621 !/ ------------------------------------------------------------------- / 622 IMPLICIT NONE 623 !/ 624 !/ ------------------------------------------------------------------- / 625 !/ Parameter list 626 !/ 627 CHARACTER, INTENT(OUT) :: STRNG*8 628 !/ 629 !/ ------------------------------------------------------------------- / 630 !/ Local parameters 631 !/ 632 CHARACTER(LEN=8) :: DATE Page 18 Source Listing WWTIME 2014-09-16 16:47 w3servmd.f90 633 CHARACTER(LEN=10) :: TIME 634 CHARACTER(LEN=5) :: ZONE 635 INTEGER :: VALUES(8) 636 !/ 637 !/ ------------------------------------------------------------------- / 638 !/ 639 ! This is supposed to be standard F90 640 ! 641 STRNG = '--:--:--' 642 CALL DATE_AND_TIME ( DATE, TIME, ZONE, VALUES ) 643 STRNG(1:2) = TIME(1:2) 644 STRNG(4:5) = TIME(3:4) 645 STRNG(7:8) = TIME(5:6) 646 ! 647 ! Dummy alternative 648 ! 649 RETURN 650 !/ 651 !/ End of WWTIME ----------------------------------------------------- / 652 !/ 653 END SUBROUTINE WWTIME ENTRY POINTS Name w3servmd_mp_wwtime_ Page 19 Source Listing WWTIME 2014-09-16 16:47 Symbol Table w3servmd.f90 SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References DATE Local 632 CHAR 8 scalar 642 DATE_AND_TIME Intrin 642 642 STRNG Dummy 577 CHAR 8 scalar ARG,OUT 641,643,644,645 TIME Local 633 CHAR 10 scalar 642,643,644,645 VALUES Local 635 I(4) 4 1 8 642 WWTIME Subr 577 ZONE Local 634 CHAR 5 scalar 642 Page 20 Source Listing WWTIME 2014-09-16 16:47 w3servmd.f90 654 !/ ------------------------------------------------------------------- / 655 SUBROUTINE EXTCDE ( IEXIT ) 656 !/ 657 !/ +-----------------------------------+ 658 !/ | WAVEWATCH III NOAA/NCEP | 659 !/ | H. L. Tolman | 660 !/ | FORTRAN 90 | 661 !/ | Last update : 06-Jan-1999 | 662 !/ +-----------------------------------+ 663 !/ 664 !/ 06-Jan-1998 : Final FORTRAN 77 ( version 1.18 ) 665 !/ 23-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 666 !/ 667 ! 1. Purpose : 668 ! 669 ! Perfor a program stop with an exit code. 670 ! 671 ! 2. Method : 672 ! 673 ! Machine dependent. 674 ! 675 ! 3. Parameters : 676 ! 677 ! Parameter list 678 ! ---------------------------------------------------------------- 679 ! IEXIT Int. I Exit code to be used. 680 ! ---------------------------------------------------------------- 681 ! 682 ! 4. Subroutines used : 683 ! 684 ! 5. Called by : 685 ! 686 ! Any. 687 ! 688 ! 9. Switches : 689 ! 690 ! !/MPI MPI finalize interface if active 691 ! 692 ! 10. Source code : 693 ! 694 !/ ------------------------------------------------------------------- / 695 IMPLICIT NONE 696 ! 697 INCLUDE "mpif.h" 698 !/ 699 !/ ------------------------------------------------------------------- / 700 !/ Parameter list 701 !/ 1240 INTEGER, INTENT(IN) :: IEXIT 1241 !/ 1242 !/ ------------------------------------------------------------------- / 1243 !/ 1244 INTEGER :: IERR_MPI 1245 LOGICAL :: RUN 1246 !/ 1247 !/ Test if MPI needs to be closed 1248 !/ Page 21 Source Listing EXTCDE 2014-09-16 16:47 w3servmd.f90 1249 CALL MPI_INITIALIZED ( RUN, IERR_MPI ) 1250 IF ( RUN ) THEN 1251 CALL MPI_BARRIER ( MPI_COMM_WORLD, IERR_MPI ) 1252 CALL MPI_FINALIZE (IERR_MPI ) 1253 END IF 1254 ! 1255 CALL EXIT ( IEXIT ) 1256 !/ 1257 !/ End of EXTCDE ----------------------------------------------------- / 1258 !/ 1259 END SUBROUTINE EXTCDE ENTRY POINTS Name w3servmd_mp_extcde_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References EXIT Intrin 717 717 EXTCDE Subr 655 294,298,302 IERR_MPI Local 706 I(4) 4 scalar 711,713,714 IEXIT Dummy 655 I(4) 4 scalar ARG,IN 717 MPIPRIV1 Common 532 28 MPIPRIV2 Common 534 24 MPIPRIVC Common 537 2 MPI_2COMPLEX Param 332 I(4) 4 scalar MPI_2DOUBLE_COMPLEX Param 338 I(4) 4 scalar MPI_2DOUBLE_PRECISION Param 334 I(4) 4 scalar MPI_2INT Param 415 I(4) 4 scalar MPI_2INTEGER Param 330 I(4) 4 scalar MPI_2REAL Param 336 I(4) 4 scalar MPI_ADDRESS_KIND Param 372 I(4) 4 scalar MPI_ANY_SOURCE Param 300 I(4) 4 scalar MPI_ANY_TAG Param 302 I(4) 4 scalar MPI_APPNUM Param 269 I(4) 4 scalar MPI_ARGVS_NULL Scalar 83 CHAR 1 2 1 COM MPI_ARGV_NULL Scalar 84 CHAR 1 1 1 COM MPI_BAND Param 217 I(4) 4 scalar MPI_BARRIER Subr 713 713 MPI_BOR Param 221 I(4) 4 scalar MPI_BOTTOM Scalar 517 I(4) 4 scalar COM MPI_BSEND_OVERHEAD Param 296 I(4) 4 scalar MPI_BXOR Param 225 I(4) 4 scalar MPI_BYTE Param 342 I(4) 4 scalar MPI_CART Param 308 I(4) 4 scalar MPI_CHAR Param 375 I(4) 4 scalar MPI_CHARACTER Param 340 I(4) 4 scalar MPI_COMBINER_CONTIGUOUS Param 423 I(4) 4 scalar MPI_COMBINER_DARRAY Param 445 I(4) 4 scalar MPI_COMBINER_DUP Param 421 I(4) 4 scalar MPI_COMBINER_F90_COMPLEX Param 449 I(4) 4 scalar Page 22 Source Listing EXTCDE 2014-09-16 16:47 Symbol Table w3servmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_COMBINER_F90_INTEGER Param 451 I(4) 4 scalar MPI_COMBINER_F90_REAL Param 447 I(4) 4 scalar MPI_COMBINER_HINDEXED Param 435 I(4) 4 scalar MPI_COMBINER_HINDEXED_INTE GER Param 433 I(4) 4 scalar MPI_COMBINER_HVECTOR Param 429 I(4) 4 scalar MPI_COMBINER_HVECTOR_INTEG ER Param 427 I(4) 4 scalar MPI_COMBINER_INDEXED Param 431 I(4) 4 scalar MPI_COMBINER_INDEXED_BLOCK Param 437 I(4) 4 scalar MPI_COMBINER_NAMED Param 419 I(4) 4 scalar MPI_COMBINER_RESIZED Param 453 I(4) 4 scalar MPI_COMBINER_STRUCT Param 441 I(4) 4 scalar MPI_COMBINER_STRUCT_INTEGE R Param 439 I(4) 4 scalar MPI_COMBINER_SUBARRAY Param 443 I(4) 4 scalar MPI_COMBINER_VECTOR Param 425 I(4) 4 scalar MPI_COMM_DUP_FN Subr 521 scalar MPI_COMM_NULL Param 239 I(4) 4 scalar MPI_COMM_NULL_COPY_FN Subr 522 scalar MPI_COMM_NULL_DELETE_FN Subr 521 scalar MPI_COMM_SELF Param 235 I(4) 4 scalar MPI_COMM_WORLD Param 233 I(4) 4 scalar 713 MPI_COMPLEX Param 318 I(4) 4 scalar MPI_COMPLEX16 Param 368 I(4) 4 scalar MPI_COMPLEX32 Param 370 I(4) 4 scalar MPI_COMPLEX8 Param 366 I(4) 4 scalar MPI_CONGRUENT Param 201 I(4) 4 scalar MPI_CONVERSION_FN_NULL Subr 527 scalar MPI_DATATYPE_NULL Param 249 I(4) 4 scalar 359 MPI_DISPLACEMENT_CURRENT Param 515 I(8) 8 scalar MPI_DISTRIBUTE_BLOCK Param 507 I(4) 4 scalar MPI_DISTRIBUTE_CYCLIC Param 509 I(4) 4 scalar MPI_DISTRIBUTE_DFLT_DARG Param 513 I(4) 4 scalar MPI_DISTRIBUTE_NONE Param 511 I(4) 4 scalar MPI_DOUBLE Param 397 I(4) 4 scalar MPI_DOUBLE_COMPLEX Param 320 I(4) 4 scalar MPI_DOUBLE_INT Param 409 I(4) 4 scalar MPI_DOUBLE_PRECISION Param 326 I(4) 4 scalar MPI_DUP_FN Subr 518 scalar MPI_ERRCODES_IGNORE Scalar 82 I(4) 4 1 1 COM MPI_ERRHANDLER_NULL Param 253 I(4) 4 scalar MPI_ERROR Param 76 I(4) 4 scalar MPI_ERRORS_ARE_FATAL Param 195 I(4) 4 scalar MPI_ERRORS_RETURN Param 197 I(4) 4 scalar MPI_ERR_ACCESS Param 189 I(4) 4 scalar MPI_ERR_AMODE Param 173 I(4) 4 scalar MPI_ERR_ARG Param 109 I(4) 4 scalar MPI_ERR_ASSERT Param 131 I(4) 4 scalar MPI_ERR_BAD_FILE Param 163 I(4) 4 scalar MPI_ERR_BASE Param 97 I(4) 4 scalar MPI_ERR_BUFFER Param 115 I(4) 4 scalar MPI_ERR_COMM Param 137 I(4) 4 scalar MPI_ERR_CONVERSION Param 193 I(4) 4 scalar MPI_ERR_COUNT Param 93 I(4) 4 scalar Page 23 Source Listing EXTCDE 2014-09-16 16:47 Symbol Table w3servmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_ERR_DIMS Param 179 I(4) 4 scalar MPI_ERR_DISP Param 125 I(4) 4 scalar MPI_ERR_DUP_DATAREP Param 117 I(4) 4 scalar MPI_ERR_FILE Param 91 I(4) 4 scalar MPI_ERR_FILE_EXISTS Param 133 I(4) 4 scalar MPI_ERR_FILE_IN_USE Param 165 I(4) 4 scalar MPI_ERR_GROUP Param 145 I(4) 4 scalar MPI_ERR_INFO Param 159 I(4) 4 scalar MPI_ERR_INFO_KEY Param 103 I(4) 4 scalar MPI_ERR_INFO_NOKEY Param 129 I(4) 4 scalar MPI_ERR_INFO_VALUE Param 153 I(4) 4 scalar MPI_ERR_INTERN Param 185 I(4) 4 scalar MPI_ERR_IN_STATUS Param 101 I(4) 4 scalar MPI_ERR_IO Param 187 I(4) 4 scalar MPI_ERR_KEYVAL Param 139 I(4) 4 scalar MPI_ERR_LASTCODE Param 121 I(4) 4 scalar MPI_ERR_LOCKTYPE Param 105 I(4) 4 scalar MPI_ERR_NAME Param 141 I(4) 4 scalar MPI_ERR_NOT_SAME Param 155 I(4) 4 scalar MPI_ERR_NO_MEM Param 161 I(4) 4 scalar MPI_ERR_NO_SPACE Param 191 I(4) 4 scalar MPI_ERR_NO_SUCH_FILE Param 181 I(4) 4 scalar MPI_ERR_OP Param 107 I(4) 4 scalar MPI_ERR_OTHER Param 87 I(4) 4 scalar MPI_ERR_PENDING Param 135 I(4) 4 scalar MPI_ERR_PORT Param 127 I(4) 4 scalar MPI_ERR_QUOTA Param 171 I(4) 4 scalar MPI_ERR_RANK Param 177 I(4) 4 scalar MPI_ERR_READ_ONLY Param 111 I(4) 4 scalar MPI_ERR_REQUEST Param 143 I(4) 4 scalar MPI_ERR_RMA_CONFLICT Param 99 I(4) 4 scalar MPI_ERR_RMA_SYNC Param 157 I(4) 4 scalar MPI_ERR_ROOT Param 175 I(4) 4 scalar MPI_ERR_SERVICE Param 183 I(4) 4 scalar MPI_ERR_SIZE Param 113 I(4) 4 scalar MPI_ERR_SPAWN Param 95 I(4) 4 scalar MPI_ERR_TAG Param 151 I(4) 4 scalar MPI_ERR_TOPOLOGY Param 147 I(4) 4 scalar MPI_ERR_TRUNCATE Param 123 I(4) 4 scalar MPI_ERR_TYPE Param 149 I(4) 4 scalar MPI_ERR_UNKNOWN Param 167 I(4) 4 scalar MPI_ERR_UNSUPPORTED_DATARE P Param 119 I(4) 4 scalar MPI_ERR_UNSUPPORTED_OPERAT ION Param 169 I(4) 4 scalar MPI_ERR_WIN Param 89 I(4) 4 scalar MPI_FILE_NULL Param 243 I(4) 4 scalar MPI_FINALIZE Subr 714 714 MPI_FLOAT Param 395 I(4) 4 scalar MPI_FLOAT_INT Param 407 I(4) 4 scalar MPI_GRAPH Param 306 I(4) 4 scalar MPI_GROUP_EMPTY Param 237 I(4) 4 scalar MPI_GROUP_NULL Param 245 I(4) 4 scalar MPI_HOST Param 259 I(4) 4 scalar MPI_IDENT Param 199 I(4) 4 scalar Page 24 Source Listing EXTCDE 2014-09-16 16:47 Symbol Table w3servmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_INFO_NULL Param 255 I(4) 4 scalar MPI_INITIALIZED Subr 711 711 MPI_INT Param 387 I(4) 4 scalar MPI_INTEGER Param 328 I(4) 4 scalar MPI_INTEGER1 Param 350 I(4) 4 scalar MPI_INTEGER16 Param 358 I(4) 4 scalar MPI_INTEGER2 Param 352 I(4) 4 scalar MPI_INTEGER4 Param 354 I(4) 4 scalar MPI_INTEGER8 Param 356 I(4) 4 scalar MPI_IN_PLACE Scalar 517 I(4) 4 scalar COM MPI_IO Param 261 I(4) 4 scalar MPI_KEYVAL_INVALID Param 294 I(4) 4 scalar MPI_LAND Param 215 I(4) 4 scalar MPI_LASTUSEDCODE Param 267 I(4) 4 scalar MPI_LB Param 346 I(4) 4 scalar MPI_LOCK_EXCLUSIVE Param 314 I(4) 4 scalar MPI_LOCK_SHARED Param 316 I(4) 4 scalar MPI_LOGICAL Param 322 I(4) 4 scalar MPI_LONG Param 391 I(4) 4 scalar MPI_LONG_DOUBLE Param 399 I(4) 4 scalar MPI_LONG_DOUBLE_INT Param 417 I(4) 4 scalar MPI_LONG_INT Param 411 I(4) 4 scalar MPI_LONG_LONG Param 405 I(4) 4 scalar MPI_LONG_LONG_INT Param 401 I(4) 4 scalar MPI_LOR Param 219 I(4) 4 scalar MPI_LXOR Param 223 I(4) 4 scalar MPI_MAX Param 207 I(4) 4 scalar MPI_MAXLOC Param 229 I(4) 4 scalar MPI_MAX_DATAREP_STRING Param 289 I(4) 4 scalar MPI_MAX_ERROR_STRING Param 277 I(4) 4 scalar MPI_MAX_INFO_KEY Param 283 I(4) 4 scalar MPI_MAX_INFO_VAL Param 285 I(4) 4 scalar MPI_MAX_OBJECT_NAME Param 281 I(4) 4 scalar MPI_MAX_PORT_NAME Param 279 I(4) 4 scalar MPI_MAX_PROCESSOR_NAME Param 287 I(4) 4 scalar MPI_MIN Param 209 I(4) 4 scalar MPI_MINLOC Param 227 I(4) 4 scalar MPI_MODE_APPEND Param 493 I(4) 4 scalar MPI_MODE_CREATE Param 489 I(4) 4 scalar MPI_MODE_DELETE_ON_CLOSE Param 485 I(4) 4 scalar MPI_MODE_EXCL Param 491 I(4) 4 scalar MPI_MODE_NOCHECK Param 461 I(4) 4 scalar MPI_MODE_NOPRECEDE Param 467 I(4) 4 scalar MPI_MODE_NOPUT Param 465 I(4) 4 scalar MPI_MODE_NOSTORE Param 463 I(4) 4 scalar MPI_MODE_NOSUCCEED Param 469 I(4) 4 scalar MPI_MODE_RDONLY Param 479 I(4) 4 scalar MPI_MODE_RDWR Param 481 I(4) 4 scalar MPI_MODE_SEQUENTIAL Param 495 I(4) 4 scalar MPI_MODE_UNIQUE_OPEN Param 487 I(4) 4 scalar MPI_MODE_WRONLY Param 483 I(4) 4 scalar MPI_NULL_COPY_FN Subr 518 scalar MPI_NULL_DELETE_FN Subr 518 scalar MPI_OFFSET_KIND Param 372 I(4) 4 scalar MPI_OP_NULL Param 247 I(4) 4 scalar Page 25 Source Listing EXTCDE 2014-09-16 16:47 Symbol Table w3servmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_ORDER_C Param 503 I(4) 4 scalar MPI_ORDER_FORTRAN Param 505 I(4) 4 scalar MPI_PACKED Param 348 I(4) 4 scalar MPI_PROC_NULL Param 298 I(4) 4 scalar MPI_PROD Param 213 I(4) 4 scalar MPI_REAL Param 324 I(4) 4 scalar MPI_REAL16 Param 364 I(4) 4 scalar MPI_REAL4 Param 360 I(4) 4 scalar MPI_REAL8 Param 362 I(4) 4 scalar MPI_REPLACE Param 231 I(4) 4 scalar MPI_REQUEST_NULL Param 251 I(4) 4 scalar MPI_ROOT Param 304 I(4) 4 scalar MPI_SEEK_CUR Param 499 I(4) 4 scalar MPI_SEEK_END Param 501 I(4) 4 scalar MPI_SEEK_SET Param 497 I(4) 4 scalar MPI_SHORT Param 383 I(4) 4 scalar MPI_SHORT_INT Param 413 I(4) 4 scalar MPI_SIGNED_CHAR Param 377 I(4) 4 scalar MPI_SIMILAR Param 203 I(4) 4 scalar MPI_SOURCE Param 76 I(4) 4 scalar MPI_STATUSES_IGNORE Scalar 81 I(4) 4 2 5 COM MPI_STATUS_IGNORE Scalar 80 I(4) 4 1 5 COM MPI_STATUS_SIZE Param 78 I(4) 4 scalar 80,81 MPI_SUBVERSION Param 312 I(4) 4 scalar MPI_SUCCESS Param 85 I(4) 4 scalar MPI_SUM Param 211 I(4) 4 scalar MPI_TAG Param 76 I(4) 4 scalar MPI_TAG_UB Param 257 I(4) 4 scalar MPI_THREAD_FUNNELED Param 473 I(4) 4 scalar MPI_THREAD_MULTIPLE Param 477 I(4) 4 scalar MPI_THREAD_SERIALIZED Param 475 I(4) 4 scalar MPI_THREAD_SINGLE Param 471 I(4) 4 scalar MPI_TYPECLASS_COMPLEX Param 459 I(4) 4 scalar MPI_TYPECLASS_INTEGER Param 457 I(4) 4 scalar MPI_TYPECLASS_REAL Param 455 I(4) 4 scalar MPI_TYPE_DUP_FN Subr 525 scalar MPI_TYPE_NULL_COPY_FN Subr 526 scalar MPI_TYPE_NULL_DELETE_FN Subr 525 scalar MPI_UB Param 344 I(4) 4 scalar MPI_UNDEFINED Param 291 I(4) 4 scalar MPI_UNDEFINED_RANK Param 291 I(4) 4 scalar MPI_UNEQUAL Param 205 I(4) 4 scalar MPI_UNIVERSE_SIZE Param 265 I(4) 4 scalar MPI_UNSIGNED Param 389 I(4) 4 scalar MPI_UNSIGNED_CHAR Param 379 I(4) 4 scalar MPI_UNSIGNED_LONG Param 393 I(4) 4 scalar MPI_UNSIGNED_LONG_LONG Param 403 I(4) 4 scalar MPI_UNSIGNED_SHORT Param 385 I(4) 4 scalar MPI_VERSION Param 310 I(4) 4 scalar MPI_WCHAR Param 381 I(4) 4 scalar MPI_WIN_BASE Param 271 I(4) 4 scalar MPI_WIN_DISP_UNIT Param 275 I(4) 4 scalar MPI_WIN_DUP_FN Subr 523 scalar MPI_WIN_NULL Param 241 I(4) 4 scalar MPI_WIN_NULL_COPY_FN Subr 524 scalar Page 26 Source Listing EXTCDE 2014-09-16 16:47 Symbol Table w3servmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_WIN_NULL_DELETE_FN Subr 523 scalar MPI_WIN_SIZE Param 273 I(4) 4 scalar MPI_WTICK Func 519 R(8) 8 scalar MPI_WTIME Func 519 R(8) 8 scalar MPI_WTIME_IS_GLOBAL Param 263 I(4) 4 scalar PMPI_WTICK Func 520 R(8) 8 scalar PMPI_WTIME Func 520 R(8) 8 scalar RUN Local 707 L(4) 4 scalar 711,712 Page 27 Source Listing EXTCDE 2014-09-16 16:47 w3servmd.f90 1260 !/ ------------------------------------------------------------------- / 1261 SUBROUTINE PRINIT 1262 !/ 1263 !/ +-----------------------------------+ 1264 !/ | WAVEWATCH III NOAA/NCEP | 1265 !/ | H. L. Tolman | 1266 !/ | FORTRAN 90 | 1267 !/ | Last update : 06-May-2005 ! 1268 !/ +-----------------------------------+ 1269 !/ 1270 !/ 06-May-2005 : Origination. ( version 3.07 ) 1271 !/ 1272 ! 1. Purpose : 1273 ! 1274 ! Initialize profilinf routine PRTIME. 1275 ! 1276 ! 2. Method : 1277 ! 1278 ! FORTRAN 90 SYSTEM_CLOCK intrinsic routine. 1279 ! 1280 ! 3. Parameters : 1281 ! 1282 ! Parameter list 1283 ! ---------------------------------------------------------------- 1284 ! ---------------------------------------------------------------- 1285 ! 1286 ! 4. Subroutines used : 1287 ! 1288 ! Name Type Module Description 1289 ! ---------------------------------------------------------------- 1290 ! SYSTEM_CLOCK 1291 ! Sur. n/a Get system time ( !/F90 ) 1292 ! ---------------------------------------------------------------- 1293 ! 1294 ! 5. Called by : 1295 ! 1296 ! 6. Error messages : 1297 ! 1298 ! 7. Remarks : 1299 ! 1300 ! 8. Structure : 1301 ! 1302 ! 9. Switches : 1303 ! 1304 ! !/F90 FORTRAN 90 specific calls. 1305 ! 1306 ! 10. Source code : 1307 ! 1308 !/ ------------------------------------------------------------------- / 1309 IMPLICIT NONE 1310 !/ 1311 ! -------------------------------------------------------------------- / 1312 ! 1313 CALL SYSTEM_CLOCK ( PRFTB ) 1314 ! 1315 FLPROF = .TRUE. 1316 ! Page 28 Source Listing PRINIT 2014-09-16 16:47 w3servmd.f90 1317 RETURN 1318 !/ 1319 !/ End of PRINIT ----------------------------------------------------- / 1320 !/ 1321 END SUBROUTINE PRINIT ENTRY POINTS Name w3servmd_mp_prinit_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References FLPROF Local 777 L(4) 4 scalar PRIV 83,777,855 PRFTB Local 775 I(4) 4 scalar PRIV 82,775,859,860,862 PRINIT Subr 723 SYSTEM_CLOCK Intrin 775 775 Page 29 Source Listing PRINIT 2014-09-16 16:47 w3servmd.f90 1322 !/ ------------------------------------------------------------------- / 1323 SUBROUTINE PRTIME ( PTIME ) 1324 !/ 1325 !/ +-----------------------------------+ 1326 !/ | WAVEWATCH III NOAA/NCEP | 1327 !/ | H. L. Tolman | 1328 !/ | FORTRAN 90 | 1329 !/ | Last update : 06-May-2005 ! 1330 !/ +-----------------------------------+ 1331 !/ 1332 !/ 06-May-2005 : Origination. ( version 3.07 ) 1333 !/ 1334 ! 1. Purpose : 1335 ! 1336 ! Get wallclock time for profiling purposes. 1337 ! 1338 ! 2. Method : 1339 ! 1340 ! FORTRAN 90 SYSTEM_CLOCK intrinsic routine. 1341 ! 1342 ! 3. Parameters : 1343 ! 1344 ! Parameter list 1345 ! ---------------------------------------------------------------- 1346 ! PTIME Real O Time retrieced from system. 1347 ! ---------------------------------------------------------------- 1348 ! 1349 ! 4. Subroutines used : 1350 ! 1351 ! Name Type Module Description 1352 ! ---------------------------------------------------------------- 1353 ! SYSTEM_CLOCK 1354 ! Sur. n/a Get system time ( !/F90 ) 1355 ! ---------------------------------------------------------------- 1356 ! 1357 ! 5. Called by : 1358 ! 1359 ! Any, after PRINIT has been called. 1360 ! 1361 ! 6. Error messages : 1362 ! 1363 ! - If no initialization, returned time equals -1. 1364 ! - If no system clock, returned time equals -1. 1365 ! 1366 ! 7. Remarks : 1367 ! 1368 ! 8. Structure : 1369 ! 1370 ! 9. Switches : 1371 ! 1372 ! !/F90 FORTRAN 90 specific calls. 1373 ! 1374 ! 10. Source code : 1375 ! 1376 !/ ------------------------------------------------------------------- / 1377 IMPLICIT NONE 1378 !/ Page 30 Source Listing PRTIME 2014-09-16 16:47 w3servmd.f90 1379 !/ ------------------------------------------------------------------- / 1380 !/ Parameter list 1381 !/ 1382 REAL, INTENT(OUT) :: PTIME 1383 !/ 1384 !/ ------------------------------------------------------------------- / 1385 !/ Local parameters 1386 !/ 1387 INTEGER :: PRFTA, PRFINC, PRFMAX, PRFDT 1388 ! 1389 ! -------------------------------------------------------------------- / 1390 ! 1391 PTIME = -1. 1392 ! 1393 IF ( .NOT. FLPROF ) RETURN 1394 ! 1395 CALL SYSTEM_CLOCK ( PRFTA, PRFINC, PRFMAX ) 1396 IF ( PRFMAX .NE. 0 ) THEN 1397 IF ( PRFTA-PRFTB .GE. 0 ) THEN 1398 PRFDT = PRFTA-PRFTB 1399 ELSE 1400 PRFDT = PRFTA-PRFTB + PRFMAX 1401 END IF 1402 PTIME = REAL(PRFDT)/REAL(PRFINC) 1403 END IF 1404 ! 1405 RETURN 1406 !/ 1407 !/ End of PRTIME ----------------------------------------------------- / 1408 !/ 1409 END SUBROUTINE PRTIME Page 31 Source Listing PRTIME 2014-09-16 16:47 Entry Points w3servmd.f90 ENTRY POINTS Name w3servmd_mp_prtime_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References PRFDT Local 849 I(4) 4 scalar 860,862,864 PRFINC Local 849 I(4) 4 scalar 857,864 PRFMAX Local 849 I(4) 4 scalar 857,858,862 PRFTA Local 849 I(4) 4 scalar 857,859,860,862 PRTIME Subr 785 PTIME Dummy 785 R(4) 4 scalar ARG,OUT 853,864 REAL Func 864 scalar 864 SYSTEM_CLOCK Intrin 857 857 Page 32 Source Listing PRTIME 2014-09-16 16:47 w3servmd.f90 1410 !/ ------------------------------------------------------------------- / 1411 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1412 ! This subroutine turn the wave spectrum by an fixed angle anti-clockwise 1413 ! so that it may be used in the rotated or stanadard system. 1414 ! First created: 26 Aug 2005 Jian-Guo Li 1415 ! Last modified: 21 Feb 2008 Jian-Guo Li 1416 ! 1417 ! Subroutine Interface: 1418 1419 Subroutine w3spectn( NFreq, NDirc, Alpha, Spectr ) 1420 1421 ! Description: 1422 ! Rotates wave spectrum anticlockwise by angle alpha in degree 1423 ! 1424 ! Subroutine arguments 1425 IMPLICIT NONE 1426 INTEGER, INTENT(IN) :: NFreq, NDirc ! No. frequ and direc bins 1427 REAL, INTENT(IN) :: Alpha ! Turning angle in degree 1428 REAL, INTENT(INOUT) :: Spectr(NFreq,NDirc) ! Wave spectrum in and out 1429 1430 ! Local variables 1431 INTEGER :: ii, jj, kk, nsft 1432 REAL :: Ddirc, frac, CNST 1433 REAL, Dimension(NFreq) :: Wrkfrq, Tmpfrq 1434 REAL, Dimension(NFreq,NDirc):: Wrkspc 1435 1436 ! Check input bin numbers 1437 IF( (NFreq .LT. 0) .OR. (NDirc .LT. 0) ) THEN 1438 PRINT*, " Invalid bin number NF or ND", NFreq, NDirc 1439 RETURN 1440 ELSE 1441 Ddirc=360.0/FLOAT(NDirc) 1442 ENDIF 1443 1444 ! Work out shift bin number and fraction 1445 1446 CNST=Alpha/Ddirc 1447 nsft=INT( CNST ) 1448 frac= CNST - FLOAT( nsft ) 1449 ! PRINT*, ' nsft and frac =', nsft, frac 1450 1451 ! Shift nsft bins if >=1 1452 IF( ABS(nsft) .GE. 1 ) THEN 1453 DO ii=1, NDirc 1454 1455 ! Wave spectral direction bin number is assumed to increase Anti-clockwise from EAST 1456 ! So shift nsft bins anticlockwise results in local bin number Decreases by nsft 1457 jj=ii - nsft 1458 1459 ! As nsft may be either positive or negative depends on alpha, wrapping may 1460 ! happen in either ends of the bin number train 1461 IF( jj > NDirc ) jj=jj - NDirc 1462 IF( jj < 1 ) jj=jj + NDirc 1463 1464 ! Copy the selected bin to the loop bin number 1465 Wrkspc(:,ii)=Spectr(:,jj) 1466 Page 33 Source Listing W3SPECTN 2014-09-16 16:47 w3servmd.f90 1467 Enddo 1468 1469 ! If nsft=0, no need to shift, simply copy 1470 ELSE 1471 Wrkspc = Spectr 1472 ENDIF 1473 1474 ! Pass fraction of wave energy in frac direction 1475 ! Wave spectral direction bin number is assumed to increase Anti-clockwise from EAST 1476 ! So Positive frac or anticlock case, smaller bin upstream 1477 IF( frac > 0.0 ) THEN 1478 Tmpfrq=Wrkspc(:,NDirc)*frac 1479 DO kk=1, NDirc 1480 Wrkfrq=Wrkspc(:,kk)*frac 1481 Spectr(:,kk)=Wrkspc(:,kk) - Wrkfrq + Tmpfrq 1482 Tmpfrq=Wrkfrq 1483 ENDDO 1484 ELSE 1485 ! Negative or clockwise case, larger bin upstream 1486 Tmpfrq=Wrkspc(:,1)*frac 1487 DO kk=NDirc, 1, -1 1488 Wrkfrq=Wrkspc(:,kk)*frac 1489 Spectr(:,kk)=Wrkspc(:,kk) + Wrkfrq - Tmpfrq 1490 Tmpfrq=Wrkfrq 1491 ENDDO 1492 ENDIF 1493 1494 ! Speasturn completed 1495 1496 Return 1497 End Subroutine w3spectn Page 34 Source Listing W3SPECTN 2014-09-16 16:47 Entry Points w3servmd.f90 ENTRY POINTS Name w3servmd_mp_w3spectn_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABS Func 914 scalar 914 ALPHA Dummy 881 R(4) 4 scalar ARG,IN 908 CNST Local 894 R(4) 4 scalar 908,909,910 DDIRC Local 894 R(4) 4 scalar 903,908 FLOAT Func 903 scalar 903,910 FRAC Local 894 R(4) 4 scalar 910,939,940,942,948,950 II Local 893 I(4) 4 scalar 915,919,927 INT Func 909 scalar 909 JJ Local 893 I(4) 4 scalar 919,923,924,927 KK Local 893 I(4) 4 scalar 941,942,943,949,950,951 NDIRC Dummy 881 I(4) 4 scalar ARG,IN 890,896,899,900,903,915,923,924,94 0,941,949 NFREQ Dummy 881 I(4) 4 scalar ARG,IN 890,895,896,899,900 NSFT Local 893 I(4) 4 scalar 909,910,914,919 SPECTR Dummy 881 R(4) 4 2 0 ARG,INOUT 927,933,943,951 TMPFRQ Local 895 R(4) 4 1 0 940,943,944,948,951,952 W3SPECTN Subr 881 WRKFRQ Local 895 R(4) 4 1 0 942,943,944,950,951,952 WRKSPC Local 896 R(4) 4 2 0 927,933,940,942,943,948,950,951 Page 35 Source Listing W3SPECTN 2014-09-16 16:47 w3servmd.f90 1498 ! 1499 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1500 ! This subroutine turn the wave action by an angle (deg) anti-clockwise 1501 ! so that it may be used in the rotated or stanadard system. 1502 ! First created: 26 Aug 2005 Jian-Guo Li 1503 ! Last modified: 9 Oct 2008 Jian-Guo Li 1504 ! 1505 ! Subroutine Interface: 1506 1507 Subroutine w3acturn( NDirc, NFreq, Alpha, Spectr ) 1508 1509 ! Description: 1510 ! Rotates wave spectrum anticlockwise by angle alpha 1511 ! 1512 ! Subroutine arguments 1513 IMPLICIT NONE 1514 INTEGER, INTENT(IN) :: NFreq, NDirc ! No. frequ and direc bins 1515 REAL, INTENT(IN) :: Alpha ! Turning angle in degree 1516 REAL, INTENT(INOUT) :: Spectr(NDirc, NFreq) ! Wave action in and out 1517 1518 ! Local variables 1519 INTEGER :: ii, jj, kk, nsft 1520 REAL :: Ddirc, frac, CNST 1521 REAL, Dimension(NFreq) :: Wrkfrq, Tmpfrq 1522 REAL, Dimension(NDirc,NFreq):: Wrkspc 1523 1524 ! Check input bin numbers 1525 IF( (NFreq .LT. 0) .OR. (NDirc .LT. 0) ) THEN 1526 PRINT*, " Invalid bin number NF or ND", NFreq, NDirc 1527 RETURN 1528 ELSE 1529 Ddirc=360.0/FLOAT(NDirc) 1530 ENDIF 1531 1532 ! Work out shift bin number and fraction 1533 1534 CNST=Alpha/Ddirc 1535 nsft=INT( CNST ) 1536 frac= CNST - FLOAT( nsft ) 1537 ! PRINT*, ' nsft and frac =', nsft, frac 1538 1539 ! Shift nsft bins if >=1 1540 IF( ABS(nsft) .GE. 1 ) THEN 1541 DO ii=1, NDirc 1542 1543 ! Wave spectral direction bin number is assumed to increase Anti-clockwise from EAST 1544 ! So shift nsft bins anticlockwise results in local bin number Decreases by nsft 1545 jj=ii - nsft 1546 1547 ! As nsft may be either positive or negative depends on alpha, wrapping may 1548 ! happen in either ends of the bin number train 1549 IF( jj > NDirc ) jj=jj - NDirc 1550 IF( jj < 1 ) jj=jj + NDirc 1551 1552 ! Copy the selected bin to the loop bin number 1553 Wrkspc(ii,:)=Spectr(jj,:) 1554 Page 36 Source Listing W3ACTURN 2014-09-16 16:47 w3servmd.f90 1555 Enddo 1556 1557 ! If nsft=0, no need to shift, simply copy 1558 ELSE 1559 Wrkspc = Spectr 1560 ENDIF 1561 1562 ! Pass fraction of wave energy in frac direction 1563 ! Wave spectral direction bin number is assumed to increase Anti-clockwise from EAST 1564 ! So Positive frac or anticlock case, smaller bin upstream 1565 IF( frac > 0.0 ) THEN 1566 Tmpfrq=Wrkspc(NDirc,:)*frac 1567 DO kk=1, NDirc 1568 Wrkfrq=Wrkspc(kk,:)*frac 1569 Spectr(kk,:)=Wrkspc(kk,:) - Wrkfrq + Tmpfrq 1570 Tmpfrq=Wrkfrq 1571 ENDDO 1572 ELSE 1573 ! Negative or clockwise case, larger bin upstream 1574 Tmpfrq=Wrkspc(1,:)*frac 1575 DO kk=NDirc, 1, -1 1576 Wrkfrq=Wrkspc(kk,:)*frac 1577 Spectr(kk,:)=Wrkspc(kk,:) + Wrkfrq - Tmpfrq 1578 Tmpfrq=Wrkfrq 1579 ENDDO 1580 ENDIF 1581 1582 ! Spectral turning completed 1583 1584 Return 1585 End Subroutine w3acturn Page 37 Source Listing W3ACTURN 2014-09-16 16:47 Entry Points w3servmd.f90 ENTRY POINTS Name w3servmd_mp_w3acturn_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABS Func 1002 scalar 1002 ALPHA Dummy 969 R(4) 4 scalar ARG,IN 996 CNST Local 982 R(4) 4 scalar 996,997,998 DDIRC Local 982 R(4) 4 scalar 991,996 FLOAT Func 991 scalar 991,998 FRAC Local 982 R(4) 4 scalar 998,1027,1028,1030,1036,1038 II Local 981 I(4) 4 scalar 1003,1007,1015 INT Func 997 scalar 997 JJ Local 981 I(4) 4 scalar 1007,1011,1012,1015 KK Local 981 I(4) 4 scalar 1029,1030,1031,1037,1038,1039 NDIRC Dummy 969 I(4) 4 scalar ARG,IN 978,984,987,988,991,1003,1011,1012 ,1028,1029,1037 NFREQ Dummy 969 I(4) 4 scalar ARG,IN 978,983,984,987,988 NSFT Local 981 I(4) 4 scalar 997,998,1002,1007 SPECTR Dummy 969 R(4) 4 2 0 ARG,INOUT 1015,1021,1031,1039 TMPFRQ Local 983 R(4) 4 1 0 1028,1031,1032,1036,1039,1040 W3ACTURN Subr 969 WRKFRQ Local 983 R(4) 4 1 0 1030,1031,1032,1038,1039,1040 WRKSPC Local 984 R(4) 4 2 0 1015,1021,1028,1030,1031,1036,1038 ,1039 Page 38 Source Listing W3ACTURN 2014-09-16 16:47 w3servmd.f90 1586 ! 1587 !Li +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1588 !Li 1589 !Li Merged UM source code for rotated grid, consisting the following 1590 !Li original subroutines in UM 6.1 1591 !Li LLTOEQ1A WCOEFF1A and LBCROTWINDS1 1592 !Li The last subroutine is modified to process only one level winds 1593 !Li cpp directives are removed and required header C_Pi.h inserted. 1594 !Li Jian-Guo Li 26 May 2005 1595 !Li 1596 !Li The WCOEFF1A subroutine is merged into LLTOEQ to reduce repetition 1597 !Li of the same calculations. Subroutine interface changed to 1598 !Li LLTOEQANGLE 1599 !Li Jian-GUo Li 23 Aug 2005 1600 !Li 1601 !Li Subroutine W3LLTOEQ -------------------------------------------- 1602 !Li 1603 !Li Purpose: Calculates latitude and longitude on equatorial 1604 !Li latitude-longitude (eq) grid used in regional 1605 !Li models from input arrays of latitude and 1606 !Li longitude on standard grid. Both input and output 1607 !Li latitudes and longitudes are in degrees. 1608 !Li Also calculate rotation angle in degree to tranform 1609 !Li standard wind velocity into equatorial wind. 1610 !Li Valid for 0= 0.0) THEN 1654 SIN_PHI_POLE = SIN(PI_OVER_180*PHI_POLE) 1655 COS_PHI_POLE = COS(PI_OVER_180*PHI_POLE) 1656 ELSE 1657 SIN_PHI_POLE = -SIN(PI_OVER_180*PHI_POLE) 1658 COS_PHI_POLE = -COS(PI_OVER_180*PHI_POLE) 1659 ENDIF 1660 1661 ! 2. Transform from standard to equatorial latitude-longitude 1662 1663 DO 200 I= 1, POINTS 1664 1665 ! Scale longitude to range -180 to +180 degs 1666 1667 A_LAMBDA=LAMBDA(I)-LAMBDA_ZERO 1668 IF(A_LAMBDA.GT. 180.0) A_LAMBDA=A_LAMBDA-360. 1669 IF(A_LAMBDA.LE.-180.0) A_LAMBDA=A_LAMBDA+360. 1670 1671 ! Convert latitude & longitude to radians 1672 1673 A_LAMBDA=PI_OVER_180*A_LAMBDA 1674 A_PHI=PI_OVER_180*PHI(I) 1675 1676 ! Compute eq latitude using equation (4.4) 1677 1678 ARG=-COS_PHI_POLE*COS(A_PHI)*COS(A_LAMBDA) & 1679 & +SIN_PHI_POLE*SIN(A_PHI) 1680 ARG=MIN(ARG, 1.0) 1681 ARG=MAX(ARG,-1.0) 1682 E_PHI=ASIN(ARG) 1683 PHI_EQ(I)=RECIP_PI_OVER_180*E_PHI 1684 1685 ! Compute eq longitude using equation (4.6) 1686 1687 TERM1 = SIN_PHI_POLE*COS(A_PHI)*COS(A_LAMBDA) & 1688 & +COS_PHI_POLE*SIN(A_PHI) 1689 TERM2 = COS(E_PHI) 1690 IF(TERM2 .LT. SMALL) THEN 1691 E_LAMBDA=0.0 1692 ELSE 1693 ARG=TERM1/TERM2 1694 ARG=MIN(ARG, 1.0) 1695 ARG=MAX(ARG,-1.0) 1696 E_LAMBDA=RECIP_PI_OVER_180*ACOS(ARG) 1697 E_LAMBDA=SIGN(E_LAMBDA,A_LAMBDA) 1698 ENDIF 1699 Page 40 Source Listing W3LLTOEQ 2014-09-16 16:47 w3servmd.f90 1700 ! Scale longitude to range 0 to 360 degs 1701 1702 IF(E_LAMBDA.GE.360.0) E_LAMBDA=E_LAMBDA-360.0 1703 IF(E_LAMBDA.LT. 0.0) E_LAMBDA=E_LAMBDA+360.0 1704 LAMBDA_EQ(I)=E_LAMBDA 1705 1706 !Li Calculate turning angle for standard wind velocity 1707 1708 E_LAMBDA=PI_OVER_180*LAMBDA_EQ(I) 1709 1710 ! Formulae used are from eqs (4.19) and (4.21) 1711 1712 TERM2=SIN(E_LAMBDA) 1713 ARG= SIN(A_LAMBDA)*TERM2*SIN_PHI_POLE & 1714 & +COS(A_LAMBDA)*COS(E_LAMBDA) 1715 ARG=MIN(ARG, 1.0) 1716 ARG=MAX(ARG,-1.0) 1717 TERM1=RECIP_PI_OVER_180*ACOS(ARG) 1718 ANGLED(I)=SIGN(TERM1,TERM2) 1719 !Li 1720 1721 200 CONTINUE 1722 1723 ! Reset Lambda pole to the setting on entry to subroutine 1724 LAMBDA_POLE=LAMBDA_POLE_KEEP 1725 1726 RETURN 1727 END SUBROUTINE W3LLTOEQ Page 41 Source Listing W3LLTOEQ 2014-09-16 16:47 Entry Points w3servmd.f90 ENTRY POINTS Name w3servmd_mp_w3lltoeq_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 200 Label 1183 1125 ACOS Func 1158 scalar 1158,1179 ANGLED Dummy 1076 R(4) 4 1 0 ARG,INOUT 1180 ARG Local 1094 R(4) 4 scalar 1140,1142,1143,1144,1155,1156,1157 ,1158,1175,1177,1178,1179 ASIN Func 1144 scalar 1144 A_LAMBDA Local 1093 R(4) 4 scalar 1129,1130,1131,1135,1140,1149,1159 ,1175,1176 A_PHI Local 1093 R(4) 4 scalar 1136,1140,1141,1149,1150 COS Func 1117 scalar 1117,1120,1140,1149,1151,1176 COS_PHI_POLE Local 1093 R(4) 4 scalar 1117,1120,1140,1150 E_LAMBDA Local 1093 R(4) 4 scalar 1153,1158,1159,1164,1165,1166,1170 ,1174,1176 E_PHI Local 1093 R(4) 4 scalar 1144,1145,1151 I Local 1095 I(4) 4 scalar 1125,1129,1136,1145,1166,1170,1180 LAMBDA Dummy 1075 R(4) 4 1 0 ARG,INOUT 1129 LAMBDA_EQ Dummy 1075 R(4) 4 1 0 ARG,INOUT 1166,1170 LAMBDA_POLE Dummy 1076 R(4) 4 scalar ARG,INOUT 1108,1109,1110,1113,1186 LAMBDA_POLE_KEEP Local 1094 R(4) 4 scalar 1108,1186 LAMBDA_ZERO Local 1094 R(4) 4 scalar 1113,1129 MAX Func 1143 scalar 1143,1157,1178 MIN Func 1142 scalar 1142,1156,1177 PHI Dummy 1075 R(4) 4 1 0 ARG,INOUT 1136 PHI_EQ Dummy 1075 R(4) 4 1 0 ARG,INOUT 1145 PHI_POLE Dummy 1076 R(4) 4 scalar ARG,INOUT 1115,1116,1117,1119,1120 PI Param 1100 R(4) 4 scalar 1101,1102 PI_OVER_180 Param 1101 R(4) 4 scalar 1116,1117,1119,1120,1135,1136,1170 POINTS Dummy 1076 I(4) 4 scalar ARG,INOUT 1086,1087,1088,1089,1090,1125 RECIP_PI_OVER_180 Param 1102 R(4) 4 scalar 1145,1158,1179 SIGN Func 1159 scalar 1159,1180 SIN Func 1116 scalar 1116,1119,1141,1150,1174,1175 SIN_PHI_POLE Local 1093 R(4) 4 scalar 1116,1119,1141,1149,1175 SMALL Param 1096 R(4) 4 scalar 1152 TERM1 Local 1094 R(4) 4 scalar 1149,1155,1179,1180 TERM2 Local 1094 R(4) 4 scalar 1151,1152,1155,1174,1175,1180 W3LLTOEQ Subr 1075 Page 42 Source Listing W3LLTOEQ 2014-09-16 16:47 w3servmd.f90 1728 ! 1729 !Li +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1730 !Li 1731 !Li Merged UM source code for rotated grid, consiting the following 1732 !Li original subroutines in UM 6.1 1733 !Li EQTOLL1A WCOEFF1A and LBCROTWINDS1 1734 !Li The last subroutine is modified to process only one level winds 1735 !Li cpp directives are removed and required header C_Pi.h inserted. 1736 !Li Jian-Guo Li 26 May 2005 1737 !Li 1738 !Li The WCOEFF1A subroutine is merged into EQTOLL to reduce repetition 1739 !Li of the same calculations. Subroutine interface changed to 1740 !Li EQTOLLANGLE 1741 !Li First created: Jian-GUo Li 23 Aug 2005 1742 !Li Last modified: Jian-GUo Li 25 Feb 2008 1743 !Li 1744 !Li Subroutine W3EQTOLL -------------------------------------------- 1745 !Li 1746 !Li Purpose: Calculates latitude and longitude on standard grid 1747 !Li from input arrays of latitude and longitude on 1748 !Li equatorial latitude-longitude (eq) grid used 1749 !Li in regional models. Both input and output latitudes 1750 !Li and longitudes are in degrees. 1751 !Li Also calculate rotation angle in degree to tranform 1752 !Li standard wind velocity into equatorial wind. 1753 !Li Valid for 0= 0.0) THEN 1796 SIN_PHI_POLE = SIN(PI_OVER_180*PHI_POLE) 1797 COS_PHI_POLE = COS(PI_OVER_180*PHI_POLE) 1798 ELSE 1799 SIN_PHI_POLE = -SIN(PI_OVER_180*PHI_POLE) 1800 COS_PHI_POLE = -COS(PI_OVER_180*PHI_POLE) 1801 ENDIF 1802 1803 ! 2. Transform from equatorial to standard latitude-longitude 1804 1805 DO 200 I= 1, POINTS 1806 1807 ! Scale eq longitude to range -180 to +180 degs 1808 1809 E_LAMBDA=LAMBDA_EQ(I) 1810 IF(E_LAMBDA.GT. 180.0) E_LAMBDA=E_LAMBDA-360.0 1811 IF(E_LAMBDA.LT.-180.0) E_LAMBDA=E_LAMBDA+360.0 1812 1813 ! Convert eq latitude & longitude to radians 1814 1815 E_LAMBDA=PI_OVER_180*E_LAMBDA 1816 E_PHI=PI_OVER_180*PHI_EQ(I) 1817 1818 ! Compute latitude using equation (4.7) 1819 1820 ARG=COS_PHI_POLE*COS(E_PHI)*COS(E_LAMBDA) & 1821 & +SIN_PHI_POLE*SIN(E_PHI) 1822 ARG=MIN(ARG, 1.0) 1823 ARG=MAX(ARG,-1.0) 1824 A_PHI=ASIN(ARG) 1825 PHI(I)=RECIP_PI_OVER_180*A_PHI 1826 1827 ! Compute longitude using equation (4.8) 1828 1829 TERM1 = COS(E_PHI)*SIN_PHI_POLE*COS(E_LAMBDA) & 1830 & -SIN(E_PHI)*COS_PHI_POLE 1831 TERM2 = COS(A_PHI) 1832 IF(TERM2.LT.SMALL) THEN 1833 A_LAMBDA=0.0 1834 ELSE 1835 ARG=TERM1/TERM2 1836 ARG=MIN(ARG, 1.0) 1837 ARG=MAX(ARG,-1.0) 1838 A_LAMBDA=RECIP_PI_OVER_180*ACOS(ARG) 1839 A_LAMBDA=SIGN(A_LAMBDA,E_LAMBDA) 1840 A_LAMBDA=A_LAMBDA+LAMBDA_ZERO 1841 END IF Page 44 Source Listing W3EQTOLL 2014-09-16 16:47 w3servmd.f90 1842 1843 ! Scale longitude to range 0 to 360 degs 1844 1845 IF(A_LAMBDA.GE.360.0) A_LAMBDA=A_LAMBDA-360.0 1846 IF(A_LAMBDA.LT. 0.0) A_LAMBDA=A_LAMBDA+360.0 1847 LAMBDA(I)=A_LAMBDA 1848 1849 !Li Calculate turning angle for standard wind velocity 1850 1851 A_LAMBDA=PI_OVER_180*(LAMBDA(I)-LAMBDA_ZERO) 1852 1853 ! Formulae used are from eqs (4.19) and (4.21) 1854 1855 TERM2=SIN(E_LAMBDA) 1856 ARG=SIN(A_LAMBDA)*TERM2*SIN_PHI_POLE & 1857 & +COS(A_LAMBDA)*COS(E_LAMBDA) 1858 ARG=MIN(ARG, 1.0) 1859 ARG=MAX(ARG,-1.0) 1860 TERM1=RECIP_PI_OVER_180*ACOS(ARG) 1861 ANGLED(I)=SIGN(TERM1,TERM2) 1862 !Li 1863 1864 200 CONTINUE 1865 1866 RETURN 1867 END SUBROUTINE W3EQTOLL ENTRY POINTS Name w3servmd_mp_w3eqtoll_ Page 45 Source Listing W3EQTOLL 2014-09-16 16:47 Symbol Table w3servmd.f90 SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 200 Label 1326 1267 ACOS Func 1300 scalar 1300,1322 ANGLED Dummy 1220 R(4) 4 1 0 ARG,INOUT 1323 ARG Local 1239 R(4) 4 scalar 1282,1284,1285,1286,1297,1298,1299 ,1300,1318,1320,1321,1322 ASIN Func 1286 scalar 1286 A_LAMBDA Local 1237 R(4) 4 scalar 1295,1300,1301,1302,1307,1308,1309 ,1313,1318,1319 A_PHI Local 1237 R(4) 4 scalar 1286,1287,1293 COS Func 1259 scalar 1259,1262,1282,1291,1293,1319 COS_PHI_POLE Local 1238 R(4) 4 scalar 1259,1262,1282,1292 E_LAMBDA Local 1237 R(4) 4 scalar 1271,1272,1273,1277,1282,1291,1301 ,1317,1319 E_PHI Local 1237 R(4) 4 scalar 1278,1282,1283,1291,1292 I Local 1240 I(4) 4 scalar 1267,1271,1278,1287,1309,1313,1323 LAMBDA Dummy 1219 R(4) 4 1 0 ARG,INOUT 1309,1313 LAMBDA_EQ Dummy 1219 R(4) 4 1 0 ARG,INOUT 1271 LAMBDA_POLE Dummy 1220 R(4) 4 scalar ARG,INOUT 1255 LAMBDA_ZERO Local 1239 R(4) 4 scalar 1255,1302,1313 MAX Func 1285 scalar 1285,1299,1321 MIN Func 1284 scalar 1284,1298,1320 PHI Dummy 1219 R(4) 4 1 0 ARG,INOUT 1287 PHI_EQ Dummy 1219 R(4) 4 1 0 ARG,INOUT 1278 PHI_POLE Dummy 1220 R(4) 4 scalar ARG,INOUT 1257,1258,1259,1261,1262 PI Param 1246 R(4) 4 scalar 1247,1248 PI_OVER_180 Param 1247 R(4) 4 scalar 1258,1259,1261,1262,1277,1278,1313 POINTS Dummy 1220 I(4) 4 scalar ARG,INOUT 1230,1231,1232,1233,1234,1267 RECIP_PI_OVER_180 Param 1248 R(4) 4 scalar 1287,1300,1322 SIGN Func 1301 scalar 1301,1323 SIN Func 1258 scalar 1258,1261,1283,1292,1317,1318 SIN_PHI_POLE Local 1238 R(4) 4 scalar 1258,1261,1283,1291,1318 SMALL Param 1242 R(4) 4 scalar 1294 TERM1 Local 1239 R(4) 4 scalar 1291,1297,1322,1323 TERM2 Local 1239 R(4) 4 scalar 1293,1294,1297,1317,1318,1323 W3EQTOLL Subr 1219 Page 46 Source Listing W3EQTOLL 2014-09-16 16:47 w3servmd.f90 1868 1869 !Li 1870 !/ 1871 SUBROUTINE STRSPLIT(STRING,TAB) 1872 !/ 1873 !/ +-----------------------------------+ 1874 !/ | WAVEWATCH III NOAA/NCEP | 1875 !/ | M. Accensi | 1876 !/ | FORTRAN 90 | 1877 !/ | Last update : 29-Apr-2013 ! 1878 !/ +-----------------------------------+ 1879 !/ 1880 !/ 29-Mar-2013 : Origination. ( version 4.10 ) 1881 !/ 1882 ! 1. Purpose : 1883 ! 1884 ! Splits string into words 1885 ! 1886 ! 2. Method : 1887 ! 1888 ! finds spaces and loops 1889 ! 1890 ! 3. Parameters : 1891 ! 1892 ! Parameter list 1893 ! ---------------------------------------------------------------- 1894 ! STRING Str O String to be splitted 1895 ! TAB Str O Array of strings 1896 ! ---------------------------------------------------------------- 1897 ! 1898 1899 IMPLICIT NONE 1900 1901 1902 1903 CHARACTER(LEN=1024), intent(IN) :: STRING 1904 CHARACTER(LEN=100), intent(INOUT) :: TAB(*) 1905 INTEGER :: cnt, I 1906 CHARACTER(LEN=1024) :: tmp_str, ori_str 1907 1908 ! initializes arrays 1909 ori_str=ADJUSTL(TRIM(STRING)) 1910 tmp_str=ori_str 1911 cnt=0 1912 1913 ! counts the number of substrings 1914 DO WHILE ((INDEX(tmp_str,' ').NE.0) .AND. (len_trim(tmp_str).NE.0)) 1915 tmp_str=ADJUSTL(tmp_str(INDEX(tmp_str,' ')+1:)) 1916 cnt=cnt+1 1917 ENDDO 1918 ! 1919 ! reinitializes arrays 1920 ! 1921 tmp_str=ori_str 1922 ! loops on each substring 1923 DO I=1,cnt 1924 TAB(I)=tmp_str(:INDEX(tmp_str,' ')) Page 47 Source Listing STRSPLIT 2014-09-16 16:47 w3servmd.f90 1925 tmp_str=ADJUSTL(tmp_str(INDEX(tmp_str,' ')+1:)) 1926 END DO 1927 1928 RETURN 1929 !/ 1930 !/ End of STRSPLIT ----------------------------------------------------- / 1931 !/ 1932 END SUBROUTINE STRSPLIT ENTRY POINTS Name w3servmd_mp_strsplit_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ADJUSTL Func 1371 scalar 1371,1377,1387 CNT Local 1367 I(4) 4 scalar 1373,1378,1385 I Local 1367 I(4) 4 scalar 1385,1386 INDEX Func 1376 scalar 1376,1377,1386,1387 LEN_TRIM Func 1376 scalar 1376 ORI_STR Local 1368 CHAR 1024 scalar 1371,1372,1383 STRING Dummy 1333 CHAR 1024 scalar ARG,IN 1371 STRSPLIT Subr 1333 TAB Dummy 1333 CHAR 100 1 0 ARG,INOUT 1386 TMP_STR Local 1368 CHAR 1024 scalar 1372,1376,1377,1383,1386,1387 TRIM Func 1371 scalar 1371 Page 48 Source Listing STRSPLIT 2014-09-16 16:47 w3servmd.f90 1933 !/ 1934 1935 !/ ------------------------------------------------------------------- / 1936 SUBROUTINE STR_TO_UPPER(STR) 1937 character(*), intent(inout) :: str 1938 integer :: i 1939 1940 DO i = 1, len(str) 1941 select case(str(i:i)) 1942 case("a":"z") 1943 str(i:i) = achar(iachar(str(i:i))-32) 1944 end select 1945 END DO 1946 !/ End of STR_TO_UPPER 1947 !/ ------------------------------------------------------------------- / 1948 END SUBROUTINE STR_TO_UPPER ENTRY POINTS Name w3servmd_mp_str_to_upper_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ACHAR Func 1405 scalar 1405 I Local 1400 I(4) 4 scalar 1402,1403,1405 IACHAR Func 1405 scalar 1405 LEN Func 1402 scalar 1402 STR Dummy 1398 CHAR scalar ARG,INOUT 1402,1403,1405 STR_TO_UPPER Subr 1398 Page 49 Source Listing STR_TO_UPPER 2014-09-16 16:47 w3servmd.f90 1949 1950 !********************************************************************** 1951 !* * 1952 !********************************************************************** 1953 SUBROUTINE SSORT1 (X, Y, N, KFLAG) 1954 !***BEGIN PROLOGUE SSORT 1955 !***PURPOSE Sort an array and optionally make the same interchanges in 1956 ! an auxiliary array. The array may be sorted in increasing 1957 ! or decreasing order. A slightly modified QUICKSORT 1958 ! algorithm is used. 1959 !***LIBRARY SLATEC 1960 !***CATEGORY N6A2B 1961 !***TYPE SINGLE PRECISION (SSORT-S, DSORT-D, ISORT-I) 1962 !***KEYWORDS SINGLETON QUICKSORT, SORT, SORTING 1963 !***AUTHOR Jones, R. E., (SNLA) 1964 ! Wisniewski, J. A., (SNLA) 1965 !***DESCRIPTION 1966 ! 1967 ! SSORT sorts array X and optionally makes the same interchanges in 1968 ! array Y. The array X may be sorted in increasing order or 1969 ! decreasing order. A slightly modified quicksort algorithm is used. 1970 ! 1971 ! Description of Parameters 1972 ! X - array of values to be sorted (usually abscissas) 1973 ! Y - array to be (optionally) carried along 1974 ! N - number of values in array X to be sorted 1975 ! KFLAG - control parameter 1976 ! = 2 means sort X in increasing order and carry Y along. 1977 ! = 1 means sort X in increasing order (ignoring Y) 1978 ! = -1 means sort X in decreasing order (ignoring Y) 1979 ! = -2 means sort X in decreasing order and carry Y along. 1980 ! 1981 !***REFERENCES R. C. Singleton, Algorithm 347, An efficient algorithm 1982 ! for sorting with minimal storage, Communications of 1983 ! the ACM, 12, 3 (1969), pp. 185-187. 1984 !***REVISION HISTORY (YYMMDD) 1985 ! 761101 DATE WRITTEN 1986 ! 761118 Modified to use the Singleton quicksort algorithm. (JAW) 1987 ! 890531 Changed all specific intrinsics to generic. (WRB) 1988 ! 890831 Modified array declarations. (WRB) 1989 ! 891009 Removed unreferenced statement labels. (WRB) 1990 ! 891024 Changed category. (WRB) 1991 ! 891024 REVISION DATE from Version 3.2 1992 ! 891214 Prologue converted to Version 4.0 format. (BAB) 1993 ! 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 1994 ! 901012 Declared all variables; changed X,Y to SX,SY. (M. McClain) 1995 ! 920501 Reformatted the REFERENCES section. (DWL, WRB) 1996 ! 920519 Clarified error messages. (DWL) 1997 ! 920801 Declarations section rebuilt and code restructured to use 1998 ! IF-THEN-ELSE-ENDIF. (RWC, WRB) 1999 !***END PROLOGUE SSORT 2000 ! .. Scalar Arguments .. 2001 INTEGER KFLAG, N 2002 ! .. Array Arguments .. 2003 REAL*4 X(*), Y(*) 2004 ! .. Local Scalars .. 2005 REAL*4 R, T, TT, TTY, TY Page 50 Source Listing SSORT1 2014-09-16 16:47 w3servmd.f90 2006 INTEGER I, IJ, J, K, KK, L, M, NN 2007 ! .. Local Arrays .. 2008 INTEGER IL(21), IU(21) 2009 ! .. External Subroutines .. 2010 ! None 2011 ! .. Intrinsic Functions .. 2012 INTRINSIC ABS, INT 2013 !***FIRST EXECUTABLE STATEMENT SSORT 2014 NN = N 2015 IF (NN .LT. 1) THEN 2016 WRITE (*,*) 'The number of values to be sorted is not positive.' 2017 RETURN 2018 ENDIF 2019 ! 2020 KK = ABS(KFLAG) 2021 IF (KK.NE.1 .AND. KK.NE.2) THEN 2022 WRITE (*,*) 'The sort control parameter, K, is not 2, 1, -1, or -2.' 2023 RETURN 2024 ENDIF 2025 ! 2026 ! Alter array X to get decreasing order if needed 2027 ! 2028 IF (KFLAG .LE. -1) THEN 2029 DO 10 I=1,NN 2030 X(I) = -X(I) 2031 10 CONTINUE 2032 ENDIF 2033 ! 2034 IF (KK .EQ. 2) GO TO 100 2035 ! 2036 ! Sort X only 2037 ! 2038 M = 1 2039 I = 1 2040 J = NN 2041 R = 0.375E0 2042 ! 2043 20 IF (I .EQ. J) GO TO 60 2044 IF (R .LE. 0.5898437E0) THEN 2045 R = R+3.90625E-2 2046 ELSE 2047 R = R-0.21875E0 2048 ENDIF 2049 ! 2050 30 K = I 2051 ! 2052 ! Select a central element of the array and save it in location T 2053 ! 2054 IJ = I + INT((J-I)*R) 2055 T = X(IJ) 2056 ! 2057 ! If first element of array is greater than T, interchange with T 2058 ! 2059 IF (X(I) .GT. T) THEN 2060 X(IJ) = X(I) 2061 X(I) = T 2062 T = X(IJ) Page 51 Source Listing SSORT1 2014-09-16 16:47 w3servmd.f90 2063 ENDIF 2064 L = J 2065 ! 2066 ! If last element of array is less than than T, interchange with T 2067 ! 2068 IF (X(J) .LT. T) THEN 2069 X(IJ) = X(J) 2070 X(J) = T 2071 T = X(IJ) 2072 ! 2073 ! If first element of array is greater than T, interchange with T 2074 ! 2075 IF (X(I) .GT. T) THEN 2076 X(IJ) = X(I) 2077 X(I) = T 2078 T = X(IJ) 2079 ENDIF 2080 ENDIF 2081 ! 2082 ! Find an element in the second half of the array which is smaller 2083 ! than T 2084 ! 2085 40 L = L-1 2086 IF (X(L) .GT. T) GO TO 40 2087 ! 2088 ! Find an element in the first half of the array which is greater 2089 ! than T 2090 ! 2091 50 K = K+1 2092 IF (X(K) .LT. T) GO TO 50 2093 ! 2094 ! Interchange these elements 2095 ! 2096 IF (K .LE. L) THEN 2097 TT = X(L) 2098 X(L) = X(K) 2099 X(K) = TT 2100 GO TO 40 2101 ENDIF 2102 ! 2103 ! Save upper and lower subscripts of the array yet to be sorted 2104 ! 2105 IF (L-I .GT. J-K) THEN 2106 IL(M) = I 2107 IU(M) = L 2108 I = K 2109 M = M+1 2110 ELSE 2111 IL(M) = K 2112 IU(M) = J 2113 J = L 2114 M = M+1 2115 ENDIF 2116 GO TO 70 2117 ! 2118 ! Begin again on another portion of the unsorted array 2119 ! Page 52 Source Listing SSORT1 2014-09-16 16:47 w3servmd.f90 2120 60 M = M-1 2121 IF (M .EQ. 0) GO TO 190 2122 I = IL(M) 2123 J = IU(M) 2124 ! 2125 70 IF (J-I .GE. 1) GO TO 30 2126 IF (I .EQ. 1) GO TO 20 2127 I = I-1 2128 ! 2129 80 I = I+1 2130 IF (I .EQ. J) GO TO 60 2131 T = X(I+1) 2132 IF (X(I) .LE. T) GO TO 80 2133 K = I 2134 ! 2135 90 X(K+1) = X(K) 2136 K = K-1 2137 IF (T .LT. X(K)) GO TO 90 2138 X(K+1) = T 2139 GO TO 80 2140 ! 2141 ! Sort X and carry Y along 2142 ! 2143 100 M = 1 2144 I = 1 2145 J = NN 2146 R = 0.375E0 2147 ! 2148 110 IF (I .EQ. J) GO TO 150 2149 IF (R .LE. 0.5898437E0) THEN 2150 R = R+3.90625E-2 2151 ELSE 2152 R = R-0.21875E0 2153 ENDIF 2154 ! 2155 120 K = I 2156 ! 2157 ! Select a central element of the array and save it in location T 2158 ! 2159 IJ = I + INT((J-I)*R) 2160 T = X(IJ) 2161 TY = Y(IJ) 2162 ! 2163 ! If first element of array is greater than T, interchange with T 2164 ! 2165 IF (X(I) .GT. T) THEN 2166 X(IJ) = X(I) 2167 X(I) = T 2168 T = X(IJ) 2169 Y(IJ) = Y(I) 2170 Y(I) = TY 2171 TY = Y(IJ) 2172 ENDIF 2173 L = J 2174 ! 2175 ! If last element of array is less than T, interchange with T 2176 ! Page 53 Source Listing SSORT1 2014-09-16 16:47 w3servmd.f90 2177 IF (X(J) .LT. T) THEN 2178 X(IJ) = X(J) 2179 X(J) = T 2180 T = X(IJ) 2181 Y(IJ) = Y(J) 2182 Y(J) = TY 2183 TY = Y(IJ) 2184 ! 2185 ! If first element of array is greater than T, interchange with T 2186 ! 2187 IF (X(I) .GT. T) THEN 2188 X(IJ) = X(I) 2189 X(I) = T 2190 T = X(IJ) 2191 Y(IJ) = Y(I) 2192 Y(I) = TY 2193 TY = Y(IJ) 2194 ENDIF 2195 ENDIF 2196 ! 2197 ! Find an element in the second half of the array which is smaller 2198 ! than T 2199 ! 2200 130 L = L-1 2201 IF (X(L) .GT. T) GO TO 130 2202 ! 2203 ! Find an element in the first half of the array which is greater 2204 ! than T 2205 ! 2206 140 K = K+1 2207 IF (X(K) .LT. T) GO TO 140 2208 ! 2209 ! Interchange these elements 2210 ! 2211 IF (K .LE. L) THEN 2212 TT = X(L) 2213 X(L) = X(K) 2214 X(K) = TT 2215 TTY = Y(L) 2216 Y(L) = Y(K) 2217 Y(K) = TTY 2218 GO TO 130 2219 ENDIF 2220 ! 2221 ! Save upper and lower subscripts of the array yet to be sorted 2222 ! 2223 IF (L-I .GT. J-K) THEN 2224 IL(M) = I 2225 IU(M) = L 2226 I = K 2227 M = M+1 2228 ELSE 2229 IL(M) = K 2230 IU(M) = J 2231 J = L 2232 M = M+1 2233 ENDIF Page 54 Source Listing SSORT1 2014-09-16 16:47 w3servmd.f90 2234 GO TO 160 2235 ! 2236 ! Begin again on another portion of the unsorted array 2237 ! 2238 150 M = M-1 2239 IF (M .EQ. 0) GO TO 190 2240 I = IL(M) 2241 J = IU(M) 2242 ! 2243 160 IF (J-I .GE. 1) GO TO 120 2244 IF (I .EQ. 1) GO TO 110 2245 I = I-1 2246 ! 2247 170 I = I+1 2248 IF (I .EQ. J) GO TO 150 2249 T = X(I+1) 2250 TY = Y(I+1) 2251 IF (X(I) .LE. T) GO TO 170 2252 K = I 2253 ! 2254 180 X(K+1) = X(K) 2255 Y(K+1) = Y(K) 2256 K = K-1 2257 IF (T .LT. X(K)) GO TO 180 2258 X(K+1) = T 2259 Y(K+1) = TY 2260 GO TO 170 2261 ! 2262 ! Clean up 2263 ! 2264 190 IF (KFLAG .LE. -1) THEN 2265 DO 200 I=1,NN 2266 X(I) = -X(I) 2267 200 CONTINUE 2268 ENDIF 2269 RETURN 2270 END SUBROUTINE SSORT1 Page 55 Source Listing SSORT1 2014-09-16 16:47 Entry Points w3servmd.f90 ENTRY POINTS Name w3servmd_mp_ssort1_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 10 Label 1493 1491 100 Label 1605 1496 110 Label 1610 1706 120 Label 1617 1705 130 Label 1662 1663,1680 140 Label 1668 1669 150 Label 1700 1610,1710 160 Label 1705 1696 170 Label 1709 1713,1722 180 Label 1716 1719 190 Label 1726 1583,1701 20 Label 1505 1588 200 Label 1729 1727 30 Label 1512 1587 40 Label 1547 1548,1562 50 Label 1553 1554 60 Label 1582 1505,1592 70 Label 1587 1578 80 Label 1591 1594,1601 90 Label 1597 1599 ABS Func 1474 scalar 1482 I Local 1468 I(4) 4 scalar 1491,1492,1501,1505,1512,1516,1521 ,1522,1523,1537,1538,1539,1567,156 8,1570,1584,1587,1588,1589,1591,15 92,1593,1594,1595,1606,1610,1617,1 621,1627,1628,1629,1631,1632,1649, 1650,1651,1653,1654,1685,1686,1688 ,1702,1705,1706,1707,1709,1710,171 1,1712,1713,1714,1727,1728 IJ Local 1468 I(4) 4 scalar 1516,1517,1522,1524,1531,1533,1538 ,1540,1621,1622,1623,1628,1630,163 1,1633,1640,1642,1643,1645,1650,16 52,1653,1655 IL Local 1470 I(4) 4 1 21 1568,1573,1584,1686,1691,1702 INT Func 1474 scalar 1516,1621 IU Local 1470 I(4) 4 1 21 1569,1574,1585,1687,1692,1703 J Local 1468 I(4) 4 scalar 1502,1505,1516,1526,1530,1531,1532 ,1567,1574,1575,1585,1587,1592,160 7,1610,1621,1635,1639,1640,1641,16 43,1644,1685,1692,1693,1703,1705,1 710 K Local 1468 I(4) 4 scalar 1512,1553,1554,1558,1560,1561,1567 ,1570,1573,1595,1597,1598,1599,160 0,1617,1668,1669,1673,1675,1676,16 Page 56 Source Listing SSORT1 2014-09-16 16:47 Symbol Table w3servmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 78,1679,1685,1688,1691,1714,1716,1 717,1718,1719,1720,1721 KFLAG Dummy 1415 I(4) 4 scalar ARG,INOUT 1482,1490,1726 KK Local 1468 I(4) 4 scalar 1482,1483,1496 L Local 1468 I(4) 4 scalar 1526,1547,1548,1558,1559,1560,1567 ,1569,1575,1635,1662,1663,1673,167 4,1675,1677,1678,1685,1687,1693 M Local 1468 I(4) 4 scalar 1500,1568,1569,1571,1573,1574,1576 ,1582,1583,1584,1585,1605,1686,168 7,1689,1691,1692,1694,1700,1701,17 02,1703 N Dummy 1415 I(4) 4 scalar ARG,INOUT 1476 NN Local 1468 I(4) 4 scalar 1476,1477,1491,1502,1607,1727 R Local 1467 R(4) 4 scalar 1503,1506,1507,1509,1516,1608,1611 ,1612,1614,1621 SSORT1 Subr 1415 T Local 1467 R(4) 4 scalar 1517,1521,1523,1524,1530,1532,1533 ,1537,1539,1540,1548,1554,1593,159 4,1599,1600,1622,1627,1629,1630,16 39,1641,1642,1649,1651,1652,1663,1 669,1711,1713,1719,1720 TT Local 1467 R(4) 4 scalar 1559,1561,1674,1676 TTY Local 1467 R(4) 4 scalar 1677,1679 TY Local 1467 R(4) 4 scalar 1623,1632,1633,1644,1645,1654,1655 ,1712,1721 X Dummy 1415 R(4) 4 1 0 ARG,INOUT 1492,1517,1521,1522,1523,1524,1530 ,1531,1532,1533,1537,1538,1539,154 0,1548,1554,1559,1560,1561,1593,15 94,1597,1599,1600,1622,1627,1628,1 629,1630,1639,1640,1641,1642,1649, 1650,1651,1652,1663,1669,1674,1675 ,1676,1711,1713,1716,1719,1720,172 8 Y Dummy 1415 R(4) 4 1 0 ARG,INOUT 1623,1631,1632,1633,1643,1644,1645 ,1653,1654,1655,1677,1678,1679,171 2,1717,1721 Page 57 Source Listing SSORT1 2014-09-16 16:47 w3servmd.f90 2271 !/ 2272 !/ End of module W3SERVMD -------------------------------------------- / 2273 !/ 2274 END MODULE W3SERVMD SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References EJ5P@0 Local 391 R(4) 4 scalar W3SERVMD Module 2 Page 58 Source Listing SSORT1 2014-09-16 16:47 Subprograms/Common Blocks w3servmd.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References EJ5P Func 391 R(4) 4 scalar 474,483,492 EXTCDE Subr 655 294,298,302 ITRACE Subr 87 MPIPRIV1 Common 532 28 MPIPRIV2 Common 534 24 MPIPRIVC Common 537 2 NEXTLN Subr 220 PRINIT Subr 723 PRTIME Subr 785 SSORT1 Subr 1415 STRACE Subr 145 STRSPLIT Subr 1333 STR_TO_UPPER Subr 1398 W3ACTURN Subr 969 W3EQTOLL Subr 1219 W3LLTOEQ Subr 1075 W3S2XY Subr 320 W3SERVMD Module 2 W3SPECTN Subr 881 WWDATE Subr 501 WWTIME Subr 577 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 Page 59 Source Listing SSORT1 2014-09-16 16:47 w3servmd.f90 -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 -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 : w3servmd.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100