Page 1 Source Listing WMUINI 2014-09-16 16:49 wmunitmd.f90 1 !/ ------------------------------------------------------------------- / 2 MODULE WMUNITMD 3 !/ 4 !/ +-----------------------------------+ 5 !/ | WAVEWATCH III NOAA/NCEP | 6 !/ | H. L. Tolman | 7 !/ | FORTRAN 90 | 8 !/ | Last update : 29-May-2009 | 9 !/ +-----------------------------------+ 10 !/ 11 !/ 29-Mar-2005 : Origination. ( version 3.07 ) 12 !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) 13 !/ 14 !/ Copyright 2009 National Weather Service (NWS), 15 !/ National Oceanic and Atmospheric Administration. All rights 16 !/ reserved. WAVEWATCH III is a trademark of the NWS. 17 !/ No unauthorized use without permission. 18 !/ 19 ! 1. Purpose : 20 ! 21 ! Dynamic assignement of unit numbers for the multi-grid wave 22 ! model. 23 ! 24 ! Allowed range of unit numbers is set in parameter statements. 25 ! 26 ! 2. Variables and types : 27 ! 28 ! Name Type Scope Description 29 ! ---------------------------------------------------------------- 30 ! UNITLW I.P. Private Lowest unit number. 31 ! UNITHG I.P. Private Highest unit number. 32 ! INPLOW, INPHGH, OUTLOW, OUTHGH, SCRLOW, SCRHGH 33 ! I.P. Private Low and high for input, output and 34 ! scratch files. 35 ! FLINIT Log. Private Flag for intialization. 36 ! 37 ! U_USED L.A. Private Flag for use/assignement. 38 ! U_TYPE C.A. Private Type of unit. 39 ! 'RES' : Reserved. 40 ! 'INP' : Input file. 41 ! 'OUT' : Output file. 42 ! 'SCR' : Scratch file. 43 ! U_NAME C.A. Private File name of unit. 44 ! U_DESC C.A. Private Decription of file. 45 ! ---------------------------------------------------------------- 46 ! 47 ! 3. Subroutines and functions : 48 ! 49 ! Name Type Scope Description 50 ! ---------------------------------------------------------------- 51 ! WMUINI Subr. Public Initialize data structures. 52 ! WMUDMP Subr. Public Dump contents of data structures. 53 ! WMUSET Subr. Public Put data directly in structure. 54 ! WMUGET Subr. Public Get a unit number. 55 ! WMUINQ Subr. Public Update ansilary info automatically. 56 ! ---------------------------------------------------------------- 57 ! Page 2 Source Listing WMUINI 2014-09-16 16:49 wmunitmd.f90 58 ! 4. Subroutines and functions used : 59 ! 60 ! Name Type Module Description 61 ! ---------------------------------------------------------------- 62 ! STRACE Subr. W3SERVMD Subroutine tracing. 63 ! EXTCDE Subr. Id. Program abort. 64 ! ---------------------------------------------------------------- 65 ! 66 ! 5. Remarks : 67 ! 68 ! - All parameters are private. Dump data using WMUDMP routine. 69 ! 70 ! 6. Switches : 71 ! 72 ! !/S Enable subroutine tracing. 73 ! !/T Enable test output 74 ! 75 ! 7. Source code : 76 ! 77 !/ ------------------------------------------------------------------- / 78 PUBLIC 79 !/ 80 !/ Define acceptable ranges of unit numbers 81 !/ 82 INTEGER, PARAMETER, PRIVATE :: UNITLW = 1, UNITHG = 120 83 INTEGER, PARAMETER, PRIVATE :: INPLOW = 10, INPHGH = 49 84 INTEGER, PARAMETER, PRIVATE :: OUTLOW = 50, OUTHGH = 98 85 INTEGER, PARAMETER, PRIVATE :: SCRLOW = 99, SCRHGH = 100 86 ! 87 LOGICAL, PRIVATE :: FLINIT = .FALSE. 88 LOGICAL, PRIVATE, ALLOCATABLE :: U_USED(:) 89 CHARACTER(LEN= 3), PRIVATE, ALLOCATABLE :: U_TYPE(:) 90 CHARACTER(LEN=30), PRIVATE, ALLOCATABLE :: U_NAME(:) 91 CHARACTER(LEN=30), PRIVATE, ALLOCATABLE :: U_DESC(:) 92 !/ 93 CONTAINS 94 !/ ------------------------------------------------------------------- / 95 SUBROUTINE WMUINI ( NDSE, NDST ) 96 !/ 97 !/ +-----------------------------------+ 98 !/ | WAVEWATCH III NOAA/NCEP | 99 !/ | H. L. Tolman | 100 !/ | FORTRAN 90 | 101 !/ | Last update : 25-Mar-2005 ! 102 !/ +-----------------------------------+ 103 !/ 104 !/ 25-Mar-2005 : Origination. ( version 3.07 ) 105 !/ 106 ! 1. Purpose : 107 ! 108 ! Allocate and initialize arrays of module. 109 ! 110 ! 2. Method : 111 ! 112 ! Allocate and test parameter setting. 113 ! 114 ! 3. Parameters : Page 3 Source Listing WMUINI 2014-09-16 16:49 wmunitmd.f90 115 ! 116 ! Parameter list 117 ! ---------------------------------------------------------------- 118 ! NDSE Int. I Unit number for error output. 119 ! NDST Int. I Unit number for test output. 120 ! ---------------------------------------------------------------- 121 ! 122 ! 4. Subroutines used : 123 ! 124 ! Name Type Module Description 125 ! ---------------------------------------------------------------- 126 ! STRACE Subr. W3SERVMD Subroutine tracing. 127 ! EXTCDE Subr. Id. Program abort. 128 ! ---------------------------------------------------------------- 129 ! 130 ! 5. Called by : 131 ! 132 ! 6. Error messages : 133 ! 134 ! See source code. 135 ! 136 ! 7. Remarks : 137 ! 138 ! 8. Structure : 139 ! 140 ! See source code. 141 ! 142 ! 9. Switches : 143 ! 144 ! !/S Enable subroutine tracing. 145 ! !/T Enable test output 146 ! 147 ! 10. Source code : 148 ! 149 !/ ------------------------------------------------------------------- / 150 USE W3SERVMD, ONLY: EXTCDE 151 ! 152 IMPLICIT NONE 153 !/ 154 !/ ------------------------------------------------------------------- / 155 !/ Parameter list 156 !/ 157 INTEGER, INTENT(IN) :: NDSE, NDST 158 !/ 159 !/ ------------------------------------------------------------------- / 160 !/ Local parameters 161 !/ 162 INTEGER :: J, I1, IN, I 163 CHARACTER(LEN=3) :: STRING 164 !/ 165 ! 166 ! -------------------------------------------------------------------- / 167 ! 1. Test parameter settings 168 ! 169 IF ( UNITLW .GE. UNITHG ) THEN 170 WRITE (NDSE,1000) UNITLW, UNITHG 171 CALL EXTCDE ( 1000 ) Page 4 Source Listing WMUINI 2014-09-16 16:49 wmunitmd.f90 172 END IF 173 ! 174 IF ( UNITLW .GT. INPLOW .OR. & 175 UNITLW .GT. OUTLOW .OR. & 176 UNITLW .GT. SCRLOW ) THEN 177 WRITE (NDSE,1001) UNITLW, INPLOW, OUTLOW, SCRLOW 178 CALL EXTCDE ( 1001 ) 179 END IF 180 ! 181 IF ( UNITHG .LT. INPHGH .OR. & 182 UNITHG .LT. OUTHGH .OR. & 183 UNITHG .LT. SCRHGH ) THEN 184 WRITE (NDSE,1002) UNITHG, INPHGH, OUTHGH, SCRHGH 185 CALL EXTCDE ( 1002 ) 186 END IF 187 ! 188 IF ( FLINIT ) THEN 189 WRITE (NDSE,1003) 190 CALL EXTCDE ( 1003 ) 191 END IF 192 ! 193 ! -------------------------------------------------------------------- / 194 ! 1. Allocate and initialize arrays 195 ! 196 ALLOCATE ( U_USED(UNITLW:UNITHG) , U_TYPE(UNITLW:UNITHG) , & 197 U_NAME(UNITLW:UNITHG) , U_DESC(UNITLW:UNITHG) ) 198 ! 199 U_USED = .FALSE. 200 U_TYPE = 'RES' 201 U_NAME = 'unknown' 202 U_DESC = 'unknown' 203 ! 204 ! -------------------------------------------------------------------- / 205 ! 2. Designate file types 206 ! 207 DO J=1, 3 208 ! 209 SELECT CASE(J) 210 CASE(1) 211 STRING = 'INP' 212 I1 = INPLOW 213 IN = INPHGH 214 CASE(2) 215 STRING = 'OUT' 216 I1 = OUTLOW 217 IN = OUTHGH 218 CASE DEFAULT 219 STRING = 'SCR' 220 I1 = SCRLOW 221 IN = SCRHGH 222 END SELECT 223 ! 224 DO I=I1, IN 225 IF ( U_TYPE(I) .NE. 'RES' ) THEN 226 WRITE (NDSE,1020) I, U_TYPE(I) 227 END IF 228 U_TYPE(I) = STRING Page 5 Source Listing WMUINI 2014-09-16 16:49 wmunitmd.f90 229 END DO 230 END DO 231 ! 232 ! -------------------------------------------------------------------- / 233 ! 3. Set flags 234 ! 235 FLINIT = .TRUE. 236 ! 237 ! -------------------------------------------------------------------- / 238 ! 4. Test output 239 ! 240 RETURN 241 ! 242 ! Formats 243 ! 244 1000 FORMAT (/' *** ERROR WMUINI: ILLEGAL UNIT RANGE ***'/ & 245 ' LOW - HIGH : ',2I10/) 246 1001 FORMAT (/' *** ERROR WMUINI: ILLEGAL LOWER LIMITS ***'/ & 247 ' ',4I10/) 248 1002 FORMAT (/' *** ERROR WMUINI: ILLEGAL HIGHER LIMITS ***'/ & 249 ' ',4I10/) 250 1003 FORMAT (/' *** ERROR WMUINI: DATA ALREADY INITIALIZED ***'/) 251 1020 FORMAT (/' *** WARNING WMUINI: UNIT',I4,' ALREADY ASSIGNED [', & 252 A,'] ***') 253 ! 254 !/ 255 !/ End of WMUINI ----------------------------------------------------- / 256 !/ 257 END SUBROUTINE WMUINI Page 6 Source Listing WMUINI 2014-09-16 16:49 Entry Points wmunitmd.f90 ENTRY POINTS Name wmunitmd_mp_wmuini_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1000 Label 244 170 1001 Label 246 177 1002 Label 248 184 1003 Label 250 189 1020 Label 251 226 EXTCDE Subr 150 150,171,178,185,190 FLINIT Local 188 L(4) 4 scalar PRIV 87,188,235,329,471,597,722 I Local 162 I(4) 4 scalar 224,225,226,228 I1 Local 162 I(4) 4 scalar 212,216,220,224 IN Local 162 I(4) 4 scalar 213,217,221,224 INPHGH Param 181 I(4) 4 scalar PRIV 83,181,184,213 INPLOW Param 174 I(4) 4 scalar PRIV 83,174,177,212 J Local 162 I(4) 4 scalar 207,209 NDSE Dummy 95 I(4) 4 scalar ARG,IN 170,177,184,189,226 NDST Dummy 95 I(4) 4 scalar ARG,IN OUTHGH Param 182 I(4) 4 scalar PRIV 84,182,184,217 OUTLOW Param 175 I(4) 4 scalar PRIV 84,175,177,216 SCRHGH Param 183 I(4) 4 scalar PRIV 85,183,184,221 SCRLOW Param 176 I(4) 4 scalar PRIV 85,176,177,220 STRING Local 163 CHAR 3 scalar 211,215,219,228 UNITHG Param 169 I(4) 4 scalar PRIV 82,169,170,181,182,183,184,196,197 ,334,335,357,476,477,613,727,728 UNITLW Param 169 I(4) 4 scalar PRIV 82,169,170,174,175,176,177,196,197 ,334,335,357,476,477,613,727,728 U_DESC Local 197 CHAR 30 1 1 ALC,PRIV 91,197,202,344,360,502,504 U_NAME Local 197 CHAR 30 1 1 ALC,PRIV 90,197,201,344,360,494,496,746 U_TYPE Local 196 CHAR 3 1 1 ALC,PRIV 89,196,200,225,226,228,343,359,489 ,617,622 U_USED Local 196 L(4) 4 1 1 ALC,PRIV 88,196,199,343,358,359,485,617,621 ,628 W3SERVMD Module 150 150 WMUINI Subr 95 Page 7 Source Listing WMUINI 2014-09-16 16:49 wmunitmd.f90 258 !/ ------------------------------------------------------------------- / 259 SUBROUTINE WMUDMP ( NDS, IREQ ) 260 !/ 261 !/ +-----------------------------------+ 262 !/ | WAVEWATCH III NOAA/NCEP | 263 !/ | H. L. Tolman | 264 !/ | FORTRAN 90 | 265 !/ | Last update : 25-Mar-2005 ! 266 !/ +-----------------------------------+ 267 !/ 268 !/ 25-Mar-2005 : Origination. ( version 3.07 ) 269 !/ 270 ! 1. Purpose : 271 ! 272 ! Display assigned unit number information from private data base. 273 ! 274 ! 2. Method : 275 ! 276 ! 3. Parameters : 277 ! 278 ! Parameter list 279 ! ---------------------------------------------------------------- 280 ! NDS Int. I Unit number for output. 281 ! IREQ Int. I Request identifier. 282 ! < 0 : Dump all data. 283 ! 0 : Dump assigned units only. 284 ! > 0 : Dump this unit only. 285 ! ---------------------------------------------------------------- 286 ! 287 ! 4. Subroutines used : 288 ! 289 ! Name Type Module Description 290 ! ---------------------------------------------------------------- 291 ! STRACE Subr. W3SERVMD Subroutine tracing. 292 ! EXTCDE Subr. Id. Program abort. 293 ! ---------------------------------------------------------------- 294 ! 295 ! 5. Called by : 296 ! 297 ! 6. Error messages : 298 ! 299 ! 7. Remarks : 300 ! 301 ! 8. Structure : 302 ! 303 ! 9. Switches : 304 ! 305 ! !/S Enable subroutine tracing. 306 ! !/T Enable test output 307 ! 308 ! 10. Source code : 309 ! 310 !/ ------------------------------------------------------------------- / 311 USE W3SERVMD, ONLY: EXTCDE 312 ! 313 IMPLICIT NONE 314 !/ Page 8 Source Listing WMUDMP 2014-09-16 16:49 wmunitmd.f90 315 !/ ------------------------------------------------------------------- / 316 !/ Parameter list 317 !/ 318 INTEGER, INTENT(IN) :: NDS, IREQ 319 !/ 320 !/ ------------------------------------------------------------------- / 321 !/ Local parameters 322 !/ 323 INTEGER :: I 324 !/ 325 ! 326 ! -------------------------------------------------------------------- / 327 ! 1. Test request and intialization 328 ! 329 IF ( .NOT. FLINIT ) THEN 330 WRITE (NDS,1000) 331 CALL EXTCDE ( 1000 ) 332 END IF 333 ! 334 IF ( IREQ.GT.0 .AND. ( IREQ.LT.UNITLW .OR. IREQ.GT.UNITHG) ) THEN 335 WRITE (NDS,1001) IREQ, UNITLW, UNITHG 336 CALL EXTCDE ( 1001 ) 337 END IF 338 ! 339 ! -------------------------------------------------------------------- / 340 ! 2. Single unit request 341 ! 342 IF ( IREQ .GT. 0 ) THEN 343 WRITE (NDS,920) IREQ, U_USED(IREQ), U_TYPE(IREQ), & 344 U_NAME(IREQ), U_DESC(IREQ) 345 ! 346 ! -------------------------------------------------------------------- / 347 ! 3. Multiple unit request 348 ! 349 ELSE 350 ! 351 IF ( IREQ .LT. 0 ) THEN 352 WRITE (NDS,930) 353 ELSE 354 WRITE (NDS,931) 355 END IF 356 ! 357 DO I=UNITLW, UNITHG 358 IF ( IREQ.LT.0 .OR. U_USED(I) ) & 359 WRITE (NDS,932) I, U_USED(I), U_TYPE(I), & 360 U_NAME(I), U_DESC(I) 361 END DO 362 WRITE (NDS,*) 363 ! 364 END IF 365 ! 366 RETURN 367 ! 368 ! Formats 369 ! 370 920 FORMAT (/' WMUDMP: Unit number : ',I6/ & 371 ' Assigned : ',L6/ & Page 9 Source Listing WMUDMP 2014-09-16 16:49 wmunitmd.f90 372 ' Type : ',A/ & 373 ' Name : ',A/ & 374 ' Description : ',A/) 375 ! 376 930 FORMAT (/' WMUDMP: Unit information '// & 377 ' Nr Flg Type Name Description '/ & 378 ' -------------------------------------------------', & 379 '---------------------') 380 931 FORMAT (/' WMUDMP: Unit information (assigned only)'// & 381 ' Nr Flg Type Name Description '/ & 382 ' -------------------------------------------------', & 383 '---------------------') 384 932 FORMAT ( 2X,I4,L4,2X,A3,2X,A20,2X,A) 385 ! 386 1000 FORMAT (/' *** ERROR WMUDMP: DATA STRUCTURE READY ***'/ & 387 /' RUN WMUINI FIRST '/) 388 1001 FORMAT (/' *** ERROR WMUDMP: UNIT NUMBER OUT OF RANGE ***' & 389 /' REQ/RANG :',3I6/) 390 !/ 391 !/ End of WMUDMP ----------------------------------------------------- / 392 !/ 393 END SUBROUTINE WMUDMP ENTRY POINTS Name wmunitmd_mp_wmudmp_ Page 10 Source Listing WMUDMP 2014-09-16 16:49 Symbol Table wmunitmd.f90 SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1000 Label 386 330 1001 Label 388 335 920 Label 370 343 930 Label 376 352 931 Label 380 354 932 Label 384 359 EXTCDE Subr 311 311,331,336 I Local 323 I(4) 4 scalar 357,358,359,360 IREQ Dummy 259 I(4) 4 scalar ARG,IN 334,335,342,343,344,351,358 NDS Dummy 259 I(4) 4 scalar ARG,IN 330,335,343,352,354,359,362 W3SERVMD Module 311 311 WMUDMP Subr 259 Page 11 Source Listing WMUDMP 2014-09-16 16:49 wmunitmd.f90 394 !/ ------------------------------------------------------------------- / 395 SUBROUTINE WMUSET ( NDSE, NDST, NDS, FLAG, TYPE, NAME, DESC ) 396 !/ 397 !/ +-----------------------------------+ 398 !/ | WAVEWATCH III NOAA/NCEP | 399 !/ | H. L. Tolman | 400 !/ | FORTRAN 90 | 401 !/ | Last update : 25-Mar-2005 ! 402 !/ +-----------------------------------+ 403 !/ 404 !/ 25-Mar-2005 : Origination. ( version 3.07 ) 405 !/ 406 ! 1. Purpose : 407 ! 408 ! Directly set information for a unit number in the data structure. 409 ! 410 ! 2. Method : 411 ! 412 ! 3. Parameters : 413 ! 414 ! Parameter list 415 ! ---------------------------------------------------------------- 416 ! NDSE Int. I Unit number for error output. 417 ! NDST Int. I Unit number for test output. 418 ! NDS Int. I Unit number to be assigned. 419 ! FLAG Log. I Flag for assigning unit. 420 ! TYPE C*3 I Type identifier to be used. 421 ! NAME C* I Name of file. 422 ! DESC C* I Description of file. 423 ! ---------------------------------------------------------------- 424 ! 425 ! 4. Subroutines used : 426 ! 427 ! Name Type Module Description 428 ! ---------------------------------------------------------------- 429 ! STRACE Sur. W3SERVMD Subroutine tracing. 430 ! EXCTDE Sur. Id. Program abort. 431 ! ---------------------------------------------------------------- 432 ! 433 ! 5. Called by : 434 ! 435 ! 6. Error messages : 436 ! 437 ! 7. Remarks : 438 ! 439 ! 8. Structure : 440 ! 441 ! 9. Switches : 442 ! 443 ! !/S Enable subroutine tracing. 444 ! !/T Enable test output 445 ! 446 ! 10. Source code : 447 ! 448 !/ ------------------------------------------------------------------- / 449 USE W3SERVMD, ONLY: EXTCDE 450 ! Page 12 Source Listing WMUSET 2014-09-16 16:49 wmunitmd.f90 451 IMPLICIT NONE 452 !/ 453 !/ ------------------------------------------------------------------- / 454 !/ Parameter list 455 !/ 456 INTEGER, INTENT(IN) :: NDSE, NDST, NDS 457 LOGICAL, INTENT(IN) :: FLAG 458 CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: & 459 TYPE 460 CHARACTER*(*), INTENT(IN), OPTIONAL :: & 461 NAME, DESC 462 !/ 463 !/ ------------------------------------------------------------------- / 464 !/ Local parameters 465 !/ 466 !/ 467 ! 468 ! -------------------------------------------------------------------- / 469 ! 1. Test input 470 ! 471 IF ( .NOT. FLINIT ) THEN 472 WRITE (NDSE,1000) 473 CALL EXTCDE ( 1000 ) 474 END IF 475 ! 476 IF ( NDS.LT.UNITLW .OR. NDS.GT.UNITHG ) THEN 477 WRITE (NDSE,1001) NDS, UNITLW, UNITHG 478 CALL EXTCDE ( 1001 ) 479 END IF 480 ! 481 ! -------------------------------------------------------------------- / 482 ! 2. Set data 483 ! 2.a Flag 484 ! 485 U_USED(NDS) = FLAG 486 ! 487 ! 2.b Type 488 ! 489 IF ( PRESENT(TYPE) ) U_TYPE(NDS) = TYPE 490 ! 491 ! 2.c Name 492 ! 493 IF ( PRESENT(NAME) ) THEN 494 U_NAME(NDS) = NAME 495 ELSE IF ( .NOT. FLAG ) THEN 496 U_NAME(NDS) = 'unknown' 497 END IF 498 ! 499 ! 2.d Description 500 ! 501 IF ( PRESENT(DESC) ) THEN 502 U_DESC(NDS) = DESC 503 ELSE IF ( .NOT. FLAG ) THEN 504 U_DESC(NDS) = 'unknown' 505 END IF 506 ! 507 RETURN Page 13 Source Listing WMUSET 2014-09-16 16:49 wmunitmd.f90 508 ! 509 ! Formats 510 ! 511 1000 FORMAT (/' *** ERROR WMUSET: INITIALIZE FIRST !!! ***') 512 1001 FORMAT (/' *** ERROR WMUSET: UNIT NUMBER OUT OF RANGE ***' & 513 /' REQ/RANG :',3I6/) 514 ! 515 !/ 516 !/ End of WMUSET ----------------------------------------------------- / 517 !/ 518 END SUBROUTINE WMUSET ENTRY POINTS Name wmunitmd_mp_wmuset_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1000 Label 511 472 1001 Label 512 477 DESC Dummy 395 CHAR scalar ARG,IN 501,502 EXTCDE Subr 449 449,473,478 FLAG Dummy 395 L(4) 4 scalar ARG,IN 485,495,503 NAME Dummy 395 CHAR scalar ARG,IN 493,494 NDS Dummy 395 I(4) 4 scalar ARG,IN 476,477,485,489,494,496,502,504 NDSE Dummy 395 I(4) 4 scalar ARG,IN 472,477 NDST Dummy 395 I(4) 4 scalar ARG,IN PRESENT Func 489 scalar 489,493,501 TYPE Dummy 395 CHAR 3 scalar ARG,IN 489 W3SERVMD Module 449 449 WMUSET Subr 395 741 Page 14 Source Listing WMUSET 2014-09-16 16:49 wmunitmd.f90 519 !/ ------------------------------------------------------------------- / 520 SUBROUTINE WMUGET ( NDSE, NDST, NDS, TYPE, NR ) 521 !/ 522 !/ +-----------------------------------+ 523 !/ | WAVEWATCH III NOAA/NCEP | 524 !/ | H. L. Tolman | 525 !/ | FORTRAN 90 | 526 !/ | Last update : 28-Mar-2005 ! 527 !/ +-----------------------------------+ 528 !/ 529 !/ 28-Mar-2005 : Origination. ( version 3.07 ) 530 !/ 531 ! 1. Purpose : 532 ! 533 ! Find a free unit number for a given file type. 534 ! 535 ! 2. Method : 536 ! 537 ! Search the data base. 538 ! 539 ! 3. Parameters : 540 ! 541 ! Parameter list 542 ! ---------------------------------------------------------------- 543 ! NDSE Int. I Unit number for error output. 544 ! NDST Int. I Unit number for test output. 545 ! NDS Int. O Unit number to be assigned. 546 ! TYPE C*3 I Type identifier to be used. 547 ! NR Int. I Number of consecutive units needed. 548 ! Needed for output bounday data files. 549 ! ---------------------------------------------------------------- 550 ! 551 ! 4. Subroutines used : 552 ! 553 ! Name Type Module Description 554 ! ---------------------------------------------------------------- 555 ! STRACE Sur. W3SERVMD Subroutine tracing. 556 ! EXCTDE Sur. Id. Program abort. 557 ! ---------------------------------------------------------------- 558 ! 559 ! 5. Called by : 560 ! 561 ! 6. Error messages : 562 ! 563 ! 7. Remarks : 564 ! 565 ! 8. Structure : 566 ! 567 ! 9. Switches : 568 ! 569 ! !/S Enable subroutine tracing. 570 ! !/T Enable test output 571 ! 572 ! 10. Source code : 573 ! 574 !/ ------------------------------------------------------------------- / 575 USE W3SERVMD, ONLY: EXTCDE Page 15 Source Listing WMUGET 2014-09-16 16:49 wmunitmd.f90 576 ! 577 IMPLICIT NONE 578 !/ 579 !/ ------------------------------------------------------------------- / 580 !/ Parameter list 581 !/ 582 INTEGER, INTENT(IN) :: NDSE, NDST 583 INTEGER, INTENT(OUT) :: NDS 584 CHARACTER(LEN=3), INTENT(IN) :: TYPE 585 INTEGER, INTENT(IN), OPTIONAL :: NR 586 !/ 587 !/ ------------------------------------------------------------------- / 588 !/ Local parameters 589 !/ 590 INTEGER :: NRC, I, J 591 LOGICAL :: OK 592 !/ 593 ! 594 ! -------------------------------------------------------------------- / 595 ! 1. Test input / output 596 ! 597 IF ( .NOT. FLINIT ) THEN 598 WRITE (NDSE,1010) 599 CALL EXTCDE ( 1010 ) 600 END IF 601 ! 602 IF ( PRESENT(NR) ) THEN 603 NRC = MAX ( 1 , NR ) 604 ELSE 605 NRC = 1 606 END IF 607 ! 608 ! -------------------------------------------------------------------- / 609 ! 2. Find first free unit number and reset flag 610 ! 611 NDS = -1 612 ! 613 DO I=UNITLW, UNITHG - NRC + 1 614 ! new: We do not allow I=NDST (unit number for test output). 615 ! NDST (aka MDST or IDST) is set to 10 in call to WMINIT 616 ! (4th argument) 617 OK = .NOT.U_USED(I) .AND. U_TYPE(I).EQ.TYPE & 618 .AND. I.NE.NDST 619 IF ( OK ) THEN 620 DO J=1, NRC-1 621 OK = OK .AND. (.NOT.U_USED(I+J) .AND. & 622 U_TYPE(I+J).EQ.TYPE ) 623 END DO 624 END IF 625 IF ( OK ) THEN 626 NDS = I 627 DO J=0, NRC-1 628 U_USED(I+J) = .TRUE. 629 END DO 630 EXIT 631 END IF 632 END DO Page 16 Source Listing WMUGET 2014-09-16 16:49 wmunitmd.f90 633 ! 634 IF ( NDS .EQ. -1 ) THEN 635 WRITE (NDSE,1020) TYPE 636 CALL EXTCDE ( 1020 ) 637 END IF 638 ! 639 RETURN 640 ! 641 ! Formats 642 ! 643 1010 FORMAT (/' *** ERROR WMUGET: INITIALIZE FIRST !!! ***') 644 1020 FORMAT (/' *** ERROR WMUGET: CANNOT FIND FREE UNIT FOR TYPE ', & 645 A,' ***'/) 646 ! 647 !/ 648 !/ End of WMUGET ----------------------------------------------------- / 649 !/ 650 END SUBROUTINE WMUGET ENTRY POINTS Name wmunitmd_mp_wmuget_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1010 Label 643 598 1020 Label 644 635 EXTCDE Subr 575 575,599,636 I Local 590 I(4) 4 scalar 613,617,618,621,622,626,628 J Local 590 I(4) 4 scalar 620,621,622,627,628 MAX Func 603 scalar 603 NDS Dummy 520 I(4) 4 scalar ARG,OUT 611,626,634 NDSE Dummy 520 I(4) 4 scalar ARG,IN 598,635 NDST Dummy 520 I(4) 4 scalar ARG,IN 618 NR Dummy 520 I(4) 4 scalar ARG,IN 602,603 NRC Local 590 I(4) 4 scalar 603,605,613,620,627 OK Local 591 L(4) 4 scalar 617,619,621,625 PRESENT Func 602 scalar 602 TYPE Dummy 520 CHAR 3 scalar ARG,IN 617,622,635 W3SERVMD Module 575 575 WMUGET Subr 520 Page 17 Source Listing WMUGET 2014-09-16 16:49 wmunitmd.f90 651 !/ ------------------------------------------------------------------- / 652 SUBROUTINE WMUINQ ( NDSE, NDST, NDS ) 653 !/ 654 !/ +-----------------------------------+ 655 !/ | WAVEWATCH III NOAA/NCEP | 656 !/ | H. L. Tolman | 657 !/ | FORTRAN 90 | 658 !/ | Last update : 29-Mar-2005 ! 659 !/ +-----------------------------------+ 660 !/ 661 !/ 29-Mar-2005 : Origination. ( version 3.07 ) 662 !/ 663 ! 1. Purpose : 664 ! 665 ! Update data base information for a given unit number. 666 ! 667 ! 2. Method : 668 ! 669 ! FORTRAN INQUIRE statement. 670 ! 671 ! 3. Parameters : 672 ! 673 ! Parameter list 674 ! ---------------------------------------------------------------- 675 ! NDSE Int. I Unit number for error output. 676 ! NDST Int. I Unit number for test output. 677 ! NDS Int. I Unit number to be assigned. 678 ! ---------------------------------------------------------------- 679 ! 680 ! 4. Subroutines used : 681 ! 682 ! Name Type Module Description 683 ! ---------------------------------------------------------------- 684 ! STRACE Sur. W3SERVMD Subroutine tracing. 685 ! EXCTDE Sur. Id. Program abort. 686 ! ---------------------------------------------------------------- 687 ! 688 ! 5. Called by : 689 ! 690 ! 6. Error messages : 691 ! 692 ! 7. Remarks : 693 ! 694 ! 8. Structure : 695 ! 696 ! 9. Switches : 697 ! 698 ! !/S Enable subroutine tracing. 699 ! !/T Enable test output 700 ! 701 ! 10. Source code : 702 ! 703 !/ ------------------------------------------------------------------- / 704 USE W3SERVMD, ONLY: EXTCDE 705 ! 706 IMPLICIT NONE 707 !/ Page 18 Source Listing WMUINQ 2014-09-16 16:49 wmunitmd.f90 708 !/ ------------------------------------------------------------------- / 709 !/ Parameter list 710 !/ 711 INTEGER, INTENT(IN) :: NDSE, NDST, NDS 712 !/ 713 !/ ------------------------------------------------------------------- / 714 !/ Local parameters 715 !/ 716 LOGICAL :: CHECK 717 !/ 718 ! 719 ! -------------------------------------------------------------------- / 720 ! 1. Test input / output 721 ! 722 IF ( .NOT. FLINIT ) THEN 723 WRITE (NDSE,1010) 724 CALL EXTCDE ( 1010 ) 725 END IF 726 ! 727 IF ( NDS.LT.UNITLW .OR. NDS.GT.UNITHG ) THEN 728 WRITE (NDSE,1011) NDS, UNITLW, UNITHG 729 CALL EXTCDE ( 1011 ) 730 END IF 731 ! 732 ! -------------------------------------------------------------------- / 733 ! 2. Check out file 734 ! 2.a Check if opened : 735 ! 736 INQUIRE (NDS,OPENED=CHECK) 737 ! 738 ! 2.b File not opened, release to pool 739 ! 740 IF ( .NOT. CHECK ) THEN 741 CALL WMUSET ( NDSE, NDST, NDS, .FALSE. ) 742 ELSE 743 ! 744 ! 2.c File is opened, get the name 745 ! 746 INQUIRE (NDS,NAME=U_NAME(NDS)) 747 ! 748 END IF 749 ! 750 RETURN 751 ! 752 ! Escape locations read errors --------------------------------------- * 753 ! 754 ! Formats 755 ! 756 1010 FORMAT (/' *** ERROR WMUINQ: INITIALIZE FIRST !!! ***') 757 1011 FORMAT (/' *** ERROR WMUINQ: UNIT NUMBER OUT OF RANGE ***' & 758 /' REQ/RANG :',3I6/) 759 ! 760 !/ 761 !/ End of WMUINQ ----------------------------------------------------- / 762 !/ 763 END SUBROUTINE WMUINQ Page 19 Source Listing WMUINQ 2014-09-16 16:49 Entry Points wmunitmd.f90 ENTRY POINTS Name wmunitmd_mp_wmuinq_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1010 Label 756 723 1011 Label 757 728 CHECK Local 716 L(4) 4 scalar 736,740 EXTCDE Subr 704 704,724,729 NDS Dummy 652 I(4) 4 scalar ARG,IN 727,728,736,741,746 NDSE Dummy 652 I(4) 4 scalar ARG,IN 723,728,741 NDST Dummy 652 I(4) 4 scalar ARG,IN 741 W3SERVMD Module 704 704 WMUINQ Subr 652 Page 20 Source Listing WMUINQ 2014-09-16 16:49 wmunitmd.f90 764 !/ 765 !/ End of module WMUNITMD -------------------------------------------- / 766 !/ 767 END MODULE WMUNITMD SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References WMUNITMD Module 2 Page 21 Source Listing WMUINQ 2014-09-16 16:49 Subprograms/Common Blocks wmunitmd.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References WMUDMP Subr 259 WMUGET Subr 520 WMUINI Subr 95 WMUINQ Subr 652 WMUNITMD Module 2 WMUSET Subr 395 741 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 Page 22 Source Listing WMUINQ 2014-09-16 16:49 wmunitmd.f90 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 : wmunitmd.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100