Page 1 Source Listing 2014-11-12 21:38 w3arrymd.f90 w3arrymd.f90(2082): remark #8291: Recommended relationship between field width 'W' and the number of fractional digits 'D' in thi... ' Spectrum : ',A,' Units : ',E8.3,1X,A, & -----------------------------------------------^ w3arrymd.f90(2083): remark #8291: Recommended relationship between field width 'W' and the number of fractional digits 'D' in thi... ' Maximum value : ',E8.3,1X,A/) -------------------------------------^ w3arrymd.f90(2080): remark #8291: Recommended relationship between field width 'W' and the number of fractional digits 'D' in thi... ' Maximum value : ',E8.3,1X,A/) -------------------------------------^ Page 2 Source Listing INA2R 2014-11-12 21:38 w3arrymd.f90 1 !/ ------------------------------------------------------------------- / 2 MODULE W3ARRYMD 3 !/ 4 !/ +-----------------------------------+ 5 !/ | WAVEWATCH III NOAA/NCEP | 6 !/ | H. L. Tolman | 7 !/ | FORTRAN 90 | 8 !/ | Last update : 30-Oct-2009 | 9 !/ +-----------------------------------+ 10 !/ 11 !/ Copyright 2009 National Weather Service (NWS), 12 !/ National Oceanic and Atmospheric Administration. All rights 13 !/ reserved. WAVEWATCH III is a trademark of the NWS. 14 !/ No unauthorized use without permission. 15 !/ 16 ! 1. Purpose : 17 ! 18 ! In this module all service routines for in and output (binary 19 ! and test) of arrays are gathered. 20 ! 21 ! 2. Variables and types : 22 ! 23 ! Name Type Scope Description 24 ! ---------------------------------------------------------------- 25 ! ICOL Int. Private Number of collums four array output 26 ! (if not 80, 132 assumed). 27 ! NFRMAX Int. Private Max number of frequencies in 1D 28 ! print plots of spectra. 29 ! ---------------------------------------------------------------- 30 ! 31 ! 3. Subroutines and functions : 32 ! 33 ! Name Type Scope Description 34 ! ---------------------------------------------------------------- 35 ! INA2R Subr. Public Read 2D real array. 36 ! INA2I Subr. Public Read 2D integer array. 37 ! OUTA2R Subr. Public Write 2D real array. 38 ! OUTA2I Subr. Public Write 2D integer array. 39 ! OUTREA Subr. Public Print out 1D real array. 40 ! OUTINT Subr. Public Print out 1D integer array. 41 ! OUTMAT Subr. Public Print out 2D real array. 42 ! PRTBLK Subr. Public Print a block-type table of a 2D 43 ! real array. 44 ! PRT1DS Subr. Public Print plot of 1D spectrum. 45 ! PRT1DM Subr. Public Print plot of 1D spectra. 46 ! PRT2DS Subr. Public Print plot of 2D spectrum. 47 ! ANGSTR Subr. PRT2DS Convert direction to string. 48 ! ---------------------------------------------------------------- 49 ! 50 ! 4. Subroutines and functions used : 51 ! 52 ! Name Type Module Description 53 ! ---------------------------------------------------------------- 54 ! STRACE Subr. W3SERVMD Subroutine tracing. ( !/S ) 55 ! ---------------------------------------------------------------- 56 ! 57 ! 5. Remarks : Page 3 Source Listing INA2R 2014-11-12 21:38 w3arrymd.f90 58 ! 59 ! 6. Switches : 60 ! 61 ! !/S Enable subroutine tracing troughout module. 62 ! !/T Switch on test output for INA2R/I and OUTA2R/I. 63 ! 64 ! 7. Source code : 65 ! 66 !/ ------------------------------------------------------------------- / 67 PUBLIC 68 ! 69 INTEGER, PARAMETER, PRIVATE :: ICOL = 80 70 INTEGER, PARAMETER, PRIVATE :: NFRMAX = 50 71 INTEGER, PARAMETER, PRIVATE :: NFM2 = NFRMAX+1 72 ! 73 CONTAINS 74 !/ ------------------------------------------------------------------- / 75 SUBROUTINE INA2R (ARRAY, MX, MY, LX, HX, LY, HY, & 76 NDS, NDST, NDSE, IDFM, RFORM, IDLA, VSC, VOF) 77 !/ 78 !/ +-----------------------------------+ 79 !/ | WAVEWATCH III NOAA/NCEP | 80 !/ | H. L. Tolman | 81 !/ | FORTRAN 90 | 82 !/ | Last update : 30-Oct-2009 | 83 !/ +-----------------------------------+ 84 !/ Based on INAR2D by N.Booij, DUT. 85 !/ 86 !/ 31-Mar-1993 : Final FORTRAN 77 ( version 1.18 ) 87 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 88 !/ 30-Oct-2009 : Implement add offset argument. ( version 3.14 ) 89 !/ (W. E. Rogers & T. J. Campbell, NRL) 90 !/ 91 ! 1. Purpose : 92 ! 93 ! Reads 2-D array of pre-described layout and format. 94 ! 95 ! 3. Parameter list 96 ! ---------------------------------------------------------------- 97 ! ARRAY R.A. O Array to be read. 98 ! MX,MY Int. I Declared size of array. 99 ! LX,HX Int. I Range of x-counters to be read. 100 ! LY,HY Int. I Range of y-counters to be read. 101 ! NDS Int. I Unit number for dataset with array. 102 ! NDST Int. I Unit number for test output. 103 ! NDSE Int. I Unit number for error messages. 104 ! IDFM Int. I Format indicator. 105 ! IDFM = 1 : Free format. 106 ! IDFM = 2 : Fixed format RFORM. 107 ! IDFM = 3 : Unformatted. 108 ! RFORM C*(*) I Format, if IDFM = 2 109 ! IDLA Int. I Lay out indicator. 110 ! IDLA = 1 : Read for IY=LY-HY, IX=LX-HX, 111 ! IX line by IX line. 112 ! IDLA = 2 : Idem, one read statement. 113 ! IDLA = 3 : Read for IY=HY-LY, IX=LX,HX, 114 ! IX line by IX line. Page 4 Source Listing INA2R 2014-11-12 21:38 w3arrymd.f90 115 ! IDLA = 4 : Idem, one read statement. 116 ! VSC Real I Scaling factor (multiplication). 117 ! VOF Real I Add offset. 118 ! ---------------------------------------------------------------- 119 ! 120 ! 4. Subroutines used : 121 ! 122 ! See mudule documentation. 123 ! 124 ! 5. Called by : 125 ! 126 ! Any. 127 ! 128 ! 6. Error messages : 129 ! 130 ! See error escape locations at end of routine. 131 ! 132 ! 8. Structure : 133 ! 134 ! See comments in code. 135 ! 136 ! 9. Switches : 137 ! 138 ! !/S Enable subroutine tracing. 139 ! !/T Dump of input parameters in parameter list. 140 ! 141 ! 10. Source code : 142 ! 143 !/ ------------------------------------------------------------------- / 144 !/ 145 ! 146 IMPLICIT NONE 147 !/ 148 !/ ------------------------------------------------------------------- / 149 !/ Parameter list 150 !/ 151 INTEGER, INTENT(IN) :: MX, MY, LX, HX, LY, HY, NDS, NDST, & 152 NDSE, IDFM, IDLA 153 REAL, INTENT(IN) :: VSC, VOF 154 CHARACTER, INTENT(IN) :: RFORM*(*) 155 REAL, INTENT(OUT) :: ARRAY(MX,MY) 156 !/ 157 !/ ------------------------------------------------------------------- / 158 !/ Local parameters 159 !/ 160 INTEGER :: IIDFM, IIDLA, IX, IY, ISTAT 161 !/ 162 !/ ------------------------------------------------------------------- / 163 !/ 164 ! 165 IF (IDFM.LT.1 .OR. IDFM.GT.3) THEN 166 IIDFM = 1 167 ELSE 168 IIDFM = IDFM 169 END IF 170 IF (IDLA.LT.1 .OR. IDLA.GT.4) THEN 171 IIDLA = 1 Page 5 Source Listing INA2R 2014-11-12 21:38 w3arrymd.f90 172 ELSE 173 IIDLA = IDLA 174 END IF 175 ! 176 ! Free format read : 177 ! 178 IF (IIDFM.EQ.1) THEN 179 IF (IIDLA.EQ.1) THEN 180 DO IY=LY, HY 181 READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & 182 (ARRAY(IX,IY),IX=LX,HX) 183 END DO 184 ELSE IF (IIDLA.EQ.2) THEN 185 READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & 186 ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) 187 ELSE IF (IIDLA.EQ.3) THEN 188 DO IY=HY, LY, -1 189 READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & 190 (ARRAY(IX,IY),IX=LX,HX) 191 END DO 192 ELSE 193 READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & 194 ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) 195 END IF 196 ! 197 ! Fixed format read : 198 ! 199 ELSE IF (IIDFM.EQ.2) THEN 200 IF (IIDLA.EQ.1) THEN 201 DO IY=LY, HY 202 READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & 203 (ARRAY(IX,IY),IX=LX,HX) 204 END DO 205 ELSE IF (IIDLA.EQ.2) THEN 206 READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & 207 ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) 208 ELSE IF (IIDLA.EQ.3) THEN 209 DO IY=HY, LY, -1 210 READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & 211 (ARRAY(IX,IY),IX=LX,HX) 212 END DO 213 ELSE 214 READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & 215 ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) 216 END IF 217 ! 218 ! Unformat read : 219 ! 220 ELSE 221 IF (IIDLA.EQ.1) THEN 222 DO IY=LY, HY 223 READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & 224 (ARRAY(IX,IY),IX=LX,HX) 225 END DO 226 ELSE IF (IIDLA.EQ.2) THEN 227 READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & 228 ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) Page 6 Source Listing INA2R 2014-11-12 21:38 w3arrymd.f90 229 ELSE IF (IIDLA.EQ.3) THEN 230 DO IY=HY, LY, -1 231 READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & 232 (ARRAY(IX,IY),IX=LX,HX) 233 END DO 234 ELSE 235 READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & 236 ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) 237 END IF 238 END IF 239 ! 240 ! Scaling : 241 ! 242 DO IX=LX, HX 243 DO IY=LY, HY 244 ARRAY(IX,IY) = VSC * ARRAY(IX,IY) + VOF 245 END DO 246 END DO 247 ! 248 RETURN 249 ! 250 ! Escape locations read errors : 251 ! 252 800 CONTINUE 253 WRITE (NDSE,900) 254 STOP 255 ! 256 801 CONTINUE 257 WRITE (NDSE,901) ISTAT 258 STOP 259 ! 260 ! Formats 261 ! 262 900 FORMAT (/' *** ERROR INA2R : '/ & 263 ' PREMATURE END OF FILE'/) 264 901 FORMAT (/' *** ERROR INA2R : '/ & 265 ' ERROR IN READING FROM FILE'/ & 266 ' IOSTAT =',I5/) 267 ! 268 !/ 269 !/ End of INA2R ----------------------------------------------------- / 270 !/ 271 END SUBROUTINE INA2R Page 7 Source Listing INA2R 2014-11-12 21:38 Entry Points w3arrymd.f90 ENTRY POINTS Name w3arrymd_mp_ina2r_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 800 Label 252 181,185,189,193,202,206,210,214,22 3,227,231,235 801 Label 256 181,185,189,193,202,206,210,214,22 3,227,231,235 900 Label 262 253 901 Label 264 257 ARRAY Dummy 75 R(4) 4 2 0 ARG,OUT 182,186,190,194,203,207,211,215,22 4,228,232,236,244 HX Dummy 75 I(4) 4 scalar ARG,IN 182,186,190,194,203,207,211,215,22 4,228,232,236,242 HY Dummy 75 I(4) 4 scalar ARG,IN 180,186,188,194,201,207,209,215,22 2,228,230,236,243 IDFM Dummy 76 I(4) 4 scalar ARG,IN 165,168 IDLA Dummy 76 I(4) 4 scalar ARG,IN 170,173 IIDFM Local 160 I(4) 4 scalar 166,168,178,199 IIDLA Local 160 I(4) 4 scalar 171,173,179,184,187,200,205,208,22 1,226,229 INA2R Subr 75 ISTAT Local 160 I(4) 4 scalar 181,185,189,193,202,206,210,214,22 3,227,231,235,257 IX Local 160 I(4) 4 scalar 182,186,190,194,203,207,211,215,22 4,228,232,236,242,244 IY Local 160 I(4) 4 scalar 180,182,186,188,190,194,201,203,20 7,209,211,215,222,224,228,230,232, 236,243,244 LX Dummy 75 I(4) 4 scalar ARG,IN 182,186,190,194,203,207,211,215,22 4,228,232,236,242 LY Dummy 75 I(4) 4 scalar ARG,IN 180,186,188,194,201,207,209,215,22 2,228,230,236,243 MX Dummy 75 I(4) 4 scalar ARG,IN 155 MY Dummy 75 I(4) 4 scalar ARG,IN 155 NDS Dummy 76 I(4) 4 scalar ARG,IN 181,185,189,193,202,206,210,214,22 3,227,231,235 NDSE Dummy 76 I(4) 4 scalar ARG,IN 253,257 NDST Dummy 76 I(4) 4 scalar ARG,IN RFORM Dummy 76 CHAR scalar ARG,IN 202,206,210,214 VOF Dummy 76 R(4) 4 scalar ARG,IN 244 VSC Dummy 76 R(4) 4 scalar ARG,IN 244 Page 8 Source Listing INA2R 2014-11-12 21:38 w3arrymd.f90 272 !/ ------------------------------------------------------------------- / 273 SUBROUTINE INA2I (ARRAY, MX, MY, LX, HX, LY, HY, & 274 NDS, NDST, NDSE, IDFM, RFORM, IDLA, VSC, VOF) 275 !/ 276 !/ +-----------------------------------+ 277 !/ | WAVEWATCH III NOAA/NCEP | 278 !/ | H. L. Tolman | 279 !/ | FORTRAN 90 | 280 !/ | Last update : 30-Oct-2009 | 281 !/ +-----------------------------------+ 282 !/ Based on INAR2D by N.Booij, DUT. 283 !/ 284 !/ 31-Mar-1993 : Final FORTRAN 77 ( version 1.18 ) 285 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 286 !/ 30-Oct-2009 : Implement add offset argument. ( version 3.14 ) 287 !/ (W. E. Rogers & T. J. Campbell, NRL) 288 !/ 289 ! 1. Purpose : 290 ! 291 ! Like INA2R , integer ARRAY, VSC and VOF, see INA2R . 292 ! 293 ! 10. Source code : 294 ! 295 !/ ------------------------------------------------------------------- / 296 !/ 297 ! 298 IMPLICIT NONE 299 !/ 300 !/ ------------------------------------------------------------------- / 301 !/ Parameter list 302 !/ 303 INTEGER, INTENT(IN) :: MX, MY, LX, HX, LY, HY, NDS, NDST, & 304 NDSE, IDFM, IDLA, VSC, VOF 305 INTEGER, INTENT(OUT) :: ARRAY(MX,MY) 306 CHARACTER, INTENT(IN) :: RFORM*(*) 307 !/ 308 !/ ------------------------------------------------------------------- / 309 !/ Local parameters 310 !/ 311 INTEGER :: IIDFM, IIDLA, IX, IY, ISTAT 312 !/ 313 !/ ------------------------------------------------------------------- / 314 !/ 315 ! 316 IF (IDFM.LT.1 .OR. IDFM.GT.3) THEN 317 IIDFM = 1 318 ELSE 319 IIDFM = IDFM 320 END IF 321 IF (IDLA.LT.1 .OR. IDLA.GT.4)THEN 322 IIDLA = 1 323 ELSE 324 IIDLA = IDLA 325 END IF 326 ! 327 ! Free format read : 328 ! Page 9 Source Listing INA2I 2014-11-12 21:38 w3arrymd.f90 329 IF (IIDFM.EQ.1) THEN 330 IF (IIDLA.EQ.1) THEN 331 DO IY=LY, HY 332 READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & 333 (ARRAY(IX,IY),IX=LX,HX) 334 END DO 335 ELSE IF (IIDLA.EQ.2) THEN 336 READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & 337 ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) 338 ELSE IF (IIDLA.EQ.3) THEN 339 DO IY=HY, LY, -1 340 READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & 341 (ARRAY(IX,IY),IX=LX,HX) 342 END DO 343 ELSE 344 READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & 345 ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) 346 END IF 347 ! 348 ! Fixed format read : 349 ! 350 ELSE IF (IIDFM.EQ.2) THEN 351 IF (IIDLA.EQ.1) THEN 352 DO IY=LY, HY 353 READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & 354 (ARRAY(IX,IY),IX=LX,HX) 355 END DO 356 ELSE IF (IIDLA.EQ.2) THEN 357 READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & 358 ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) 359 ELSE IF (IIDLA.EQ.3) THEN 360 DO IY=HY, LY, -1 361 READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & 362 (ARRAY(IX,IY),IX=LX,HX) 363 END DO 364 ELSE 365 READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & 366 ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) 367 END IF 368 ! 369 ! Unformat read : 370 ! 371 ELSE 372 IF (IIDLA.EQ.1) THEN 373 DO IY=LY, HY 374 READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & 375 (ARRAY(IX,IY),IX=LX,HX) 376 END DO 377 ELSE IF (IIDLA.EQ.2) THEN 378 READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & 379 ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) 380 ELSE IF (IIDLA.EQ.3) THEN 381 DO IY=HY, LY, -1 382 READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & 383 (ARRAY(IX,IY),IX=LX,HX) 384 END DO 385 ELSE Page 10 Source Listing INA2I 2014-11-12 21:38 w3arrymd.f90 386 READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & 387 ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) 388 END IF 389 END IF 390 ! 391 ! Scaling : 392 ! 393 DO IX=LX, HX 394 DO IY=LY, HY 395 ARRAY(IX,IY) = VSC * ARRAY(IX,IY) + VOF 396 END DO 397 END DO 398 ! 399 RETURN 400 ! 401 ! Escape locations read errors : 402 ! 403 800 CONTINUE 404 WRITE (NDSE,900) 405 STOP 406 ! 407 801 CONTINUE 408 WRITE (NDSE,901) ISTAT 409 STOP 410 ! 411 ! Formats 412 ! 413 900 FORMAT (/' *** ERROR INA2I : '/ & 414 ' PREMATURE END OF FILE'/) 415 901 FORMAT (/' *** ERROR INA2I : '/ & 416 ' ERROR IN READING FROM FILE'/ & 417 ' IOSTAT =',I5/) 418 ! 419 !/ 420 !/ End of INA2I ----------------------------------------------------- / 421 !/ 422 END SUBROUTINE INA2I Page 11 Source Listing INA2I 2014-11-12 21:38 Entry Points w3arrymd.f90 ENTRY POINTS Name w3arrymd_mp_ina2i_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 800 Label 403 332,336,340,344,353,357,361,365,37 4,378,382,386 801 Label 407 332,336,340,344,353,357,361,365,37 4,378,382,386 900 Label 413 404 901 Label 415 408 ARRAY Dummy 273 I(4) 4 2 0 ARG,OUT 333,337,341,345,354,358,362,366,37 5,379,383,387,395 HX Dummy 273 I(4) 4 scalar ARG,IN 333,337,341,345,354,358,362,366,37 5,379,383,387,393 HY Dummy 273 I(4) 4 scalar ARG,IN 331,337,339,345,352,358,360,366,37 3,379,381,387,394 IDFM Dummy 274 I(4) 4 scalar ARG,IN 316,319 IDLA Dummy 274 I(4) 4 scalar ARG,IN 321,324 IIDFM Local 311 I(4) 4 scalar 317,319,329,350 IIDLA Local 311 I(4) 4 scalar 322,324,330,335,338,351,356,359,37 2,377,380 INA2I Subr 273 ISTAT Local 311 I(4) 4 scalar 332,336,340,344,353,357,361,365,37 4,378,382,386,408 IX Local 311 I(4) 4 scalar 333,337,341,345,354,358,362,366,37 5,379,383,387,393,395 IY Local 311 I(4) 4 scalar 331,333,337,339,341,345,352,354,35 8,360,362,366,373,375,379,381,383, 387,394,395 LX Dummy 273 I(4) 4 scalar ARG,IN 333,337,341,345,354,358,362,366,37 5,379,383,387,393 LY Dummy 273 I(4) 4 scalar ARG,IN 331,337,339,345,352,358,360,366,37 3,379,381,387,394 MX Dummy 273 I(4) 4 scalar ARG,IN 305 MY Dummy 273 I(4) 4 scalar ARG,IN 305 NDS Dummy 274 I(4) 4 scalar ARG,IN 332,336,340,344,353,357,361,365,37 4,378,382,386 NDSE Dummy 274 I(4) 4 scalar ARG,IN 404,408 NDST Dummy 274 I(4) 4 scalar ARG,IN RFORM Dummy 274 CHAR scalar ARG,IN 353,357,361,365 VOF Dummy 274 I(4) 4 scalar ARG,IN 395 VSC Dummy 274 I(4) 4 scalar ARG,IN 395 Page 12 Source Listing INA2I 2014-11-12 21:38 w3arrymd.f90 423 !/ ------------------------------------------------------------------- / 424 SUBROUTINE OUTA2R (ARRAY, MX, MY, LX, HX, LY, HY, & 425 NDS, NDST, NDSE, IDFM, RFORM, IDLA, VSC, VOF) 426 !/ 427 !/ +-----------------------------------+ 428 !/ | WAVEWATCH III NOAA/NCEP | 429 !/ | H. L. Tolman | 430 !/ | FORTRAN 90 | 431 !/ | Last update : 30-Oct-2009 | 432 !/ +-----------------------------------+ 433 !/ 434 !/ 31-Mar-1993 : Final FORTRAN 77 ( version 1.18 ) 435 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 436 !/ 21-Feb-2008 ; Bug fix IDFM=1, IDLA=2 writing ( version 3.13 ) 437 !/ 30-Oct-2009 ; Fix non-integer loop bound. ( version 3.14 ) 438 !/ (T. J. Campbell, NRL) 439 !/ 30-Oct-2009 : Implement add offset argument. ( version 3.14 ) 440 !/ (W. E. Rogers & T. J. Campbell, NRL) 441 !/ 442 ! 1. Purpose : 443 ! 444 ! Writes 2-D array of pre-described layout and format. "Inverse" 445 ! version of INA2R . For documentation see INA2R . 446 ! 447 ! N.B. - ARRAY_OUT <= ( ARRAY_IN - VOF ) / VSC 448 ! - No error trapping on write. 449 ! 450 ! 10. Source code : 451 ! 452 !/ ------------------------------------------------------------------- / 453 !/ 454 ! 455 IMPLICIT NONE 456 !/ 457 !/ ------------------------------------------------------------------- / 458 !/ Parameter list 459 !/ 460 INTEGER, INTENT(IN) :: MX, MY, LX, HX, LY, HY, NDS, NDST, & 461 NDSE, IDFM, IDLA 462 REAL, INTENT(IN) :: VSC, VOF, ARRAY(MX,MY) 463 CHARACTER, INTENT(IN) :: RFORM*(*) 464 !/ 465 !/ ------------------------------------------------------------------- / 466 !/ Local parameters 467 !/ 468 INTEGER :: IIDFM, IIDLA, IX, IY, ISTAT 469 !/ 470 !/ ------------------------------------------------------------------- / 471 !/ 472 ! 473 IF (IDFM.LT.1 .OR. IDFM.GT.3) THEN 474 IIDFM = 1 475 ELSE 476 IIDFM = IDFM 477 END IF 478 IF (IDLA.LT.1 .OR. IDLA.GT.4) THEN 479 IIDLA = 1 Page 13 Source Listing OUTA2R 2014-11-12 21:38 w3arrymd.f90 480 ELSE 481 IIDLA = IDLA 482 END IF 483 ! 484 ! Free format write : 485 ! 486 IF (IIDFM.EQ.1) THEN 487 IF (IIDLA.EQ.1) THEN 488 DO IY=LY, HY 489 WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & 490 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 491 END DO 492 ELSE IF (IIDLA.EQ.2) THEN 493 WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & 494 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,INT(HX/VSC)),IY=LY,HY) 495 ELSE IF (IIDLA.EQ.3) THEN 496 DO IY=HY, LY, -1 497 WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & 498 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 499 END DO 500 ELSE 501 WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & 502 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) 503 END IF 504 ! 505 ! Fixed format write : 506 ! 507 ELSE IF (IIDFM.EQ.2) THEN 508 IF (IIDLA.EQ.1) THEN 509 DO IY=LY, HY 510 WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & 511 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 512 END DO 513 ELSE IF (IIDLA.EQ.2) THEN 514 WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & 515 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=LY,HY) 516 ELSE IF (IIDLA.EQ.3) THEN 517 DO IY=HY, LY, -1 518 WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & 519 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 520 END DO 521 ELSE 522 WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & 523 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) 524 END IF 525 ! 526 ! Unformat write : 527 ! 528 ELSE 529 IF (IIDLA.EQ.1) THEN 530 DO IY=LY, HY 531 WRITE (NDS,ERR=800,IOSTAT=ISTAT) & 532 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 533 END DO 534 ELSE IF (IIDLA.EQ.2) THEN 535 WRITE (NDS,ERR=800,IOSTAT=ISTAT) & 536 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=LY,HY) Page 14 Source Listing OUTA2R 2014-11-12 21:38 w3arrymd.f90 537 ELSE IF (IIDLA.EQ.3) THEN 538 DO IY=HY, LY, -1 539 WRITE (NDS,ERR=800,IOSTAT=ISTAT) & 540 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 541 END DO 542 ELSE 543 WRITE (NDS,ERR=800,IOSTAT=ISTAT) & 544 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) 545 END IF 546 END IF 547 ! 548 RETURN 549 ! 550 ! Escape locations write errors : 551 ! 552 800 CONTINUE 553 WRITE (NDSE,900) ISTAT 554 STOP 555 ! 556 ! Formats 557 ! 558 900 FORMAT (/' *** ERROR OUTA2R : '/ & 559 ' ERROR IN WRITING TO FILE'/ & 560 ' IOSTAT =',I5/) 561 ! 562 !/ 563 !/ End of OUTA2R ----------------------------------------------------- / 564 !/ 565 END SUBROUTINE OUTA2R Page 15 Source Listing OUTA2R 2014-11-12 21:38 Entry Points w3arrymd.f90 ENTRY POINTS Name w3arrymd_mp_outa2r_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 800 Label 552 489,493,497,501,510,514,518,522,53 1,535,539,543 900 Label 558 553 ARRAY Dummy 424 R(4) 4 2 0 ARG,IN 490,494,498,502,511,515,519,523,53 2,536,540,544 HX Dummy 424 I(4) 4 scalar ARG,IN 490,494,498,502,511,515,519,523,53 2,536,540,544 HY Dummy 424 I(4) 4 scalar ARG,IN 488,494,496,502,509,515,517,523,53 0,536,538,544 IDFM Dummy 425 I(4) 4 scalar ARG,IN 473,476 IDLA Dummy 425 I(4) 4 scalar ARG,IN 478,481 IIDFM Local 468 I(4) 4 scalar 474,476,486,507 IIDLA Local 468 I(4) 4 scalar 479,481,487,492,495,508,513,516,52 9,534,537 INT Func 494 scalar 494 ISTAT Local 468 I(4) 4 scalar 489,493,497,501,510,514,518,522,53 1,535,539,543,553 IX Local 468 I(4) 4 scalar 490,494,498,502,511,515,519,523,53 2,536,540,544 IY Local 468 I(4) 4 scalar 488,490,494,496,498,502,509,511,51 5,517,519,523,530,532,536,538,540, 544 LX Dummy 424 I(4) 4 scalar ARG,IN 490,494,498,502,511,515,519,523,53 2,536,540,544 LY Dummy 424 I(4) 4 scalar ARG,IN 488,494,496,502,509,515,517,523,53 0,536,538,544 MX Dummy 424 I(4) 4 scalar ARG,IN 462 MY Dummy 424 I(4) 4 scalar ARG,IN 462 NDS Dummy 425 I(4) 4 scalar ARG,IN 489,493,497,501,510,514,518,522,53 1,535,539,543 NDSE Dummy 425 I(4) 4 scalar ARG,IN 553 NDST Dummy 425 I(4) 4 scalar ARG,IN OUTA2R Subr 424 RFORM Dummy 425 CHAR scalar ARG,IN 510,514,518,522 VOF Dummy 425 R(4) 4 scalar ARG,IN 490,494,498,502,511,515,519,523,53 2,536,540,544 VSC Dummy 425 R(4) 4 scalar ARG,IN 490,494,498,502,511,515,519,523,53 2,536,540,544 Page 16 Source Listing OUTA2R 2014-11-12 21:38 w3arrymd.f90 566 !/ ------------------------------------------------------------------- / 567 SUBROUTINE OUTA2I (ARRAY, MX, MY, LX, HX, LY, HY, & 568 NDS, NDST, NDSE, IDFM, RFORM, IDLA, VSC, VOF) 569 !/ 570 !/ +-----------------------------------+ 571 !/ | WAVEWATCH III NOAA/NCEP | 572 !/ | H. L. Tolman | 573 !/ | FORTRAN 90 | 574 !/ | Last update : 30-Oct-2009 | 575 !/ +-----------------------------------+ 576 !/ 577 !/ 31-Mar-1993 : Final FORTRAN 77 ( version 1.18 ) 578 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 579 !/ 30-Oct-2009 : Implement add offset argument. ( version 3.14 ) 580 !/ (W. E. Rogers & T. J. Campbell, NRL) 581 !/ 582 ! 1. Purpose : 583 ! 584 ! Like OUTA2R, integer ARRAY, VSC and VOF, see OUTA2R. 585 ! 586 ! 10. Source code : 587 ! 588 !/ ------------------------------------------------------------------- / 589 !/ 590 ! 591 IMPLICIT NONE 592 !/ 593 !/ ------------------------------------------------------------------- / 594 !/ Parameter list 595 !/ 596 INTEGER, INTENT(IN) :: MX, MY, LX, HX, LY, HY, NDS, NDST, & 597 NDSE, IDFM, IDLA, ARRAY(MX,MY) 598 INTEGER, INTENT(IN) :: VSC, VOF 599 CHARACTER, INTENT(IN) :: RFORM*(*) 600 !/ 601 !/ ------------------------------------------------------------------- / 602 !/ Local parameters 603 !/ 604 INTEGER :: IIDFM, IIDLA, IX, IY, ISTAT 605 !/ 606 !/ ------------------------------------------------------------------- / 607 !/ 608 ! 609 IF (IDFM.LT.1 .OR. IDFM.GT.3) THEN 610 IIDFM = 1 611 ELSE 612 IIDFM = IDFM 613 END IF 614 IF (IDLA.LT.1 .OR. IDLA.GT.4) THEN 615 IIDLA = 1 616 ELSE 617 IIDLA = IDLA 618 END IF 619 ! 620 ! Free format write : 621 ! 622 IF (IIDFM.EQ.1) THEN Page 17 Source Listing OUTA2I 2014-11-12 21:38 w3arrymd.f90 623 IF (IIDLA.EQ.1) THEN 624 DO IY=LY, HY 625 WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & 626 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 627 END DO 628 ELSE IF (IIDLA.EQ.2) THEN 629 WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & 630 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=LY,HY) 631 ELSE IF (IIDLA.EQ.3) THEN 632 DO IY=HY, LY, -1 633 WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & 634 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 635 END DO 636 ELSE 637 WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & 638 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) 639 END IF 640 ! 641 ! Fixed format write : 642 ! 643 ELSE IF (IIDFM.EQ.2) THEN 644 IF (IIDLA.EQ.1) THEN 645 DO IY=LY, HY 646 WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & 647 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 648 END DO 649 ELSE IF (IIDLA.EQ.2) THEN 650 WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & 651 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=LY,HY) 652 ELSE IF (IIDLA.EQ.3) THEN 653 DO IY=HY, LY, -1 654 WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & 655 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 656 END DO 657 ELSE 658 WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & 659 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) 660 END IF 661 ! 662 ! Unformat write : 663 ! 664 ELSE 665 IF (IIDLA.EQ.1) THEN 666 DO IY=LY, HY 667 WRITE (NDS,ERR=800,IOSTAT=ISTAT) & 668 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 669 END DO 670 ELSE IF (IIDLA.EQ.2) THEN 671 WRITE (NDS,ERR=800,IOSTAT=ISTAT) & 672 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=LY,HY) 673 ELSE IF (IIDLA.EQ.3) THEN 674 DO IY=HY, LY, -1 675 WRITE (NDS,ERR=800,IOSTAT=ISTAT) & 676 ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) 677 END DO 678 ELSE 679 WRITE (NDS,ERR=800,IOSTAT=ISTAT) & Page 18 Source Listing OUTA2I 2014-11-12 21:38 w3arrymd.f90 680 (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) 681 END IF 682 END IF 683 ! 684 RETURN 685 ! 686 ! Escape locations write errors : 687 ! 688 800 CONTINUE 689 WRITE (NDSE,900) ISTAT 690 STOP 691 ! 692 ! Formats 693 ! 694 900 FORMAT (/' *** ERROR OUTA2I : '/ & 695 ' ERROR IN WRITING TO FILE'/ & 696 ' IOSTAT =',I5/) 697 ! 698 !/ 699 !/ End of OUTA2I ----------------------------------------------------- / 700 !/ 701 END SUBROUTINE OUTA2I ENTRY POINTS Name w3arrymd_mp_outa2i_ Page 19 Source Listing OUTA2I 2014-11-12 21:38 Symbol Table w3arrymd.f90 SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 800 Label 688 625,629,633,637,646,650,654,658,66 7,671,675,679 900 Label 694 689 ARRAY Dummy 567 I(4) 4 2 0 ARG,IN 626,630,634,638,647,651,655,659,66 8,672,676,680 HX Dummy 567 I(4) 4 scalar ARG,IN 626,630,634,638,647,651,655,659,66 8,672,676,680 HY Dummy 567 I(4) 4 scalar ARG,IN 624,630,632,638,645,651,653,659,66 6,672,674,680 IDFM Dummy 568 I(4) 4 scalar ARG,IN 609,612 IDLA Dummy 568 I(4) 4 scalar ARG,IN 614,617 IIDFM Local 604 I(4) 4 scalar 610,612,622,643 IIDLA Local 604 I(4) 4 scalar 615,617,623,628,631,644,649,652,66 5,670,673 ISTAT Local 604 I(4) 4 scalar 625,629,633,637,646,650,654,658,66 7,671,675,679,689 IX Local 604 I(4) 4 scalar 626,630,634,638,647,651,655,659,66 8,672,676,680 IY Local 604 I(4) 4 scalar 624,626,630,632,634,638,645,647,65 1,653,655,659,666,668,672,674,676, 680 LX Dummy 567 I(4) 4 scalar ARG,IN 626,630,634,638,647,651,655,659,66 8,672,676,680 LY Dummy 567 I(4) 4 scalar ARG,IN 624,630,632,638,645,651,653,659,66 6,672,674,680 MX Dummy 567 I(4) 4 scalar ARG,IN 597 MY Dummy 567 I(4) 4 scalar ARG,IN 597 NDS Dummy 568 I(4) 4 scalar ARG,IN 625,629,633,637,646,650,654,658,66 7,671,675,679 NDSE Dummy 568 I(4) 4 scalar ARG,IN 689 NDST Dummy 568 I(4) 4 scalar ARG,IN OUTA2I Subr 567 RFORM Dummy 568 CHAR scalar ARG,IN 646,650,654,658 VOF Dummy 568 I(4) 4 scalar ARG,IN 626,630,634,638,647,651,655,659,66 8,672,676,680 VSC Dummy 568 I(4) 4 scalar ARG,IN 626,630,634,638,647,651,655,659,66 8,672,676,680 Page 20 Source Listing OUTA2I 2014-11-12 21:38 w3arrymd.f90 702 !/ ------------------------------------------------------------------- / 703 SUBROUTINE OUTREA (NDS,ARRAY,DIM,ANAME) 704 !/ 705 !/ +-----------------------------------+ 706 !/ | WAVEWATCH III NOAA/NCEP | 707 !/ | H. L. Tolman | 708 !/ | FORTRAN 90 | 709 !/ | Last update : 29-Nov-1999 | 710 !/ +-----------------------------------+ 711 !/ Original versions G. Ph. van Vledder 712 !/ P. H. Willems 713 !/ 714 !/ 29-Mar-1993 : Final FORTRAN 77 ( version 1.18 ) 715 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 716 !/ 717 ! 1. Purpose : 718 ! 719 ! Print contents of a 1-D real array, see OUTINT. 720 ! 721 !/ ------------------------------------------------------------------- / 722 !/ 723 ! 724 IMPLICIT NONE 725 !/ 726 !/ ------------------------------------------------------------------- / 727 !/ Parameter list 728 !/ 729 INTEGER, INTENT(IN) :: NDS, DIM 730 REAL, INTENT(IN) :: ARRAY(DIM) 731 CHARACTER, INTENT(IN) :: ANAME*(*) 732 !/ 733 !/ ------------------------------------------------------------------- / 734 !/ Local parameters 735 !/ 736 INTEGER :: I, K 737 !/ 738 !/ ------------------------------------------------------------------- / 739 !/ 740 ! 741 WRITE (NDS,8000) ANAME 742 ! 743 IF (ICOL.EQ.80) THEN 744 ! 745 WRITE (NDS,8005) (I, I=1, 5) 746 WRITE (NDS,8010) 747 DO K=0, DIM, 5 748 IF (DIM-K.GE.5) THEN 749 WRITE (NDS,'(1X,I4,A,5E12.4,A)') & 750 K,' |',(ARRAY(I),I= K+1, K+5),' |' 751 ELSE 752 WRITE (NDS,'(1X,T71,''|'',T2,I4,A,5E12.4)') & 753 K,' |',(ARRAY(I),I= K+1, DIM) 754 END IF 755 END DO 756 WRITE (NDS,8010) 757 ! 758 ELSE Page 21 Source Listing OUTREA 2014-11-12 21:38 w3arrymd.f90 759 ! 760 WRITE (NDS,9005) (I, I=1, 10) 761 WRITE (NDS,9010) 762 DO K=0, DIM, 10 763 IF (DIM-K.GE.10) THEN 764 WRITE (NDS,'(1X,I4,A,10E12.4,A)') & 765 K,' |',(ARRAY(I),I= K+1, K+10),' |' 766 ELSE 767 WRITE (NDS,'(1X,T131,''|'',T2,I4,A,10E12.4)') & 768 K,' |',(ARRAY(I),I= K+1, DIM) 769 END IF 770 END DO 771 WRITE (NDS,9010) 772 END IF 773 ! 774 RETURN 775 ! 776 8000 FORMAT (/,1X,'A R R A Y D U M P (REAL) / NAME: ',A) 777 8005 FORMAT (8X,5I12) 778 8010 FORMAT (7X,'+',62('-'),'+') 779 9005 FORMAT (8X,10I12) 780 9010 FORMAT (7X,'+',122('-'),'+') 781 !/ 782 !/ End of OUTREA ----------------------------------------------------- / 783 !/ 784 END SUBROUTINE OUTREA ENTRY POINTS Name w3arrymd_mp_outrea_ Page 22 Source Listing OUTREA 2014-11-12 21:38 Symbol Table w3arrymd.f90 SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 8000 Label 776 741 8005 Label 777 745 8010 Label 778 746,756 9005 Label 779 760 9010 Label 780 761,771 ANAME Dummy 703 CHAR scalar ARG,IN 741 ARRAY Dummy 703 R(4) 4 1 0 ARG,IN 750,753,765,768 DIM Dummy 703 I(4) 4 scalar ARG,IN 730,747,748,753,762,763,768 I Local 736 I(4) 4 scalar 745,750,753,760,765,768 ICOL Param 743 I(4) 4 scalar PRIV 69,743,849,957 K Local 736 I(4) 4 scalar 747,748,750,753,762,763,765,768 NDS Dummy 703 I(4) 4 scalar ARG,IN 741,745,746,749,752,756,760,761,76 4,767,771 OUTREA Subr 703 Page 23 Source Listing OUTREA 2014-11-12 21:38 w3arrymd.f90 785 !/ ------------------------------------------------------------------- / 786 SUBROUTINE OUTINT ( NDS, IARRAY, DIM, ANAME ) 787 !/ 788 !/ +-----------------------------------+ 789 !/ | WAVEWATCH III NOAA/NCEP | 790 !/ | H. L. Tolman | 791 !/ | FORTRAN 90 | 792 !/ | Last update : 29-Mar-1993 | 793 !/ +-----------------------------------+ 794 !/ Original versions G. Ph. van Vledder 795 !/ P. H. Willems 796 !/ 797 !/ 29-Mar-1993 : Final FORTRAN 77 ( version 1.18 ) 798 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 799 !/ 800 ! 1. Purpose : 801 ! 802 ! Print contents of a 1-D integer array. 803 ! 804 ! 2. Method : 805 ! 806 ! 3. Parameters : 807 ! 808 ! Parameter list 809 ! ---------------------------------------------------------------- 810 ! NDS Int. I Output unit number. 811 ! IARRAY I.A. I Array to be printed. 812 ! DIM Int. I Number of elements to be printed. 813 ! ANAME C*(*) I Name of array. 814 ! ---------------------------------------------------------------- 815 ! 816 ! 4. Subroutines used : 817 ! 818 ! See mudule documentation. 819 ! 820 ! 5. Called by : 821 ! 822 ! Anny routine or program. 823 ! 824 ! 10. Source code : 825 ! 826 !/ ------------------------------------------------------------------- / 827 !/ 828 ! 829 IMPLICIT NONE 830 !/ 831 !/ ------------------------------------------------------------------- / 832 !/ Parameter list 833 !/ 834 INTEGER, INTENT(IN) :: NDS, DIM, IARRAY(DIM) 835 CHARACTER, INTENT(IN) :: ANAME*(*) 836 !/ 837 !/ ------------------------------------------------------------------- / 838 !/ Local parameters 839 !/ 840 INTEGER :: I, K 841 !/ Page 24 Source Listing OUTINT 2014-11-12 21:38 w3arrymd.f90 842 !/ ------------------------------------------------------------------- / 843 !/ 844 ! 845 WRITE (NDS,8000) ANAME 846 ! 847 ! ------- 80 COLUMNS ----- 848 ! 849 IF (ICOL.EQ.80) THEN 850 WRITE (NDS,8005) (I, I=1, 5) 851 WRITE (NDS,8010) 852 DO K=0, DIM, 5 853 IF (DIM-K.GE.5) THEN 854 WRITE (NDS,'(1X,I4,A,5I12,A)') & 855 K,' |',(IARRAY(I),I= K+1, K+5),' |' 856 ELSE 857 WRITE (NDS,'(1X,T71,''|'',T2,I4,A,5I12)') & 858 K,' |',(IARRAY(I),I= K+1, DIM) 859 END IF 860 END DO 861 WRITE (NDS,8010) 862 ELSE 863 ! 864 ! ---- 132 COLUMNS ---- 865 ! 866 WRITE (NDS,9005) (I, I=1, 10) 867 WRITE (NDS,9010) 868 DO K=0, DIM, 10 869 IF (DIM-K.GE.10) THEN 870 WRITE (NDS,'(1X,I4,A,10I12,A)') & 871 K,' |',(IARRAY(I),I= K+1, K+10),' |' 872 ELSE 873 WRITE (NDS,'(1X,T131,''|'',T2,I4,A,10I12)') & 874 K,' |',(IARRAY(I),I= K+1, DIM) 875 END IF 876 END DO 877 WRITE (NDS,9010) 878 END IF 879 ! 880 RETURN 881 ! 882 8000 FORMAT (/,1X,'A R R A Y D U M P (INTEGER) / NAME: ',A) 883 8005 FORMAT (8X,5I12) 884 8010 FORMAT (7X,'+',62('-'),'+') 885 9005 FORMAT (8X,10I12) 886 9010 FORMAT (7X,'+',122('-'),'+') 887 !/ 888 !/ End of OUTINT ----------------------------------------------------- / 889 !/ 890 END SUBROUTINE OUTINT Page 25 Source Listing OUTINT 2014-11-12 21:38 Entry Points w3arrymd.f90 ENTRY POINTS Name w3arrymd_mp_outint_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 8000 Label 882 845 8005 Label 883 850 8010 Label 884 851,861 9005 Label 885 866 9010 Label 886 867,877 ANAME Dummy 786 CHAR scalar ARG,IN 845 DIM Dummy 786 I(4) 4 scalar ARG,IN 834,852,853,858,868,869,874 I Local 840 I(4) 4 scalar 850,855,858,866,871,874 IARRAY Dummy 786 I(4) 4 1 0 ARG,IN 855,858,871,874 K Local 840 I(4) 4 scalar 852,853,855,858,868,869,871,874 NDS Dummy 786 I(4) 4 scalar ARG,IN 845,850,851,854,857,861,866,867,87 0,873,877 OUTINT Subr 786 Page 26 Source Listing OUTINT 2014-11-12 21:38 w3arrymd.f90 891 !/ ------------------------------------------------------------------- / 892 SUBROUTINE OUTMAT (NDS,A,MX,NX,NY,MNAME) 893 !/ 894 !/ +-----------------------------------+ 895 !/ | WAVEWATCH III NOAA/NCEP | 896 !/ | H. L. Tolman | 897 !/ | FORTRAN 90 | 898 !/ | Last update : 29-Nov-1999 | 899 !/ +-----------------------------------+ 900 !/ Original versions G. Ph. van Vledder 901 !/ 902 !/ 29-Mar-1993 : Final FORTRAN 77 ( version 1.18 ) 903 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 904 !/ 905 ! 1. Purpose : 906 ! 907 ! Print contents of a 2-D real array. 908 ! 909 ! 2. Method : 910 ! 911 ! 3. Parameters : 912 ! 913 ! Parameter list 914 ! ---------------------------------------------------------------- 915 ! NDS Int. I Output unit number. 916 ! A R.A. I Matrix to be printed. 917 ! MX Int. I Dimension of first index. 918 ! NX Int. I Number of points for first index. 919 ! NY Int. I Number of points for scond index. 920 ! MNAME C*(*) I Name of matrix. 921 ! ---------------------------------------------------------------- 922 ! 923 ! 4. Subroutines used : 924 ! 925 ! See mudule documentation. 926 ! 927 ! 5. Called by : 928 ! 929 ! Anny routine or program. 930 ! 931 ! 10. Source code : 932 ! 933 !/ ------------------------------------------------------------------- / 934 !/ 935 ! 936 IMPLICIT NONE 937 !/ 938 !/ ------------------------------------------------------------------- / 939 !/ Parameter list 940 !/ 941 INTEGER, INTENT(IN) :: NDS, MX, NX, NY 942 REAL, INTENT(IN) :: A(MX,NY) 943 CHARACTER, INTENT(IN) :: MNAME*(*) 944 !/ 945 !/ ------------------------------------------------------------------- / 946 !/ Local parameters 947 !/ Page 27 Source Listing OUTMAT 2014-11-12 21:38 w3arrymd.f90 948 INTEGER :: LBLOK, NBLOK, IBLOK, IX, IX1, IX2, IY 949 !/ 950 !/ ------------------------------------------------------------------- / 951 !/ 952 ! 953 WRITE(NDS,8000) MNAME 954 ! 955 ! ------ 80 COLUMNS ----- 956 ! 957 IF(ICOL.EQ.80) THEN 958 LBLOK = 6 959 NBLOK = (NX-1)/LBLOK + 1 960 DO IBLOK = 1,NBLOK 961 IX1 = (IBLOK-1)*LBLOK + 1 962 IX2 = IX1 + LBLOK - 1 963 IF(IX2.GT.NX) IX2 = NX 964 WRITE(NDS,8001) (IX,IX = IX1,IX2) 965 WRITE(NDS,8002) 966 DO IY = 1,NY 967 WRITE(NDS,8003) IY,(A(IX,IY),IX = IX1,IX2) 968 END DO 969 WRITE(NDS,8002) 970 END DO 971 ELSE 972 ! 973 ! ---- 132 COLUMNS ---- 974 ! 975 LBLOK = 12 976 NBLOK = (NX-1)/LBLOK + 1 977 DO IBLOK = 1,NBLOK 978 IX1 = (IBLOK-1)*LBLOK + 1 979 IX2 = IX1 + LBLOK - 1 980 IF(IX2.GT.NX) IX2 = NX 981 WRITE(NDS,9001) (IX,IX = IX1,IX2) 982 WRITE(NDS,9002) 983 DO IY = 1,NY 984 WRITE(NDS,9003) IY,(A(IX,IY),IX = IX1,IX2) 985 END DO 986 WRITE(NDS,9002) 987 END DO 988 END IF 989 ! 990 RETURN 991 ! 992 ! Formats 993 ! 994 8000 FORMAT(/,1X,' M A T R I X D U M P (REAL) / NAME: ',A) 995 8001 FORMAT(9X,6I10) 996 8002 FORMAT(1X,6X,'+',62('-'),'+') 997 8003 FORMAT(1X,T71,'|',T2,I5,' | ',12E10.3) 998 9001 FORMAT(9X,12I10) 999 9002 FORMAT(1X,6X,'+',122('-'),'+') 1000 9003 FORMAT(1X,T131,'|',T2,I5,' | ',12E10.3) 1001 !/ 1002 !/ End of OUTMAT ----------------------------------------------------- / 1003 !/ 1004 END SUBROUTINE OUTMAT Page 28 Source Listing OUTMAT 2014-11-12 21:38 Entry Points w3arrymd.f90 ENTRY POINTS Name w3arrymd_mp_outmat_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 8000 Label 994 953 8001 Label 995 964 8002 Label 996 965,969 8003 Label 997 967 9001 Label 998 981 9002 Label 999 982,986 9003 Label 1000 984 A Dummy 892 R(4) 4 2 0 ARG,IN 967,984 IBLOK Local 948 I(4) 4 scalar 960,961,977,978 IX Local 948 I(4) 4 scalar 964,967,981,984 IX1 Local 948 I(4) 4 scalar 961,962,964,967,978,979,981,984 IX2 Local 948 I(4) 4 scalar 962,963,964,967,979,980,981,984 IY Local 948 I(4) 4 scalar 966,967,983,984 LBLOK Local 948 I(4) 4 scalar 958,959,961,962,975,976,978,979 MNAME Dummy 892 CHAR scalar ARG,IN 953 MX Dummy 892 I(4) 4 scalar ARG,IN 942 NBLOK Local 948 I(4) 4 scalar 959,960,976,977 NDS Dummy 892 I(4) 4 scalar ARG,IN 953,964,965,967,969,981,982,984,98 6 NX Dummy 892 I(4) 4 scalar ARG,IN 959,963,976,980 NY Dummy 892 I(4) 4 scalar ARG,IN 942,966,983 OUTMAT Subr 892 Page 29 Source Listing OUTMAT 2014-11-12 21:38 w3arrymd.f90 1005 !/ ------------------------------------------------------------------- / 1006 SUBROUTINE PRTBLK (NDS, NX, NY, MX, F, MAP, MAP0, FSC, & 1007 IX1, IX2, IX3, IY1, IY2, IY3, PRVAR, PRUNIT) 1008 !/ 1009 !/ +-----------------------------------+ 1010 !/ | WAVEWATCH III NOAA/NCEP | 1011 !/ | H. L. Tolman | 1012 !/ | FORTRAN 90 | 1013 !/ | Last update : 29-Nov-1999 | 1014 !/ +-----------------------------------+ 1015 !/ 1016 !/ 04-Jun-1996 : Final FORTRAN 77 ( version 1.18 ) 1017 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 1018 !/ 1019 ! 1. Purpose : 1020 ! 1021 ! Print a block-type table of a two-dimensional field using a 1022 ! land-sea array. 1023 ! 1024 ! 3. Parameters : 1025 ! 1026 ! Parameter list 1027 ! ---------------------------------------------------------------- 1028 ! NDS Int. I File unit number. 1029 ! NX, NY Int. I X and Y range of arrays. 1030 ! MY Int. I Actual X size of arrays. 1031 ! F R.A. I Array to pr presented. 1032 ! MAP I.A. I Map array for land points. 1033 ! MAP0 Int. I Map value for land points in MAP. 1034 ! FSC Real I Scaling factor. 1035 ! IX1-3 Int. I Firts, last, increment grid points in X 1036 ! direction. 1037 ! IY1-3 Int. I Id. Y direction. 1038 ! PRVAR C*(*) I Name of variable. 1039 ! PRUNIT C*(*) I Units of spectrum. 1040 ! ---------------------------------------------------------------- 1041 ! 1042 ! 4. Subroutines used : 1043 ! 1044 ! See mudule documentation. 1045 ! 1046 ! 5. Called by : 1047 ! 1048 ! Any program. 1049 ! 1050 ! 6. Error messages : 1051 ! 1052 ! None. 1053 ! 1054 ! 7. Remarks : 1055 ! 1056 ! 8. Structure : 1057 ! 1058 ! ------------------------------------------------ 1059 ! Check if automatic scaling 1060 ! If automatic scaling : get extermata 1061 ! Print heading Page 30 Source Listing PRTBLK 2014-11-12 21:38 w3arrymd.f90 1062 ! Print table 1063 ! Print ending 1064 ! ------------------------------------------------ 1065 ! 1066 ! 9. Switches : 1067 ! 1068 ! !/S Enable subroutine tracing using STRACE. 1069 ! 1070 ! 10. Source code : 1071 ! 1072 !/ ------------------------------------------------------------------- / 1073 !/ 1074 ! 1075 IMPLICIT NONE 1076 !/ 1077 !/ ------------------------------------------------------------------- / 1078 !/ Parameter list 1079 !/ 1080 INTEGER, INTENT(IN) :: NDS, NX, NY, MX, MAP(MX,NY), MAP0, & 1081 IX1, IX2, IX3, IY1, IY2, IY3 1082 REAL, INTENT(IN) :: F(MX,NY), FSC 1083 CHARACTER, INTENT(IN) :: PRVAR*(*), PRUNIT*(*) 1084 !/ 1085 !/ ------------------------------------------------------------------- / 1086 !/ Local parameters 1087 !/ 1088 INTEGER :: IX, IY, JJ, JM, K1, LX, I 1089 REAL :: FMAX, RR 1090 LOGICAL :: FLSCLE 1091 CHARACTER :: PNUM*5, STRA*5, PNUM2*2, STRA3*3 1092 DIMENSION :: PNUM(25), PNUM2(61) 1093 !/ 1094 !/ ------------------------------------------------------------------- / 1095 !/ 1096 ! 1097 ! Check scaling 1098 ! 1099 FLSCLE = (FSC.LE.0.) 1100 ! 1101 ! Extremata 1102 ! 1103 IF (FLSCLE) THEN 1104 FMAX = 1.E-15 1105 DO IX=1, NX 1106 DO IY=1, NY 1107 IF ( MAP(IX,IY) .NE. MAP0 ) & 1108 FMAX = MAX ( FMAX , ABS(F(IX,IY)) ) 1109 END DO 1110 END DO 1111 END IF 1112 ! 1113 ! Normalized print plot ----------------------------------------------- 1114 ! 1115 IF (FLSCLE) THEN 1116 ! 1117 ! Heading 1118 ! Page 31 Source Listing PRTBLK 2014-11-12 21:38 w3arrymd.f90 1119 WRITE (NDS,901) PRVAR, FMAX, PRUNIT 1120 ! 1121 STRA = ' ' 1122 JJ = 0 1123 DO IX = IX1, IX2, IX3 1124 JJ = JJ + 1 1125 END DO 1126 LX = JJ 1127 WRITE (NDS,911) 1128 WRITE (NDS,912) (IX,IX=IX1,IX2,2*IX3) 1129 PNUM2(1) = '--' 1130 WRITE (NDS,910) STRA, ' +', (PNUM2(1), I=1, LX), '-+' 1131 ! 1132 ! Write table 1133 ! 1134 JM = 0 1135 DO IY = IY2, IY1, IY3*(-1) 1136 ! 1137 JJ = 0 1138 DO IX = IX1, IX2, IX3 1139 JJ = JJ + 1 1140 IF (MAP(IX,IY).EQ.MAP0) THEN 1141 PNUM2(JJ) = ' ' 1142 ELSE 1143 RR = 10.*F(IX,IY)/FMAX 1144 WRITE (STRA, FMT='(I2,3X)') INT(RR*1.000001) 1145 PNUM2(JJ) = STRA(1:2) 1146 IF (PNUM2(JJ).EQ.'10' .OR. PNUM2(JJ).EQ.'**' .OR. & 1147 F(IX,IY).EQ.FMAX) THEN 1148 IF ( RR .LT. 0. ) THEN 1149 PNUM2(JJ) = '-*' 1150 ELSE 1151 PNUM2(JJ) = ' *' 1152 END IF 1153 END IF 1154 END IF 1155 END DO 1156 ! 1157 IF (JM.EQ.0) THEN 1158 WRITE (STRA, FMT='(I5)') IY 1159 JM = 2 1160 ELSE 1161 STRA = ' ' 1162 JM = JM-1 1163 END IF 1164 ! 1165 LX = JJ 1166 WRITE (NDS,910) STRA, ' |', (PNUM2(I), I=1, LX), ' |' 1167 END DO 1168 ! 1169 STRA = ' ' 1170 PNUM2(1) = '--' 1171 WRITE (NDS,910) STRA, ' +', (PNUM2(1), I=1, LX), '-+' 1172 WRITE (NDS,912) (IX,IX=IX1,IX2,2*IX3) 1173 WRITE (NDS,911) 1174 ! 1175 ! Non-normalized print plot ------------------------------------------- Page 32 Source Listing PRTBLK 2014-11-12 21:38 w3arrymd.f90 1176 ! 1177 ELSE 1178 ! 1179 ! Heading 1180 ! 1181 WRITE (NDS,900) PRVAR, FSC, PRUNIT 1182 ! 1183 JJ = 0 1184 PNUM(1) = ' ' 1185 DO IX = IX1, IX2, IX3 1186 JJ = JJ + 1 1187 END DO 1188 LX = JJ 1189 WRITE (NDS,921) 1190 WRITE (NDS,922) (IX,IX=IX1,IX2,IX3) 1191 STRA3 = ' ' 1192 PNUM(1) = '-----' 1193 WRITE (NDS,920) STRA3, ' +', (PNUM(1), I=1, LX), '-+ ' 1194 ! 1195 ! Write table 1196 ! 1197 JM = 0 1198 DO IY = IY2, IY1, IY3*(-1) 1199 IF (JM.EQ.0) THEN 1200 WRITE (STRA3, FMT='(I3)') IY 1201 JM = 2 1202 ELSE 1203 STRA3 = ' ' 1204 JM = JM-1 1205 END IF 1206 ! 1207 JJ = 0 1208 DO IX = IX1, IX2, IX3 1209 JJ = JJ + 1 1210 IF (MAP(IX,IY).EQ.MAP0) THEN 1211 PNUM(JJ) = ' ' 1212 ELSE 1213 RR = F(IX,IY) 1214 K1 = NINT (RR / FSC) 1215 WRITE (STRA, FMT='(I5)') K1 1216 PNUM(JJ) = STRA 1217 END IF 1218 END DO 1219 ! 1220 LX = JJ 1221 WRITE (NDS,920) STRA3, ' |', (PNUM(I), I=1, LX), ' | ' 1222 END DO 1223 ! 1224 STRA3 = ' ' 1225 PNUM(1) = '-----' 1226 WRITE (NDS,920) STRA3, ' +', (PNUM(1), I=1, LX), '-+ ' 1227 WRITE (NDS,922) (IX,IX=IX1,IX2,IX3) 1228 WRITE (NDS,921) 1229 ! 1230 END IF 1231 ! 1232 RETURN Page 33 Source Listing PRTBLK 2014-11-12 21:38 w3arrymd.f90 1233 ! 1234 ! Formats 1235 ! 1236 900 FORMAT (/, ' Variable: ',A,' Units: ',E10.3,1X,A) 1237 901 FORMAT (/, ' Variable: ',A,' Max.: ',E10.3,1X,A) 1238 ! 1239 910 FORMAT (1X,A5,63A2) 1240 911 FORMAT (' ') 1241 912 FORMAT (6X,36I4) 1242 ! 1243 920 FORMAT (1X,A3,A2,25A5) 1244 921 FORMAT (' ') 1245 922 FORMAT (6X,25I5) 1246 !/ 1247 !/ End of PRTBLK ----------------------------------------------------- / 1248 !/ 1249 END SUBROUTINE PRTBLK ENTRY POINTS Name w3arrymd_mp_prtblk_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 900 Label 1236 1181 901 Label 1237 1119 910 Label 1239 1130,1166,1171 911 Label 1240 1127,1173 912 Label 1241 1128,1172 920 Label 1243 1193,1221,1226 921 Label 1244 1189,1228 922 Label 1245 1190,1227 ABS Func 1108 scalar 1108 F Dummy 1006 R(4) 4 2 0 ARG,IN 1108,1143,1147,1213 FLSCLE Local 1090 L(4) 4 scalar 1099,1103,1115 FMAX Local 1089 R(4) 4 scalar 1104,1108,1119,1143,1147 FSC Dummy 1006 R(4) 4 scalar ARG,IN 1099,1181,1214 I Local 1088 I(4) 4 scalar 1130,1166,1171,1193,1221,1226 INT Func 1144 scalar 1144 IX Local 1088 I(4) 4 scalar 1105,1107,1108,1123,1128,1138,1140 ,1143,1147,1172,1185,1190,1208,121 0,1213,1227 IX1 Dummy 1007 I(4) 4 scalar ARG,IN 1123,1128,1138,1172,1185,1190,1208 ,1227 IX2 Dummy 1007 I(4) 4 scalar ARG,IN 1123,1128,1138,1172,1185,1190,1208 ,1227 IX3 Dummy 1007 I(4) 4 scalar ARG,IN 1123,1128,1138,1172,1185,1190,1208 ,1227 IY Local 1088 I(4) 4 scalar 1106,1107,1108,1135,1140,1143,1147 ,1158,1198,1200,1210,1213 IY1 Dummy 1007 I(4) 4 scalar ARG,IN 1135,1198 Page 34 Source Listing PRTBLK 2014-11-12 21:38 Symbol Table w3arrymd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References IY2 Dummy 1007 I(4) 4 scalar ARG,IN 1135,1198 IY3 Dummy 1007 I(4) 4 scalar ARG,IN 1135,1198 JJ Local 1088 I(4) 4 scalar 1122,1124,1126,1137,1139,1141,1145 ,1146,1149,1151,1165,1183,1186,118 8,1207,1209,1211,1216,1220 JM Local 1088 I(4) 4 scalar 1134,1157,1159,1162,1197,1199,1201 ,1204 K1 Local 1088 I(4) 4 scalar 1214,1215 LX Local 1088 I(4) 4 scalar 1126,1130,1165,1166,1171,1188,1193 ,1220,1221,1226 MAP Dummy 1006 I(4) 4 2 0 ARG,IN 1107,1140,1210 MAP0 Dummy 1006 I(4) 4 scalar ARG,IN 1107,1140,1210 MAX Func 1108 scalar 1108 MX Dummy 1006 I(4) 4 scalar ARG,IN 1080,1082 NDS Dummy 1006 I(4) 4 scalar ARG,IN 1119,1127,1128,1130,1166,1171,1172 ,1173,1181,1189,1190,1193,1221,122 6,1227,1228 NINT Func 1214 scalar 1214 NX Dummy 1006 I(4) 4 scalar ARG,IN 1105 NY Dummy 1006 I(4) 4 scalar ARG,IN 1080,1082,1106 PNUM Local 1091 CHAR 5 1 25 1184,1192,1193,1211,1216,1221,1225 ,1226 PNUM2 Local 1091 CHAR 2 1 61 1129,1130,1141,1145,1146,1149,1151 ,1166,1170,1171 PRTBLK Subr 1006 PRUNIT Dummy 1007 CHAR scalar ARG,IN 1119,1181 PRVAR Dummy 1007 CHAR scalar ARG,IN 1119,1181 RR Local 1089 R(4) 4 scalar 1143,1144,1148,1213,1214 STRA Local 1091 CHAR 5 scalar 1121,1130,1144,1145,1158,1161,1166 ,1169,1171,1215,1216 STRA3 Local 1091 CHAR 3 scalar 1191,1193,1200,1203,1221,1224,1226 Page 35 Source Listing PRTBLK 2014-11-12 21:38 w3arrymd.f90 1250 !/ ------------------------------------------------------------------- / 1251 SUBROUTINE PRT1DS (NDS, NFR, E, FR, UFR, NLINES, FTOPI, & 1252 PRVAR, PRUNIT, PNTNME) 1253 !/ 1254 !/ +-----------------------------------+ 1255 !/ | WAVEWATCH III NOAA/NCEP | 1256 !/ | H. L. Tolman | 1257 !/ | FORTRAN 90 | 1258 !/ | Last update : 29-Nov-1999 | 1259 !/ +-----------------------------------+ 1260 !/ 1261 !/ 10-Mar-1992 : Final FORTRAN 77 ( version 1.18 ) 1262 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 1263 !/ 1264 ! 1. Purpose : 1265 ! 1266 ! Produces a print plot of a 1-D spectrum. 1267 ! 1268 ! 3. Parameters : 1269 ! 1270 ! Parameter list 1271 ! ---------------------------------------------------------------- 1272 ! NDS Int. I File unit number. 1273 ! NFR Int. I Number of frequencies. 1274 ! E R.A. I Spectral densities. 1275 ! FR R.A. I Frequencies. 1276 ! UFR C*(*) I If 'HZ', frequencies in Hz, otherwise in 1277 ! rad/s (N.B., does not re-scale spectrum). 1278 ! NLINES Int. I Hight of plot in lines. 1279 ! FTOPI Real I Highest value of density in plot, 1280 ! if FTOPI.LE.0., automatic scaling. 1281 ! PRVAR C*(*) I Name of variable. 1282 ! PRUNIT C*(*) I Units of spectrum. 1283 ! PNTNME C*(*) I Name of location. 1284 ! ---------------------------------------------------------------- 1285 ! 1286 ! 4. Subroutines used : 1287 ! 1288 ! See mudule documentation. 1289 ! 1290 ! 5. Called by : 1291 ! 1292 ! Any routine. 1293 ! 1294 ! 6. Error messages : 1295 ! 1296 ! None. 1297 ! 1298 ! 7. Remarks : 1299 ! 1300 ! - Paperwidth is "set" by NFRMAX. 1301 ! 1302 ! 8. Structure : 1303 ! 1304 ! ------------------------------------------------ 1305 ! Initializations and preparations. 1306 ! Determine maximum of spectra. Page 36 Source Listing PRT1DS 2014-11-12 21:38 w3arrymd.f90 1307 ! Scaling / normalization. 1308 ! Printing of spectrum 1309 ! ---------------------------------------------- 1310 ! Print ID 1311 ! Print heading 1312 ! Print table 1313 ! Print ending 1314 ! ------------------------------------------------ 1315 ! 1316 ! 9. Switches : 1317 ! 1318 ! !/S Enable subroutine tracing using STRACE. 1319 ! 1320 ! 10. Source code : 1321 ! 1322 !/ ------------------------------------------------------------------- / 1323 !/ 1324 ! 1325 IMPLICIT NONE 1326 !/ 1327 !/ ------------------------------------------------------------------- / 1328 !/ Parameter list 1329 !/ 1330 INTEGER, INTENT(IN) :: NDS, NFR, NLINES 1331 REAL, INTENT(IN) :: FTOPI, E(NFR), FR(NFR) 1332 CHARACTER, INTENT(IN) :: PRVAR*(*), PRUNIT*(*), PNTNME*(*), & 1333 UFR*(*) 1334 !/ 1335 !/ ------------------------------------------------------------------- / 1336 !/ Local parameters 1337 !/ 1338 INTEGER :: NFRB, IFR, IL, IL0 1339 REAL, SAVE :: TOPFAC = 1.1 1340 REAL :: FTOP, RLINES, FACFR, FSC, FLINE, & 1341 EMAX, EMIN, EXTR, FLOC 1342 LOGICAL :: FLSCLE 1343 CHARACTER :: STRA*10, STRA2*2, PNUM2*2 1344 DIMENSION :: PNUM2(NFM2) 1345 !/ 1346 !/ ------------------------------------------------------------------- / 1347 !/ 1348 ! 1349 FTOP = FTOPI 1350 ! 1351 NFRB = MIN (NFR,50) 1352 RLINES = REAL(NLINES) 1353 FLSCLE = FTOP.LE.0. 1354 ! 1355 IF (UFR.EQ.'HZ') THEN 1356 FACFR = 1. 1357 ELSE 1358 FACFR = 0.159155 1359 END IF 1360 ! 1361 ! Maximum of 1-D spectrum 1362 ! 1363 EMAX = 0. Page 37 Source Listing PRT1DS 2014-11-12 21:38 w3arrymd.f90 1364 EMIN = 0. 1365 ! 1366 DO IFR=1, NFR 1367 EMAX = MAX ( EMAX , E(IFR) ) 1368 EMIN = MIN ( EMIN , E(IFR) ) 1369 END DO 1370 ! 1371 IF (EMAX.EQ.0. .AND. EMIN.EQ.0.) THEN 1372 EMAX = 1.E-20 1373 EMIN = -1.E-20 1374 END IF 1375 ! 1376 IF (EMAX.GT.ABS(EMIN)) THEN 1377 EXTR = EMAX 1378 ELSE 1379 EXTR = EMIN 1380 END IF 1381 ! 1382 ! Scaling / Normalization 1383 ! 1384 IF (FLSCLE) THEN 1385 IF (EMAX.GT.ABS(EMIN)) THEN 1386 FLOC = EMAX * TOPFAC 1387 FSC = FLOC / REAL(NINT(EMAX/(EMAX-EMIN)*RLINES)) 1388 ELSE 1389 FLOC = EMIN * TOPFAC 1390 FSC = FLOC / REAL(NINT(EMIN/(EMAX-EMIN)*RLINES)) 1391 FLOC = FTOP + RLINES*FSC 1392 IF (EMAX.LT.0.01*FSC) FTOP = 0. 1393 END IF 1394 ELSE 1395 FLOC = FTOP 1396 FSC = FLOC / RLINES 1397 IF (EMAX*EMIN.LT.0) FSC = 2.*FSC 1398 IF (EMAX.LT.0.01*FSC) FLOC = 0. 1399 END IF 1400 ! 1401 IL0 = MOD ( NINT(FLOC/FSC) , 2 ) + 1 1402 ! 1403 ! Print ID 1404 ! 1405 WRITE (NDS,900) PNTNME, PRVAR, EXTR, PRUNIT 1406 ! 1407 ! Print heading 1408 ! 1409 FLINE = FLOC 1410 IF (MOD(NLINES+IL0,2).EQ.0) THEN 1411 WRITE (STRA, FMT='(E10.3)') FLINE 1412 ELSE 1413 STRA= ' ' 1414 END IF 1415 ! 1416 DO IFR=1, NFRB 1417 IF ( NINT( (E(IFR)-FLINE)/FSC ) .EQ.0) THEN 1418 PNUM2(IFR) = '-*' 1419 ELSE 1420 PNUM2(IFR) = '--' Page 38 Source Listing PRT1DS 2014-11-12 21:38 w3arrymd.f90 1421 END IF 1422 END DO 1423 ! 1424 PNUM2(NFRB+1) = '-+' 1425 STRA2 = ' +' 1426 WRITE (NDS,910) STRA, STRA2, (PNUM2(IFR),IFR=1, NFRB+1) 1427 ! 1428 ! Print table 1429 ! 1430 DO IL = 1, NLINES-1 1431 FLINE = FLOC - FSC * REAL(IL) 1432 IF (ABS(FLINE).LT.0.01*FSC) FLINE = 0. 1433 IF (MOD(NLINES+IL0-IL,2).EQ.0) THEN 1434 WRITE (STRA, FMT='(E10.3)') FLINE 1435 STRA2 = ' +' 1436 ELSE 1437 STRA = ' ' 1438 STRA2 = ' |' 1439 END IF 1440 DO IFR=1, NFRB 1441 IF (ABS(FLINE).LT.0.1*FSC) THEN 1442 PNUM2(NFRB+1) = '-|' 1443 IF ( NINT( (E(IFR)-FLINE)/FSC ) .EQ.0) THEN 1444 PNUM2(IFR) = '-*' 1445 ELSE 1446 PNUM2(IFR) = '--' 1447 END IF 1448 ELSE 1449 PNUM2(NFRB+1) = ' |' 1450 IF ( NINT( (E(IFR)-FLINE)/FSC ) .EQ.0) THEN 1451 PNUM2(IFR) = ' *' 1452 ELSE 1453 PNUM2(IFR) = ' ' 1454 END IF 1455 END IF 1456 END DO 1457 WRITE (NDS,910) STRA, STRA2, (PNUM2(IFR),IFR=1, NFRB+1) 1458 END DO 1459 ! 1460 ! write ending 1461 ! 1462 FLINE = FLOC - FSC * REAL(IL) 1463 IF (ABS(FLINE).LT.0.01*FSC) FLINE = 0. 1464 WRITE (STRA, FMT='(E10.3)') FLINE 1465 IF (MOD(IL0,2).EQ.0) THEN 1466 WRITE (STRA, FMT='(E10.3)') FLINE 1467 ELSE 1468 STRA = ' ' 1469 END IF 1470 STRA2 = ' +' 1471 PNUM2(NFRB+1) = '-+' 1472 ! 1473 DO IFR=1, NFRB 1474 IF ( NINT( (E(IFR)-FLINE)/FSC ) .EQ.0) THEN 1475 PNUM2(IFR) = '-*' 1476 ELSE IF ( MOD (IFR-2,4) .EQ. 0 ) THEN 1477 PNUM2(IFR) = '-|' Page 39 Source Listing PRT1DS 2014-11-12 21:38 w3arrymd.f90 1478 ELSE 1479 PNUM2(IFR) = '--' 1480 END IF 1481 END DO 1482 ! 1483 WRITE (NDS,910) STRA, STRA2, (PNUM2(IFR),IFR=1, NFRB+1) 1484 WRITE (NDS,911) (FR(IFR)*FACFR,IFR=2,NFRB,4) 1485 WRITE (NDS,920) 1486 ! 1487 RETURN 1488 ! 1489 ! Formats 1490 ! 1491 900 FORMAT (/' Location : ',A & 1492 /' Spectrum : ',A,' Extreme value : ',E10.3,1X,A/) 1493 ! 1494 910 FORMAT (A10,A2,60A2) 1495 911 FORMAT (10X,15F8.3) 1496 ! 1497 920 FORMAT (' ') 1498 !/ 1499 !/ End of PRT1DS ----------------------------------------------------- / 1500 !/ 1501 END SUBROUTINE PRT1DS ENTRY POINTS Name w3arrymd_mp_prt1ds_ Page 40 Source Listing PRT1DS 2014-11-12 21:38 Symbol Table w3arrymd.f90 SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 900 Label 1491 1405 910 Label 1494 1426,1457,1483 911 Label 1495 1484 920 Label 1497 1485 ABS Func 1376 scalar 1376,1385,1432,1441,1463 E Dummy 1251 R(4) 4 1 0 ARG,IN 1367,1368,1417,1443,1450,1474 EMAX Local 1341 R(4) 4 scalar 1363,1367,1371,1372,1376,1377,1385 ,1386,1387,1390,1392,1397,1398 EMIN Local 1341 R(4) 4 scalar 1364,1368,1371,1373,1376,1379,1385 ,1387,1389,1390,1397 EXTR Local 1341 R(4) 4 scalar 1377,1379,1405 FACFR Local 1340 R(4) 4 scalar 1356,1358,1484 FLINE Local 1340 R(4) 4 scalar 1409,1411,1417,1431,1432,1434,1441 ,1443,1450,1462,1463,1464,1466,147 4 FLOC Local 1341 R(4) 4 scalar 1386,1387,1389,1390,1391,1395,1396 ,1398,1401,1409,1431,1462 FLSCLE Local 1342 L(4) 4 scalar 1353,1384 FR Dummy 1251 R(4) 4 1 0 ARG,IN 1484 FSC Local 1340 R(4) 4 scalar 1387,1390,1391,1392,1396,1397,1398 ,1401,1417,1431,1432,1441,1443,145 0,1462,1463,1474 FTOP Local 1340 R(4) 4 scalar 1349,1353,1391,1392,1395 FTOPI Dummy 1251 R(4) 4 scalar ARG,IN 1349 IFR Local 1338 I(4) 4 scalar 1366,1367,1368,1416,1417,1418,1420 ,1426,1440,1443,1444,1446,1450,145 1,1453,1457,1473,1474,1475,1476,14 77,1479,1483,1484 IL Local 1338 I(4) 4 scalar 1430,1431,1433,1462 IL0 Local 1338 I(4) 4 scalar 1401,1410,1433,1465 MAX Func 1367 scalar 1367 MIN Func 1351 scalar 1351,1368 MOD Func 1401 scalar 1401,1410,1433,1465,1476 NDS Dummy 1251 I(4) 4 scalar ARG,IN 1405,1426,1457,1483,1484,1485 NFM2 Param 1344 I(4) 4 scalar PRIV 71,1344 NFR Dummy 1251 I(4) 4 scalar ARG,IN 1331,1351,1366 NFRB Local 1338 I(4) 4 scalar 1351,1416,1424,1426,1440,1442,1449 ,1457,1471,1473,1483,1484 NINT Func 1387 scalar 1387,1390,1401,1417,1443,1450,1474 NLINES Dummy 1251 I(4) 4 scalar ARG,IN 1352,1410,1430,1433 PNTNME Dummy 1252 CHAR scalar ARG,IN 1405 PNUM2 Local 1343 CHAR 2 1 51 1418,1420,1424,1426,1442,1444,1446 ,1449,1451,1453,1457,1471,1475,147 7,1479,1483 PRT1DS Subr 1251 PRUNIT Dummy 1252 CHAR scalar ARG,IN 1405 PRVAR Dummy 1252 CHAR scalar ARG,IN 1405 REAL Func 1352 scalar 1352,1387,1390,1431,1462 RLINES Local 1340 R(4) 4 scalar 1352,1387,1390,1391,1396 STRA Local 1343 CHAR 10 scalar 1411,1413,1426,1434,1437,1457,1464 ,1466,1468,1483 Page 41 Source Listing PRT1DS 2014-11-12 21:38 Symbol Table w3arrymd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References STRA2 Local 1343 CHAR 2 scalar 1425,1426,1435,1438,1457,1470,1483 TOPFAC Local 1339 R(4) 4 scalar 1339,1386,1389 UFR Dummy 1251 CHAR scalar ARG,IN 1355 Page 42 Source Listing PRT1DS 2014-11-12 21:38 w3arrymd.f90 1502 !/ ------------------------------------------------------------------- / 1503 SUBROUTINE PRT1DM (NDS, NFR, NE, E, FR, UFR, NLINES, FTOPI, & 1504 PRVAR, PRUNIT, PNTNME) 1505 !/ 1506 !/ +-----------------------------------+ 1507 !/ | WAVEWATCH III NOAA/NCEP | 1508 !/ | H. L. Tolman | 1509 !/ | FORTRAN 90 | 1510 !/ | Last update : 17-Apr-1992 | 1511 !/ +-----------------------------------+ 1512 !/ 1513 !/ 17-Apr-1992 : Final FORTRAN 77 ( version 1.18 ) 1514 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 1515 !/ 1516 ! 1. Purpose : 1517 ! 1518 ! Produces a print plot of several 1-D spectra. 1519 ! 1520 ! 3. Parameters : 1521 ! 1522 ! Parameter list 1523 ! ---------------------------------------------------------------- 1524 ! NDS Int. I File unit number. 1525 ! NFR Int. I Number of frequencies. 1526 ! NE Int. I Number of spectra. 1527 ! E R.A. I Spectral densities. 1528 ! FR R.A. I Frequencies. 1529 ! UFR C* I If 'HZ', frequencies in Hz, otherwise in 1530 ! rad/s 1531 ! NLINES Int. I Hight of plot in lines. 1532 ! FTOPI Real I Highest value of density in plot, 1533 ! if FTOP.LE.0., automatic scaling. 1534 ! PRVAR C*(*) I Name of variable. 1535 ! PRUNIT C*(*) I Units of spectrum. 1536 ! PNTNME C*(*) I Name of location. 1537 ! ---------------------------------------------------------------- 1538 ! 1539 ! 4. Subroutines used : 1540 ! 1541 ! See mudule documentation. 1542 ! 1543 ! 5. Called by : 1544 ! 1545 ! Any routine. 1546 ! 1547 ! 6. Error messages : 1548 ! 1549 ! None. 1550 ! 1551 ! 7. Remarks : 1552 ! 1553 ! - Paperwidth is "set" by NFRMAX. 1554 ! 1555 ! 8. Structure : 1556 ! 1557 ! ------------------------------------------------ 1558 ! Initializations and preparations. Page 43 Source Listing PRT1DM 2014-11-12 21:38 w3arrymd.f90 1559 ! Determine maximum of spectrum. 1560 ! Scaling / normalization. 1561 ! Printing of spectrum 1562 ! ---------------------------------------------- 1563 ! Print ID 1564 ! Print heading 1565 ! Print table 1566 ! Print ending 1567 ! ------------------------------------------------ 1568 ! 1569 ! 9. Switches : 1570 ! 1571 ! !/S Enable subroutine tracing using STRACE. 1572 ! 1573 ! 10. Source code : 1574 ! 1575 !/ ------------------------------------------------------------------- / 1576 !/ 1577 ! 1578 IMPLICIT NONE 1579 !/ 1580 !/ ------------------------------------------------------------------- / 1581 !/ Parameter list 1582 !/ 1583 INTEGER, INTENT(IN) :: NDS, NFR, NE, NLINES 1584 REAL, INTENT(IN) :: FTOPI, E(NFR,NE), FR(NFR) 1585 CHARACTER, INTENT(IN) :: PRVAR*(*), PRUNIT*(*), PNTNME*(*), & 1586 UFR*(*) 1587 DIMENSION :: PRVAR(NE) 1588 !/ 1589 !/ ------------------------------------------------------------------- / 1590 !/ Local parameters 1591 !/ 1592 INTEGER, PARAMETER :: NFRMAX = 50 1593 INTEGER, PARAMETER :: NFM2 = NFRMAX+1 1594 INTEGER :: NFRB, IFR, IE, IL 1595 REAL, SAVE :: TOPFAC = 1.1 1596 REAL :: FTOP, RLINES, FACFR, FSC, FLINE, & 1597 EMAX, EMIN, EXTR, FLOC 1598 LOGICAL :: FLSCLE 1599 CHARACTER :: STRA*10, STRA2*2, STRAX*2, PNUM2*2 1600 DIMENSION :: PNUM2(NFM2) 1601 !/ 1602 !/ ------------------------------------------------------------------- / 1603 !/ 1604 ! 1605 ! Test output, echo input 1606 ! 1607 FTOP = FTOPI 1608 NFRB = MIN (NFR,50) 1609 RLINES = REAL(NLINES) 1610 FLSCLE = FTOP.LE.0. 1611 ! 1612 IF (UFR.EQ.'HZ') THEN 1613 FACFR = 1. 1614 ELSE 1615 FACFR = 0.159155 Page 44 Source Listing PRT1DM 2014-11-12 21:38 w3arrymd.f90 1616 END IF 1617 ! 1618 ! Maximum of 1-D spectrum 1619 ! 1620 EMAX = 0. 1621 EMIN = 0. 1622 ! 1623 DO IE=1, NE 1624 DO IFR=1, NFR 1625 EMAX = MAX ( EMAX , E(IFR,IE) ) 1626 EMIN = MIN ( EMIN , E(IFR,IE) ) 1627 END DO 1628 END DO 1629 ! 1630 IF (EMAX.EQ.0. .AND. EMIN.EQ.0.) THEN 1631 EMAX = 1.E-20 1632 EMIN = -1.E-20 1633 END IF 1634 ! 1635 IF (EMAX.GT.ABS(EMIN)) THEN 1636 EXTR = EMAX 1637 ELSE 1638 EXTR = EMIN 1639 END IF 1640 ! 1641 ! Scaling / Normalization 1642 ! 1643 IF (FLSCLE) THEN 1644 IF (EMAX.GT.ABS(EMIN)) THEN 1645 FTOP = EMAX * TOPFAC 1646 FSC = FTOP / REAL(NINT(EMAX/(EMAX-EMIN)*RLINES)) 1647 ELSE 1648 FTOP = EMIN * TOPFAC 1649 FSC = FTOP / REAL(NINT(EMIN/(EMAX-EMIN)*RLINES)) 1650 FTOP = FTOP + RLINES*FSC 1651 IF (ABS(FTOP).LT.0.01*FSC) FTOP = 0. 1652 END IF 1653 ELSE 1654 FSC = FTOP / RLINES 1655 IF (EMAX*EMIN.LT.0) FSC = 2.*FSC 1656 IF (EMAX.EQ.0.) FTOP = 0. 1657 END IF 1658 ! 1659 ! Print ID 1660 ! 1661 WRITE (NDS,900) PNTNME, EXTR, PRUNIT 1662 ! 1663 ! Print heading 1664 ! 1665 FLINE = FTOP 1666 IF (MOD(NLINES,2).EQ.0) THEN 1667 WRITE (STRA, FMT='(E10.3)') FLINE 1668 ELSE 1669 STRA= ' ' 1670 END IF 1671 ! 1672 DO IFR=1, NFRB Page 45 Source Listing PRT1DM 2014-11-12 21:38 w3arrymd.f90 1673 PNUM2(IFR) = '--' 1674 DO IE=1, NE 1675 IF ( NINT( (E(IFR,IE)-FLINE)/FSC ) .EQ.0) THEN 1676 IF (IE.LT.10) THEN 1677 WRITE (STRAX,'(A1,I1)') '-', IE 1678 ELSE 1679 WRITE (STRAX,'(I2)') IE 1680 END IF 1681 PNUM2(IFR) = STRAX 1682 END IF 1683 END DO 1684 END DO 1685 ! 1686 PNUM2(NFRB+1) = '-+' 1687 STRA2 = ' +' 1688 WRITE (NDS,910) STRA, STRA2, (PNUM2(IFR),IFR=1, NFRB+1) 1689 ! 1690 ! Print table 1691 ! 1692 PNUM2(NFRB+1) = ' |' 1693 ! 1694 DO IL = 1, NLINES-1 1695 FLINE = FTOP - FSC * REAL(IL) 1696 IF (ABS(FLINE).LT.0.01*FSC) FLINE = 0. 1697 IF (MOD(NLINES-IL,2).EQ.0) THEN 1698 WRITE (STRA, FMT='(E10.3)') FLINE 1699 STRA2 = ' +' 1700 ELSE 1701 STRA = ' ' 1702 STRA2 = ' |' 1703 END IF 1704 DO IFR=1, NFRB 1705 PNUM2(NFRB+1) = ' |' 1706 IF (ABS(FLINE).LT.0.1*FSC) THEN 1707 PNUM2(IFR) = '--' 1708 PNUM2(NFRB+1) = '-+' 1709 DO IE=1, NE 1710 IF ( NINT( (E(IFR,IE)-FLINE)/FSC ) .EQ.0) THEN 1711 IF (IE.LT.10) THEN 1712 WRITE (STRAX,'(A1,I1)') '-', IE 1713 ELSE 1714 WRITE (STRAX,'(I2)') IE 1715 END IF 1716 PNUM2(IFR) = STRAX 1717 END IF 1718 END DO 1719 ELSE 1720 PNUM2(IFR) = ' ' 1721 DO IE=1, NE 1722 IF ( NINT( (E(IFR,IE)-FLINE)/FSC ) .EQ.0) THEN 1723 WRITE (STRAX,'(I2)') IE 1724 PNUM2(IFR) = STRAX 1725 END IF 1726 END DO 1727 END IF 1728 END DO 1729 WRITE (NDS,910) STRA, STRA2, (PNUM2(IFR),IFR=1, NFRB+1) Page 46 Source Listing PRT1DM 2014-11-12 21:38 w3arrymd.f90 1730 END DO 1731 ! 1732 ! write ending 1733 ! 1734 FLINE = FTOP - FSC * REAL(IL) 1735 IF (ABS(FLINE).LT.0.01*FSC) FLINE = 0. 1736 WRITE (STRA, FMT='(E10.3)') FLINE 1737 STRA2 = ' +' 1738 PNUM2(NFRB+1) = '-+' 1739 ! 1740 DO IFR=1, NFRB 1741 IF ( MOD (IFR-2,4) .EQ. 0 ) THEN 1742 PNUM2(IFR) = '-|' 1743 ELSE 1744 PNUM2(IFR) = '--' 1745 END IF 1746 DO IE=1, NE 1747 IF ( NINT( (E(IFR,IE)-FLINE)/FSC ) .EQ.0) THEN 1748 IF (IE.LT.10) THEN 1749 WRITE (STRAX,'(A1,I1)') '-', IE 1750 ELSE 1751 WRITE (STRAX,'(I2)') IE 1752 END IF 1753 PNUM2(IFR) = STRAX 1754 END IF 1755 END DO 1756 END DO 1757 ! 1758 WRITE (NDS,910) STRA, STRA2, (PNUM2(IFR),IFR=1, NFRB+1) 1759 WRITE (NDS,911) (FR(IFR)*FACFR,IFR=2,NFRB,4) 1760 WRITE (NDS,920) 1761 WRITE (NDS,921) (PRVAR(IE),IE=1,NE) 1762 WRITE (NDS,920) 1763 IF (FLSCLE) FTOP = 0. 1764 ! 1765 RETURN 1766 ! 1767 ! Formats 1768 ! 1769 900 FORMAT (/' Location : ',A & 1770 /' Extreme value : ',E10.3,1X,A/) 1771 ! 1772 910 FORMAT (A10,A2,60A2) 1773 911 FORMAT (10X,15F8.3) 1774 ! 1775 920 FORMAT (' ') 1776 921 FORMAT (10X,'spectra : ',10(A,' ')/) 1777 !/ 1778 !/ End of PRT1DM ----------------------------------------------------- / 1779 !/ 1780 END SUBROUTINE PRT1DM Page 47 Source Listing PRT1DM 2014-11-12 21:38 Entry Points w3arrymd.f90 ENTRY POINTS Name w3arrymd_mp_prt1dm_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 900 Label 1769 1661 910 Label 1772 1688,1729,1758 911 Label 1773 1759 920 Label 1775 1760,1762 921 Label 1776 1761 ABS Func 1635 scalar 1635,1644,1651,1696,1706,1735 E Dummy 1503 R(4) 4 2 0 ARG,IN 1625,1626,1675,1710,1722,1747 EMAX Local 1597 R(4) 4 scalar 1620,1625,1630,1631,1635,1636,1644 ,1645,1646,1649,1655,1656 EMIN Local 1597 R(4) 4 scalar 1621,1626,1630,1632,1635,1638,1644 ,1646,1648,1649,1655 EXTR Local 1597 R(4) 4 scalar 1636,1638,1661 FACFR Local 1596 R(4) 4 scalar 1613,1615,1759 FLINE Local 1596 R(4) 4 scalar 1665,1667,1675,1695,1696,1698,1706 ,1710,1722,1734,1735,1736,1747 FLOC Local 1597 R(4) 4 scalar FLSCLE Local 1598 L(4) 4 scalar 1610,1643,1763 FR Dummy 1503 R(4) 4 1 0 ARG,IN 1759 FSC Local 1596 R(4) 4 scalar 1646,1649,1650,1651,1654,1655,1675 ,1695,1696,1706,1710,1722,1734,173 5,1747 FTOP Local 1596 R(4) 4 scalar 1607,1610,1645,1646,1648,1649,1650 ,1651,1654,1656,1665,1695,1734,176 3 FTOPI Dummy 1503 R(4) 4 scalar ARG,IN 1607 IE Local 1594 I(4) 4 scalar 1623,1625,1626,1674,1675,1676,1677 ,1679,1709,1710,1711,1712,1714,172 1,1722,1723,1746,1747,1748,1749,17 51,1761 IFR Local 1594 I(4) 4 scalar 1624,1625,1626,1672,1673,1675,1681 ,1688,1704,1707,1710,1716,1720,172 2,1724,1729,1740,1741,1742,1744,17 47,1753,1758,1759 IL Local 1594 I(4) 4 scalar 1694,1695,1697,1734 MAX Func 1625 scalar 1625 MIN Func 1608 scalar 1608,1626 MOD Func 1666 scalar 1666,1697,1741 NDS Dummy 1503 I(4) 4 scalar ARG,IN 1661,1688,1729,1758,1759,1760,1761 ,1762 NE Dummy 1503 I(4) 4 scalar ARG,IN 1584,1587,1623,1674,1709,1721,1746 ,1761 NFM2 Param 1593 I(4) 4 scalar 1600 NFR Dummy 1503 I(4) 4 scalar ARG,IN 1584,1608,1624 NFRB Local 1594 I(4) 4 scalar 1608,1672,1686,1688,1692,1704,1705 Page 48 Source Listing PRT1DM 2014-11-12 21:38 Symbol Table w3arrymd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References ,1708,1729,1738,1740,1758,1759 NFRMAX Param 1592 I(4) 4 scalar 1593 NINT Func 1646 scalar 1646,1649,1675,1710,1722,1747 NLINES Dummy 1503 I(4) 4 scalar ARG,IN 1609,1666,1694,1697 PNTNME Dummy 1504 CHAR scalar ARG,IN 1661 PNUM2 Local 1599 CHAR 2 1 51 1673,1681,1686,1688,1692,1705,1707 ,1708,1716,1720,1724,1729,1738,174 2,1744,1753,1758 PRT1DM Subr 1503 PRUNIT Dummy 1504 CHAR scalar ARG,IN 1661 PRVAR Dummy 1504 CHAR 1 0 ARG,IN 1761 REAL Func 1609 scalar 1609,1646,1649,1695,1734 RLINES Local 1596 R(4) 4 scalar 1609,1646,1649,1650,1654 STRA Local 1599 CHAR 10 scalar 1667,1669,1688,1698,1701,1729,1736 ,1758 STRA2 Local 1599 CHAR 2 scalar 1687,1688,1699,1702,1729,1737,1758 STRAX Local 1599 CHAR 2 scalar 1677,1679,1681,1712,1714,1716,1723 ,1724,1749,1751,1753 TOPFAC Local 1595 R(4) 4 scalar 1595,1645,1648 UFR Dummy 1503 CHAR scalar ARG,IN 1612 Page 49 Source Listing PRT1DM 2014-11-12 21:38 w3arrymd.f90 1781 !/ ------------------------------------------------------------------- / 1782 SUBROUTINE PRT2DS (NDS, NFR0, NFR, NTH, E, FR, UFR, FACSP, FSC, & 1783 RRCUT, PRVAR, PRUNIT, PNTNME) 1784 !/ 1785 !/ +-----------------------------------+ 1786 !/ | WAVEWATCH III NOAA/NCEP | 1787 !/ | H. L. Tolman | 1788 !/ | FORTRAN 90 | 1789 !/ | Last update : 29-Nov-1999 | 1790 !/ +-----------------------------------+ 1791 !/ 1792 !/ 07-Jun-1996 : Final FORTRAN 77 ( version 1.18 ) 1793 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 1794 !/ 1795 ! 1. Purpose : 1796 ! 1797 ! Prints a block type table of a 2-D spectrum. Input considers 1798 ! cartesian directions, output according to meteorological 1799 ! conventions (compass direction where waves come from). 1800 ! 1801 ! 3. Parameters : 1802 ! 1803 ! Parameter list 1804 ! ---------------------------------------------------------------- 1805 ! NDS Int. I File unit number. 1806 ! NFR0 Int. I Array size for freq. 1807 ! NFR Int. I Number of frequencies. 1808 ! NTH Int. I Number of frequencies. 1809 ! E R.A. I Spectral densities. 1810 ! FR R.A. I Frequencies. 1811 ! UFR C*(*) I If 'HZ', frequencies in Hz, otherwise in 1812 ! rad/s 1813 ! FACSP Real I Conversion factor to obtain (Hz,degr) 1814 ! spectrum from E 1815 ! FSC Real I Scale factor, if FSC.eq.0. automatic 1816 ! scaling for "compressed" block. 1817 ! RRCUT Real I Relative cut-off for printing. 1818 ! PRVAR C*(*) I Name of variable. 1819 ! PRUNIT C*(*) I Units of spectrum. 1820 ! PNTNME C*(*) I Name of location. 1821 ! ---------------------------------------------------------------- 1822 ! 1823 ! 4. Subroutines used : 1824 ! 1825 ! ANGSTR (Internal) 1826 ! 1827 ! 5. Called by : 1828 ! 1829 ! Any program. 1830 ! 1831 ! 6. Error messages : 1832 ! 1833 ! None. 1834 ! 1835 ! 7. Remarks : 1836 ! 1837 ! PNUM2: dimensioning changed from 51 to 71 due to "subscript out Page 50 Source Listing ANGSTR 2014-11-12 21:38 w3arrymd.f90 1838 ! of range" fault (Sep 28 2012) 1839 ! 1840 ! 8. Structure : 1841 ! 1842 ! ------------------------------------------------ 1843 ! Initializations and preparations. 1844 ! Determine maximum of spectrum. 1845 ! Scaling / normalization. 1846 ! Do for normalized or non-norm. spectrum 1847 ! ---------------------------------------------- 1848 ! Print ID 1849 ! Print heading 1850 ! Print table 1851 ! Print ending 1852 ! ------------------------------------------------ 1853 ! 1854 ! 9. Switches : 1855 ! 1856 ! !/S Enable subroutine tracing using STRACE. 1857 ! !/T Diagnostic test output. 1858 ! 1859 ! 10. Source code : 1860 ! 1861 !/ ------------------------------------------------------------------- / 1862 !/ 1863 ! 1864 IMPLICIT NONE 1865 !/ 1866 !/ ------------------------------------------------------------------- / 1867 !/ Parameter list 1868 !/ 1869 INTEGER, INTENT(IN) :: NDS, NFR0, NFR, NTH 1870 REAL, INTENT(IN) :: E(NFR0,*), FR(*), FACSP, FSC, RRCUT 1871 CHARACTER, INTENT(IN) :: PRVAR*(*), PRUNIT*(*), PNTNME*(*), & 1872 UFR*(*) 1873 !/ 1874 !/ ------------------------------------------------------------------- / 1875 !/ Local parameters 1876 !/ 1877 INTEGER :: IFR, ITH, NFRB, INTANG, ITHSEC 1878 LOGICAL :: FLSCLE 1879 REAL :: FACFR, EMAX, EMIN, DTHDEG, RR, RRC 1880 CHARACTER :: PNUM*5, STRA*5, STRANG*5, PNUM2*2, & 1881 STRA2*2 1882 DIMENSION :: PNUM(25), PNUM2(71) 1883 !/ 1884 !/ ------------------------------------------------------------------- / 1885 !/ 1886 ! 1887 ! initialisations 1888 ! 1889 FLSCLE = .FALSE. 1890 IF (FSC.EQ.0.) THEN 1891 FLSCLE = .TRUE. 1892 RRC = RRCUT * 10. 1893 END IF 1894 ! Page 51 Source Listing ANGSTR 2014-11-12 21:38 w3arrymd.f90 1895 IF (UFR.EQ.'HZ') THEN 1896 FACFR = 1. 1897 ELSE 1898 FACFR = 0.159155 1899 END IF 1900 ! 1901 ! Maximum of spectrum 1902 ! 1903 EMAX = 1.E-20 1904 EMIN = 0. 1905 ! 1906 DO IFR=1, NFR 1907 DO ITH=1, NTH 1908 EMAX = MAX ( EMAX , E(IFR,ITH) ) 1909 EMIN = MIN ( EMIN , E(IFR,ITH) ) 1910 END DO 1911 END DO 1912 ! 1913 EMAX = MAX (EMAX, ABS(EMIN) ) 1914 ! 1915 DTHDEG = 360. / REAL(NTH) 1916 ! 1917 ! Normalized spectra : = = = = = = = = = = = = = = = = = = = = = = 1918 ! 1919 IF (FLSCLE) THEN 1920 ! 1921 ! Write ID 1922 ! 1923 WRITE (NDS,900) PNTNME, PRVAR, EMAX*FACSP, PRUNIT 1924 ! 1925 ! Write Head 1926 ! 1927 NFRB = MIN (NFR,50) 1928 WRITE (NDS,910) (FR(IFR)*FACFR,IFR=2,NFRB,4) 1929 ! 1930 DO IFR=1, NFR 1931 IF ( MOD((IFR-2),4) .EQ. 0) THEN 1932 PNUM2(IFR) = '-|' 1933 ELSE 1934 PNUM2(IFR) = '--' 1935 END IF 1936 END DO 1937 ! 1938 PNUM2(NFRB+1) = '-+' 1939 WRITE (NDS,920) (PNUM2(IFR),IFR=1, NFRB+1) 1940 ! 1941 ! Write table 1942 ! 1943 ITHSEC = NTH + 1 1944 ! 1945 DO ITH= NTH, 1, -1 1946 INTANG = 270 - NINT (DTHDEG*REAL(ITH-1)) 1947 IF (INTANG.LT.0) THEN 1948 ITHSEC = ITH 1949 CYCLE 1950 END IF 1951 CALL ANGSTR (INTANG, STRANG, 4, 2) Page 52 Source Listing ANGSTR 2014-11-12 21:38 w3arrymd.f90 1952 DO IFR=1, NFRB 1953 RR = E(IFR,ITH)/EMAX 1954 IF (E(IFR,ITH).EQ.EMAX .OR. RR.GE.1.) THEN 1955 PNUM2(IFR) = ' *' 1956 ELSE IF (-E(IFR,ITH).EQ.EMAX .OR. RR.LE.-1.) THEN 1957 PNUM2(IFR) = ' #' 1958 ELSE IF (ABS(RR).LT.RRC) THEN 1959 PNUM2(IFR) = ' ' 1960 ELSE IF ((RR*10.).LT.0. .AND. (RR*10.).GT.-1.) THEN 1961 PNUM2(IFR) = '-0' 1962 ELSE 1963 WRITE (STRA2, FMT='(I2)') INT (RR*10.) 1964 PNUM2(IFR) = STRA2 1965 END IF 1966 END DO 1967 PNUM2(NFRB+1) = ' |' 1968 WRITE (NDS,930) STRANG, (PNUM2(IFR),IFR=1, NFRB+1) 1969 END DO 1970 ! 1971 DO ITH= NTH, ITHSEC, -1 1972 INTANG = 630 - NINT (DTHDEG*REAL(ITH-1)) 1973 CALL ANGSTR (INTANG, STRANG, 4, 2) 1974 DO IFR=1, NFRB 1975 RR = E(IFR,ITH)/EMAX 1976 IF (E(IFR,ITH).EQ.EMAX .OR. RR.GE.1.) THEN 1977 PNUM2(IFR) = ' *' 1978 ELSE IF (-E(IFR,ITH).EQ.EMAX .OR. RR.LE.-1.) THEN 1979 PNUM2(IFR) = ' #' 1980 ELSE IF (ABS(RR).LT.RRC) THEN 1981 PNUM2(IFR) = ' ' 1982 ELSE IF ((RR*10.).LT.0. .AND. (RR*10.).GT.-1.) THEN 1983 PNUM2(IFR) = '-0' 1984 ELSE 1985 WRITE (STRA2, FMT='(I2)') INT (RR*10.) 1986 PNUM2(IFR) = STRA2 1987 END IF 1988 END DO 1989 PNUM2(NFRB+1) = ' |' 1990 WRITE (NDS,930) STRANG, (PNUM2(IFR),IFR=1, NFRB+1) 1991 END DO 1992 ! 1993 ! Write ending: 1994 ! 1995 PNUM2(1) = '--' 1996 PNUM2(2) = '-+' 1997 WRITE (NDS,920) (PNUM2(1),IFR=1, NFRB), PNUM2(2) 1998 WRITE (NDS,950) 1999 ! 2000 ! Scaled spectra : = = = = = = = = = = = = = = = = = = = = = = = = 2001 ! 2002 ELSE 2003 ! 2004 ! Write ID 2005 ! 2006 WRITE (NDS,901) PNTNME, PRVAR, FSC, PRUNIT, & 2007 EMAX*FACSP, PRUNIT 2008 ! Page 53 Source Listing ANGSTR 2014-11-12 21:38 w3arrymd.f90 2009 ! Write heading 2010 ! 2011 NFRB = MIN (NFR,25) 2012 ! 2013 WRITE (NDS,911) (FR(IFR)*FACFR,IFR=2,NFRB,2) 2014 PNUM(1) = '-----' 2015 PNUM(2) = '-- ' 2016 ! 2017 IF (NFRB.LT.25) THEN 2018 WRITE (NDS,921) (PNUM(1),IFR=1, NFRB), PNUM(2) 2019 ELSE 2020 WRITE (NDS,921) (PNUM(1),IFR=1, NFRB) 2021 END IF 2022 ! 2023 ! write table : 2024 ! 2025 ITHSEC = NTH + 1 2026 ! 2027 DO ITH= NTH, 1, -1 2028 INTANG = 270 - NINT (DTHDEG*REAL(ITH-1)) 2029 IF (INTANG.LT.0) THEN 2030 ITHSEC = ITH 2031 CYCLE 2032 END IF 2033 CALL ANGSTR (INTANG, STRANG, 4, 2) 2034 DO IFR=1, NFRB 2035 RR = E(IFR,ITH) 2036 IF (ABS(RR/EMAX).LT.RRCUT) THEN 2037 PNUM(IFR) = ' ' 2038 ELSE 2039 WRITE (STRA, FMT='(I5)') NINT (RR*FACSP/FSC) 2040 PNUM(IFR) = STRA 2041 END IF 2042 END DO 2043 WRITE (NDS,931) STRANG, (PNUM(IFR),IFR=1, NFRB) 2044 END DO 2045 ! 2046 DO ITH= NTH, ITHSEC, -1 2047 INTANG = 630 - NINT (DTHDEG*REAL(ITH-1)) 2048 CALL ANGSTR (INTANG, STRANG, 4, 2) 2049 DO IFR=1, NFRB 2050 RR = E(IFR,ITH) 2051 IF (ABS(RR/EMAX).LT.RRCUT) THEN 2052 PNUM(IFR) = ' ' 2053 ELSE 2054 WRITE (STRA, FMT='(I5)') NINT (RR*FACSP/FSC) 2055 PNUM(IFR) = STRA 2056 END IF 2057 END DO 2058 WRITE (NDS,931) STRANG, (PNUM(IFR),IFR=1, NFRB) 2059 END DO 2060 ! 2061 ! write ending : 2062 ! 2063 PNUM(1) = '-----' 2064 PNUM(2) = '-- ' 2065 IF (NFRB.LT.25) THEN Page 54 Source Listing ANGSTR 2014-11-12 21:38 w3arrymd.f90 2066 WRITE (NDS,921) (PNUM(1),IFR=1, NFRB), PNUM(2) 2067 ELSE 2068 WRITE (NDS,921) (PNUM(1),IFR=1, NFRB) 2069 END IF 2070 WRITE (NDS,950) 2071 ! 2072 END IF 2073 ! 2074 RETURN 2075 ! 2076 ! Formats 2077 ! 2078 900 FORMAT (/' Location : ',A/ & 2079 ' Spectrum : ',A,' (Normalized) ', & 2080 ' Maximum value : ',E8.3,1X,A/) .....................................1 (1) Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edit descriptor is 'W>=D+7'. 2081 901 FORMAT (/' Location : ',A/ & 2082 ' Spectrum : ',A,' Units : ',E8.3,1X,A, & ...............................................1 (1) Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edit descriptor is 'W>=D+7'. 2083 ' Maximum value : ',E8.3,1X,A/) .....................................1 (1) Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edit descriptor is 'W>=D+7'. 2084 ! 2085 910 FORMAT (5X,' ang.| frequencies (Hz) '/ & 2086 5X,' deg.|',F6.3,15F8.3) 2087 920 FORMAT (5X,' ----+',60A2) 2088 930 FORMAT (5X,' ',A4,' |',60A2) 2089 ! 2090 911 FORMAT (' ang.| frequencies (Hz) '/ & 2091 ' deg.|',12F10.3) 2092 921 FORMAT (' ----|',25A5) 2093 931 FORMAT (' ',A4,' |',25A5) 2094 ! 2095 950 FORMAT (' ') 2096 ! 2097 !/ 2098 !/ Internal subroutine ANGSTR ---------------------------------------- / 2099 !/ 2100 CONTAINS 2101 !/ 2102 !/ ------------------------------------------------------------------- / 2103 SUBROUTINE ANGSTR (IANG, SANG, ILEN, INUM) 2104 !/ 2105 !/ +-----------------------------------+ 2106 !/ | WAVEWATCH III NOAA/NCEP | 2107 !/ | H. L. Tolman | 2108 !/ | FORTRAN 90 | 2109 !/ | Last update : 29-Nov-1999 | 2110 !/ +-----------------------------------+ 2111 !/ 2112 !/ 10-Mar-1992 : Final FORTRAN 77 ( version 1.18 ) 2113 !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) Page 55 Source Listing ANGSTR 2014-11-12 21:38 w3arrymd.f90 2114 ! 2115 ! INPUT : IANG --> INTEGER ANGLE (DEGREES) 2116 ! ILEN --> STRING LENGTH 2117 ! INUM --> <1 : ONLY FOUR MAIN DIRECTIONS 2118 ! 1 : N,E,S,W AND NUMERICAL OUTPUT 2119 ! 2 : EIGHT MAIN DIRECTIONS 2120 ! >2 : EIGHT DIRECTIONS + NUMERICAL OUTPUT 2121 ! OUTPUT : SANG --> STRING 2122 ! 2123 !/ ------------------------------------------------------------------- / 2124 !/ 2125 ! 2126 IMPLICIT NONE 2127 !/ 2128 !/ ------------------------------------------------------------------- / 2129 !/ Parameter list 2130 !/ 2131 INTEGER, INTENT(IN) :: IANG, ILEN, INUM 2132 CHARACTER, INTENT(OUT) :: SANG*(*) 2133 !/ 2134 !/ ------------------------------------------------------------------- / 2135 !/ Local parameters 2136 !/ 2137 INTEGER :: I, J 2138 CHARACTER :: SAUX*4 2139 !/ 2140 !/ ------------------------------------------------------------------- / 2141 !/ 2142 ! numerical : 2143 ! 2144 IF (INUM.EQ.1 .OR. INUM.GE.3) THEN 2145 WRITE (SAUX, FMT='(I4)') IANG 2146 ELSE 2147 SAUX = ' ' 2148 END IF 2149 ! 2150 ! string : 2151 ! 2152 IF (IANG.EQ.0) THEN 2153 SAUX = ' N' 2154 ELSE IF (IANG.EQ.90) THEN 2155 SAUX = ' E' 2156 ELSE IF (IANG.EQ.180) THEN 2157 SAUX = ' S' 2158 ELSE IF (IANG.EQ.270) THEN 2159 SAUX = ' W' 2160 ELSE IF (INUM.GE.2) THEN 2161 IF (IANG.EQ.45) THEN 2162 SAUX = ' NE' 2163 ELSE IF (IANG.EQ.135) THEN 2164 SAUX = ' SE' 2165 ELSE IF (IANG.EQ.225) THEN 2166 SAUX = ' SW' 2167 ELSE IF (IANG.EQ.315) THEN 2168 SAUX = ' NW' 2169 END IF 2170 END IF Page 56 Source Listing ANGSTR 2014-11-12 21:38 w3arrymd.f90 2171 ! 2172 ! Auxilary string to output : 2173 ! 2174 DO I=1, ILEN-4 2175 SANG = ' ' 2176 END DO 2177 J = 0 2178 DO I=ILEN-3, ILEN 2179 J = J + 1 2180 SANG(I:I) = SAUX(J:J) 2181 END DO 2182 RETURN 2183 !/ 2184 !/ End of ANGSTR ----------------------------------------------------- / 2185 !/ 2186 END SUBROUTINE ANGSTR ENTRY POINTS Name w3arrymdprt2ds_mp_angstr_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ANGSTR Subr 2103 1951,1973,2033,2048 I Local 2137 I(4) 4 scalar 2174,2178,2180 IANG Dummy 2103 I(4) 4 scalar ARG,IN 2145,2152,2154,2156,2158,2161,2163 ,2165,2167 ILEN Dummy 2103 I(4) 4 scalar ARG,IN 2174,2178 INUM Dummy 2103 I(4) 4 scalar ARG,IN 2144,2160 J Local 2137 I(4) 4 scalar 2177,2179,2180 SANG Dummy 2103 CHAR scalar ARG,OUT 2175,2180 SAUX Local 2138 CHAR 4 scalar 2145,2147,2153,2155,2157,2159,2162 ,2164,2166,2168,2180 Page 57 Source Listing ANGSTR 2014-11-12 21:38 w3arrymd.f90 2187 !/ 2188 !/ End of PRT2DS ----------------------------------------------------- / 2189 !/ 2190 END SUBROUTINE PRT2DS ENTRY POINTS Name w3arrymd_mp_prt2ds_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 900 Label 2078 1923 901 Label 2081 2006 910 Label 2085 1928 911 Label 2090 2013 920 Label 2087 1939,1997 921 Label 2092 2018,2020,2066,2068 930 Label 2088 1968,1990 931 Label 2093 2043,2058 950 Label 2095 1998,2070 ABS Func 1913 scalar 1913,1958,1980,2036,2051 DTHDEG Local 1879 R(4) 4 scalar 1915,1946,1972,2028,2047 E Dummy 1782 R(4) 4 2 0 ARG,IN 1908,1909,1953,1954,1956,1975,1976 ,1978,2035,2050 EMAX Local 1879 R(4) 4 scalar 1903,1908,1913,1923,1953,1954,1956 ,1975,1976,1978,2007,2036,2051 EMIN Local 1879 R(4) 4 scalar 1904,1909,1913 FACFR Local 1879 R(4) 4 scalar 1896,1898,1928,2013 FACSP Dummy 1782 R(4) 4 scalar ARG,IN 1923,2007,2039,2054 FLSCLE Local 1878 L(4) 4 scalar 1889,1891,1919 FR Dummy 1782 R(4) 4 1 0 ARG,IN 1928,2013 FSC Dummy 1782 R(4) 4 scalar ARG,IN 1890,2006,2039,2054 IFR Local 1877 I(4) 4 scalar 1906,1908,1909,1928,1930,1931,1932 ,1934,1939,1952,1953,1954,1955,195 6,1957,1959,1961,1964,1968,1974,19 75,1976,1977,1978,1979,1981,1983,1 986,1990,1997,2013,2018,2020,2034, 2035,2037,2040,2043,2049,2050,2052 ,2055,2058,2066,2068 INT Func 1963 scalar 1963,1985 INTANG Local 1877 I(4) 4 scalar 1946,1947,1951,1972,1973,2028,2029 ,2033,2047,2048 ITH Local 1877 I(4) 4 scalar 1907,1908,1909,1945,1946,1948,1953 ,1954,1956,1971,1972,1975,1976,197 8,2027,2028,2030,2035,2046,2047,20 50 ITHSEC Local 1877 I(4) 4 scalar 1943,1948,1971,2025,2030,2046 MAX Func 1908 scalar 1908,1913 MIN Func 1909 scalar 1909,1927,2011 MOD Func 1931 scalar 1931 NDS Dummy 1782 I(4) 4 scalar ARG,IN 1923,1928,1939,1968,1990,1997,1998 Page 58 Source Listing ANGSTR 2014-11-12 21:38 Symbol Table w3arrymd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References ,2006,2013,2018,2020,2043,2058,206 6,2068,2070 NFR Dummy 1782 I(4) 4 scalar ARG,IN 1906,1927,1930,2011 NFR0 Dummy 1782 I(4) 4 scalar ARG,IN 1870 NFRB Local 1877 I(4) 4 scalar 1927,1928,1938,1939,1952,1967,1968 ,1974,1989,1990,1997,2011,2013,201 7,2018,2020,2034,2043,2049,2058,20 65,2066,2068 NINT Func 1946 scalar 1946,1972,2028,2039,2047,2054 NTH Dummy 1782 I(4) 4 scalar ARG,IN 1907,1915,1943,1945,1971,2025,2027 ,2046 PNTNME Dummy 1783 CHAR scalar ARG,IN 1923,2006 PNUM Local 1880 CHAR 5 1 25 2014,2015,2018,2020,2037,2040,2043 ,2052,2055,2058,2063,2064,2066,206 8 PNUM2 Local 1880 CHAR 2 1 71 1932,1934,1938,1939,1955,1957,1959 ,1961,1964,1967,1968,1977,1979,198 1,1983,1986,1989,1990,1995,1996,19 97 PRT2DS Subr 1782 PRUNIT Dummy 1783 CHAR scalar ARG,IN 1923,2006,2007 PRVAR Dummy 1783 CHAR scalar ARG,IN 1923,2006 REAL Func 1915 scalar 1915,1946,1972,2028,2047 RR Local 1879 R(4) 4 scalar 1953,1954,1956,1958,1960,1963,1975 ,1976,1978,1980,1982,1985,2035,203 6,2039,2050,2051,2054 RRC Local 1879 R(4) 4 scalar 1892,1958,1980 RRCUT Dummy 1783 R(4) 4 scalar ARG,IN 1892,2036,2051 STRA Local 1880 CHAR 5 scalar 2039,2040,2054,2055 STRA2 Local 1881 CHAR 2 scalar 1963,1964,1985,1986 STRANG Local 1880 CHAR 5 scalar 1951,1968,1973,1990,2033,2043,2048 ,2058 UFR Dummy 1782 CHAR scalar ARG,IN 1895 Page 59 Source Listing ANGSTR 2014-11-12 21:38 w3arrymd.f90 2191 !/ 2192 !/ End of module W3ARRYMD -------------------------------------------- / 2193 !/ 2194 END MODULE W3ARRYMD SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References NFRMAX Param 70 I(4) 4 scalar PRIV 70,71 W3ARRYMD Module 2 Page 60 Source Listing ANGSTR 2014-11-12 21:38 Subprograms/Common Blocks w3arrymd.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References ANGSTR Subr 2103 1951,1973,2033,2048 INA2I Subr 273 INA2R Subr 75 OUTA2I Subr 567 OUTA2R Subr 424 OUTINT Subr 786 OUTMAT Subr 892 OUTREA Subr 703 PRT1DM Subr 1503 PRT1DS Subr 1251 PRT2DS Subr 1782 PRTBLK Subr 1006 W3ARRYMD Module 2 COMPILER OPTIONS BEING USED -align nocommons -align nodcommons -align noqcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume byterecl -assume nocc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_unit_star -assume old_ldout_format -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume nostd_mod_proc_name -assume norealloc_lhs -assume underscore -assume no2underscores -auto no -auto_scalar no -bintext -ccdefault default -check noargs -check noarg_temp_created -check nobounds -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check power -check noshape -check nounderflow -check nouninitialized -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D _MT -D __INTEL_COMPILER_BUILD_DATE=20120612 -D __pentium4 -D __pentium4__ Page 61 Source Listing ANGSTR 2014-11-12 21:38 w3arrymd.f90 -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 -O2 no -pad_source -real_size 32 no -recursive -reentrancy none no -sharable_localsaves -vec=simd -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w noargument_checking -w nodeclarations -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage -includepath : /gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/,.f,./.f,/usrx/local/intel/composerxe/mkl/include/.f, /usrx/local/intel/composerxe/tbb/include/.f,/gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/.f, /gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/.f,/usr/local/include/.f,/usr/lib/gcc/x86_64-redhat-linux/4.4.7/include/.f, /usr/include/.f,/usr/include/.f -list filename : w3arrymd.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100