Page 1 Source Listing W3FLDO 2014-09-16 17:01 w3fldsmd.f90 1 !/ ------------------------------------------------------------------- / 2 MODULE W3FLDSMD 3 !/ 4 !/ +-----------------------------------+ 5 !/ | WAVEWATCH III NOAA/NCEP | 6 !/ | H. L. Tolman | 7 !/ | A. Chawla | 8 !/ | FORTRAN 90 | 9 !/ | Last update : 06-Dec-2012 | 10 !/ +-----------------------------------+ 11 !/ 12 !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 13 !/ 25-Jan-2002 : Data assimilation set up. ( version 2.17 ) 14 !/ 26-Dec-2002 : Continuously moving grid. ( version 3.02 ) 15 !/ 04-Sep-2003 : Bug fix W3FLHD. ( version 3.04 ) 16 !/ 27-Dec-2004 : Multiple grid version. ( version 3.06 ) 17 !/ 05-Jul-2005 : Correct first level/ice. ( version 3.07 ) 18 !/ 27-Jun-2006 : Adding file name preamble. ( version 3.09 ) 19 !/ 09-Oct-2007 : Make file header optional. ( version 3.13 ) 20 !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) 21 !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 ) 22 !/ (W. E. Rogers & T. J. Campbell, NRL) 23 !/ 04-Apr-2010 : Adding icebergs with ISI. ( version 3.14 ) 24 !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to 25 !/ specify index closure for a grid. ( version 3.14 ) 26 !/ (T. J. Campbell, NRL) 27 !/ 30-Oct-2012 : Implement tidal analysis (F. Ardhuin)(version 4.08 ) 28 !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.OF ) 29 !/ 5-Mar-2012 : Cleanup of tidal analysis (version 4.09 ) 30 !/ 31 !/ Copyright 2009-2012 National Weather Service (NWS), 32 !/ National Oceanic and Atmospheric Administration. All rights 33 !/ reserved. WAVEWATCH III is a trademark of the NWS. 34 !/ No unauthorized use without permission. 35 !/ 36 ! 1. Purpose : 37 ! 38 ! Gathers a set of routines to manage input fields of depth, 39 ! current, wind and ice concentration. 40 ! 41 ! 2. Variables and types : 42 ! 43 ! 3. Subroutines and functions : 44 ! 45 ! Name Type Scope Description 46 ! ---------------------------------------------------------------- 47 ! W3FLDO Subr. Public Open data file. 48 ! W3FLDG Subr. Public. Read/write data file (fields). 49 ! W3FLDD Subr. Public. Read/write data file (data). 50 ! W3FLDP Subr. Public. Generic field interpolation. 51 ! W3FLDH Subr. Public. Process homogeneous fields. 52 ! W3FLDM Subr. Public. Process moving grid data. 53 ! W3FLDTIDE Subr. Public. Read/write tidal constituents 54 ! ---------------------------------------------------------------- 55 ! 56 ! 4. Subroutines and functions used : 57 ! Page 2 Source Listing W3FLDO 2014-09-16 17:01 w3fldsmd.f90 58 ! Name Type Module Description 59 ! ---------------------------------------------------------------- 60 ! STRACE Subr. W3SERVMD Subroutine tracing. ( !/S ) 61 ! TICK21 Subr. W3TIMEMD Increment the clock. 62 ! DSEC21 R.F. W3TIMEMD Calculate time differnces. 63 ! ---------------------------------------------------------------- 64 ! 65 ! 5. Remarks : 66 ! 67 ! - By design, these routines do not use the WAVEWATCH III data 68 ! structure. With this approach, they can be used in a straight- 69 ! forward way in other programs to generate WAVEWATCH III input 70 ! data sets directly from such programs. 71 ! 72 ! 6. Switches : 73 ! 74 ! 7. Source code : 75 ! 76 !/ ------------------------------------------------------------------- / 77 PUBLIC 78 CONTAINS 79 !/ ------------------------------------------------------------------- / 80 SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & 81 GTYPE, IERR, FEXT, FPRE, FHDR, TIDEFLAGIN ) 82 !/ 83 !/ +-----------------------------------+ 84 !/ | WAVEWATCH III NOAA/NCEP | 85 !/ | H. L. Tolman | 86 !/ | A. Chawla | 87 !/ | FORTRAN 90 | 88 !/ | Last update : 26-Dec--2012| 89 !/ +-----------------------------------+ 90 !/ 91 !/ 15-Jan-1999 : Final FORTRAN 77 ( version 1.18 ) 92 !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 93 !/ 24-Jan-2001 : Flat grid version (formats only) ( version 2.06 ) 94 !/ 24-Jan-2002 : Assimilation data added. ( version 2.17 ) 95 !/ 27-Dec-2004 : Multiple grid version. ( version 3.06 ) 96 !/ 27-Jun-2006 : Adding file name preamble. ( version 3.09 ) 97 !/ 09-Oct-2007 : Make file header optional. ( version 3.13 ) 98 !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 ) 99 !/ (W. E. Rogers & T. J. Campbell, NRL) 100 !/ 04-Apr-2010 : Adding iceberg field. ( version 3.14 ) 101 !/ 09-Sep-2012 : Implement tidal cons. (F. Ardhuin ) ( version 4.09 ) 102 !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.11 ) 103 !/ 104 ! 1. Purpose : 105 ! 106 ! Open and prepare WAVEWATCH III field files as used by the 107 ! generic shell and the field preprocessor. 108 ! 109 ! 2. Method : 110 ! 111 ! The file header contains a general WAVEWATCH III ID string, 112 ! a field ID string and the dimensions of the grid. If a file 113 ! is opened to be read, these parameters are all checked. 114 ! Page 3 Source Listing W3FLDO 2014-09-16 17:01 w3fldsmd.f90 115 ! 3. Parameters : 116 ! 117 ! Parameter list 118 ! ---------------------------------------------------------------- 119 ! INXOUT C*(*) I Test string for read/write, valid are: 120 ! 'READ' and 'WRITE'. 121 ! IDFLD C*3 I/O ID string for field type, valid are: 'IC1', 122 ! 'IC2', 'IC3', 'IC4', 'IC5', 'MDN', 'MTH', 123 ! 'MVS', 'LEV', 'CUR', 'WND', 'WNS', 'ICE', 124 ! 'ISI', and 'DTn'. 125 ! NDS Int. I Dataset number for fields file. 126 ! NDST Int. I Dataset number for test output. 127 ! NDSE Int. I Dataset number for error output. 128 ! (No output if NDSE < 0). 129 ! NX, NY Int. I Discrete grid dimensions. \ 130 ! GTYPE Int. I Integer flag indicating type of grid. /a 131 ! NX Int. I/O Record length. \ 132 ! GTYPE Int. I Undefined value. /b 133 ! IERR Int. O Error indicator. 134 ! 0 : No errors. 135 ! 1 : Illegal INXOUT. 136 ! 2 : Illegal ID. 137 ! 3 : Error in opening file. 138 ! 4 : Write error in file. 139 ! 5 : Read error in file. 140 ! 6 : Premature EOF in read. 141 ! 7 : Unexpected file identifier read. 142 ! 8 : Unexpected field identifier read. 143 ! 9 : Unexpected grid dimensions read. 144 ! 10 : Unexpected data info. 145 ! ---------------------------------------------------------------- 146 ! a) for output fields. 147 ! b) for input data. 148 ! 149 ! 4. Subroutines used : 150 ! 151 ! Name Type Module Description 152 ! ---------------------------------------------------------------- 153 ! STRACE Subr. W3SERVMD Subroutine tracing. 154 ! ---------------------------------------------------------------- 155 ! 156 ! 5. Called by : 157 ! 158 ! Name Type Module Description 159 ! ---------------------------------------------------------------- 160 ! WW3_PREP Prog. N/A Input data preprocessor. 161 ! WW3_SHEL Prog. N/A Basic wave model driver. 162 ! ...... Prog. N/A Any other program that reads or 163 ! writes WAVEWATCH III data files. 164 ! ---------------------------------------------------------------- 165 ! 166 ! 6. Error messages : 167 ! 168 ! See end of subroutine. 169 ! 170 ! 7. Remarks : 171 ! Page 4 Source Listing W3FLDO 2014-09-16 17:01 w3fldsmd.f90 172 ! - On read, the ID 'WND' may be changed to 'WNS' (including 173 ! stability data). 174 ! - On read, the ID 'ICE' may be changed to 'ISI' (including 175 ! iceberg data). 176 ! 177 ! 8. Structure : 178 ! 179 ! See source code. 180 ! 181 ! 9. Switches : 182 ! 183 ! !/S Enable subroutine tracing. 184 ! !/T Enable test output. 185 ! 186 ! 10. Source code : 187 ! 188 !/ ------------------------------------------------------------------- / 189 !/ 190 ! 191 IMPLICIT NONE 192 !/ 193 !/ ------------------------------------------------------------------- / 194 !/ Parameter list 195 !/ 196 INTEGER, INTENT(IN) :: NDS, NDST, NDSE, NY 197 INTEGER, INTENT(INOUT) :: NX 198 INTEGER, INTENT(OUT) :: IERR 199 INTEGER, INTENT(INOUT) :: GTYPE 200 CHARACTER(LEN=3), INTENT(INOUT) :: IDFLD 201 CHARACTER, INTENT(IN) :: INXOUT*(*) 202 CHARACTER, INTENT(IN), OPTIONAL :: FEXT*(*), FPRE*(*) 203 LOGICAL, INTENT(IN), OPTIONAL :: FHDR 204 INTEGER, INTENT(INOUT), OPTIONAL :: TIDEFLAGIN 205 !/ 206 !/ ------------------------------------------------------------------- / 207 !/ Local parameters 208 !/ 209 INTEGER :: NXT, NYT, GTYPET, I 210 INTEGER :: FILLER(3) 211 LOGICAL :: WRITE 212 CHARACTER(LEN=3) :: TSFLD 213 CHARACTER(LEN=11) :: FORM = 'UNFORMATTED' 214 CHARACTER(LEN=13) :: TSSTR, IDSTR = 'WAVEWATCH III' 215 CHARACTER(LEN=20) :: TEMPXT 216 CHARACTER(LEN=30) :: FNAME 217 LOGICAL :: FDHDR = .TRUE. 218 INTEGER :: TIDEFLAG = 0 219 LOGICAL :: TIDEOK = .FALSE. 220 ! 221 ! 'FORM' is used for initial testing of new files only. 222 !/ 223 !/ ------------------------------------------------------------------- / 224 !/ 225 ! 226 ! test input parameters ---------------------------------------------- * 227 ! 228 FILLER(:)=0 Page 5 Source Listing W3FLDO 2014-09-16 17:01 w3fldsmd.f90 229 IF ( PRESENT(TIDEFLAGIN) ) THEN 230 TIDEFLAG = TIDEFLAGIN 231 ELSE 232 TIDEFLAG = 0 233 END IF 234 235 IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') GOTO 801 236 IF ( IDFLD.NE.'IC1' .AND. IDFLD.NE.'IC2' .AND. & 237 IDFLD.NE.'IC3' .AND. IDFLD.NE.'IC4' .AND. & 238 IDFLD.NE.'IC5' .AND. IDFLD.NE.'MDN' .AND. & 239 IDFLD.NE.'MTH' .AND. IDFLD.NE.'MVS' .AND. & 240 IDFLD.NE.'LEV' .AND. IDFLD.NE.'CUR' .AND. & 241 IDFLD.NE.'WND' .AND. IDFLD.NE.'WNS' .AND. & 242 IDFLD.NE.'ICE' .AND. IDFLD.NE.'DT0' .AND. & 243 IDFLD.NE.'DT1' .AND. IDFLD.NE.'DT2' .AND. & 244 IDFLD.NE.'ISI' ) GOTO 802 245 ! 246 IF ( PRESENT(FEXT) ) THEN 247 TEMPXT = FEXT 248 I = LEN_TRIM(FEXT) 249 ELSE 250 TEMPXT = 'ww3' 251 I = 3 252 END IF 253 ! 254 IF ( PRESENT(FHDR) ) THEN 255 FDHDR = FHDR 256 END IF 257 ! 258 ! Set internal variables --------------------------------------------- * 259 ! 260 IF ( IDFLD.EQ.'LEV' ) THEN 261 FNAME = 'level.' // TEMPXT(:I) 262 I = I + 6 263 ELSE IF ( IDFLD.EQ.'CUR' ) THEN 264 FNAME = 'current.' // TEMPXT(:I) 265 I = I + 8 266 ELSE IF ( IDFLD.EQ.'WND' .OR. IDFLD.EQ.'WNS' ) THEN 267 FNAME = 'wind.' // TEMPXT(:I) 268 I = I + 5 269 ELSE IF ( IDFLD.EQ.'ICE' .OR. IDFLD.EQ.'ISI' ) THEN 270 FNAME = 'ice.' // TEMPXT(:I) 271 I = I + 4 272 ELSE IF ( IDFLD.EQ.'DT0' ) THEN 273 FNAME = 'data0.' // TEMPXT(:I) 274 I = I + 6 275 ELSE IF ( IDFLD.EQ.'DT1' ) THEN 276 FNAME = 'data1.' // TEMPXT(:I) 277 I = I + 6 278 ELSE IF ( IDFLD.EQ.'DT2' ) THEN 279 FNAME = 'data2.' // TEMPXT(:I) 280 I = I + 6 281 ELSE IF ( IDFLD.EQ.'MDN' ) THEN 282 FNAME = 'muddens.' // TEMPXT(:I) 283 I = I + 8 284 ELSE IF ( IDFLD.EQ.'MTH' ) THEN 285 FNAME = 'mudthk.' // TEMPXT(:I) Page 6 Source Listing W3FLDO 2014-09-16 17:01 w3fldsmd.f90 286 I = I + 7 287 ELSE IF ( IDFLD.EQ.'MVS' ) THEN 288 FNAME = 'mudvisc.' // TEMPXT(:I) 289 I = I + 8 290 ELSE IF ( IDFLD.EQ.'IC1' ) THEN 291 FNAME = 'ice1.' // TEMPXT(:I) 292 I = I + 5 293 ELSE IF ( IDFLD.EQ.'IC2' ) THEN 294 FNAME = 'ice2.' // TEMPXT(:I) 295 I = I + 5 296 ELSE IF ( IDFLD.EQ.'IC3' ) THEN 297 FNAME = 'ice3.' // TEMPXT(:I) 298 I = I + 5 299 ELSE IF ( IDFLD.EQ.'IC4' ) THEN 300 FNAME = 'ice4.' // TEMPXT(:I) 301 I = I + 5 302 ELSE IF ( IDFLD.EQ.'IC5' ) THEN 303 FNAME = 'ice5.' // TEMPXT(:I) 304 I = I + 5 305 END IF 306 ! 307 WRITE = INXOUT .EQ. 'WRITE' 308 ! 309 ! Open file ---------------------------------------------------------- * 310 ! 311 IF ( WRITE ) THEN 312 IF ( PRESENT(FPRE) ) THEN 313 OPEN (NDS,FILE=FPRE//FNAME(:I),FORM=FORM,ERR=803, & 314 IOSTAT=IERR) 315 ELSE 316 OPEN (NDS,FILE=FNAME(:I),FORM=FORM,ERR=803,IOSTAT=IERR) 317 END IF 318 ELSE 319 IF ( PRESENT(FPRE) ) THEN 320 OPEN (NDS,FILE=FPRE//FNAME(:I),FORM=FORM, & 321 STATUS='OLD',ERR=803,IOSTAT=IERR) 322 ELSE 323 OPEN (NDS,FILE=FNAME(:I),FORM=FORM, & 324 STATUS='OLD',ERR=803,IOSTAT=IERR) 325 END IF 326 END IF 327 ! 328 ! Process test data -------------------------------------------------- * 329 ! 330 IF ( WRITE ) THEN 331 IF ( FDHDR ) THEN 332 IF ( FORM .EQ. 'UNFORMATTED' ) THEN 333 ! 334 ! The "filler" was added for compatibility with old binary forcing files 335 ! It is now also used for tidal info ... 336 ! 337 WRITE (NDS,ERR=804,IOSTAT=IERR) & 338 IDSTR, IDFLD, NX, NY, GTYPE, FILLER(1:2), TIDEFLAG 339 ELSE 340 WRITE (NDS,900,ERR=804,IOSTAT=IERR) & 341 IDSTR, IDFLD, NX, NY, GTYPE, FILLER(1:2), TIDEFLAG 342 END IF Page 7 Source Listing W3FLDO 2014-09-16 17:01 w3fldsmd.f90 343 END IF 344 ELSE 345 IF ( FORM .EQ. 'UNFORMATTED' ) THEN 346 READ (NDS,END=806,ERR=805,IOSTAT=IERR) & 347 TSSTR, TSFLD, NXT, NYT, GTYPET, FILLER(1:2), TIDEFLAG 348 ELSE 349 READ (NDS,900,END=806,ERR=805,IOSTAT=IERR) & 350 TSSTR, TSFLD, NXT, NYT, GTYPET, FILLER(1:2), TIDEFLAG 351 END IF 352 IF ((FILLER(1).NE.0.OR.FILLER(2).NE.0).AND.TIDEFLAG.GE.0) TIDEFLAG=0 353 IF (TIDEFLAG.NE.0.AND.(.NOT.TIDEOK)) THEN 354 GOTO 810 355 END IF 356 ! 357 IF ( IDSTR .NE. TSSTR ) GOTO 807 358 IF (( IDFLD.EQ.'WND' .AND. TSFLD.EQ.'WNS') .OR. & 359 ( IDFLD.EQ.'ICE' .AND. TSFLD.EQ.'ISI') ) THEN 360 IDFLD = TSFLD 361 END IF 362 IF ( IDFLD .NE. TSFLD ) GOTO 808 363 IF ( IDFLD(1:2) .NE. 'DT' ) THEN 364 IF ( NX.NE.NXT .OR. NY.NE.NYT ) THEN 365 GOTO 809 366 ELSE 367 NX = NXT 368 IF (GTYPE.LE.3) GTYPE = GTYPET 369 END IF 370 END IF 371 END IF 372 ! 373 ! File OK ------------------------------------------------------------ * 374 ! 375 IERR = 0 376 IF ( PRESENT(TIDEFLAGIN) ) THEN 377 TIDEFLAGIN = TIDEFLAG 378 END IF 379 380 RETURN 381 ! 382 ! Error escape locations 383 ! 384 801 CONTINUE 385 IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT 386 IERR = 1 387 RETURN 388 ! 389 802 CONTINUE 390 IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD 391 IERR = 2 392 RETURN 393 ! 394 803 CONTINUE 395 IF ( NDSE .GE. 0 ) WRITE (NDSE,1003) IDFLD, IERR 396 IERR = 3 397 RETURN 398 ! 399 804 CONTINUE Page 8 Source Listing W3FLDO 2014-09-16 17:01 w3fldsmd.f90 400 IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) IDFLD, IERR 401 IERR = 4 402 RETURN 403 ! 404 805 CONTINUE 405 IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) IDFLD, IERR 406 IERR = 5 407 RETURN 408 ! 409 806 CONTINUE 410 IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) IDFLD 411 IERR = 6 412 RETURN 413 ! 414 807 CONTINUE 415 IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) TSSTR, IDSTR 416 IERR = 7 417 RETURN 418 ! 419 808 CONTINUE 420 IF ( NDSE .GE. 0 ) WRITE (NDSE,1008) TSFLD, IDFLD 421 IERR = 8 422 RETURN 423 ! 424 809 CONTINUE 425 IF ( NDSE .GE. 0 ) WRITE (NDSE,1009) & 426 NXT, NYT, GTYPET, & 427 NX , NY , GTYPE 428 ! 429 810 CONTINUE 430 IF ( NDSE .GE. 0 ) WRITE (NDSE,1010) & 431 FILLER(1:2),TIDEFLAG 432 IERR = 9 433 RETURN 434 ! 435 ! Formats 436 ! 437 900 FORMAT (1X,A13,1X,A3,3I12) 438 ! 439 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ & 440 ' ILLEGAL INXOUT STRING : ',A/) 441 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ & 442 ' ILLEGAL FIELD ID STRING : ',A/) 443 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ & 444 ' ERROR IN OPENING ',A,' FILE, IOSTAT =',I6/) 445 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ & 446 ' ERROR IN WRITING TO ',A,' FILE, IOSTAT =',I6/) 447 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ & 448 ' ERROR IN READING ',A,' FILE, IOSTAT =',I6/) 449 450 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ & 451 ' PREMATURE END OF ',A,' FILE'/) 452 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ & 453 ' ILLEGAL FILE ID STRING >',A,'<'/ & 454 ' SHOULD BE >',A,'<'/) 455 1008 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ & 456 ' ILLEGAL FIELD ID STRING >',A,'<'/ & Page 9 Source Listing W3FLDO 2014-09-16 17:01 w3fldsmd.f90 457 ' SHOULD BE >',A,'<'/) 458 1009 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ & 459 ' INCOMPATIBLE GRID DATA : ',3(1X,I4)/ & 460 ' SHOULD BE : ',3(1X,I4)/) 461 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ & 462 ' FILLER indicates use of tidal constituents',3I4, /& 463 ' For this the code should be compiled with TIDE switch'/) 464 ! 465 !/ 466 !/ End of W3FLDO ---------------------------------------------------- / 467 !/ 468 END SUBROUTINE W3FLDO ENTRY POINTS Name w3fldsmd_mp_w3fldo_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1001 Label 439 385 1002 Label 441 390 1003 Label 443 395 1004 Label 445 400 1005 Label 447 405 1006 Label 450 410 1007 Label 452 415 1008 Label 455 420 1009 Label 458 425 1010 Label 461 430 801 Label 384 235 802 Label 389 244 803 Label 394 313,316,321,324 804 Label 399 337,340 805 Label 404 346,349 806 Label 409 346,349 807 Label 414 357 808 Label 419 362 809 Label 424 365 810 Label 429 354 900 Label 437 340,349 FDHDR Local 217 L(4) 4 scalar 217,255,331 FEXT Dummy 81 CHAR scalar ARG,IN 246,247,248 FHDR Dummy 81 L(4) 4 scalar ARG,IN 254,255 FILLER Local 210 I(4) 4 1 3 228,338,341,347,350,352,431 FNAME Local 216 CHAR 30 scalar 261,264,267,270,273,276,279,282,28 5,288,291,294,297,300,303,313,316, 320,323 FORM Local 213 CHAR 11 scalar 213,313,316,320,323,332,345 FPRE Dummy 81 CHAR scalar ARG,IN 312,313,319,320 GTYPE Dummy 81 I(4) 4 scalar ARG,INOUT 338,341,368,427 GTYPET Local 209 I(4) 4 scalar 347,350,368,426 Page 10 Source Listing W3FLDO 2014-09-16 17:01 Symbol Table w3fldsmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References I Local 209 I(4) 4 scalar 248,251,261,262,264,265,267,268,27 0,271,273,274,276,277,279,280,282, 283,285,286,288,289,291,292,294,29 5,297,298,300,301,303,304,313,316, 320,323 IDFLD Dummy 80 CHAR 3 scalar ARG,INOUT 236,237,238,239,240,241,242,243,24 4,260,263,266,269,272,275,278,281, 284,287,290,293,296,299,302,338,34 1,358,359,360,362,363,390,395,400, 405,410,420 IDSTR Local 214 CHAR 13 scalar 214,338,341,357,415 IERR Dummy 81 I(4) 4 scalar ARG,OUT 314,316,321,324,337,340,346,349,37 5,386,391,395,396,400,401,405,406, 411,416,421,432 INXOUT Dummy 80 CHAR scalar ARG,IN 235,307,385 LEN_TRIM Func 248 scalar 248 NDS Dummy 80 I(4) 4 scalar ARG,IN 313,316,320,323,337,340,346,349 NDSE Dummy 80 I(4) 4 scalar ARG,IN 385,390,395,400,405,410,415,420,42 5,430 NDST Dummy 80 I(4) 4 scalar ARG,IN NX Dummy 80 I(4) 4 scalar ARG,INOUT 338,341,364,367,427 NXT Local 209 I(4) 4 scalar 347,350,364,367,426 NY Dummy 80 I(4) 4 scalar ARG,IN 338,341,364,427 NYT Local 209 I(4) 4 scalar 347,350,364,426 PRESENT Func 229 scalar 229,246,254,312,319,376 TEMPXT Local 215 CHAR 20 scalar 247,250,261,264,267,270,273,276,27 9,282,285,288,291,294,297,300,303 TIDEFLAG Local 218 I(4) 4 scalar 218,230,232,338,341,347,350,352,35 3,377,431 TIDEFLAGIN Dummy 81 I(4) 4 scalar ARG,INOUT 229,230,376,377 TIDEOK Local 219 L(4) 4 scalar 219,353 TSFLD Local 212 CHAR 3 scalar 347,350,358,359,360,362,420 TSSTR Local 214 CHAR 13 scalar 347,350,357,415 W3FLDO Subr 80 WRITE Local 211 L(4) 4 scalar 307,311,330 Page 11 Source Listing W3FLDO 2014-09-16 17:01 w3fldsmd.f90 469 470 !/ ------------------------------------------------------------------- / 471 SUBROUTINE W3FLDTIDE1 ( INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IERR ) 472 !/ 473 !/ +-----------------------------------+ 474 !/ | WAVEWATCH III NOAA/NCEP | 475 !/ | F. Ardhuin | 476 !/ | | 477 !/ | FORTRAN 90 | 478 !/ | Last update : 30-Jun-2013 | 479 !/ +-----------------------------------+ 480 !/ 481 !/ 24-Sep-2012 : Creation ( version 4.09 ) 482 !/ 30-Jun-2013 : Split in 2 subroutines ( version 4.11 ) 483 !/ 484 ! 1. Purpose : 485 ! 486 ! Reads and writes tidal consituents 487 ! 488 ! 2. Method : 489 ! 490 ! 3. Parameters : 491 ! 492 ! Parameter list 493 ! ---------------------------------------------------------------- 494 ! INXOUT C*(*) I Test string for read/write, valid are: 495 ! 'READ' and 'WRITE'. 496 ! IDFLD C*3 I/O ID string for field type, valid are: 497 ! 'LEV', 'CUR', 'WND', 'WNS', 'ICE', 'ISI', and 'DTn'. 498 ! NDS Int. I Dataset number for fields file. 499 ! NDST Int. I Dataset number for test output. 500 ! NDSE Int. I Dataset number for error output. 501 ! (No output if NDSE < 0). 502 ! NX, NY Int. I Discrete grid dimensions. \ 503 ! IERR Int. O Error indicator. 504 ! 0 : No errors. 505 ! 1 : Illegal INXOUT. 506 ! ---------------------------------------------------------------- 507 ! a) for output fields. 508 ! b) for input data. 509 ! 510 ! 4. Subroutines used : 511 ! 512 ! Name Type Module Description 513 ! ---------------------------------------------------------------- 514 ! STRACE Subr. W3SERVMD Subroutine tracing. 515 ! ---------------------------------------------------------------- 516 ! 517 ! 5. Called by : 518 ! 519 ! Name Type Module Description 520 ! ---------------------------------------------------------------- 521 ! WW3_PREP Prog. N/A Input data preprocessor. 522 ! WW3_PRNC Prog. N/A NetCDF input data preprocessor. 523 ! WW3_SHEL Prog. N/A Basic wave model driver. 524 ! ---------------------------------------------------------------- 525 ! Page 12 Source Listing W3FLDTIDE1 2014-09-16 17:01 w3fldsmd.f90 526 ! 6. Error messages : 527 ! 528 ! See end of subroutine. 529 ! 530 ! 7. Remarks : 531 ! 532 ! - On read, the ID 'WND' may be changed to 'WNS' (including 533 ! stability data). 534 ! - On read, the ID 'ICE' may be changed to 'ISI' (including 535 ! iceberg data). 536 ! 537 ! 8. Structure : 538 ! 539 ! See source code. 540 ! 541 ! 9. Switches : 542 ! 543 ! !/S Enable subroutine tracing. 544 ! !/T Enable test output. 545 ! 546 ! 10. Source code : 547 ! 548 !/ ------------------------------------------------------------------- / 549 !/ 550 ! 551 USE W3IDATMD 552 IMPLICIT NONE 553 !/ 554 !/ ------------------------------------------------------------------- / 555 !/ Parameter list 556 !/ 557 INTEGER, INTENT(IN) :: NDS, NDST, NDSE, NX, NY 558 CHARACTER(LEN=3), INTENT(INOUT) :: IDFLD 559 CHARACTER*(*), INTENT(IN) :: INXOUT 560 INTEGER, INTENT(OUT) :: IERR 561 !/ 562 !/ ------------------------------------------------------------------- / 563 !/ Local parameters 564 !/ 565 LOGICAL :: WRITE 566 INTEGER :: I, IX 567 ! 568 !/ 569 !/ ------------------------------------------------------------------- / 570 !/ 571 ! 572 ! test input parameters ---------------------------------------------- * 573 ! 574 IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') GOTO 801 575 IF ( IDFLD.NE.'LEV' .AND. IDFLD.NE.'CUR' .AND. & 576 IDFLD.NE.'WND' .AND. IDFLD.NE.'WNS' .AND. & 577 IDFLD.NE.'ICE' .AND. IDFLD.NE.'DT0' .AND. & 578 IDFLD.NE.'DT1' .AND. IDFLD.NE.'DT2' .AND. & 579 IDFLD.NE.'ISI' ) GOTO 802 580 WRITE = INXOUT .EQ. 'WRITE' 581 582 ! Page 13 Source Listing W3FLDTIDE1 2014-09-16 17:01 w3fldsmd.f90 583 ! File OK ------------------------------------------------------------ * 584 ! 585 IERR = 0 586 RETURN 587 ! 588 ! Error escape locations 589 ! 590 801 CONTINUE 591 IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT 592 IERR = 1 593 RETURN 594 ! 595 802 CONTINUE 596 IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD 597 IERR = 2 598 RETURN 599 ! 600 804 CONTINUE 601 IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) IDFLD, IERR 602 IERR = 4 603 RETURN 604 ! 605 805 CONTINUE 606 IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) IDFLD, IERR 607 IERR = 5 608 RETURN 609 ! 610 806 CONTINUE 611 IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) IDFLD 612 IERR = 6 613 RETURN 614 ! 615 ! Formats 616 ! 617 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE : '/ & 618 ' ILLEGAL INXOUT STRING : ',A/) 619 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE : '/ & 620 ' ILLEGAL FIELD ID STRING : ',A/) 621 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE : '/ & 622 ' ERROR IN WRITING TO ',A,' FILE, IOSTAT =',I6/) 623 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE : '/ & 624 ' ERROR IN READING ',A,' FILE, IOSTAT =',I6/) 625 626 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE : '/ & 627 ' PREMATURE END OF ',A,' FILE'/) 628 !/ 629 !/ End of W3FLDO ---------------------------------------------------- / 630 !/ 631 END SUBROUTINE W3FLDTIDE1 Page 14 Source Listing W3FLDTIDE1 2014-09-16 17:01 Entry Points w3fldsmd.f90 ENTRY POINTS Name w3fldsmd_mp_w3fldtide1_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1001 Label 617 591 1002 Label 619 596 1004 Label 621 601 1005 Label 623 606 1006 Label 626 611 801 Label 590 574 802 Label 595 579 804 Label 600 805 Label 605 806 Label 610 I Local 566 I(4) 4 scalar IDFLD Dummy 471 CHAR 3 scalar ARG,INOUT 575,576,577,578,579,596,601,606,61 1 IERR Dummy 471 I(4) 4 scalar ARG,OUT 585,592,597,601,602,606,607,612 INXOUT Dummy 471 CHAR scalar ARG,IN 574,580,591 IX Local 566 I(4) 4 scalar NDS Dummy 471 I(4) 4 scalar ARG,IN NDSE Dummy 471 I(4) 4 scalar ARG,IN 591,596,601,606,611 NDST Dummy 471 I(4) 4 scalar ARG,IN NX Dummy 471 I(4) 4 scalar ARG,IN NY Dummy 471 I(4) 4 scalar ARG,IN W3FLDTIDE1 Subr 471 W3IDATMD Module 551 551 WRITE Local 565 L(4) 4 scalar 580 Page 15 Source Listing W3FLDTIDE1 2014-09-16 17:01 w3fldsmd.f90 632 633 634 !/ ------------------------------------------------------------------- / 635 SUBROUTINE W3FLDTIDE2 ( INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IDAT, IERR ) 636 !/ 637 !/ +-----------------------------------+ 638 !/ | WAVEWATCH III NOAA/NCEP | 639 !/ | F. Ardhuin | 640 !/ | | 641 !/ | FORTRAN 90 | 642 !/ | Last update : 30-Jun-2013 | 643 !/ +-----------------------------------+ 644 !/ 645 !/ 24-Sep-2012 : Creation ( version 4.09 ) 646 !/ 30-Jun-2013 : Split in 2 subroutines ( version 4.11 ) 647 !/ 648 ! 1. Purpose : 649 ! 650 ! Reads and writes tidal consituents 651 ! 652 ! 2. Method : 653 ! 654 ! 3. Parameters : 655 ! 656 ! Parameter list 657 ! ---------------------------------------------------------------- 658 ! INXOUT C*(*) I Test string for read/write, valid are: 659 ! 'READ' and 'WRITE'. 660 ! IDFLD C*3 I/O ID string for field type, valid are: 661 ! 'LEV', 'CUR', 'WND', 'WNS', 'ICE', 'ISI', and 'DTn'. 662 ! NDS Int. I Dataset number for fields file. 663 ! NDST Int. I Dataset number for test output. 664 ! NDSE Int. I Dataset number for error output. 665 ! (No output if NDSE < 0). 666 ! NX, NY Int. I Discrete grid dimensions. \ 667 ! IDAT Int. I Equal to 1 if W3IDATMD arrays are to be filled 668 ! IERR Int. O Error indicator. 669 ! 0 : No errors. 670 ! 1 : Illegal INXOUT. 671 ! ---------------------------------------------------------------- 672 ! a) for output fields. 673 ! b) for input data. 674 ! 675 ! 4. Subroutines used : 676 ! 677 ! Name Type Module Description 678 ! ---------------------------------------------------------------- 679 ! STRACE Subr. W3SERVMD Subroutine tracing. 680 ! ---------------------------------------------------------------- 681 ! 682 ! 5. Called by : 683 ! 684 ! Name Type Module Description 685 ! ---------------------------------------------------------------- 686 ! WW3_PREP Prog. N/A Input data preprocessor. 687 ! WW3_PRNC Prog. N/A NetCDF input data preprocessor. 688 ! WW3_SHEL Prog. N/A Basic wave model driver. Page 16 Source Listing W3FLDTIDE2 2014-09-16 17:01 w3fldsmd.f90 689 ! ---------------------------------------------------------------- 690 ! 691 ! 6. Error messages : 692 ! 693 ! See end of subroutine. 694 ! 695 ! 7. Remarks : 696 ! 697 ! - On read, the ID 'WND' may be changed to 'WNS' (including 698 ! stability data). 699 ! - On read, the ID 'ICE' may be changed to 'ISI' (including 700 ! iceberg data). 701 ! 702 ! 8. Structure : 703 ! 704 ! See source code. 705 ! 706 ! 9. Switches : 707 ! 708 ! !/S Enable subroutine tracing. 709 ! !/T Enable test output. 710 ! 711 ! 10. Source code : 712 ! 713 !/ ------------------------------------------------------------------- / 714 !/ 715 ! 716 USE W3IDATMD 717 IMPLICIT NONE 718 !/ 719 !/ ------------------------------------------------------------------- / 720 !/ Parameter list 721 !/ 722 INTEGER, INTENT(IN) :: NDS, NDST, NDSE, NX, NY, IDAT 723 CHARACTER(LEN=3), INTENT(INOUT) :: IDFLD 724 CHARACTER*(*), INTENT(IN) :: INXOUT 725 INTEGER, INTENT(OUT) :: IERR 726 !/ 727 !/ ------------------------------------------------------------------- / 728 !/ Local parameters 729 !/ 730 LOGICAL :: WRITE 731 INTEGER :: I, IX, TIDE_MF1 732 CHARACTER(LEN=100) :: LIST(70) 733 !/ 734 !/ ------------------------------------------------------------------- / 735 !/ 736 ! 737 ! test input parameters ---------------------------------------------- * 738 ! 739 IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') GOTO 801 740 IF ( IDFLD.NE.'LEV' .AND. IDFLD.NE.'CUR' .AND. & 741 IDFLD.NE.'WND' .AND. IDFLD.NE.'WNS' .AND. & 742 IDFLD.NE.'ICE' .AND. IDFLD.NE.'DT0' .AND. & 743 IDFLD.NE.'DT1' .AND. IDFLD.NE.'DT2' .AND. & 744 IDFLD.NE.'ISI' ) GOTO 802 745 WRITE = INXOUT .EQ. 'WRITE' Page 17 Source Listing W3FLDTIDE2 2014-09-16 17:01 w3fldsmd.f90 746 747 ! 748 ! File OK ------------------------------------------------------------ * 749 ! 750 IERR = 0 751 RETURN 752 ! 753 ! Error escape locations 754 ! 755 801 CONTINUE 756 IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT 757 IERR = 1 758 RETURN 759 ! 760 802 CONTINUE 761 IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD 762 IERR = 2 763 RETURN 764 ! 765 804 CONTINUE 766 IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) IDFLD, IERR 767 IERR = 4 768 RETURN 769 ! 770 805 CONTINUE 771 IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) IDFLD, IERR 772 IERR = 5 773 RETURN 774 ! 775 806 CONTINUE 776 IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) IDFLD 777 IERR = 6 778 RETURN 779 ! 780 807 CONTINUE 781 IERR = 7 782 RETURN 783 ! 784 ! Formats 785 ! 786 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ & 787 ' ILLEGAL INXOUT STRING : ',A/) 788 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ & 789 ' ILLEGAL FIELD ID STRING : ',A/) 790 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ & 791 ' ERROR IN WRITING TO ',A,' FILE, IOSTAT =',I6/) 792 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ & 793 ' ERROR IN READING ',A,' FILE, IOSTAT =',I6/) 794 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ & 795 ' PREMATURE END OF ',A,' FILE'/) 796 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ & 797 ' TIDAL CONSTITUENTS NOT RECOGNIZED ',A /) 798 !/ 799 !/ End of W3FLDO ---------------------------------------------------- / 800 !/ 801 END SUBROUTINE W3FLDTIDE2 Page 18 Source Listing W3FLDTIDE2 2014-09-16 17:01 Entry Points w3fldsmd.f90 ENTRY POINTS Name w3fldsmd_mp_w3fldtide2_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1001 Label 786 756 1002 Label 788 761 1004 Label 790 766 1005 Label 792 771 1006 Label 794 776 1007 Label 796 801 Label 755 739 802 Label 760 744 804 Label 765 805 Label 770 806 Label 775 807 Label 780 I Local 731 I(4) 4 scalar IDAT Dummy 635 I(4) 4 scalar ARG,IN IDFLD Dummy 635 CHAR 3 scalar ARG,INOUT 740,741,742,743,744,761,766,771,77 6 IERR Dummy 635 I(4) 4 scalar ARG,OUT 750,757,762,766,767,771,772,777,78 1 INXOUT Dummy 635 CHAR scalar ARG,IN 739,745,756 IX Local 731 I(4) 4 scalar LIST Local 732 CHAR 100 1 70 NDS Dummy 635 I(4) 4 scalar ARG,IN NDSE Dummy 635 I(4) 4 scalar ARG,IN 756,761,766,771,776 NDST Dummy 635 I(4) 4 scalar ARG,IN NX Dummy 635 I(4) 4 scalar ARG,IN NY Dummy 635 I(4) 4 scalar ARG,IN TIDE_MF1 Local 731 I(4) 4 scalar W3FLDTIDE2 Subr 635 W3IDATMD Module 716 716 WRITE Local 730 L(4) 4 scalar 745 Page 19 Source Listing W3FLDTIDE2 2014-09-16 17:01 w3fldsmd.f90 802 803 !/ ------------------------------------------------------------------- / 804 SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & 805 NX, NY, T0, TN, TF0, FX0, FY0, FA0, & 806 TFN, FXN, FYN, FAN, IERR) 807 !/ 808 !/ +-----------------------------------+ 809 !/ | WAVEWATCH III NOAA/NCEP | 810 !/ | H. L. Tolman | 811 !/ | FORTRAN 90 | 812 !/ | Last update : 26-Dec-2012 | 813 !/ +-----------------------------------+ 814 !/ 815 !/ 15-Jan-1999 : Final FORTRAN 77 ( version 1.18 ) 816 !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 817 !/ 05-Jul-2005 : Correct first level/ice. ( version 3.07 ) 818 !/ 04-Apr-2010 : Adding icebergs in ISI ( version 3.14 ) 819 !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.11 ) 820 !/ 821 ! 1. Purpose : 822 ! 823 ! Update input fields in the WAVEWATCH III generic shell from a 824 ! WAVEWATCH III shell data file or write from preprocessor. 825 ! 826 ! 2. Method : 827 ! 828 ! Read from file opened by W3FLDO. 829 ! 830 ! 3. Parameters : 831 ! 832 ! Parameter list 833 ! ---------------------------------------------------------------- 834 ! INXOUT C*(*) I Test string for read/write, valid are: 835 ! 'READ' and 'WRITE'. 836 ! IDFLD C*3 I ID string for field type, valid are: 'IC1', 837 ! 'IC2', 'IC3', 'IC4', 'IC5', 'MDN', 'MTH', 'MVS', 838 ! 'LEV', 'CUR', 'WND', 'WNS', 'ICE' and 'ISI'. 839 ! NDS Int. I Dataset number for fields file. 840 ! NDST Int. I Dataset number for test output. 841 ! NDSE Int. I Dataset number for error output. 842 ! (No error output if NDSE < 0 ). 843 ! MX,MY Int. I Array dimensions output fields. 844 ! NX,NY Int. I Discrete grid dimensions. 845 ! T0-N I.A. I Time interval considered (dummy for write). 846 ! TF0-N I.A. I/O Field times (TFN dummy for write). 847 ! Fxx R.A. I/O Input fields (FxN dummy for write). 848 ! subtypes: FX0, FY0, FA0, FXN, FYN, FAN 849 ! (meaning is inferred from context as follows) 850 ! "0" denotes "prior time level" 851 ! "N" denotes "next time level" 852 ! "X" denotes x in a vector 853 ! "Y" denotes y in a vector 854 ! "A" denotes scalar 855 ! IERR Int. O Error indicator, 856 ! -1 Past last data 857 ! 0 OK, 858 ! 1 : Illegal INXOUT. Page 20 Source Listing W3FLDG 2014-09-16 17:01 w3fldsmd.f90 859 ! 2 : Illegal IDFLD. 860 ! 3 : Error in writing time. 861 ! 4 : Error in writing field. 862 ! 5 : Error in reading time. 863 ! 6 : Premature EOF reading field. 864 ! 7 : Error reading field. 865 ! ---------------------------------------------------------------- 866 ! 867 ! 4. Subroutines used : 868 ! 869 ! Name Type Module Description 870 ! ---------------------------------------------------------------- 871 ! STRACE Subr. Id. Subroutine tracing. 872 ! TICK21 Subr. W3TIMEMD Advance time. 873 ! DSEC21 Func. Id. Difference between times. 874 ! ---------------------------------------------------------------- 875 ! 876 ! 5. Called by : 877 ! 878 ! Name Type Module Description 879 ! ---------------------------------------------------------------- 880 ! WW3_PREP Prog. N/A Input data preprocessor. 881 ! WW3_SHEL Prog. N/A Basic wave model driver. 882 ! ...... Prog. N/A Any other program that reads or 883 ! writes WAVEWATCH III data files. 884 ! ---------------------------------------------------------------- 885 ! 886 ! 6. Error messages : 887 ! 888 ! See end of subroutine. 889 ! 890 ! 7. Remarks : 891 ! 892 ! - Saving of previous fields needed only for reading of 2-D fields. 893 ! 894 ! 8. Structure : 895 ! 896 ! See source code. 897 ! 898 ! 9. Switches : 899 ! 900 ! !/S Enable subroutine tracing. 901 ! !/T Enable test output. 902 ! 903 ! 10. Source code : 904 ! 905 !/ ------------------------------------------------------------------- / 906 !/ 907 USE W3TIMEMD 908 ! 909 IMPLICIT NONE 910 !/ 911 !/ ------------------------------------------------------------------- / 912 !/ Parameter list 913 !/ 914 INTEGER, INTENT(IN) :: NDS, NDST, NDSE, MX, MY, & 915 NX, NY, T0(2), TN(2) Page 21 Source Listing W3FLDG 2014-09-16 17:01 w3fldsmd.f90 916 INTEGER, INTENT(INOUT) :: TF0(2), TFN(2) 917 INTEGER, INTENT(OUT) :: IERR 918 REAL, INTENT(INOUT) :: FX0(MX,MY), FY0(MX,MY), & 919 FXN(MX,MY), FYN(MX,MY), & 920 FA0(MX,MY), FAN(MX,MY) 921 CHARACTER, INTENT(IN) :: INXOUT*(*) 922 CHARACTER(LEN=3), INTENT(IN) :: IDFLD 923 !/ 924 !/ ------------------------------------------------------------------- / 925 !/ Local parameters 926 !/ 927 INTEGER :: IX, IY, J, ISTAT 928 REAL :: DTTST 929 LOGICAL :: WRITE, FL2D, FLFRST, FLBE, FLST 930 !/ 931 !/ ------------------------------------------------------------------- / 932 !/ 933 !/ 934 IERR = 0 935 ! 936 ! test input parameters ---------------------------------------------- * 937 ! 938 IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') GOTO 801 939 IF ( IDFLD.NE.'IC1' .AND. IDFLD.NE.'IC2' .AND. & 940 IDFLD.NE.'IC3' .AND. IDFLD.NE.'IC4' .AND. & 941 IDFLD.NE.'IC5' .AND. IDFLD.NE.'MDN' .AND. & 942 IDFLD.NE.'MTH' .AND. IDFLD.NE.'MVS' .AND. & 943 IDFLD.NE.'LEV' .AND. IDFLD.NE.'CUR' .AND. & 944 IDFLD.NE.'WND' .AND. IDFLD.NE.'WNS' .AND. & 945 IDFLD.NE.'ICE' .AND. IDFLD.NE.'ISI' ) GOTO 802 946 ! 947 ! Set internal variables --------------------------------------------- * 948 ! 949 WRITE = INXOUT .EQ. 'WRITE' 950 FL2D = IDFLD.EQ.'CUR' .OR. IDFLD.EQ.'WND' .OR. IDFLD.EQ.'WNS' & 951 .OR. IDFLD.EQ.'ISI' 952 FLBE = IDFLD.EQ.'ISI' 953 FLST = IDFLD.EQ.'WNS' 954 FLFRST = TFN(1) .EQ. -1 955 ! 956 ! Loop over times / fields ========================================== * 957 ! 958 DO 959 ! 960 ! Shift fields (2d fields only) 961 ! 962 !--------------------------------------------- 963 ! begin temporary notes 964 ! Why are fields shifted only if 2d? This does not make sense. 965 ! My guess is that this is a false association: 966 ! at present the fields that are 2d also happen to be the fields 967 ! that are interpolated in time (winds and currents) 968 969 ! SUBROUTINE W3UCUR ( FLFRST ) 970 ! Interpolate the current field to the present time. 971 ! SUBROUTINE W3UWND ( FLFRST, VGX, VGY ) 972 ! Interpolate wind fields to the given time. Page 22 Source Listing W3FLDG 2014-09-16 17:01 w3fldsmd.f90 973 974 ! The "0" variables are needed only if there is interpolation in time. 975 ! end temporary notes 976 !--------------------------------------------- 977 978 IF ( (.NOT.WRITE) .AND. FL2D ) THEN 979 ! 980 TF0(1) = TFN(1) 981 TF0(2) = TFN(2) 982 ! unless TFN has been changed in the do loop, the following line is essentally 983 ! "if not.flfrst" 984 IF ( TFN(1) .NE. -1 ) THEN 985 DO IX=1, NX 986 DO IY=1, NY 987 FX0(IX,IY) = FXN(IX,IY) 988 FY0(IX,IY) = FYN(IX,IY) 989 END DO 990 IF( FLST ) THEN 991 DO IY=1, NY 992 FA0(IX,IY) = FAN(IX,IY) 993 END DO 994 END IF 995 END DO 996 END IF 997 ! 998 END IF 999 1000 ! 1001 ! Process fields, write --------------------------------------------- * 1002 ! 1003 IF ( WRITE ) THEN 1004 ! 1005 WRITE (NDS,ERR=803,IOSTAT=ISTAT) TF0 1006 IF ( .NOT. FL2D ) THEN 1007 J = 1 1008 WRITE (NDS,ERR=804,IOSTAT=ISTAT) & 1009 ((FA0(IX,IY),IX=1,NX),IY=1,NY) 1010 ELSE 1011 J = 1 1012 WRITE (NDS,ERR=804,IOSTAT=ISTAT) & 1013 ((FX0(IX,IY),IX=1,NX),IY=1,NY) 1014 J = 2 1015 WRITE (NDS,ERR=804,IOSTAT=ISTAT) & 1016 ((FY0(IX,IY),IX=1,NX),IY=1,NY) 1017 J = 3 1018 IF ( FLST ) WRITE (NDS,ERR=804,IOSTAT=ISTAT) & 1019 ((FA0(IX,IY),IX=1,NX),IY=1,NY) 1020 END IF 1021 ! 1022 EXIT 1023 ! 1024 ! Process fields, read ---------------------------------------------- * 1025 ! 1026 ELSE 1027 ! 1028 READ (NDS,END=800,ERR=805,IOSTAT=ISTAT) TFN 1029 IF ( .NOT. FL2D ) THEN Page 23 Source Listing W3FLDG 2014-09-16 17:01 w3fldsmd.f90 1030 ! note: "J" here does *not* refer to data type, wlev etc. 1031 ! It refers to the dimension. 1032 J = 1 1033 READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) & 1034 ((FAN(IX,IY),IX=1,NX),IY=1,NY) 1035 ELSE 1036 J = 1 1037 READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) & 1038 ((FXN(IX,IY),IX=1,NX),IY=1,NY) 1039 J = 2 1040 READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) & 1041 ((FYN(IX,IY),IX=1,NX),IY=1,NY) 1042 FAN(:,:) = FXN(:,:) ! this was added for ISI files 1043 1044 ! note: it appears that FAN is immediately overwritten below if FLST. 1045 ! I do not know if this is intended. 1046 1047 J = 3 1048 IF ( FLST ) READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) & 1049 ((FAN(IX,IY),IX=1,NX),IY=1,NY) 1050 END IF 1051 ! 1052 ! Check time, branch back if necessary 1053 ! 1054 DTTST = DSEC21 ( T0 , TFN ) 1055 1056 ! notes: my guess is that DTTST is the difference between the time of 1057 ! computations (T0) and the time that we just read (TFN). Again, 1058 ! this code appears to be using a false association between "is this 1059 ! 2d?" vs. "is this field interpolated in time"? 1060 1061 IF ( .NOT.FL2D .AND. FLFRST .AND. DTTST .EQ. 0. )EXIT 1062 1063 ! notes: If it will be interpolated in time, we need to continue until 1064 ! we have one that has a date larger than the current time, so we have 1065 ! something to interpolate to. 1066 1067 IF ( DTTST .GT. 0. )EXIT 1068 ! 1069 END IF 1070 ! 1071 END DO 1072 ! 1073 ! Branch point for EOF in 2d fields, current and wind 1074 ! 1075 300 CONTINUE 1076 ! 1077 ! Check first field (2d fields only) 1078 ! 1079 ! note: Nothing appears to be checked here. Rather, this is setting 1080 ! "0" values as "N" values 1081 1082 ! note: Again, this code appears to be using a false association between 1083 ! "is this 2d" and "is this field interpolated in time"? 1084 ! The "0" variables are needed only if there is interpolation in time. 1085 1086 IF ( .NOT.WRITE .AND. FL2D .AND. TF0(1) .EQ. -1 ) THEN Page 24 Source Listing W3FLDG 2014-09-16 17:01 w3fldsmd.f90 1087 ! 1088 TF0(1) = T0(1) 1089 TF0(2) = T0(2) 1090 ! 1091 DO IX=1, NX 1092 DO IY=1, NY 1093 FX0(IX,IY) = FXN(IX,IY) 1094 FY0(IX,IY) = FYN(IX,IY) 1095 END DO 1096 IF( FLST ) THEN 1097 DO IY=1, NY 1098 FA0(IX,IY) = FAN(IX,IY) 1099 END DO 1100 END IF 1101 END DO 1102 ! 1103 END IF 1104 ! 1105 ! Branch point for EOF in 1d fields, e.g. level and ice 1106 ! 1107 500 CONTINUE 1108 ! 1109 ! Process fields, end ----------------------------------------------- * 1110 ! 1111 RETURN 1112 ! 1113 ! EOF escape location (have read to end of file) 1114 ! 1115 800 CONTINUE 1116 IERR = -1 1117 ! 1118 IF ( FL2D ) THEN 1119 TFN(1) = TN(1) 1120 TFN(2) = TN(2) 1121 CALL TICK21 ( TFN , 1. ) 1122 END IF 1123 ! 1124 IF ( FL2D ) THEN 1125 GOTO 300 1126 ELSE 1127 GOTO 500 1128 END IF 1129 ! 1130 ! Error escape locations 1131 ! 1132 801 CONTINUE 1133 IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT 1134 IERR = 1 1135 RETURN 1136 ! 1137 802 CONTINUE 1138 IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD 1139 IERR = 2 1140 RETURN 1141 ! 1142 803 CONTINUE 1143 IF ( NDSE .GE. 0 ) WRITE (NDSE,1003) ISTAT Page 25 Source Listing W3FLDG 2014-09-16 17:01 w3fldsmd.f90 1144 IERR = 3 1145 RETURN 1146 ! 1147 804 CONTINUE 1148 IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) J, ISTAT 1149 IERR = 4 1150 RETURN 1151 ! 1152 805 CONTINUE 1153 IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) ISTAT 1154 IERR = 5 1155 RETURN 1156 ! 1157 806 CONTINUE 1158 IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) J, ISTAT 1159 IERR = 6 1160 RETURN 1161 ! 1162 807 CONTINUE 1163 IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) J, ISTAT 1164 IERR = 7 1165 RETURN 1166 ! 1167 ! Formats 1168 ! 1169 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ & 1170 ' ILLEGAL INXOUT STRING : ',A/) 1171 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ & 1172 ' ILLEGAL FIELD ID STRING : ',A/) 1173 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ & 1174 ' ERROR IN WRITING TIME, IOSTAT =',I6/) 1175 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ & 1176 ' ERROR IN WRITING FIELD ',I1,', IOSTAT =',I6/) 1177 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ & 1178 ' ERROR IN READING TIME, IOSTAT =',I6/) 1179 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ & 1180 ' PRMATURE EOF READING FIELD ',I1,', IOSTAT =',I6/) 1181 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ & 1182 ' ERROR IN READING FIELD ',I1,', IOSTAT =',I6/) 1183 ! 1184 !/ 1185 !/ End of W3FLDG ----------------------------------------------------- / 1186 !/ 1187 END SUBROUTINE W3FLDG Page 26 Source Listing W3FLDG 2014-09-16 17:01 Entry Points w3fldsmd.f90 ENTRY POINTS Name w3fldsmd_mp_w3fldg_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1001 Label 1169 1133 1002 Label 1171 1138 1003 Label 1173 1143 1004 Label 1175 1148 1005 Label 1177 1153 1006 Label 1179 1158 1007 Label 1181 1163 300 Label 1075 1125 500 Label 1107 1127 800 Label 1115 1028 801 Label 1132 938 802 Label 1137 945 803 Label 1142 1005 804 Label 1147 1008,1012,1015,1018 805 Label 1152 1028 806 Label 1157 1033,1037,1040,1048 807 Label 1162 1033,1037,1040,1048 DSEC21 Func 1054 R(4) 4 scalar 1054 DTTST Local 928 R(4) 4 scalar 1054,1061,1067 FA0 Dummy 805 R(4) 4 2 0 ARG,INOUT 992,1009,1019,1098 FAN Dummy 806 R(4) 4 2 0 ARG,INOUT 992,1034,1042,1049,1098 FL2D Local 929 L(4) 4 scalar 950,978,1006,1029,1061,1086,1118,1 124 FLBE Local 929 L(4) 4 scalar 952 FLFRST Local 929 L(4) 4 scalar 954,1061 FLST Local 929 L(4) 4 scalar 953,990,1018,1048,1096 FX0 Dummy 805 R(4) 4 2 0 ARG,INOUT 987,1013,1093 FXN Dummy 806 R(4) 4 2 0 ARG,INOUT 987,1038,1042,1093 FY0 Dummy 805 R(4) 4 2 0 ARG,INOUT 988,1016,1094 FYN Dummy 806 R(4) 4 2 0 ARG,INOUT 988,1041,1094 IDFLD Dummy 804 CHAR 3 scalar ARG,IN 939,940,941,942,943,944,945,950,95 1,952,953,1138 IERR Dummy 806 I(4) 4 scalar ARG,OUT 934,1116,1134,1139,1144,1149,1154, 1159,1164 INXOUT Dummy 804 CHAR scalar ARG,IN 938,949,1133 ISTAT Local 927 I(4) 4 scalar 1005,1008,1012,1015,1018,1028,1033 ,1037,1040,1048,1143,1148,1153,115 8,1163 IX Local 927 I(4) 4 scalar 985,987,988,992,1009,1013,1016,101 9,1034,1038,1041,1049,1091,1093,10 94,1098 IY Local 927 I(4) 4 scalar 986,987,988,991,992,1009,1013,1016 ,1019,1034,1038,1041,1049,1092,109 3,1094,1097,1098 Page 27 Source Listing W3FLDG 2014-09-16 17:01 Symbol Table w3fldsmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References J Local 927 I(4) 4 scalar 1007,1011,1014,1017,1032,1036,1039 ,1047,1148,1158,1163 MX Dummy 804 I(4) 4 scalar ARG,IN 918,919,920 MY Dummy 804 I(4) 4 scalar ARG,IN 918,919,920 NDS Dummy 804 I(4) 4 scalar ARG,IN 1005,1008,1012,1015,1018,1028,1033 ,1037,1040,1048 NDSE Dummy 804 I(4) 4 scalar ARG,IN 1133,1138,1143,1148,1153,1158,1163 NDST Dummy 804 I(4) 4 scalar ARG,IN NX Dummy 805 I(4) 4 scalar ARG,IN 985,1009,1013,1016,1019,1034,1038, 1041,1049,1091 NY Dummy 805 I(4) 4 scalar ARG,IN 986,991,1009,1013,1016,1019,1034,1 038,1041,1049,1092,1097 T0 Dummy 805 I(4) 4 1 2 ARG,IN 1054,1088,1089 TF0 Dummy 805 I(4) 4 1 2 ARG,INOUT 980,981,1005,1086,1088,1089 TFN Dummy 806 I(4) 4 1 2 ARG,INOUT 954,980,981,984,1028,1054,1119,112 0,1121 TICK21 Subr 1121 1121 TN Dummy 805 I(4) 4 1 2 ARG,IN 1119,1120 W3FLDG Subr 804 W3TIMEMD Module 907 907 WRITE Local 929 L(4) 4 scalar 949,978,1003,1086 Page 28 Source Listing W3FLDG 2014-09-16 17:01 w3fldsmd.f90 1188 !/ ------------------------------------------------------------------- / 1189 SUBROUTINE W3FLDD (INXOUT, IDFLD, NDS, NDST, NDSE, TIME, TD, & 1190 NR, ND, NDOUT, DATA, IERR ) 1191 !/ 1192 !/ +-----------------------------------+ 1193 !/ | WAVEWATCH III NOAA/NCEP | 1194 !/ | H. L. Tolman | 1195 !/ | FORTRAN 90 | 1196 !/ | Last update : 26-Dec-2012 | 1197 !/ +-----------------------------------+ 1198 !/ 1199 !/ 24-Jan-2002 : Origination. ( version 2.17 ) 1200 !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.11 ) 1201 !/ 1202 ! 1. Purpose : 1203 ! 1204 ! Update assimilation data in the WAVEWATCH III generic shell from 1205 ! a WAVEWATCH III shell data file or write from preprocessor. 1206 ! 1207 ! 2. Method : 1208 ! 1209 ! Read from file opened by W3FLDO. 1210 ! 1211 ! 3. Parameters : 1212 ! 1213 ! Parameter list 1214 ! ---------------------------------------------------------------- 1215 ! INXOUT C*(*) I Test string for read/write, valid are: 1216 ! 'WRITE' Write a data field to file. 1217 ! 'SIZE' Get the number of records of 1218 ! next data set. 1219 ! 'READ' Read the data set found by 1220 ! 'SIZE' after allocating proper 1221 ! data array. 1222 ! IDFLD C*3 I ID string for field type, valid are: 1223 ! 'DT0', 'DT1', and 'DT2'. 1224 ! NDS Int. I Dataset number for fields file. 1225 ! NDST Int. I Dataset number for test output. 1226 ! NDSE Int. I Dataset number for error output. 1227 ! (No error output if NDSE < 0 ). 1228 ! TIME I.A. I Minimum time for data. 1229 ! TD I.A. I/O Data time. 1230 ! NR,ND Int. I Array dimensions. 1231 ! NDOUT Int. O Number of data to be read next. 1232 ! DATA R.A. I/O Data array. 1233 ! IERR Int. O Error indicator, 1234 ! -1 Past last data 1235 ! 0 OK, 1236 ! 1 : Illegal INXOUT. 1237 ! 2 : Illegal IDFLD. 1238 ! 3 : Error in writing time. 1239 ! 4 : Error in writing data. 1240 ! 5 : Error in reading time. 1241 ! 6 : Premature EOF reading data. 1242 ! 7 : Error reading data. 1243 ! ---------------------------------------------------------------- 1244 ! Page 29 Source Listing W3FLDD 2014-09-16 17:01 w3fldsmd.f90 1245 ! 4. Subroutines used : 1246 ! 1247 ! Name Type Module Description 1248 ! ---------------------------------------------------------------- 1249 ! STRACE Subr. Id. Subroutine tracing. 1250 ! TICK21 Subr. W3TIMEMD Advance time. 1251 ! DSEC21 Func. Id. Difference between times. 1252 ! ---------------------------------------------------------------- 1253 ! 1254 ! 5. Called by : 1255 ! 1256 ! Name Type Module Description 1257 ! ---------------------------------------------------------------- 1258 ! WW3_PREP Prog. N/A Input data preprocessor. 1259 ! WW3_SHEL Prog. N/A Basic wave model driver. 1260 ! ...... Prog. N/A Any other program that reads or 1261 ! writes WAVEWATCH III data files. 1262 ! ---------------------------------------------------------------- 1263 ! 1264 ! 6. Error messages : 1265 ! 1266 ! See end of subroutine. 1267 ! 1268 ! 7. Remarks : 1269 ! 1270 ! 8. Structure : 1271 ! 1272 ! See source code. 1273 ! 1274 ! 9. Switches : 1275 ! 1276 ! !/S Enable subroutine tracing. 1277 ! !/T Enable test output. 1278 ! 1279 ! 10. Source code : 1280 ! 1281 !/ ------------------------------------------------------------------- / 1282 !/ 1283 USE W3TIMEMD 1284 ! 1285 IMPLICIT NONE 1286 !/ 1287 !/ ------------------------------------------------------------------- / 1288 !/ Parameter list 1289 !/ 1290 INTEGER, INTENT(IN) :: NDS, NDST, NDSE, TIME(2), NR, ND 1291 INTEGER, INTENT(INOUT) :: TD(2), NDOUT 1292 INTEGER, INTENT(OUT) :: IERR 1293 REAL, INTENT(INOUT) :: DATA(NR,ND) 1294 CHARACTER, INTENT(IN) :: INXOUT*(*) 1295 CHARACTER(LEN=3), INTENT(IN) :: IDFLD 1296 !/ 1297 !/ ------------------------------------------------------------------- / 1298 !/ Local parameters 1299 !/ 1300 INTEGER :: ISTAT, NRT 1301 REAL :: DTTST Page 30 Source Listing W3FLDD 2014-09-16 17:01 w3fldsmd.f90 1302 LOGICAL :: WRITE, SIZE 1303 !/ 1304 !/ ------------------------------------------------------------------- / 1305 !/ 1306 !/ 1307 IERR = 0 1308 ! 1309 ! test input parameters ---------------------------------------------- * 1310 ! 1311 IF ( INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE' .AND. & 1312 INXOUT.NE.'SIZE' ) GOTO 801 1313 IF ( IDFLD.NE.'DT0' .AND. IDFLD.NE.'DT1' .AND. & 1314 IDFLD.NE.'DT2' ) GOTO 802 1315 ! 1316 ! Set internal variables --------------------------------------------- * 1317 ! 1318 WRITE = INXOUT .EQ. 'WRITE' 1319 SIZE = INXOUT .EQ. 'SIZE' 1320 ! 1321 ! Process fields, write --------------------------------------------- * 1322 ! 1323 IF ( WRITE ) THEN 1324 ! 1325 WRITE (NDS,ERR=803,IOSTAT=ISTAT) TD, ND 1326 WRITE (NDS,ERR=804,IOSTAT=ISTAT) DATA 1327 ! 1328 ! Process fields, read size ----------------------------------------- * 1329 ! 1330 ELSE IF ( SIZE ) THEN 1331 ! 1332 100 CONTINUE 1333 READ (NDS,END=800,ERR=805,IOSTAT=ISTAT) TD, NDOUT 1334 ! 1335 ! Check time, read and branch back if necessary 1336 ! 1337 DTTST = DSEC21 ( TIME , TD ) 1338 IF ( DTTST.LT.0. .OR. NDOUT.EQ.0 ) THEN 1339 IF (NDOUT.GT.0) READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) 1340 GOTO 100 1341 END IF 1342 ! 1343 ! Process fields, read data ----------------------------------------- * 1344 ! 1345 ELSE 1346 ! 1347 READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) DATA 1348 END IF 1349 ! 1350 ! Process fields, end ----------------------------------------------- * 1351 ! 1352 RETURN 1353 ! 1354 ! EOF escape location 1355 ! 1356 800 CONTINUE 1357 IERR = -1 1358 RETURN Page 31 Source Listing W3FLDD 2014-09-16 17:01 w3fldsmd.f90 1359 ! 1360 ! Error escape locations 1361 ! 1362 801 CONTINUE 1363 IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT 1364 IERR = 1 1365 RETURN 1366 ! 1367 802 CONTINUE 1368 IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD 1369 IERR = 2 1370 RETURN 1371 ! 1372 803 CONTINUE 1373 IF ( NDSE .GE. 0 ) WRITE (NDSE,1003) ISTAT 1374 IERR = 3 1375 RETURN 1376 ! 1377 804 CONTINUE 1378 IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) ISTAT 1379 IERR = 4 1380 RETURN 1381 ! 1382 805 CONTINUE 1383 IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) ISTAT 1384 IERR = 5 1385 RETURN 1386 ! 1387 806 CONTINUE 1388 IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) ISTAT 1389 IERR = 6 1390 RETURN 1391 ! 1392 807 CONTINUE 1393 IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) ISTAT 1394 IERR = 7 1395 RETURN 1396 ! 1397 ! Formats 1398 ! 1399 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ & 1400 ' ILLEGAL INXOUT STRING : ',A/) 1401 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ & 1402 ' ILLEGAL FIELD ID STRING : ',A/) 1403 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ & 1404 ' ERROR IN WRITING TIME, IOSTAT =',I6/) 1405 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ & 1406 ' ERROR IN WRITING DATA, IOSTAT =',I6/) 1407 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ & 1408 ' ERROR IN READING TIME, IOSTAT =',I6/) 1409 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ & 1410 ' PRMATURE EOF READING DATA, IOSTAT =',I6/) 1411 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ & 1412 ' ERROR IN READING DATA, IOSTAT =',I6/) 1413 ! 1414 !/ 1415 !/ End of W3FLDD ----------------------------------------------------- / Page 32 Source Listing W3FLDD 2014-09-16 17:01 w3fldsmd.f90 1416 !/ 1417 END SUBROUTINE W3FLDD ENTRY POINTS Name w3fldsmd_mp_w3fldd_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 100 Label 1332 1340 1001 Label 1399 1363 1002 Label 1401 1368 1003 Label 1403 1373 1004 Label 1405 1378 1005 Label 1407 1383 1006 Label 1409 1388 1007 Label 1411 1393 800 Label 1356 1333 801 Label 1362 1312 802 Label 1367 1314 803 Label 1372 1325 804 Label 1377 1326 805 Label 1382 1333 806 Label 1387 1339,1347 807 Label 1392 1339,1347 DATA Dummy 1190 R(4) 4 2 0 ARG,INOUT 1326,1347 DSEC21 Func 1337 R(4) 4 scalar 1337 DTTST Local 1301 R(4) 4 scalar 1337,1338 IDFLD Dummy 1189 CHAR 3 scalar ARG,IN 1313,1314,1368 IERR Dummy 1190 I(4) 4 scalar ARG,OUT 1307,1357,1364,1369,1374,1379,1384 ,1389,1394 INXOUT Dummy 1189 CHAR scalar ARG,IN 1311,1312,1318,1319,1363 ISTAT Local 1300 I(4) 4 scalar 1325,1326,1333,1339,1347,1373,1378 ,1383,1388,1393 ND Dummy 1190 I(4) 4 scalar ARG,IN 1293,1325 NDOUT Dummy 1190 I(4) 4 scalar ARG,INOUT 1333,1338,1339 NDS Dummy 1189 I(4) 4 scalar ARG,IN 1325,1326,1333,1339,1347 NDSE Dummy 1189 I(4) 4 scalar ARG,IN 1363,1368,1373,1378,1383,1388,1393 NDST Dummy 1189 I(4) 4 scalar ARG,IN NR Dummy 1190 I(4) 4 scalar ARG,IN 1293 NRT Local 1300 I(4) 4 scalar SIZE Local 1302 L(4) 4 scalar 1319,1330 TD Dummy 1189 I(4) 4 1 2 ARG,INOUT 1325,1333,1337 TIME Dummy 1189 I(4) 4 1 2 ARG,IN 1337 W3FLDD Subr 1189 W3TIMEMD Module 1283 1283 WRITE Local 1302 L(4) 4 scalar 1318,1323 Page 33 Source Listing W3FLDD 2014-09-16 17:01 w3fldsmd.f90 1418 !/ ------------------------------------------------------------------- / 1419 SUBROUTINE W3FLDP ( NDSM, NDST, NDSE, IERR, FLAGLL, & 1420 MX, MY, NX, NY, & 1421 TLAT, TLON, MAPOVR, ILAND, MXI, MYI, & 1422 NXI, NYI, CLOSED, ALAT, ALON, MASK, & 1423 RD11, RD21, RD12, RD22, IX1, IX2, IY1, IY2 ) 1424 !/ 1425 !/ +-----------------------------------+ 1426 !/ | WAVEWATCH III NOAA/NCEP | 1427 !/ | H. L. Tolman | 1428 !/ | FORTRAN 90 | 1429 !/ | Last update : 30-Oct-2009 | 1430 !/ +-----------------------------------+ 1431 !/ 1432 !/ 08-Feb-1999 : Final FORTRAN 77 ( version 1.18 ) 1433 !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 1434 !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 ) 1435 !/ (W. E. Rogers & T. J. Campbell, NRL) 1436 !/ 1437 ! 1. Purpose : 1438 ! 1439 ! General purpose routine for interpolating data of an irregular 1440 ! grid given by ALAT and ALON to a target grid given by TLAT and TLON. 1441 ! 1442 ! 2. Method : 1443 ! 1444 ! Use the grid search and remapping utilities (W3GSRUMD). 1445 ! Bi-linear interpolation. 1446 ! 1447 ! 3. Parameters : 1448 ! 1449 ! Parameter list 1450 ! ---------------------------------------------------------------- 1451 ! NDSM Int. I Unit number message output (disabled if 0). 1452 ! NDST Int. I Unit number test output. 1453 ! NDSE Int. I Unit number error output. 1454 ! IERR Int. O Error indicator (number of lost points due 1455 ! to ap conflicts). 1456 ! FLAGLL Log. I Coordinate system flag (T=Lat/Lon, F=Cartesian) 1457 ! MX,MY Int. I Array dimensions for output type arrays. 1458 ! NX,NY Int. I Id. actual field syze. 1459 ! TLAT R.A. I Y-coordinates of output grid. 1460 ! TLON R.A. I X-coordinates of output grid. 1461 ! MAPOVR I.A. I/O Overlay map, the value of a grid point is 1462 ! incremeted by 1 of the corresponding grid 1463 ! point of the output grid is covered by the 1464 ! input grid. Land points are masked out by 1465 ! setting them to ILAND. 1466 ! ILAND Int. I Value for land points in MAPOVR (typically<0) 1467 ! MXI,MYI Int. I Array dimensions for input fields. 1468 ! NXI,NYI Int. I Id. actual field sizes. 1469 ! CLOSED Log. I Flag for closed longitude range in input. 1470 ! ALAT R.A. I Y-coordinates of input grid. 1471 ! ALON R.A. I/O X-coordinates of input grid. 1472 ! (will be modified if CLOSED) 1473 ! MASK I.A. I Land-sea mask for input field (0=land). 1474 ! RDnn R.A. O Interpolation factors (see below). Page 34 Source Listing W3FLDP 2014-09-16 17:01 w3fldsmd.f90 1475 ! IXn,IYn I.A. O Interpolation addresses (see below). 1476 ! ---------------------------------------------------------------- 1477 ! 1478 ! RD12| |RD22 1479 ! IY2 --+----------+-- 1480 ! | | 1481 ! | | 1482 ! | | 1483 ! | | 1484 ! IY1 --+----------+-- 1485 ! RD11| |RD21 1486 ! 1487 ! IX1 IX2 1488 ! 1489 ! Internal parameters 1490 ! ---------------------------------------------------------------- 1491 ! ---------------------------------------------------------------- 1492 ! 1493 ! 4. Subroutines used : 1494 ! 1495 ! Name Type Module Description 1496 ! ---------------------------------------------------------------- 1497 ! STRACE Subr. Id. Subroutine tracing. 1498 ! TICK21 Subr. W3TIMEMD Advance time. 1499 ! DSEC21 Func. Id. Difference between times. 1500 ! W3GSUC Func. W3GSRUMD Create grid-search-utility object 1501 ! W3GSUD Subr. W3GSRUMD Destroy grid-search-utility object 1502 ! W3GRMP Func. W3GSRUMD Compute interpolation weights 1503 ! ---------------------------------------------------------------- 1504 ! 1505 ! 5. Called by : 1506 ! 1507 ! Name Type Module Description 1508 ! ---------------------------------------------------------------- 1509 ! WW3_PREP Prog. N/A Input data preprocessor. 1510 ! ...... Prog. N/A Any other program that reads or 1511 ! writes WAVEWATCH III data files. 1512 ! ---------------------------------------------------------------- 1513 ! 1514 ! 6. Error messages : 1515 ! 1516 ! 7. Remarks : 1517 ! 1518 ! - Land points in the input grid are taken out of the interp. 1519 ! algorithm. If this results in zero weight factors through the 1520 ! interpolation box in the input grid, the closest 2 sea point 1521 ! for an extended 4x4 grid are used for interpolation, weighted 1522 ! by the inverse distance. 1523 ! 1524 ! 8. Structure : 1525 ! 1526 ! ----------------------------------------------------------------- 1527 ! 1. Initializations. 1528 ! a Initialize counters and factors. 1529 ! b Setup logical mask 1530 ! c Create grid-search-utility object 1531 ! 2. Loop over output grid Page 35 Source Listing W3FLDP 2014-09-16 17:01 w3fldsmd.f90 1532 ! a Check if sea point 1533 ! b Find enclosing cell and compute interpolation weights using 1534 ! W3GRMP 1535 ! c Non-masked or partially masked cell 1536 ! d Fully masked cell 1537 ! e Update overlay map 1538 ! 2. Finalizations. 1539 ! a Final output 1540 ! b Destroy grid-search-utility object 1541 ! ----------------------------------------------------------------- 1542 ! 1543 ! 9. Switches : 1544 ! 1545 ! !/S Enable subroutine tracing. 1546 ! 1547 ! !/T Enable limited test output. 1548 ! !/T1 Enable full debugging in W3GRMP 1549 ! 1550 ! 10. Source code : 1551 ! 1552 !/ ------------------------------------------------------------------- / 1553 !/ 1554 USE W3GSRUMD 1555 ! 1556 IMPLICIT NONE 1557 !/ 1558 !/ ------------------------------------------------------------------- / 1559 !/ Parameter list 1560 !/ 1561 INTEGER, INTENT(IN) :: NDSM, NDST, NDSE, MX, MY, NX, NY, & 1562 MXI, MYI, NXI, NYI, MASK(MXI,MYI) 1563 INTEGER, INTENT(INOUT) :: MAPOVR(MX,MY), ILAND 1564 INTEGER, INTENT(OUT) :: IERR, IX1(MX,MY), IX2(MX,MY), & 1565 IY1(MX,MY), IY2(MX,MY) 1566 REAL, INTENT(IN) :: TLAT(MY,MX), TLON(MY,MX) 1567 REAL, INTENT(IN) ,TARGET :: ALAT(MXI,MYI) 1568 REAL, INTENT(INOUT),TARGET :: ALON(MXI,MYI) 1569 REAL, INTENT(OUT) :: RD11(MX,MY), RD12(MX,MY), & 1570 RD21(MX,MY), RD22(MX,MY) 1571 LOGICAL, INTENT(IN) :: FLAGLL, CLOSED 1572 !/ 1573 !/ ------------------------------------------------------------------- / 1574 !/ Local parameters 1575 !/ 1576 TYPE(T_GSU) :: GSU 1577 INTEGER :: IX, IY, I, J, NNBR, II(4), JJ(4), & 1578 MSKC, IFOUND, IMASK, ICOR1 1579 REAL :: RR(4), X, Y 1580 REAL, POINTER :: PLAT(:,:), PLON(:,:) 1581 LOGICAL :: INGRID, LMSK(MXI,MYI) 1582 LOGICAL :: LDBG = .FALSE. 1583 INTEGER, PARAMETER :: NNBR_MAX = 2 1584 INTEGER :: ICLO 1585 !/ 1586 !/ ------------------------------------------------------------------- / 1587 !/ 1588 ! Page 36 Source Listing W3FLDP 2014-09-16 17:01 w3fldsmd.f90 1589 ! 1. Initializations ------------------------------------------------ * 1590 ! 1.a Initialize counters and factors 1591 ! 1592 IERR = 0 1593 IFOUND = 0 1594 IMASK = 0 1595 ICOR1 = 0 1596 ICLO = ICLO_NONE 1597 IF ( FLAGLL .AND. CLOSED ) ICLO = ICLO_SMPL 1598 ! 1599 DO 110, IX=1, NX 1600 DO 100, IY=1, NY 1601 RD11(IX,IY) = 0. 1602 RD12(IX,IY) = 0. 1603 RD21(IX,IY) = 0. 1604 RD22(IX,IY) = 0. 1605 IX1(IX,IY) = 1 1606 IX2(IX,IY) = 1 1607 IY1(IX,IY) = 1 1608 IY2(IX,IY) = 1 1609 100 CONTINUE 1610 110 CONTINUE 1611 ! 1612 ! 1.b Setup logical mask 1613 ! 1614 LMSK = MASK .EQ. 0 1615 ! 1616 ! 1.c Create grid-search-utility object for input grid 1617 ! 1618 PLAT => ALAT 1619 PLON => ALON 1620 GSU = W3GSUC( .TRUE., FLAGLL, ICLO, MXI, MYI, PLON, PLAT ) 1621 ! 1622 ! 2. Loop over output grid ------------------------------------------ * 1623 ! 1624 DO 500, IY=1, NY 1625 DO 400, IX=1, NX 1626 ! 1627 X = TLON(IY,IX) 1628 Y = TLAT(IY,IX) 1629 ! 1630 ! 2.a Check if sea point 1631 ! 1632 IF ( MAPOVR(IX,IY) .NE. ILAND ) THEN 1633 ! 1634 ! 2.b Find enclosing cell and compute interpolation weights 1635 ! 1636 NNBR = NNBR_MAX 1637 INGRID = W3GRMP( GSU, X, Y, II, JJ, RR, & 1638 LMSK, MSKC, NNBR, LDBG ) 1639 ! 1640 IF ( INGRID ) THEN 1641 ! 1642 ! 2.c Non-masked or partially masked cell: simply store the weights 1643 ! 1644 IF ( MSKC.EQ.MSKC_NONE .OR. MSKC.EQ.MSKC_PART ) THEN 1645 ! Page 37 Source Listing W3FLDP 2014-09-16 17:01 w3fldsmd.f90 1646 IF ( MSKC.EQ.MSKC_PART ) IMASK = IMASK + 1 1647 ! 1648 ! ..... Here we switch from counter-clockwise order to column-major 1649 IX1 (IX,IY) = II(1) 1650 IX2 (IX,IY) = II(2) 1651 IY1 (IX,IY) = JJ(1) 1652 IY2 (IX,IY) = JJ(4) 1653 RD11(IX,IY) = RR(1) 1654 RD21(IX,IY) = RR(2) 1655 RD12(IX,IY) = RR(4) 1656 RD22(IX,IY) = RR(3) 1657 ! 1658 ! 2.d Fully masked cell 1659 ! 1660 ELSE !MSKC.EQ.MSKC_FULL 1661 ! 1662 IMASK = IMASK + 1 1663 ! 1664 IF ( NNBR .GT. 0 ) THEN 1665 ICOR1 = ICOR1 + 1 1666 IX1 (IX,IY) = II(1) 1667 IY1 (IX,IY) = JJ(1) 1668 RD11(IX,IY) = RR(1) 1669 IF ( NNBR .GT. 1 ) THEN 1670 IX1 (IX,IY) = II(2) 1671 IY1 (IX,IY) = JJ(2) 1672 RD22(IX,IY) = RR(2) 1673 END IF 1674 ELSE 1675 IERR = IERR + 1 1676 WRITE (NDSE,910) IX, IY, X, Y, & 1677 II(1), II(2), JJ(1), JJ(2) 1678 END IF ! NNBR 1679 ! 1680 END IF ! MSKC 1681 ! 1682 ! 2.e Update overlay map 1683 ! 1684 MAPOVR(IX,IY) = MAPOVR(IX,IY) + 1 1685 IFOUND = IFOUND + 1 1686 ! 1687 END IF ! INGRID 1688 ENDIF ! sea-point 1689 ! 1690 ! ... End loop over output grid -------------------------------------- * 1691 ! 1692 400 CONTINUE 1693 500 CONTINUE 1694 ! 1695 ! 3. Finalizations -------------------------------------------------- * 1696 ! 3.a Final output 1697 ! 1698 IF (NDSM.NE.0) WRITE (NDSM,900) IFOUND, IMASK, ICOR1, IERR 1699 ! 1700 ! 3.b Destroy grid-search-utility object 1701 ! 1702 CALL W3GSUD(GSU) Page 38 Source Listing W3FLDP 2014-09-16 17:01 w3fldsmd.f90 1703 ! 1704 RETURN 1705 ! 1706 ! Formats 1707 ! 1708 900 FORMAT (/' *** MESSAGE W3FLDP: FINAL SEA POINT COUNT :',I8/ & 1709 ' INTERPOLATION ACROSS SHORE:',I8/ & 1710 ' CORRECTED COASTAL POINTS :',I8/ & 1711 ' UNCORRECTABLE C. POINTS :',I8/) 1712 ! 1713 910 FORMAT ( ' *** WARNING W3FLDP : SEA POINT ON LAND MASK ', & 1714 '(COULD NOT BE CORRECTED)'/ & 1715 ' COORDINATES IN OUTPUT GRID :',2I4,2F8.2/ & 1716 ' X-COUNTERS IN INPUT GRID :',2I4/ & 1717 ' Y-COUNTERS IN INPUT GRID :',2I4) 1718 ! 1719 !/ 1720 !/ End of W3FLDP ----------------------------------------------------- / 1721 !/ 1722 END SUBROUTINE W3FLDP ENTRY POINTS Name w3fldsmd_mp_w3fldp_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 100 Label 1609 1600 110 Label 1610 1599 400 Label 1692 1625 500 Label 1693 1624 900 Label 1708 1698 910 Label 1713 1676 ALAT Dummy 1422 R(4) 4 2 0 ARG,TGT,IN 1618 ALON Dummy 1422 R(4) 4 2 0 ARG,TGT,INOUT 1619 CLOSED Dummy 1422 L(4) 4 scalar ARG,IN 1597 FLAGLL Dummy 1419 L(4) 4 scalar ARG,IN 1597,1620 GSU Local 1576 T_GSU 8 scalar 1620,1637,1702 I Local 1577 I(4) 4 scalar ICLO Local 1584 I(4) 4 scalar 1596,1597,1620 ICLO_NONE Param 1596 I(4) 4 scalar 1596 ICLO_SMPL Param 1597 I(4) 4 scalar 1597 ICOR1 Local 1578 I(4) 4 scalar 1595,1665,1698 IERR Dummy 1419 I(4) 4 scalar ARG,OUT 1592,1675,1698 IFOUND Local 1578 I(4) 4 scalar 1593,1685,1698 II Local 1577 I(4) 4 1 4 1637,1649,1650,1666,1670,1677 ILAND Dummy 1421 I(4) 4 scalar ARG,INOUT 1632 IMASK Local 1578 I(4) 4 scalar 1594,1646,1662,1698 INGRID Local 1581 L(4) 4 scalar 1637,1640 IX Local 1577 I(4) 4 scalar 1599,1601,1602,1603,1604,1605,1606 ,1607,1608,1625,1627,1628,1632,164 Page 39 Source Listing W3FLDP 2014-09-16 17:01 Symbol Table w3fldsmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 9,1650,1651,1652,1653,1654,1655,16 56,1666,1667,1668,1670,1671,1672,1 676,1684 IX1 Dummy 1423 I(4) 4 2 0 ARG,OUT 1605,1649,1666,1670 IX2 Dummy 1423 I(4) 4 2 0 ARG,OUT 1606,1650 IY Local 1577 I(4) 4 scalar 1600,1601,1602,1603,1604,1605,1606 ,1607,1608,1624,1627,1628,1632,164 9,1650,1651,1652,1653,1654,1655,16 56,1666,1667,1668,1670,1671,1672,1 676,1684 IY1 Dummy 1423 I(4) 4 2 0 ARG,OUT 1607,1651,1667,1671 IY2 Dummy 1423 I(4) 4 2 0 ARG,OUT 1608,1652 J Local 1577 I(4) 4 scalar JJ Local 1577 I(4) 4 1 4 1637,1651,1652,1667,1671,1677 LDBG Local 1582 L(4) 4 scalar 1582,1638 LMSK Local 1581 L(4) 4 2 0 TGT 1614,1638 MAPOVR Dummy 1421 I(4) 4 2 0 ARG,INOUT 1632,1684 MASK Dummy 1422 I(4) 4 2 0 ARG,IN 1614 MSKC Local 1578 I(4) 4 scalar 1638,1644,1646 MSKC_NONE Param 1644 I(4) 4 scalar 1644 MSKC_PART Param 1644 I(4) 4 scalar 1644,1646 MX Dummy 1420 I(4) 4 scalar ARG,IN 1563,1564,1565,1566,1569,1570 MXI Dummy 1421 I(4) 4 scalar ARG,IN 1562,1567,1568,1581,1620 MY Dummy 1420 I(4) 4 scalar ARG,IN 1563,1564,1565,1566,1569,1570 MYI Dummy 1421 I(4) 4 scalar ARG,IN 1562,1567,1568,1581,1620 NDSE Dummy 1419 I(4) 4 scalar ARG,IN 1676 NDSM Dummy 1419 I(4) 4 scalar ARG,IN 1698 NDST Dummy 1419 I(4) 4 scalar ARG,IN NNBR Local 1577 I(4) 4 scalar 1636,1638,1664,1669 NNBR_MAX Param 1583 I(4) 4 scalar 1636 NX Dummy 1420 I(4) 4 scalar ARG,IN 1599,1625 NXI Dummy 1422 I(4) 4 scalar ARG,IN NY Dummy 1420 I(4) 4 scalar ARG,IN 1600,1624 NYI Dummy 1422 I(4) 4 scalar ARG,IN PLAT Local 1580 R(4) 4 2 1 PTR 1618,1620 PLON Local 1580 R(4) 4 2 1 PTR 1619,1620 RD11 Dummy 1423 R(4) 4 2 0 ARG,OUT 1601,1653,1668 RD12 Dummy 1423 R(4) 4 2 0 ARG,OUT 1602,1655 RD21 Dummy 1423 R(4) 4 2 0 ARG,OUT 1603,1654 RD22 Dummy 1423 R(4) 4 2 0 ARG,OUT 1604,1656,1672 RR Local 1579 R(4) 4 1 4 1637,1653,1654,1655,1656,1668,1672 TLAT Dummy 1421 R(4) 4 2 0 ARG,IN 1628 TLON Dummy 1421 R(4) 4 2 0 ARG,IN 1627 T_GSU Type 1576 scalar 1576 W3FLDP Subr 1419 W3GRMP Local 1637 scalar 1637 W3GRMP_R4 Func 1637 L(4) 4 scalar PRIV 1637 W3GSRUMD Module 1554 1554 W3GSUC Local 1620 scalar 1620 W3GSUC_R4 Func 1620 RECORD 8 scalar PRIV 1620 W3GSUD Subr 1702 1702 X Local 1579 R(4) 4 scalar 1627,1637,1676 Y Local 1579 R(4) 4 scalar 1628,1637,1676 Page 40 Source Listing W3FLDP 2014-09-16 17:01 w3fldsmd.f90 1723 !/ ------------------------------------------------------------------- / 1724 SUBROUTINE W3FLDH (J, NDST, NDSE, MX, MY, NX, NY, T0, TN, & 1725 NH, NHM, THO, HA, HD, HS, TF0, FX0, FY0, FS0,& 1726 TFN, FXN, FYN, FSN, IERR) 1727 !/ 1728 !/ +-----------------------------------+ 1729 !/ | WAVEWATCH III NOAA/NCEP | 1730 !/ | H. L. Tolman | 1731 !/ | FORTRAN 90 | 1732 !/ | Last update : 05-Jul-2005 | 1733 !/ +-----------------------------------+ 1734 !/ 1735 !/ 15-Jan-1999 : Final FORTRAN 77 ( version 1.18 ) 1736 !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 1737 !/ 04-Sep-2003 : Bug fix par. list declaration. ( version 3.04 ) 1738 !/ 05-Jul-2005 : Correct first level/ice. ( version 3.07 ) 1739 !/ 1740 ! 1. Purpose : 1741 ! 1742 ! Update homogeneous input fields for the WAVEWATCH III generic 1743 ! shell. 1744 ! 1745 ! 2. Method : 1746 ! 1747 ! Variables defining the homogeneous fields are transfered through 1748 ! the parameter list (see section 3). 1749 ! 1750 ! 3. Parameters : 1751 ! 1752 ! Parameter list 1753 ! ---------------------------------------------------------------- 1754 ! J Int I Field number of input field as in shell. 1755 ! -7 : ice parameter 1 1756 ! -6 : ice parameter 2 1757 ! -5 : ice parameter 3 1758 ! -4 : ice parameter 4 1759 ! -3 : ice parameter 5 1760 ! -2 : mud parameter 1 1761 ! -1 : mud parameter 2 1762 ! 0 : mud parameter 3 1763 ! 1 : water levels 1764 ! 2 : currents 1765 ! 3 : winds 1766 ! NDST Int. I Unit number test output. 1767 ! NDSE Int. I Unit number error messages. 1768 ! (No output if NDSE < 0). 1769 ! MX,MY Int. I Array dimensions output fields. 1770 ! NX,NY Int. I Field dimensions output fields. 1771 ! T0-N I.A. I Time interval considered. 1772 ! NH Int. I/O Number of homogeneous fields J. 1773 ! NHM Int. I Array dimension corresponding to NH. 1774 ! THO I.A. I/O Times for all homogeneous fields left. 1775 ! HA R.A. I/O Id. amplitude. 1776 ! HD R.A. I/O Id. direction (degr., Naut.). 1777 ! HS R.A. I/O Id. air-sea temperature difference (degr.). 1778 ! TF0-N I.A. I/O Times of input fields 1779 ! Fxx R.A. I/O Input fields (X, Y, Scalar) Page 41 Source Listing W3FLDH 2014-09-16 17:01 w3fldsmd.f90 1780 ! IERR Int. O Error indicator, 1781 ! 0 OK, 1782 ! 1 Illegal field number 1783 ! -1 Past last data 1784 ! ---------------------------------------------------------------- 1785 ! 1786 ! 4. Subroutines used : 1787 ! 1788 ! Name Type Module Description 1789 ! ---------------------------------------------------------------- 1790 ! STRACE Subr. Id. Subroutine tracing. 1791 ! TICK21 Subr. W3TIMEMD Advance time. 1792 ! DSEC21 Func. Id. Difference between times. 1793 ! ---------------------------------------------------------------- 1794 ! 1795 ! 5. Called by : 1796 ! 1797 ! Name Type Module Description 1798 ! ---------------------------------------------------------------- 1799 ! WW3_SHEL Prog. N/A Basic wave model driver. 1800 ! ---------------------------------------------------------------- 1801 ! 1802 ! 6. Error messages : 1803 ! 1804 ! - See end of subroutine. 1805 ! - Array dimensions not checked. 1806 ! 1807 ! 7. Remarks : 1808 ! 1809 ! - No homogeneous ice fields available. 1810 ! - Previous fields needed only for 2-D fields. 1811 ! 1812 ! 8. Structure : 1813 ! 1814 ! See source code. 1815 ! 1816 ! 9. Switches : 1817 ! 1818 ! !/S Enable subroutine tracing. 1819 ! !/T Enable test output. 1820 ! 1821 ! 10. Source code : 1822 ! 1823 !/ ------------------------------------------------------------------- / 1824 !/ 1825 USE W3TIMEMD 1826 ! 1827 IMPLICIT NONE 1828 !/ 1829 !/ ------------------------------------------------------------------- / 1830 !/ Parameter list 1831 !/ 1832 INTEGER, INTENT(IN) :: J, NDST, NDSE, MX, MY, NX, NY, & 1833 T0(2), TN(2), NHM 1834 INTEGER, INTENT(INOUT) :: NH, THO(2,-7:4,NHM), TF0(2), TFN(2) 1835 INTEGER, INTENT(OUT) :: IERR 1836 REAL, INTENT(INOUT) :: HA(NHM,-7:4), HD(NHM,-7:4), HS(NHM,-7:4), & Page 42 Source Listing W3FLDH 2014-09-16 17:01 w3fldsmd.f90 1837 FX0(MX,MY), FY0(MX,MY), FS0(MX,MY), & 1838 FXN(MX,MY), FYN(MX,MY), FSN(MX,MY) 1839 !/ 1840 !/ ------------------------------------------------------------------- / 1841 !/ Local parameters 1842 !/ 1843 INTEGER :: IX, IY, I 1844 REAL :: X, Y, DIR, DTTST, DERA 1845 LOGICAL :: FLFRST 1846 !/ 1847 !/ ------------------------------------------------------------------- / 1848 !/ 1849 ! 1850 IERR = 0 1851 DERA = ATAN(1.)/45. 1852 1853 1854 ! 1855 ! Test field ID number for validity 1856 ! 1857 !old: IF ( J.LE.0 .OR. J .GT.3 ) GOTO 801 1858 IF ( J.LT.-7 .OR. J .GT.3 ) GOTO 801 1859 FLFRST = TFN(1) .EQ. -1 1860 ! 1861 ! Loop over times / fields ========================================== * 1862 ! 1863 DO 1864 ! 1865 ! Shift fields 1866 ! 1867 TF0(1) = TFN(1) 1868 TF0(2) = TFN(2) 1869 IF ( TFN(1) .NE. -1 ) THEN 1870 IF ( J .EQ. 2 ) THEN 1871 DO IX=1, NX 1872 DO IY=1, NY 1873 FX0(IX,IY) = FXN(IX,IY) 1874 FY0(IX,IY) = FYN(IX,IY) 1875 END DO 1876 END DO 1877 ELSE IF ( J .EQ. 3 ) THEN 1878 DO IX=1, NX 1879 DO IY=1, NY 1880 FX0(IX,IY) = FXN(IX,IY) 1881 FY0(IX,IY) = FYN(IX,IY) 1882 FS0(IX,IY) = FSN(IX,IY) 1883 END DO 1884 END DO 1885 END IF 1886 END IF 1887 ! 1888 ! New field 1889 ! 1890 IF ( NH .NE. 0. ) THEN 1891 TFN(1) = THO(1,J,1) 1892 TFN(2) = THO(2,J,1) 1893 ! Page 43 Source Listing W3FLDH 2014-09-16 17:01 w3fldsmd.f90 1894 IF ( J.GE.(-7).AND.(J.LE.1)) THEN 1895 DO IX=1, NX 1896 DO IY=1, NY 1897 FSN(IX,IY) = HS(1,J) 1898 1899 END DO 1900 END DO 1901 END IF 1902 ! 1903 IF ( J .EQ. 2 ) THEN 1904 DIR = ( 270. - HD(1,J) ) * DERA 1905 X = HA(1,J) * COS(DIR) 1906 Y = HA(1,J) * SIN(DIR) 1907 DO IX=1, NX 1908 DO IY=1, NY 1909 FXN(IX,IY) = X 1910 FYN(IX,IY) = Y 1911 END DO 1912 END DO 1913 END IF 1914 ! 1915 IF ( J .EQ. 3 ) THEN 1916 DIR = ( 270. - HD(1,J) ) * DERA 1917 X = HA(1,J) * COS(DIR) 1918 Y = HA(1,J) * SIN(DIR) 1919 DO IX=1, NX 1920 DO IY=1, NY 1921 FXN(IX,IY) = X 1922 FYN(IX,IY) = Y 1923 FSN(IX,IY) = HS(1,J) 1924 END DO 1925 END DO 1926 END IF 1927 ! 1928 ! Shift data arrays 1929 ! 1930 DO I=1, NH-1 1931 THO(1,J,I) = THO(1,J,I+1) 1932 THO(2,J,I) = THO(2,J,I+1) 1933 HA(I,J) = HA(I+1,J) 1934 HD(I,J) = HD(I+1,J) 1935 HS(I,J) = HS(I+1,J) 1936 END DO 1937 NH = NH - 1 1938 ! 1939 ELSE 1940 ! 1941 TFN(1) = TN(1) 1942 TFN(2) = TN(2) 1943 CALL TICK21 ( TFN , 1. ) 1944 IERR = -1 1945 ! 1946 END IF 1947 ! 1948 ! Check time 1949 ! 1950 DTTST = DSEC21 ( T0 , TFN ) Page 44 Source Listing W3FLDH 2014-09-16 17:01 w3fldsmd.f90 1951 IF ( J.GE.(-7).AND.(J.LE.1).AND.FLFRST .AND. DTTST.EQ.0. ) EXIT 1952 IF ( DTTST .GT. 0. ) EXIT 1953 END DO 1954 ! 1955 ! Check if first field 1956 ! 1957 IF ( J.NE.1 .AND. TFN(1) .EQ. -1 ) THEN 1958 TF0(1) = T0(1) 1959 TF0(2) = T0(2) 1960 ! 1961 DO IX=1, NX 1962 DO IY=1, NY 1963 FX0(IX,IY) = FXN(IX,IY) 1964 FY0(IX,IY) = FYN(IX,IY) 1965 FS0(IX,IY) = FSN(IX,IY) 1966 END DO 1967 END DO 1968 END IF 1969 ! 1970 RETURN 1971 ! 1972 ! Error escape locations 1973 ! 1974 801 CONTINUE 1975 IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) J 1976 IERR = 1 1977 RETURN 1978 ! 1979 ! Formats 1980 ! 1981 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDH : '/ & 1982 ' ILLEGAL FIELD ID NR : ',I4/) 1983 ! 1984 !/ 1985 !/ End of W3FLDH ----------------------------------------------------- / 1986 !/ 1987 END SUBROUTINE W3FLDH Page 45 Source Listing W3FLDH 2014-09-16 17:01 Entry Points w3fldsmd.f90 ENTRY POINTS Name w3fldsmd_mp_w3fldh_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1001 Label 1981 1975 801 Label 1974 1858 ATAN Func 1851 scalar 1851 COS Func 1905 scalar 1905,1917 DERA Local 1844 R(4) 4 scalar 1851,1904,1916 DIR Local 1844 R(4) 4 scalar 1904,1905,1906,1916,1917,1918 DSEC21 Func 1950 R(4) 4 scalar 1950 DTTST Local 1844 R(4) 4 scalar 1950,1951,1952 FLFRST Local 1845 L(4) 4 scalar 1859,1951 FS0 Dummy 1725 R(4) 4 2 0 ARG,INOUT 1882,1965 FSN Dummy 1726 R(4) 4 2 0 ARG,INOUT 1882,1897,1923,1965 FX0 Dummy 1725 R(4) 4 2 0 ARG,INOUT 1873,1880,1963 FXN Dummy 1726 R(4) 4 2 0 ARG,INOUT 1873,1880,1909,1921,1963 FY0 Dummy 1725 R(4) 4 2 0 ARG,INOUT 1874,1881,1964 FYN Dummy 1726 R(4) 4 2 0 ARG,INOUT 1874,1881,1910,1922,1964 HA Dummy 1725 R(4) 4 2 0 ARG,INOUT 1905,1906,1917,1918,1933 HD Dummy 1725 R(4) 4 2 0 ARG,INOUT 1904,1916,1934 HS Dummy 1725 R(4) 4 2 0 ARG,INOUT 1897,1923,1935 I Local 1843 I(4) 4 scalar 1930,1931,1932,1933,1934,1935 IERR Dummy 1726 I(4) 4 scalar ARG,OUT 1850,1944,1976 IX Local 1843 I(4) 4 scalar 1871,1873,1874,1878,1880,1881,1882 ,1895,1897,1907,1909,1910,1919,192 1,1922,1923,1961,1963,1964,1965 IY Local 1843 I(4) 4 scalar 1872,1873,1874,1879,1880,1881,1882 ,1896,1897,1908,1909,1910,1920,192 1,1922,1923,1962,1963,1964,1965 J Dummy 1724 I(4) 4 scalar ARG,IN 1858,1870,1877,1891,1892,1894,1897 ,1903,1904,1905,1906,1915,1916,191 7,1918,1923,1931,1932,1933,1934,19 35,1951,1957,1975 MX Dummy 1724 I(4) 4 scalar ARG,IN 1837,1838 MY Dummy 1724 I(4) 4 scalar ARG,IN 1837,1838 NDSE Dummy 1724 I(4) 4 scalar ARG,IN 1975 NDST Dummy 1724 I(4) 4 scalar ARG,IN NH Dummy 1725 I(4) 4 scalar ARG,INOUT 1890,1930,1937 NHM Dummy 1725 I(4) 4 scalar ARG,IN 1834,1836 NX Dummy 1724 I(4) 4 scalar ARG,IN 1871,1878,1895,1907,1919,1961 NY Dummy 1724 I(4) 4 scalar ARG,IN 1872,1879,1896,1908,1920,1962 SIN Func 1906 scalar 1906,1918 T0 Dummy 1724 I(4) 4 1 2 ARG,IN 1950,1958,1959 TF0 Dummy 1725 I(4) 4 1 2 ARG,INOUT 1867,1868,1958,1959 TFN Dummy 1726 I(4) 4 1 2 ARG,INOUT 1859,1867,1868,1869,1891,1892,1941 ,1942,1943,1950,1957 THO Dummy 1725 I(4) 4 3 0 ARG,INOUT 1891,1892,1931,1932 Page 46 Source Listing W3FLDH 2014-09-16 17:01 Symbol Table w3fldsmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References TICK21 Subr 1943 1943 TN Dummy 1724 I(4) 4 1 2 ARG,IN 1941,1942 W3FLDH Subr 1724 W3TIMEMD Module 1825 1825 X Local 1844 R(4) 4 scalar 1905,1909,1917,1921 Y Local 1844 R(4) 4 scalar 1906,1910,1918,1922 Page 47 Source Listing W3FLDH 2014-09-16 17:01 w3fldsmd.f90 1988 !/ ------------------------------------------------------------------- / 1989 SUBROUTINE W3FLDM (J, NDST, NDSE, T0, TN, NH, NHM, THO, HA, HD, & 1990 TF0, A0, D0, TFN, AN, DN, IERR) 1991 !/ 1992 !/ +-----------------------------------+ 1993 !/ | WAVEWATCH III NOAA/NCEP | 1994 !/ | H. L. Tolman | 1995 !/ | FORTRAN 90 | 1996 !/ | Last update : 26-Dec-2002 | 1997 !/ +-----------------------------------+ 1998 !/ 1999 !/ 26-Dec-2002 : Origination. ( version 3.02 ) 2000 !/ 2001 ! 1. Purpose : 2002 ! 2003 ! Update moving grid info for the WAVEWATCH III generic 2004 ! shell. 2005 ! 2006 ! 2. Method : 2007 ! 2008 ! Variables defining the homogeneous fields are transfered through 2009 ! the parameter list (see section 3). 2010 ! 2011 ! 3. Parameters : 2012 ! 2013 ! Parameter list 2014 ! ---------------------------------------------------------------- 2015 ! J Int I Field number, should be 4. 2016 ! NDST Int. I Unit number test output. 2017 ! NDSE Int. I Unit number error messages. 2018 ! (No output if NDSE < 0). 2019 ! T0-N I.A. I Time interval considered. 2020 ! NH Int. I/O Number of homogeneous fields J. 2021 ! NHM Int. I Array dimension corresponding to NH. 2022 ! THO I.A. I/O Times for all homogeneous fields left. 2023 ! HA R.A. I/O Id. amplitude. 2024 ! HD R.A. I/O Id. direction (degr., Naut.). 2025 ! TF0-N I.A. I/O Times of input fields 2026 ! A/D0/N R.A. I/O Input data. 2027 ! IERR Int. O Error indicator, 2028 ! 0 OK, 2029 ! 1 Illegal field number 2030 ! -1 Past last data 2031 ! ---------------------------------------------------------------- 2032 ! 2033 ! 4. Subroutines used : 2034 ! 2035 ! Name Type Module Description 2036 ! ---------------------------------------------------------------- 2037 ! STRACE Subr. Id. Subroutine tracing. 2038 ! TICK21 Subr. W3TIMEMD Advance time. 2039 ! DSEC21 Func. Id. Difference between times. 2040 ! ---------------------------------------------------------------- 2041 ! 2042 ! 5. Called by : 2043 ! 2044 ! Name Type Module Description Page 48 Source Listing W3FLDM 2014-09-16 17:01 w3fldsmd.f90 2045 ! ---------------------------------------------------------------- 2046 ! WW3_SHEL Prog. N/A Basic wave model driver. 2047 ! ---------------------------------------------------------------- 2048 ! 2049 ! 6. Error messages : 2050 ! 2051 ! - See end of subroutine. 2052 ! - Array dimensions not checked. 2053 ! 2054 ! 7. Remarks : 2055 ! 2056 ! 8. Structure : 2057 ! 2058 ! See source code. 2059 ! 2060 ! 9. Switches : 2061 ! 2062 ! !/S Enable subroutine tracing. 2063 ! !/T Enable test output. 2064 ! 2065 ! 10. Source code : 2066 ! 2067 !/ ------------------------------------------------------------------- / 2068 !/ 2069 USE W3TIMEMD 2070 ! 2071 IMPLICIT NONE 2072 !/ 2073 !/ ------------------------------------------------------------------- / 2074 !/ Parameter list 2075 !/ 2076 INTEGER, INTENT(IN) :: J, NDST, NDSE, T0(2), TN(2), NHM 2077 INTEGER, INTENT(INOUT) :: NH, THO(2,-7:4,NHM), TF0(2), TFN(2) 2078 INTEGER, INTENT(OUT) :: IERR 2079 REAL, INTENT(INOUT) :: HA(NHM,-7:4), HD(NHM,-7:4), A0, AN, D0, DN 2080 !/ 2081 !/ ------------------------------------------------------------------- / 2082 !/ Local parameters 2083 !/ 2084 INTEGER :: I 2085 REAL :: DTTST, DERA 2086 LOGICAL :: FLFRST 2087 !/ 2088 !/ ------------------------------------------------------------------- / 2089 !/ 2090 ! 2091 IERR = 0 2092 DERA = ATAN(1.)/45. 2093 ! 2094 ! Test field ID number for validity 2095 ! 2096 IF ( J .NE. 4 ) GOTO 801 2097 FLFRST = TFN(1) .EQ. -1 2098 ! 2099 ! Backward branch point ============================================= * 2100 ! 2101 100 CONTINUE Page 49 Source Listing W3FLDM 2014-09-16 17:01 w3fldsmd.f90 2102 ! 2103 ! Shift data 2104 ! 2105 TF0(1) = TFN(1) 2106 TF0(2) = TFN(2) 2107 IF ( TFN(1) .NE. -1 ) THEN 2108 A0 = AN 2109 D0 = DN 2110 END IF 2111 ! 2112 ! New field 2113 ! 2114 IF ( NH .NE. 0. ) THEN 2115 TFN(1) = THO(1,J,1) 2116 TFN(2) = THO(2,J,1) 2117 AN = HA(1,J) 2118 DN = ( 90. - HD(1,J) ) * DERA 2119 ! 2120 ! Shift data arrays 2121 ! 2122 DO I=1, NH-1 2123 THO(1,J,I) = THO(1,J,I+1) 2124 THO(2,J,I) = THO(2,J,I+1) 2125 HA(I,J) = HA(I+1,J) 2126 HD(I,J) = HD(I+1,J) 2127 END DO 2128 NH = NH - 1 2129 ! 2130 ELSE 2131 ! 2132 TFN(1) = TN(1) 2133 TFN(2) = TN(2) 2134 CALL TICK21 ( TFN , 1. ) 2135 IERR = -1 2136 ! 2137 END IF 2138 ! 2139 ! Check time 2140 ! 2141 DTTST = DSEC21 ( T0 , TFN ) 2142 IF ( DTTST .LE. 0. ) GOTO 100 2143 ! 2144 ! Check if first field 2145 ! 2146 IF ( TF0(1).EQ.-1 ) THEN 2147 TF0(1) = T0(1) 2148 TF0(2) = T0(2) 2149 A0 = AN 2150 D0 = DN 2151 END IF 2152 ! 2153 RETURN 2154 ! 2155 ! Error escape locations 2156 ! 2157 801 CONTINUE 2158 IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) J Page 50 Source Listing W3FLDM 2014-09-16 17:01 w3fldsmd.f90 2159 IERR = 1 2160 RETURN 2161 ! 2162 ! Formats 2163 ! 2164 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDM : '/ & 2165 ' ILLEGAL FIELD ID NR : ',I4/) 2166 ! 2167 !/ 2168 !/ End of W3FLDM ----------------------------------------------------- / 2169 !/ 2170 END SUBROUTINE W3FLDM ENTRY POINTS Name w3fldsmd_mp_w3fldm_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 100 Label 2101 2142 1001 Label 2164 2158 801 Label 2157 2096 A0 Dummy 1990 R(4) 4 scalar ARG,INOUT 2108,2149 AN Dummy 1990 R(4) 4 scalar ARG,INOUT 2108,2117,2149 ATAN Func 2092 scalar 2092 D0 Dummy 1990 R(4) 4 scalar ARG,INOUT 2109,2150 DERA Local 2085 R(4) 4 scalar 2092,2118 DN Dummy 1990 R(4) 4 scalar ARG,INOUT 2109,2118,2150 DSEC21 Func 2141 R(4) 4 scalar 2141 DTTST Local 2085 R(4) 4 scalar 2141,2142 FLFRST Local 2086 L(4) 4 scalar 2097 HA Dummy 1989 R(4) 4 2 0 ARG,INOUT 2117,2125 HD Dummy 1989 R(4) 4 2 0 ARG,INOUT 2118,2126 I Local 2084 I(4) 4 scalar 2122,2123,2124,2125,2126 IERR Dummy 1990 I(4) 4 scalar ARG,OUT 2091,2135,2159 J Dummy 1989 I(4) 4 scalar ARG,IN 2096,2115,2116,2117,2118,2123,2124 ,2125,2126,2158 NDSE Dummy 1989 I(4) 4 scalar ARG,IN 2158 NDST Dummy 1989 I(4) 4 scalar ARG,IN NH Dummy 1989 I(4) 4 scalar ARG,INOUT 2114,2122,2128 NHM Dummy 1989 I(4) 4 scalar ARG,IN 2077,2079 T0 Dummy 1989 I(4) 4 1 2 ARG,IN 2141,2147,2148 TF0 Dummy 1990 I(4) 4 1 2 ARG,INOUT 2105,2106,2146,2147,2148 TFN Dummy 1990 I(4) 4 1 2 ARG,INOUT 2097,2105,2106,2107,2115,2116,2132 ,2133,2134,2141 THO Dummy 1989 I(4) 4 3 0 ARG,INOUT 2115,2116,2123,2124 TICK21 Subr 2134 2134 TN Dummy 1989 I(4) 4 1 2 ARG,IN 2132,2133 W3FLDM Subr 1989 W3TIMEMD Module 2069 2069 Page 51 Source Listing W3FLDM 2014-09-16 17:01 w3fldsmd.f90 2171 !/ 2172 !/ End of module W3FLDSMD -------------------------------------------- / 2173 !/ 2174 END MODULE W3FLDSMD SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References W3FLDSMD Module 2 Page 52 Source Listing W3FLDM 2014-09-16 17:01 Subprograms/Common Blocks w3fldsmd.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References W3FLDD Subr 1189 W3FLDG Subr 804 W3FLDH Subr 1724 W3FLDM Subr 1989 W3FLDO Subr 80 W3FLDP Subr 1419 W3FLDSMD Module 2 W3FLDTIDE1 Subr 471 W3FLDTIDE2 Subr 635 COMPILER OPTIONS BEING USED -align nocommons -align nodcommons -align noqcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume byterecl -assume nocc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_unit_star -assume old_ldout_format -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume nostd_mod_proc_name -assume norealloc_lhs -assume underscore -assume no2underscores -auto no -auto_scalar no -bintext -ccdefault default -check noargs -check noarg_temp_created -check nobounds -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check power -check noshape -check nounderflow -check nouninitialized -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D _MT -D __INTEL_COMPILER_BUILD_DATE=20120612 -D __pentium4 -D __pentium4__ -D __tune_pentium4__ -D __SSE2__ -D __SSE3__ -D __SSSE3__ -D __SSE4_1__ -D __SSE4_2__ -D __SSE__ -D __MMX__ Page 53 Source Listing W3FLDM 2014-09-16 17:01 w3fldsmd.f90 -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 : w3fldsmd.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100