Page 1 Source Listing WMUPDT 2014-09-16 16:49 wmupdtmd.f90 1 !/ ------------------------------------------------------------------- / 2 MODULE WMUPDTMD 3 !/ 4 !/ +-----------------------------------+ 5 !/ | WAVEWATCH III NOAA/NCEP | 6 !/ | H. L. Tolman | 7 !/ | FORTRAN 90 | 8 !/ | Last update : 06-Dec-2010 | 9 !/ +-----------------------------------+ 10 !/ 11 !/ 22-Feb-2005 : Origination. ( version 3.07 ) 12 !/ 14-Oct-2006 : Adding separate input grids. ( version 3.10 ) 13 !/ 10-Dec-2006 : Bug fix WMUPD2 initial fields. ( version 3.10 ) 14 !/ 12-Jan-2007 : General clean-up and bug fixes. ( version 3.10 ) 15 !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) 16 !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) 17 !/ (W. E. Rogers & T. J. Campbell, NRL) 18 !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to 19 !/ specify index closure for a grid. ( version 3.14 ) 20 !/ (T. J. Campbell, NRL) 21 !/ 22 !/ Copyright 2009 National Weather Service (NWS), 23 !/ National Oceanic and Atmospheric Administration. All rights 24 !/ reserved. WAVEWATCH III is a trademark of the NWS. 25 !/ No unauthorized use without permission. 26 !/ 27 ! 1. Purpose : 28 ! 29 ! Update model input at the driver level of the multi-grid 30 ! version of WAVEWATCH III. 31 ! 32 ! 2. Variables and types : 33 ! 34 ! 3. Subroutines and functions : 35 ! 36 ! Name Type Scope Description 37 ! ---------------------------------------------------------------- 38 ! WMUPDT Subr. Public Updating of all model inputs. 39 ! WMUPD1 Subr. Public Native inputs. 40 ! WMUPD2 Subr. Public From input grids. 41 ! WMUPDV Subr. Public For WMUPD2 vector fields. 42 ! WMUPDS Subr. Public For WMUPD2 scalar fields. 43 ! ---------------------------------------------------------------- 44 ! 45 ! 4. Subroutines and functions used : 46 ! 47 ! See subroutine documentation. 48 ! 49 ! 5. Remarks : 50 ! 51 ! 6. Switches : 52 ! 53 ! !/CRX0 Current vector component conservation. 54 ! !/CRX1 Current speed conservation. 55 ! !/CRX2 Current exenrgy conservation. 56 ! 57 ! !/WNX0 Wind vector component conservation. Page 2 Source Listing WMUPDT 2014-09-16 16:49 wmupdtmd.f90 58 ! !/WNX1 Wind speed conservation. 59 ! !/WNX2 Wind exenrgy conservation. 60 ! 61 ! !/S Enable subroutine tracing. 62 ! !/T Enable test output 63 ! !/T1 Test output interpolation data. 64 ! 65 ! 7. Source code : 66 ! 67 !/ ------------------------------------------------------------------- / 68 PUBLIC 69 !/ 70 INTEGER, PARAMETER :: SWPMAX = 5 71 !/ 72 CONTAINS 73 !/ ------------------------------------------------------------------- / 74 SUBROUTINE WMUPDT ( IMOD ,TDATA ) 75 !/ 76 !/ +-----------------------------------+ 77 !/ | WAVEWATCH III NOAA/NCEP | 78 !/ | H. L. Tolman | 79 !/ | FORTRAN 90 | 80 !/ | Last update : 12-Jan-2007 | 81 !/ +-----------------------------------+ 82 !/ 83 !/ 22-Feb-2005 : Origination. ( version 3.07 ) 84 !/ 14-Oct-2006 : Adding separate input grids. ( version 3.10 ) 85 !/ 12-Jan-2007 : General clean-up and bug fixes. ( version 3.10 ) 86 !/ 87 ! 1. Purpose : 88 ! 89 ! Update inputs for seleceted wave model grid. 90 ! 91 ! 2. Method : 92 ! 93 ! Reading from native grid files if update is needed based on 94 ! time of data. 95 ! 96 ! 3. Parameters : 97 ! 98 ! Parameter list 99 ! ---------------------------------------------------------------- 100 ! IMOD Int. I Model number, 101 ! TDATA I.A. I Time for which all is data available. 102 ! ---------------------------------------------------------------- 103 ! 104 ! 4. Subroutines used : 105 ! 106 ! Name Type Module Description 107 ! ---------------------------------------------------------------- 108 ! W3SETG Subr. W3GDATMD Point to grid/model. 109 ! W3SETW Subr. W3WDATMD Point to grid/model. 110 ! W3SETI Subr. W3IDATMD Point to grid/model. 111 ! WMSETM Subr. WMMDATMD Point to grid/model. 112 ! STRACE Subr. W3ERVMD Subroutine tracing. 113 ! EXTCDE Subr. Id. Program abort. 114 ! DSEC21 Func. W3TIMEMD Time difference. Page 3 Source Listing WMUPDT 2014-09-16 16:49 wmupdtmd.f90 115 ! STME21 Subr. Id. Write time string. 116 ! TICK21 Subr. Id. Advancing time. 117 ! ---------------------------------------------------------------- 118 ! 119 ! 5. Called by : 120 ! 121 ! Name Type Module Description 122 ! ---------------------------------------------------------------- 123 ! WMWAVE Subr. WMWAVEMD Multi-grid model main routine. 124 ! ---------------------------------------------------------------- 125 ! 126 ! 6. Error messages : 127 ! 128 ! 7. Remarks : 129 ! 130 ! - IDFLDS dimensioning is hardwired as IDFLDS(-7:7) where 131 ! lowest possible value of JFIRST is JFIRST=-7 132 ! 133 ! 8. Structure : 134 ! 135 ! See source code. 136 ! 137 ! 9. Switches : 138 ! 139 ! !/S Enable subroutine tracing. 140 ! !/T Enable test output 141 ! 142 ! 10. Source code : 143 ! 144 !/ ------------------------------------------------------------------- / 145 !/ 146 USE W3GDATMD, ONLY: W3SETG 147 USE W3WDATMD, ONLY: W3SETW 148 USE W3IDATMD, ONLY: W3SETI 149 USE WMMDATMD, ONLY: WMSETM 150 USE W3SERVMD, ONLY: EXTCDE 151 USE W3TIMEMD, ONLY: DSEC21, STME21, TICK21 152 !/ 153 USE W3GDATMD, ONLY: NX, NY, FILEXT 154 USE W3WDATMD, ONLY: TIME 155 156 USE W3IDATMD, ONLY: FLAGS, TLN, TC0, TCN, TW0, TWN, TIN, T0N, & 157 T1N, T2N, TG0, TGN, TFN, TDN 158 159 USE W3IDATMD, ONLY: FLAGS, TLN, TC0, TCN, TW0, TWN, TIN, T0N, & 160 T1N, T2N, TG0, TGN, TFN, TDN, TTN, TVN, & 161 TZN, TI1, TI2, TI3, TI4, TI5, JFIRST 162 163 USE WMMDATMD, ONLY: IMPROC, MDSO, MDSS, MDST, MDSE, NMPSCR, & 164 NMPERR, ETIME, FLLSTL, FLLSTI, INPMAP, & 165 IDINP, IFLSTI, IFLSTL 166 !/ 167 IMPLICIT NONE 168 !/ 169 !/ ------------------------------------------------------------------- / 170 !/ Parameter list 171 !/ Page 4 Source Listing WMUPDT 2014-09-16 16:49 wmupdtmd.f90 172 INTEGER, INTENT(IN) :: IMOD 173 INTEGER, INTENT(INOUT) :: TDATA(2) 174 !/ 175 !/ ------------------------------------------------------------------- / 176 !/ Local parameters 177 !/ 178 INTEGER :: MDSEN, J, DTIME(2), IERR, NDTNEW, JJ 179 REAL :: DTTST 180 LOGICAL :: FIRST 181 CHARACTER(LEN=13) :: IDFLDS(-7:8) 182 CHARACTER(LEN=23) :: DTME21 183 ! 184 DATA IDFLDS / 'ice param. 1 ' , 'ice param. 2 ' , & 185 'ice param. 3 ' , 'ice param. 4 ' , & 186 'ice param. 5 ' , & 187 'mud density ' , 'mud thkness ' , & 188 'mud viscos. ' , & 189 'water levels ' , 'currents ' , & 190 'winds ' , 'ice fields ' , & 191 'mean param. ' , '1D spectra ' , & 192 '2D spectra ' , 'grid speed ' / 193 !/ 194 !/ ------------------------------------------------------------------- / 195 ! 0. Initialization 196 ! 0.a Subroutine tracing and echo of input 197 ! 198 IF ( IMPROC .EQ. NMPERR ) THEN 199 MDSEN = MDSE 200 ELSE 201 MDSEN = -1 202 END IF 203 ! 204 ! 0.b Point to proper grids and initialize 205 ! 206 CALL W3SETG ( IMOD, MDSE, MDST ) 207 CALL W3SETW ( IMOD, MDSE, MDST ) 208 CALL W3SETI ( IMOD, MDSE, MDST ) 209 CALL WMSETM ( IMOD, MDSE, MDST ) 210 ! 211 FLLSTL = .FALSE. 212 FLLSTI = .FALSE. 213 IERR = 0 214 ! 215 ! 0.c Output 216 ! 217 IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN 218 CALL STME21 ( TIME , DTME21 ) 219 WRITE (MDSS,900) IMOD, DTME21 220 END IF 221 ! 222 ! 1. Loop over input types ------------------------------------------ / 223 ! 224 DO J=JFIRST, 8 225 ! 226 ! 1.a Check if update needed 227 ! 228 IF ( .NOT. FLAGS(J) ) CYCLE Page 5 Source Listing WMUPDT 2014-09-16 16:49 wmupdtmd.f90 229 ! 230 ! 1.b Test time 231 ! 232 IF ( TFN(1,J) .EQ. -1 ) THEN 233 FIRST = .TRUE. 234 DTTST = 0. 235 ELSE 236 FIRST = .FALSE. 237 DTTST = DSEC21 ( TIME , TFN(:,J) ) 238 END IF 239 ! 240 IF ( DTTST .GT. 0. ) CYCLE 241 IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & 242 WRITE (MDSS,901) IDFLDS(J) 243 ! 244 ! 2. Using native input --------------------------------------------- / 245 ! 246 IF ( INPMAP(IMOD,J) .EQ. 0 ) THEN 247 ! 248 CALL WMUPD1 ( IMOD, IDINP(IMOD,J), J, IERR ) 249 ! 250 ! 3. Using input from other grid ------------------------------------ / 251 ! 252 ELSE IF ( INPMAP(IMOD,J) .GT. 0 ) THEN 253 ! 254 ! 3.a Check if input grid is available 255 ! 256 JJ = -INPMAP(IMOD,J) 257 CALL W3SETG ( JJ, MDSE, MDST ) 258 CALL W3SETI ( JJ, MDSE, MDST ) 259 ! 260 IF ( TFN(1,J) .EQ. -1 ) THEN 261 DTTST = 0. 262 ELSE 263 IF ( FIRST .OR. ( J.EQ.1 .AND. IFLSTL(-JJ) ) & 264 .OR. ( J.EQ.4 .AND. IFLSTI(-JJ) ) ) THEN 265 DTTST = 1. 266 ELSE 267 DTTST = DSEC21 ( TIME , TFN(:,J) ) 268 END IF 269 END IF 270 ! 271 IF ( J .EQ. 1 ) FLLSTL = IFLSTL(-JJ) 272 IF ( J .EQ. 4 ) FLLSTI = IFLSTI(-JJ) 273 ! 274 ! 3.b If needed, update input grid 275 ! Note: flags in WMMDATMD set for grid IMOD ! 276 ! 277 IF ( DTTST .LE. 0. ) THEN 278 ! 279 IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & 280 WRITE (MDSS,930) FILEXT 281 ! 282 CALL WMUPD1 ( JJ, IDINP(JJ,J), J, IERR ) 283 ! 284 IF ( J .EQ. 1 ) IFLSTL(-JJ) = FLLSTL 285 IF ( J .EQ. 4 ) IFLSTI(-JJ) = FLLSTI Page 6 Source Listing WMUPDT 2014-09-16 16:49 wmupdtmd.f90 286 ! 287 END IF 288 ! 289 ! 3.c Set up for update, and call updating routine 290 ! 291 CALL W3SETG ( IMOD, MDSE, MDST ) 292 CALL W3SETI ( IMOD, MDSE, MDST ) 293 ! 294 CALL WMUPD2 ( IMOD, J, JJ, IERR ) 295 ! 296 ! 4. Using input from coupler --------------------------------------- / 297 ! 298 ! Version 3.10: Needs to be supplied still. 299 ! Once interface if generated, should be only a test 300 ! on availability. 301 ELSE 302 ! 303 IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) then 304 write (mdse,*) ' ' 305 write (mdse,*) ' *** ERROR WMUPDTMD: COUPLER OPTION NOT YET IMPLEMENTED ***' 306 write (mdse,*) 307 end if 308 call extcde (99) 309 ! 310 END IF 311 ! 312 ! 5. Finalize for each type ----------------------------------------- / 313 ! 5.a Process IERR output 314 ! 315 IF ( IERR.GT.0 ) GOTO 2000 316 IF ( IERR.LT.0 .AND. MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & 317 WRITE (MDSS,950) IDFLDS(J) 318 ! 319 ! 5.b End of master loop 320 ! 321 END DO 322 ! 323 ! 6. Compute TDATA -------------------------------------------------- / 324 ! 325 TDATA = ETIME 326 ! 327 DO J=JFIRST, 8 328 IF ( .NOT. FLAGS(J) ) CYCLE 329 DTTST = DSEC21 ( TFN(:,J) , TDATA ) 330 IF ( DTTST.GT.0. .AND. .NOT. ( (FLLSTL .AND. J.EQ.1) .OR. & 331 (FLLSTI .AND. J.EQ.4) ) ) THEN 332 TDATA = TFN(:,J) 333 END IF 334 END DO 335 ! 336 ! 6. Compute TDN ---------------------------------------------------- / 337 ! 338 TDN = TDATA 339 CALL TICK21 ( TDN, 1. ) 340 DO J=5, 7 341 IF ( FLAGS(J) ) THEN 342 DTTST = DSEC21 ( TFN(:,J) , TDN ) Page 7 Source Listing WMUPDT 2014-09-16 16:49 wmupdtmd.f90 343 IF ( DTTST.GT.0. ) TDN = TFN(:,J) 344 END IF 345 END DO 346 ! 347 ! 7. Final test output ---------------------------------------------- / 348 ! 349 RETURN 350 ! 351 ! Error escape locations 352 ! 353 2000 CONTINUE 354 CALL EXTCDE ( 2000 ) 355 RETURN 356 ! 357 ! Formats 358 ! 359 900 FORMAT ( ' Updating input for grid',I3,' at ',A) 360 901 FORMAT ( ' Updating ',A) 361 930 FORMAT ( ' First updating ',A) 362 950 FORMAT ( ' Past last ',A) 363 ! 364 !/ 365 !/ End of WMUPDT ----------------------------------------------------- / 366 !/ 367 END SUBROUTINE WMUPDT ENTRY POINTS Name wmupdtmd_mp_wmupdt_ Page 8 Source Listing WMUPDT 2014-09-16 16:49 Symbol Table wmupdtmd.f90 SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 2000 Label 353 315 900 Label 359 219 901 Label 360 242 930 Label 361 280 950 Label 362 317 DSEC21 Func 151 R(4) 4 scalar 151,237,267,329,342 DTIME Local 178 I(4) 4 1 2 DTME21 Local 182 CHAR 23 scalar 218,219 DTTST Local 179 R(4) 4 scalar 234,237,240,261,265,267,277,329,33 0,342,343 ETIME Local 164 I(4) 4 1 2 164,325 EXTCDE Subr 150 150,308,354 FILEXT Local 153 CHAR 10 scalar PTR 153,280 FIRST Local 180 L(4) 4 scalar 233,236,263 FLAGS Local 156 L(4) 4 1 1 PTR 156,159,228,328,341 FLLSTI Local 164 L(4) 4 scalar PTR 164,212,272,285,331 FLLSTL Local 164 L(4) 4 scalar PTR 164,211,271,284,330 IDFLDS Local 181 CHAR 13 1 16 184,242,317 IDINP Local 165 CHAR 3 2 1 ALC 165,248,282 IERR Local 178 I(4) 4 scalar 213,248,282,294,315,316 IFLSTI Local 165 L(4) 4 1 1 ALC 165,264,272,285 IFLSTL Local 165 L(4) 4 1 1 ALC 165,263,271,284 IMOD Dummy 74 I(4) 4 scalar ARG,IN 206,207,208,209,219,246,248,252,25 6,291,292,294 IMPROC Local 163 I(4) 4 scalar 163,198,217,241,279,303,316 INPMAP Local 164 I(4) 4 2 1 ALC 164,246,252,256 J Local 178 I(4) 4 scalar 224,228,232,237,242,246,248,252,25 6,260,263,264,267,271,272,282,284, 285,294,317,327,328,329,330,331,33 2,340,341,342,343 JFIRST Local 161 I(4) 4 scalar 161,224,327 JJ Local 178 I(4) 4 scalar 256,257,258,263,264,271,272,282,28 4,285,294 MDSE Local 163 I(4) 4 scalar 163,199,206,207,208,209,257,258,29 1,292,304,305,306 MDSEN Local 178 I(4) 4 scalar 199,201 MDSO Local 163 I(4) 4 scalar 163,217,241,279,303,316 MDSS Local 163 I(4) 4 scalar 163,217,219,241,242,279,280,303,31 6,317 MDST Local 163 I(4) 4 scalar 163,206,207,208,209,257,258,291,29 2 NDTNEW Local 178 I(4) 4 scalar NMPERR Local 164 I(4) 4 scalar 164,198 NMPSCR Local 163 I(4) 4 scalar 163,217,241,279,303,316 NX Local 153 I(4) 4 scalar PTR 153 NY Local 153 I(4) 4 scalar PTR 153 STME21 Subr 151 151,218 T0N Local 156 I(4) 4 1 1 PTR 156,159 T1N Local 157 I(4) 4 1 1 PTR 157,160 T2N Local 157 I(4) 4 1 1 PTR 157,160 TC0 Local 156 I(4) 4 1 1 PTR 156,159 Page 9 Source Listing WMUPDT 2014-09-16 16:49 Symbol Table wmupdtmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References TCN Local 156 I(4) 4 1 1 PTR 156,159 TDATA Dummy 74 I(4) 4 1 2 ARG,INOUT 325,329,332,338 TDN Local 157 I(4) 4 1 1 PTR 157,160,338,339,342,343 TFN Local 157 I(4) 4 2 1 PTR 157,160,232,237,260,267,329,332,34 2,343 TG0 Local 157 I(4) 4 1 1 PTR 157,160 TGN Local 157 I(4) 4 1 1 PTR 157,160 TI1 Local 161 I(4) 4 1 1 PTR 161 TI2 Local 161 I(4) 4 1 1 PTR 161 TI3 Local 161 I(4) 4 1 1 PTR 161 TI4 Local 161 I(4) 4 1 1 PTR 161 TI5 Local 161 I(4) 4 1 1 PTR 161 TICK21 Subr 151 151,339 TIME Local 154 I(4) 4 1 1 PTR 154,218,237,267 TIN Local 156 I(4) 4 1 1 PTR 156,159 TLN Local 156 I(4) 4 1 1 PTR 156,159 TTN Local 160 I(4) 4 1 1 PTR 160 TVN Local 160 I(4) 4 1 1 PTR 160 TW0 Local 156 I(4) 4 1 1 PTR 156,159 TWN Local 156 I(4) 4 1 1 PTR 156,159 TZN Local 161 I(4) 4 1 1 PTR 161 W3GDATMD Module 146 146,153 W3IDATMD Module 148 148,156,159 W3SERVMD Module 150 150 W3SETG Subr 146 146,206,257,291 W3SETI Subr 148 148,208,258,292 W3SETW Subr 147 147,207 W3TIMEMD Module 151 151 W3WDATMD Module 147 147,154 WMMDATMD Module 149 149,163 WMSETM Subr 149 149,209 WMUPDT Subr 74 Page 10 Source Listing WMUPDT 2014-09-16 16:49 wmupdtmd.f90 368 !/ ------------------------------------------------------------------- / 369 SUBROUTINE WMUPD1 ( IMOD, IDSTR, J, IERR ) 370 !/ 371 !/ +-----------------------------------+ 372 !/ | WAVEWATCH III NOAA/NCEP | 373 !/ | H. L. Tolman | 374 !/ | FORTRAN 90 | 375 !/ | Last update : 07-Oct-2006 | 376 !/ +-----------------------------------+ 377 !/ 378 !/ 07-Oct-2006 : Origination. ( version 3.10 ) 379 !/ 380 ! 1. Purpose : 381 ! 382 ! Update selected input using native input files. 383 ! 384 ! 2. Method : 385 ! 386 ! Reading from native grid files. 387 ! 388 ! 3. Parameters : 389 ! 390 ! Parameter list 391 ! ---------------------------------------------------------------- 392 ! IMOD Int. I Model number, 393 ! IDSTR C*3 I ID string corresponding to J. 394 ! J Int. I Input type. 395 ! IERR Int. O Error indicator. 396 ! ---------------------------------------------------------------- 397 ! 398 ! 4. Subroutines used : 399 ! 400 ! Name Type Module Description 401 ! ---------------------------------------------------------------- 402 ! WMDIMD Subr. WMMDATMD Set dimension of data grids. 403 ! W3FLDG Subr. W3FLDSMD Get input field. 404 ! W3FLDD Subr. Id. Get input data. 405 ! W3FLDM Subr. Id. Get grid speed data. 406 ! STRACE Subr. W3ERVMD Subroutine tracing. 407 ! ---------------------------------------------------------------- 408 ! 409 ! 5. Called by : 410 ! 411 ! Name Type Module Description 412 ! ---------------------------------------------------------------- 413 ! WMUPDT Subr. WMUPDTMD Master inpu update routine. 414 ! ---------------------------------------------------------------- 415 ! 416 ! 6. Error messages : 417 ! 418 ! 7. Remarks : 419 ! 420 ! - Pointers set in calling routine. 421 ! 422 ! 8. Structure : 423 ! 424 ! See source code. Page 11 Source Listing WMUPD1 2014-09-16 16:49 wmupdtmd.f90 425 ! 426 ! 9. Switches : 427 ! 428 ! !/S Enable subroutine tracing. 429 ! !/T Enable test output 430 ! 431 ! 10. Source code : 432 ! 433 !/ ------------------------------------------------------------------- / 434 !/ 435 USE WMMDATMD, ONLY: WMDIMD 436 USE W3FLDSMD, ONLY: W3FLDG, W3FLDD, W3FLDM 437 !/ 438 USE W3GDATMD, ONLY: NX, NY 439 USE W3WDATMD, ONLY: TIME 440 USE W3IDATMD, ONLY: TLN, WLEV, TC0, TCN, CX0, CXN, CY0, CYN, & 441 TW0, TWN, WX0, WXN, WY0, WYN, DT0, DTN, & 442 TIN, ICEI, T0N, T1N, T2N, TDN, FLAGS, & 443 TG0, TGN, GA0, GD0, GAN, GDN, BERGI, & 444 TTN, MUDT, TVN, MUDV, TZN, MUDD, & 445 TI1, TI2, TI3, TI4, TI5, & 446 ICEP1, ICEP2,ICEP3, ICEP4, ICEP5 447 USE WMMDATMD, ONLY: IMPROC, NMPERR, MDST, MDSE, MDSF, ETIME, & 448 FLLSTL, FLLSTI, RCLD, NDT, DATA0, DATA1, & 449 DATA2, NMV, NMVMAX, TMV, AMV, DMV 450 !/ 451 IMPLICIT NONE 452 !/ 453 !/ ------------------------------------------------------------------- / 454 !/ Parameter list 455 !/ 456 INTEGER, INTENT(IN) :: IMOD, J 457 INTEGER, INTENT(OUT) :: IERR 458 CHARACTER(LEN=3), INTENT(IN) :: IDSTR 459 !/ 460 !/ ------------------------------------------------------------------- / 461 !/ Local parameters 462 !/ 463 INTEGER :: MDSEN, DTIME(2), NDTNEW 464 REAL :: XXX(NY,NX) 465 !/ 466 !/ ------------------------------------------------------------------- / 467 ! 0. Initialization 468 ! 0.a Subroutine tracing and echo of input 469 ! 470 IF ( IMPROC .EQ. NMPERR ) THEN 471 MDSEN = MDSE 472 ELSE 473 MDSEN = -1 474 END IF 475 ! 476 ! 0.b Start case selection 477 ! 478 SELECT CASE (J) 479 ! 480 ! -7. Ice parameter 1 ---------------------------------------------- / 481 ! Page 12 Source Listing WMUPD1 2014-09-16 16:49 wmupdtmd.f90 482 CASE (-7) 483 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 484 NX, NY, NX, NY, TIME, ETIME, DTIME, & 485 XXX, XXX, XXX, TI1, XXX, XXX, ICEP1, IERR) 486 ! 487 ! -6. Ice parameter 2 ---------------------------------------------- / 488 ! 489 CASE (-6) 490 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 491 NX, NY, NX, NY, TIME, ETIME, DTIME, & 492 XXX, XXX, XXX, TI2, XXX, XXX, ICEP2, IERR) 493 ! 494 ! -5. Ice parameter 3 ---------------------------------------------- / 495 ! 496 CASE (-5) 497 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 498 NX, NY, NX, NY, TIME, ETIME, DTIME, & 499 XXX, XXX, XXX, TI3, XXX, XXX, ICEP3, IERR) 500 ! 501 ! -4. Ice parameter 4 ---------------------------------------------- / 502 ! 503 CASE (-4) 504 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 505 NX, NY, NX, NY, TIME, ETIME, DTIME, & 506 XXX, XXX, XXX, TI4, XXX, XXX, ICEP4, IERR) 507 ! 508 ! -3. Ice parameter 5 ---------------------------------------------- / 509 ! 510 CASE (-3) 511 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 512 NX, NY, NX, NY, TIME, ETIME, DTIME, & 513 XXX, XXX, XXX, TI5, XXX, XXX, ICEP5, IERR) 514 ! 515 ! -2. Mud Density -------------------------------------------------- / 516 ! 517 CASE (-2) 518 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 519 NX, NY, NX, NY, TIME, ETIME, DTIME, & 520 XXX, XXX, XXX, TZN, XXX, XXX, MUDD, IERR) 521 ! 522 ! -1. Mud Thickness -------------------------------------------------- / 523 ! 524 CASE (-1) 525 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 526 NX, NY, NX, NY, TIME, ETIME, DTIME, & 527 XXX, XXX, XXX, TTN, XXX, XXX, MUDT, IERR) 528 ! 529 ! 0. Mud Viscosity -------------------------------------------------- / 530 ! 531 CASE (0) 532 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 533 NX, NY, NX, NY, TIME, ETIME, DTIME, & 534 XXX, XXX, XXX, TVN, XXX, XXX, MUDV, IERR) 535 ! 536 ! 1. Water levels --------------------------------------------------- / 537 ! 538 CASE (1) Page 13 Source Listing WMUPD1 2014-09-16 16:49 wmupdtmd.f90 539 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 540 NX, NY, NX, NY, TIME, ETIME, DTIME, & 541 XXX, XXX, XXX, TLN, XXX, XXX, WLEV, IERR) 542 IF ( IERR .LT. 0 ) FLLSTL = .TRUE. 543 ! 544 ! 2. Currents ------------------------------------------------------- / 545 ! 546 CASE (2) 547 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 548 NX, NY, NX, NY, TIME, ETIME, TC0, & 549 CX0, CY0, XXX, TCN, CXN, CYN, XXX, IERR) 550 ! 551 ! 3. Winds ---------------------------------------------------------- / 552 ! 553 CASE (3) 554 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 555 NX, NY, NX, NY, TIME, ETIME, TW0, & 556 WX0, WY0, DT0, TWN, WXN, WYN, DTN, IERR) 557 ! 558 ! 4. Ice ------------------------------------------------------------ / 559 ! 560 CASE (4) 561 CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 562 NX, NY, NX, NY, TIME, ETIME, DTIME, & 563 XXX, XXX, XXX, TIN, XXX , BERGI, ICEI, IERR) 564 IF ( IERR .LT. 0 ) FLLSTI = .TRUE. 565 ! 566 ! 5. Data type 0 ---------------------------------------------------- / 567 ! 568 CASE (5) 569 CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 570 TIME, T0N, RCLD(1), NDT(1), NDTNEW, & 571 DATA0, IERR ) 572 IF ( IERR .LT. 0 ) THEN 573 FLAGS(J) = .FALSE. 574 RCLD(1) = 1 575 NDT(1) = 1 576 CALL WMDIMD ( IMOD, MDSE, MDST, 1 ) 577 ELSE 578 NDT(J) = NDTNEW 579 CALL WMDIMD ( IMOD, MDSE, MDST, 1 ) 580 CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST, & 581 MDSEN, TIME, T0N, RCLD(1), NDT(1), & 582 NDTNEW, DATA0, IERR ) 583 END IF 584 ! 585 ! 6. Data type 1 ---------------------------------------------------- / 586 ! 587 CASE ( 6 ) 588 CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 589 TIME, T1N, RCLD(2), NDT(2), NDTNEW, & 590 DATA1, IERR ) 591 IF ( IERR .LT. 0 ) THEN 592 FLAGS(J) = .FALSE. 593 RCLD(2) = 1 594 NDT(2) = 1 595 CALL WMDIMD ( IMOD, MDSE, MDST, 2 ) Page 14 Source Listing WMUPD1 2014-09-16 16:49 wmupdtmd.f90 596 ELSE 597 NDT(J) = NDTNEW 598 CALL WMDIMD ( IMOD, MDSE, MDST, 2 ) 599 CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST, & 600 MDSEN, TIME, T1N, RCLD(2), NDT(2), & 601 NDTNEW, DATA1, IERR ) 602 END IF 603 ! 604 ! 7. Data type 2 ---------------------------------------------------- / 605 ! 606 CASE ( 7 ) 607 CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST, MDSEN, & 608 TIME, T2N, RCLD(3), NDT(3), NDTNEW, & 609 DATA2, IERR ) 610 IF ( IERR .LT. 0 ) THEN 611 FLAGS(J) = .FALSE. 612 RCLD(3) = 1 613 NDT(3) = 1 614 CALL WMDIMD ( IMOD, MDSE, MDST, 3 ) 615 ELSE 616 NDT(J) = NDTNEW 617 CALL WMDIMD ( IMOD, MDSE, MDST, 3 ) 618 CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST, & 619 MDSEN, TIME, T2N, RCLD(3), NDT(3), & 620 NDTNEW, DATA2, IERR ) 621 END IF 622 ! 623 ! 8. Moving grid data ----------------------------------------------- / 624 ! 625 CASE ( 8 ) 626 ! notes: 627 ! SUBROUTINE W3FLDM in w3fldsmd.ftn : 628 !< INTEGER, INTENT(INOUT) :: NH, THO(2,4,NHM), TF0(2), TFN(2) 629 !> INTEGER, INTENT(INOUT) :: NH, THO(2,-7:4,NHM), TF0(2), TFN(2) 630 !< REAL, INTENT(INOUT) :: HA(NHM,4), HD(NHM,4), A0, AN, D0, DN 631 !> REAL, INTENT(INOUT) :: HA(NHM,-7:4), HD(NHM,-7:4), A0, AN, D0, DN 632 ! Arguments # 633 ! THO 8 634 ! HA 9 635 ! HD 10 636 ! Here, that is TMV AMV DMV 637 CALL W3FLDM ( 4, MDST, MDSEN, TIME, ETIME, NMV, NMVMAX, TMV,& 638 AMV, DMV, TG0, GA0, GD0, TGN, GAN, GDN, IERR ) 639 ! 640 END SELECT 641 ! 642 ! 9. End of routine -------------------------------------------------- / 643 ! 644 RETURN 645 ! 646 ! Formats 647 ! 648 !/ 649 !/ End of WMUPD1 ----------------------------------------------------- / 650 !/ 651 END SUBROUTINE WMUPD1 Page 15 Source Listing WMUPD1 2014-09-16 16:49 Entry Points wmupdtmd.f90 ENTRY POINTS Name wmupdtmd_mp_wmupd1_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References AMV Local 449 R(4) 4 2 1 PTR 449,638 BERGI Local 443 R(4) 4 2 1 PTR 443,563 CX0 Local 440 R(4) 4 2 1 PTR 440,549 CXN Local 440 R(4) 4 2 1 PTR 440,549 CY0 Local 440 R(4) 4 2 1 PTR 440,549 CYN Local 440 R(4) 4 2 1 PTR 440,549 DATA0 Local 448 R(4) 4 2 1 PTR 448,571,582 DATA1 Local 448 R(4) 4 2 1 PTR 448,590,601 DATA2 Local 449 R(4) 4 2 1 PTR 449,609,620 DMV Local 449 R(4) 4 2 1 PTR 449,638 DT0 Local 441 R(4) 4 2 1 PTR 441,556 DTIME Local 463 I(4) 4 1 2 484,491,498,505,512,519,526,533,54 0,562 DTN Local 441 R(4) 4 2 1 PTR 441,556 ETIME Local 447 I(4) 4 1 2 447,484,491,498,505,512,519,526,53 3,540,548,555,562,637 FLAGS Local 442 L(4) 4 1 1 PTR 442,573,592,611 FLLSTI Local 448 L(4) 4 scalar PTR 448,564 FLLSTL Local 448 L(4) 4 scalar PTR 448,542 GA0 Local 443 R(4) 4 scalar PTR 443,638 GAN Local 443 R(4) 4 scalar PTR 443,638 GD0 Local 443 R(4) 4 scalar PTR 443,638 GDN Local 443 R(4) 4 scalar PTR 443,638 ICEI Local 442 R(4) 4 2 1 PTR 442,563 ICEP1 Local 446 R(4) 4 2 1 PTR 446,485 ICEP2 Local 446 R(4) 4 2 1 PTR 446,492 ICEP3 Local 446 R(4) 4 2 1 PTR 446,499 ICEP4 Local 446 R(4) 4 2 1 PTR 446,506 ICEP5 Local 446 R(4) 4 2 1 PTR 446,513 IDSTR Dummy 369 CHAR 3 scalar ARG,IN 483,490,497,504,511,518,525,532,53 9,547,554,561,569,580,588,599,607, 618 IERR Dummy 369 I(4) 4 scalar ARG,OUT 485,492,499,506,513,520,527,534,54 1,542,549,556,563,564,571,572,582, 590,591,601,609,610,620,638 IMOD Dummy 369 I(4) 4 scalar ARG,IN 483,490,497,504,511,518,525,532,53 9,547,554,561,569,576,579,580,588, 595,598,599,607,614,617,618 IMPROC Local 447 I(4) 4 scalar 447,470 J Dummy 369 I(4) 4 scalar ARG,IN 478,483,490,497,504,511,518,525,53 2,539,547,554,561,569,573,578,580, 588,592,597,599,607,611,616,618 MDSE Local 447 I(4) 4 scalar 447,471,576,579,595,598,614,617 MDSEN Local 463 I(4) 4 scalar 471,473,483,490,497,504,511,518,52 Page 16 Source Listing WMUPD1 2014-09-16 16:49 Symbol Table wmupdtmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 5,532,539,547,554,561,569,581,588, 600,607,619,637 MDSF Local 447 I(4) 4 2 1 ALC 447,483,490,497,504,511,518,525,53 2,539,547,554,561,569,580,588,599, 607,618 MDST Local 447 I(4) 4 scalar 447,483,490,497,504,511,518,525,53 2,539,547,554,561,569,576,579,580, 588,595,598,599,607,614,617,618,63 7 MUDD Local 444 R(4) 4 2 1 PTR 444,520 MUDT Local 444 R(4) 4 2 1 PTR 444,527 MUDV Local 444 R(4) 4 2 1 PTR 444,534 NDT Local 448 I(4) 4 1 1 PTR 448,570,575,578,581,589,594,597,60 0,608,613,616,619 NDTNEW Local 463 I(4) 4 scalar 570,578,582,589,597,601,608,616,62 0 NMPERR Local 447 I(4) 4 scalar 447,470 NMV Local 449 I(4) 4 scalar PTR 449,637 NMVMAX Local 449 I(4) 4 scalar 449,637 NX Local 438 I(4) 4 scalar PTR 438,464,484,491,498,505,512,519,52 6,533,540,548,555,562 NY Local 438 I(4) 4 scalar PTR 438,464,484,491,498,505,512,519,52 6,533,540,548,555,562 RCLD Local 448 I(4) 4 1 1 PTR 448,570,574,581,589,593,600,608,61 2,619 T0N Local 442 I(4) 4 1 1 PTR 442,570,581 T1N Local 442 I(4) 4 1 1 PTR 442,589,600 T2N Local 442 I(4) 4 1 1 PTR 442,608,619 TC0 Local 440 I(4) 4 1 1 PTR 440,548 TCN Local 440 I(4) 4 1 1 PTR 440,549 TDN Local 442 I(4) 4 1 1 PTR 442 TG0 Local 443 I(4) 4 1 1 PTR 443,638 TGN Local 443 I(4) 4 1 1 PTR 443,638 TI1 Local 445 I(4) 4 1 1 PTR 445,485 TI2 Local 445 I(4) 4 1 1 PTR 445,492 TI3 Local 445 I(4) 4 1 1 PTR 445,499 TI4 Local 445 I(4) 4 1 1 PTR 445,506 TI5 Local 445 I(4) 4 1 1 PTR 445,513 TIME Local 439 I(4) 4 1 1 PTR 439,484,491,498,505,512,519,526,53 3,540,548,555,562,570,581,589,600, 608,619,637 TIN Local 442 I(4) 4 1 1 PTR 442,563 TLN Local 440 I(4) 4 1 1 PTR 440,541 TMV Local 449 I(4) 4 3 1 PTR 449,637 TTN Local 444 I(4) 4 1 1 PTR 444,527 TVN Local 444 I(4) 4 1 1 PTR 444,534 TW0 Local 441 I(4) 4 1 1 PTR 441,555 TWN Local 441 I(4) 4 1 1 PTR 441,556 TZN Local 444 I(4) 4 1 1 PTR 444,520 W3FLDD Subr 436 436,569,580,588,599,607,618 W3FLDG Subr 436 436,483,490,497,504,511,518,525,53 2,539,547,554,561 W3FLDM Subr 436 436,637 W3FLDSMD Module 436 436 W3GDATMD Module 438 438 Page 17 Source Listing WMUPD1 2014-09-16 16:49 Symbol Table wmupdtmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References W3IDATMD Module 440 440 W3WDATMD Module 439 439 WLEV Local 440 R(4) 4 2 1 PTR 440,541 WMDIMD Subr 435 435,576,579,595,598,614,617 WMMDATMD Module 435 435,447 WMUPD1 Subr 369 248,282 WX0 Local 441 R(4) 4 2 1 PTR 441,556 WXN Local 441 R(4) 4 2 1 PTR 441,556 WY0 Local 441 R(4) 4 2 1 PTR 441,556 WYN Local 441 R(4) 4 2 1 PTR 441,556 XXX Local 464 R(4) 4 2 0 485,492,499,506,513,520,527,534,54 1,549,563 Page 18 Source Listing WMUPD1 2014-09-16 16:49 wmupdtmd.f90 652 !/ ------------------------------------------------------------------- / 653 SUBROUTINE WMUPD2 ( IMOD, J, JMOD, IERR ) 654 !/ 655 !/ +-----------------------------------+ 656 !/ | WAVEWATCH III NOAA/NCEP | 657 !/ | H. L. Tolman | 658 !/ | FORTRAN 90 | 659 !/ | Last update : 10-Dec-2006 | 660 !/ +-----------------------------------+ 661 !/ 662 !/ 14-Oct-2006 : Origination. ( version 3.10 ) 663 !/ 10-Dec-2006 : Bug fix WMUPD2 initial fields. ( version 3.10 ) 664 !/ 665 ! 1. Purpose : 666 ! 667 ! Update selected input using input grids. 668 ! 669 ! 2. Method : 670 ! 671 ! Managing data, interpolation done inother routines. 672 ! 673 ! 3. Parameters : 674 ! 675 ! Parameter list 676 ! ---------------------------------------------------------------- 677 ! IMOD Int. I Model number, 678 ! J Int. I Input type. 679 ! JMOD Int. I Model number source grid. 680 ! IERR Int. O Error indicator. 681 ! ---------------------------------------------------------------- 682 ! 683 ! 4. Subroutines used : 684 ! 685 ! Name Type Module Description 686 ! ---------------------------------------------------------------- 687 ! STRACE Subr. W3ERVMD Subroutine tracing. 688 ! EXTCDE Subr. Id. Program abort. 689 ! WMUPDV Subr. local Interpolation of vector fields. 690 ! WMUPDS Subr. local Interpolation of scalar fields. 691 ! ---------------------------------------------------------------- 692 ! 693 ! 5. Called by : 694 ! 695 ! Name Type Module Description 696 ! ---------------------------------------------------------------- 697 ! WMUPDT Subr. WMUPDTMD Master input update routine. 698 ! ---------------------------------------------------------------- 699 ! 700 ! 6. Error messages : 701 ! 702 ! 7. Remarks : 703 ! 704 ! 8. Structure : 705 ! 706 ! See source code. 707 ! 708 ! 9. Switches : Page 19 Source Listing WMUPD2 2014-09-16 16:49 wmupdtmd.f90 709 ! 710 ! !/CRX0 Current vector component conservation. 711 ! !/CRX1 Current speed conservation. 712 ! !/CRX2 Current exenrgy conservation. 713 ! 714 ! !/WNX0 Wind vector component conservation. 715 ! 716 ! !/S Enable subroutine tracing. 717 ! !/T Enable test output 718 ! 719 ! 10. Source code : 720 ! 721 !/ ------------------------------------------------------------------- / 722 !/ 723 USE W3SERVMD, ONLY: EXTCDE 724 !/ 725 USE W3WDATMD, ONLY: TIME 726 USE W3IDATMD, ONLY: INPUTS 727 USE WMMDATMD, ONLY: IMPROC, NMPERR, NMPSCR, MDST, MDSE, MDSS, & 728 MDSO, ETIME, IDINP 729 !/ 730 IMPLICIT NONE 731 !/ 732 !/ ------------------------------------------------------------------- / 733 !/ Parameter list 734 !/ 735 INTEGER, INTENT(IN) :: IMOD, J, JMOD 736 INTEGER, INTENT(OUT) :: IERR 737 !/ 738 !/ ------------------------------------------------------------------- / 739 !/ Local parameters 740 !/ 741 INTEGER :: ICONSC, ICONSW 742 !/ 743 !/ ------------------------------------------------------------------- / 744 ! 0. Initialization 745 ! 0.a Subroutine tracing and echo of input 746 ! 747 IERR = 0 748 ICONSC = 1 749 ICONSW = 1 750 ! 751 ! 1. Shift fields ( currents and winds only ) ------------------------ / 752 ! 753 SELECT CASE (J) 754 ! 755 ! 1.a Currents 756 ! 757 CASE (2) 758 IF ( INPUTS(IMOD)%TFN(1,J) .GT. 0 ) THEN 759 INPUTS(IMOD)%TC0(:) = INPUTS(IMOD)%TFN(:,J) 760 INPUTS(IMOD)%CX0 = INPUTS(IMOD)%CXN 761 INPUTS(IMOD)%CY0 = INPUTS(IMOD)%CYN 762 END IF 763 ! 764 ! 1.b Winds 765 ! Page 20 Source Listing WMUPD2 2014-09-16 16:49 wmupdtmd.f90 766 CASE (3) 767 IF ( INPUTS(IMOD)%TFN(1,J) .GT. 0 ) THEN 768 INPUTS(IMOD)%TW0(:) = INPUTS(IMOD)%TFN(:,J) 769 INPUTS(IMOD)%WX0 = INPUTS(IMOD)%WXN 770 INPUTS(IMOD)%WY0 = INPUTS(IMOD)%WYN 771 INPUTS(IMOD)%DT0 = INPUTS(IMOD)%DTN 772 END IF 773 ! 774 END SELECT 775 ! 776 ! 2. Process fields at ending time ----------------------------------- / 777 ! 778 INPUTS(IMOD)%TFN(:,J) = INPUTS(JMOD)%TFN(:,J) 779 ! 780 SELECT CASE (J) 781 ! 782 ! 2.a-3 Ice parameter 1 783 ! 784 CASE (-7) 785 CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEP1, & 786 JMOD, INPUTS(JMOD)%ICEP1, 0. ) 787 ! 788 ! 2.a-3 Ice parameter 2 789 ! 790 CASE (-6) 791 CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEP2, & 792 JMOD, INPUTS(JMOD)%ICEP2, 0. ) 793 ! 794 ! 2.a-3 Ice parameter 3 795 ! 796 CASE (-5) 797 CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEP3, & 798 JMOD, INPUTS(JMOD)%ICEP3, 0. ) 799 ! 800 ! 2.a-3 Ice parameter 4 801 ! 802 CASE (-4) 803 CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEP4, & 804 JMOD, INPUTS(JMOD)%ICEP4, 0. ) 805 ! 806 ! 2.a-3 Ice parameter 5 807 ! 808 CASE (-3) 809 CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEP5, & 810 JMOD, INPUTS(JMOD)%ICEP5, 0. ) 811 ! 812 ! 2.a-2 Mud densities 813 ! 814 CASE (-2) 815 CALL WMUPDS ( IMOD, INPUTS(IMOD)%MUDD, & 816 JMOD, INPUTS(JMOD)%MUDD, 0. ) 817 ! 818 ! 2.a-1 Mud viscosities 819 ! 820 CASE (-1) 821 CALL WMUPDS ( IMOD, INPUTS(IMOD)%MUDT, & 822 JMOD, INPUTS(JMOD)%MUDT, 0. ) Page 21 Source Listing WMUPD2 2014-09-16 16:49 wmupdtmd.f90 823 ! 824 ! 2.a-0 Mud thicknesses 825 ! 826 CASE (0) 827 CALL WMUPDS ( IMOD, INPUTS(IMOD)%MUDV, & 828 JMOD, INPUTS(JMOD)%MUDV, 0. ) 829 ! 830 ! 2.a Water levels 831 ! 832 CASE (1) 833 CALL WMUPDS ( IMOD, INPUTS(IMOD)%WLEV, & 834 JMOD, INPUTS(JMOD)%WLEV, 0. ) 835 ! 836 ! 2.b Curents 837 ! 838 CASE (2) 839 CALL WMUPDV ( IMOD, INPUTS(IMOD)%CXN, INPUTS(IMOD)%CYN, & 840 JMOD, INPUTS(JMOD)%CXN, INPUTS(JMOD)%CYN, & 841 0., ICONSC ) 842 ! 843 ! 2.c Wind speeds 844 ! 845 CASE (3) 846 CALL WMUPDV ( IMOD, INPUTS(IMOD)%WXN, INPUTS(IMOD)%WYN, & 847 JMOD, INPUTS(JMOD)%WXN, INPUTS(JMOD)%WYN, & 848 0., ICONSW ) 849 IF ( IDINP(IMOD,J) .EQ. 'WNS' ) CALL WMUPDS & 850 ( IMOD, INPUTS(IMOD)%DTN, & 851 JMOD, INPUTS(JMOD)%DTN, 0. ) 852 ! 853 ! 2.d Ice concentrations 854 ! 855 CASE (4) 856 CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEI, & 857 JMOD, INPUTS(JMOD)%ICEI, 0. ) 858 IF ( IDINP(IMOD,J) .EQ. 'ISI' ) CALL WMUPDS & 859 ( IMOD, INPUTS(IMOD)%BERGI, & 860 JMOD, INPUTS(JMOD)%BERGI, 0. ) 861 ! 862 ! 2.e Assimilation data 0 863 ! 864 CASE (5) 865 GOTO 2999 866 ! 867 ! 2.f Assimilation data 1 868 ! 869 CASE (6) 870 GOTO 2999 871 ! 872 ! 2.g Assimilation data 2 873 ! 874 CASE (7) 875 GOTO 2999 876 ! 877 END SELECT 878 ! 879 ! 3. Check and update first fields ( currents and winds only ) ------- / Page 22 Source Listing WMUPD2 2014-09-16 16:49 wmupdtmd.f90 880 ! 881 SELECT CASE (J) 882 ! 883 ! 3.a Currents 884 ! 885 CASE (2) 886 IF ( INPUTS(IMOD)%TC0(1) .LT. 0 ) THEN 887 INPUTS(IMOD)%TC0(:) = INPUTS(JMOD)%TC0(:) 888 ICONSC = 1 889 CALL WMUPDV ( IMOD, INPUTS(IMOD)%CX0, INPUTS(IMOD)%CY0, & 890 JMOD, INPUTS(JMOD)%CX0, INPUTS(JMOD)%CY0, & 891 0., ICONSC ) 892 END IF 893 ! 894 ! 3.b Winds 895 ! 896 CASE (3) 897 IF ( INPUTS(IMOD)%TW0(1) .LT. 0 ) THEN 898 INPUTS(IMOD)%TW0(:) = INPUTS(JMOD)%TW0(:) 899 ICONSW = 1 900 CALL WMUPDV ( IMOD, INPUTS(IMOD)%WX0, INPUTS(IMOD)%WY0, & 901 JMOD, INPUTS(JMOD)%WX0, INPUTS(JMOD)%WY0, & 902 0., ICONSW ) 903 IF ( IDINP(IMOD,J) .EQ. 'WNS' ) CALL WMUPDS & 904 ( IMOD, INPUTS(IMOD)%DT0, & 905 JMOD, INPUTS(JMOD)%DT0, 0. ) 906 END IF 907 ! 908 END SELECT 909 ! 910 ! 4. End of routine -------------------------------------------------- / 911 ! 912 RETURN 913 ! 914 ! Error escape locations 915 ! 916 2999 CONTINUE 917 IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) WRITE (MDSE,1999) 918 CALL EXTCDE ( 2999 ) 919 RETURN 920 ! 921 ! Formats 922 ! 923 1999 FORMAT (/' *** ERROR WMUPD2: OPTION NOT YET IMPLEMENTED ***'/) 924 ! 925 !/ 926 !/ End of WMUPD2 ----------------------------------------------------- / 927 !/ 928 END SUBROUTINE WMUPD2 Page 23 Source Listing WMUPD2 2014-09-16 16:49 Entry Points wmupdtmd.f90 ENTRY POINTS Name wmupdtmd_mp_wmupd2_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1999 Label 923 917 2999 Label 916 865,870,875 BERGI Local 859 R(4) 4 2 1 PTR 859,860 CX0 Local 760 R(4) 4 2 1 PTR 760,889,890 CXN Local 760 R(4) 4 2 1 PTR 760,839,840 CY0 Local 761 R(4) 4 2 1 PTR 761,889,890 CYN Local 761 R(4) 4 2 1 PTR 761,839,840 DT0 Local 771 R(4) 4 2 1 PTR 771,904,905 DTN Local 771 R(4) 4 2 1 PTR 771,850,851 ETIME Local 728 I(4) 4 1 2 728 EXTCDE Subr 723 723,918 ICEI Local 856 R(4) 4 2 1 PTR 856,857 ICEP1 Local 785 R(4) 4 2 1 PTR 785,786 ICEP2 Local 791 R(4) 4 2 1 PTR 791,792 ICEP3 Local 797 R(4) 4 2 1 PTR 797,798 ICEP4 Local 803 R(4) 4 2 1 PTR 803,804 ICEP5 Local 809 R(4) 4 2 1 PTR 809,810 ICONSC Local 741 I(4) 4 scalar 748,841,888,891 ICONSW Local 741 I(4) 4 scalar 749,848,899,902 IDINP Local 728 CHAR 3 2 1 ALC 728,849,858,903 IERR Dummy 653 I(4) 4 scalar ARG,OUT 747 IMOD Dummy 653 I(4) 4 scalar ARG,IN 758,759,760,761,767,768,769,770,77 1,778,785,791,797,803,809,815,821, 827,833,839,846,849,850,856,858,85 9,886,887,889,897,898,900,903,904 IMPROC Local 727 I(4) 4 scalar 727,917 INPUTS Local 726 RECORD 2280 1 1 ALC,TGT 726,758,759,760,761,767,768,769,77 0,771,778,785,786,791,792,797,798, 803,804,809,810,815,816,821,822,82 7,828,833,834,839,840,846,847,850, 851,856,857,859,860,886,887,889,89 0,897,898,900,901,904,905 J Dummy 653 I(4) 4 scalar ARG,IN 753,758,759,767,768,778,780,849,85 8,881,903 JMOD Dummy 653 I(4) 4 scalar ARG,IN 778,786,792,798,804,810,816,822,82 8,834,840,847,851,857,860,887,890, 898,901,905 MDSE Local 727 I(4) 4 scalar 727,917 MDSO Local 728 I(4) 4 scalar 728,917 MDSS Local 727 I(4) 4 scalar 727,917 MDST Local 727 I(4) 4 scalar 727 MUDD Local 815 R(4) 4 2 1 PTR 815,816 MUDT Local 821 R(4) 4 2 1 PTR 821,822 MUDV Local 827 R(4) 4 2 1 PTR 827,828 Page 24 Source Listing WMUPD2 2014-09-16 16:49 Symbol Table wmupdtmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References NMPERR Local 727 I(4) 4 scalar 727 NMPSCR Local 727 I(4) 4 scalar 727,917 TC0 Local 759 I(4) 4 1 2 759,886,887 TFN Local 758 I(4) 4 2 32 758,759,767,768,778 TIME Local 725 I(4) 4 1 1 PTR 725 TW0 Local 768 I(4) 4 1 2 768,897,898 W3IDATMD Module 726 726 W3SERVMD Module 723 723 W3WDATMD Module 725 725 WLEV Local 833 R(4) 4 2 1 PTR 833,834 WMMDATMD Module 727 727 WMUPD2 Subr 653 294 WX0 Local 769 R(4) 4 2 1 PTR 769,900,901 WXN Local 769 R(4) 4 2 1 PTR 769,846,847 WY0 Local 770 R(4) 4 2 1 PTR 770,900,901 WYN Local 770 R(4) 4 2 1 PTR 770,846,847 Page 25 Source Listing WMUPD2 2014-09-16 16:49 wmupdtmd.f90 929 !/ ------------------------------------------------------------------- / 930 SUBROUTINE WMUPDV ( IMOD, VX, VY, JMOD, VXI, VYI, UNDEF, CONSTP ) 931 !/ 932 !/ +-----------------------------------+ 933 !/ | WAVEWATCH III NOAA/NCEP | 934 !/ | H. L. Tolman | 935 !/ | FORTRAN 90 | 936 !/ | Last update : 06-Dec-2010 | 937 !/ +-----------------------------------+ 938 !/ 939 !/ 14-Oct-2006 : Origination. ( version 3.10 ) 940 !/ 12-Jan-2007 : General clean-up and bug fixes. ( version 3.10 ) 941 !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) 942 !/ (W. E. Rogers & T. J. Campbell, NRL) 943 !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to 944 !/ specify index closure for a grid. ( version 3.14 ) 945 !/ (T. J. Campbell, NRL) 946 !/ 947 ! 1. Purpose : 948 ! 949 ! Interpolate vector field from input grid to model grid. 950 ! 951 ! 2. Method : 952 ! 953 ! Interpolating or averaging from input grid. 954 ! 955 ! 3. Parameters : 956 ! 957 ! Parameter list 958 ! ---------------------------------------------------------------- 959 ! IMOD Int. I Output model number, 960 ! VX/Y Int. O Output vector field. 961 ! JMOD Int. I Input model number, 962 ! VX/YI Int. I Input vector field. 963 ! UNDEF Int. I Value for mapped out point and points not 964 ! covered. 965 ! CONSTP Int. I Conservation type : 966 ! 1: Vector speed. 967 ! 2: Vector speed squared. 968 ! *: Vector components. 969 ! ---------------------------------------------------------------- 970 ! 971 ! 4. Subroutines used : 972 ! 973 ! Name Type Module Description 974 ! ---------------------------------------------------------------- 975 ! STRACE Subr. W3ERVMD Subroutine tracing. 976 ! EXTCDE Subr. Id. Program abort. 977 ! ---------------------------------------------------------------- 978 ! 979 ! 5. Called by : 980 ! 981 ! Name Type Module Description 982 ! ---------------------------------------------------------------- 983 ! WMUPD2 Subr. WMUPDTMD Input update routine. 984 ! ---------------------------------------------------------------- 985 ! Page 26 Source Listing WMUPDV 2014-09-16 16:49 wmupdtmd.f90 986 ! 6. Error messages : 987 ! 988 ! 7. Remarks : 989 ! 990 ! - Grid pointers for output grid need to be set externally. 991 ! - If input grid does not cover point of target grid, taget grid 992 ! values are set to UNDEF. 993 ! 994 ! 8. Structure : 995 ! 996 ! See source code. 997 ! 998 ! 9. Switches : 999 ! 1000 ! !/S Enable subroutine tracing. 1001 ! !/T Enable test output 1002 ! !/T1 Test output interpolation data. 1003 ! 1004 ! 10. Source code : 1005 ! 1006 !/ ------------------------------------------------------------------- / 1007 !/ 1008 USE W3SERVMD, ONLY: EXTCDE 1009 !/ 1010 USE W3GDATMD, ONLY: NX, NY, X0, Y0, SX, SY, GRIDS, FLAGLL, & 1011 GTYPE, RLGTYPE, CLGTYPE, UNGTYPE, & 1012 ICLOSE_NONE, ICLOSE_SMPL, ICLOSE_TRPL 1013 USE WMMDATMD, ONLY: IMPROC, NMPERR, NMPSCR, MDST, MDSE, MDSO, & 1014 MDSS 1015 !/ 1016 IMPLICIT NONE 1017 !/ 1018 !/ ------------------------------------------------------------------- / 1019 !/ Parameter list 1020 !/ 1021 INTEGER, INTENT(IN) :: IMOD, JMOD, CONSTP 1022 REAL, INTENT(OUT) :: VX(NX,NY), VY(NX,NY) 1023 REAL, INTENT(IN) :: VXI(GRIDS(JMOD)%NX,GRIDS(JMOD)%NY), & 1024 VYI(GRIDS(JMOD)%NX,GRIDS(JMOD)%NY), & 1025 UNDEF 1026 !/ 1027 !/ ------------------------------------------------------------------- / 1028 !/ Local parameters 1029 !/ 1030 INTEGER :: IXO, IYO, IX, IY, IXF0, IXFN, IYF0, & 1031 IYFN, IXS0, IXSN, IYS0, IYSN, IXS, & 1032 MXA, MYA, J, J1, J2, IXC, IYC, JJ, & 1033 JX, JY 1034 INTEGER, ALLOCATABLE :: NXA(:,:), NYA(:,:) 1035 REAL :: XR, YR, R1, R2, RT, XFL, XFR, XSL, & 1036 XSR, YFL, YFR, YSL, YSR 1037 REAL :: VXL, VYL, VA0, VA, VA2, FACTOR, & 1038 WTOT, WL 1039 REAL, ALLOCATABLE :: RXA(:,:), RYA(:,:) 1040 LOGICAL :: MAP1(NX,NY), MAP2(NX,NY), & 1041 MAP3(NX,NY), FLAGUP 1042 ! Page 27 Source Listing WMUPDV 2014-09-16 16:49 wmupdtmd.f90 1043 INTEGER, POINTER :: NXI, NYI, MAP(:,:), MAPI(:,:) 1044 REAL, POINTER :: X0I, Y0I, SXI, SYI 1045 INTEGER, POINTER :: ICLOSE 1046 !/ 1047 !/ ------------------------------------------------------------------- / 1048 ! 0. Initialization 1049 ! 0.a Subroutine tracing and test output 1050 ! 1051 1052 IF ( GRIDS(IMOD)%GTYPE .EQ. CLGTYPE .OR. & 1053 GRIDS(JMOD)%GTYPE .EQ. CLGTYPE ) THEN 1054 WRITE (MDSE,'(/2A)') ' *** ERROR WMUPDV: ', & 1055 'CURVILINEAR GRID SUPPORT NOT YET IMPLEMENTED ***' 1056 CALL EXTCDE ( 999 ) 1057 ELSE IF ( GRIDS(IMOD)%GTYPE .EQ. UNGTYPE .OR. & 1058 GRIDS(JMOD)%GTYPE .EQ. UNGTYPE ) THEN 1059 WRITE (MDSE,'(/2A)') ' *** ERROR WMUPDV: ', & 1060 'UNSTRUCTURED GRID SUPPORT NOT YET IMPLEMENTED ***' 1061 CALL EXTCDE ( 999 ) 1062 END IF 1063 ! 1064 NXI => GRIDS(JMOD)%NX 1065 NYI => GRIDS(JMOD)%NY 1066 X0I => GRIDS(JMOD)%X0 1067 Y0I => GRIDS(JMOD)%Y0 1068 SXI => GRIDS(JMOD)%SX 1069 SYI => GRIDS(JMOD)%SY 1070 MAP => GRIDS(IMOD)%MAPSTA 1071 MAPI => GRIDS(JMOD)%MAPSTA 1072 ICLOSE => GRIDS(JMOD)%ICLOSE 1073 ! 1074 ! 0.b Initialize fields 1075 ! 1076 VX = UNDEF 1077 VY = UNDEF 1078 ! 1079 ! 1. Case of identical resolution and coinciding grids --------------- / 1080 ! 1081 1082 IF ( ABS(SX/SXI-1.) .LT. 1.E-3 .AND. & 1083 ABS(SY/SYI-1.) .LT. 1.E-3 .AND. & 1084 ABS(MOD((ABS(X0-X0I))/SX+0.5,1.)-0.5) .LT. 1.E-2 .AND. & 1085 ABS(MOD((ABS(Y0-Y0I))/SY+0.5,1.)-0.5) .LT. 1.E-2 ) THEN 1086 ! 1087 ! 1.a Offsets 1088 ! 1089 1090 IXO = NINT((X0-X0I)/SX) 1091 ! 1092 IF ( FLAGLL ) THEN 1093 IXF0 = 1 1094 IXFN = NX 1095 IXS0 = -999 1096 IXSN = -999 1097 ELSE 1098 IXF0 = MAX ( 1 , 1-IXO ) 1099 IXFN = MIN ( NX , NXI-IXO ) Page 28 Source Listing WMUPDV 2014-09-16 16:49 wmupdtmd.f90 1100 IXS0 = MAX ( 1 , 1+IXO ) 1101 IXSN = IXS0 + IXFN - IXF0 1102 END IF 1103 ! 1104 IYO = NINT((Y0-Y0I)/SY) 1105 ! 1106 IYF0 = MAX ( 1 , 1-IYO ) 1107 IYFN = MIN ( NY , NYI-IYO ) 1108 IYS0 = MAX ( 1 , 1+IYO ) 1109 IYSN = IYS0 + IYFN - IYF0 1110 ! 1111 ! 1.b Fill arrays for sea points only 1112 ! 1113 1114 DO IX=IXF0, IXFN 1115 IF ( FLAGLL ) THEN 1116 IXS = 1 + NINT ( MOD ( & 1117 1080.+X0+(REAL(IX)-0.5)*SX-X0I , 360. ) / SX - 0.5 ) 1118 IF ( IXS .GT. NXI ) CYCLE 1119 ELSE 1120 IXS = IX + IXO 1121 END IF 1122 VX(IX,IYF0:IYFN) = VXI(IXS,IYS0:IYSN) 1123 VY(IX,IYF0:IYFN) = VYI(IXS,IYS0:IYSN) 1124 END DO 1125 ! 1126 ! 1.c Return to calling routine 1127 ! 1128 RETURN 1129 ! 1130 END IF 1131 ! 1132 ! 2. General case --------------------------------------------------- / 1133 ! 1134 ! 2.a Interpolation / averaging data for X axis 1135 ! 1136 IF ( SX/SXI .LT. 1.0001 ) THEN 1137 MXA = 2 1138 ELSE 1139 MXA = 2 + INT(SX/SXI) 1140 END IF 1141 ! 1142 ALLOCATE ( NXA(NX,0:MXA) , RXA(NX,MXA) ) 1143 NXA = 0 1144 RXA = 0. 1145 ! 1146 IF ( MXA .EQ. 2 ) THEN 1147 ! 1148 DO IX=1, NX 1149 IF ( FLAGLL ) THEN 1150 XR = 1. + MOD & 1151 ( 1080.+X0+REAL(IX-1)*SX-X0I , 360. ) / SXI 1152 ELSE 1153 XR = 1. + ( X0+REAL(IX-1)*SX - X0I ) / SXI 1154 END IF 1155 IF ( XR.GT.0. ) THEN 1156 J1 = INT(XR) Page 29 Source Listing WMUPDV 2014-09-16 16:49 wmupdtmd.f90 1157 J2 = J1 + 1 1158 R2 = MAX ( 0. , XR-REAL(J1) ) 1159 R1 = 1. - R2 1160 IF ( FLAGLL .AND. ICLOSE.NE.ICLOSE_NONE ) THEN 1161 J1 = 1 + MOD(J1-1,NXI) 1162 J2 = 1 + MOD(J2-1,NXI) 1163 END IF 1164 IF ( J1.GE.1 .AND. J1.LE.NXI .AND. R1.GT.0.05 ) THEN 1165 NXA(IX,0) = NXA(IX,0) + 1 1166 NXA(IX,NXA(IX,0)) = J1 1167 RXA(IX,NXA(IX,0)) = R1 1168 END IF 1169 IF ( J2.GE.1 .AND. J2.LE.NXI .AND. R2.GT.0.05 ) THEN 1170 NXA(IX,0) = NXA(IX,0) + 1 1171 NXA(IX,NXA(IX,0)) = J2 1172 RXA(IX,NXA(IX,0)) = R2 1173 END IF 1174 IF ( NXA(IX,0) .GT. 0 ) THEN 1175 RT = SUM ( RXA(IX,:) ) 1176 IF ( RT .LT. 0.7 ) THEN 1177 NXA(IX,:) = 0 1178 RXA(IX,:) = 0. 1179 END IF 1180 END IF 1181 END IF 1182 END DO 1183 ! 1184 ELSE 1185 ! 1186 DO IX=1, NX 1187 ! 1188 XFL = X0 + REAL(IX-1)*SX - 0.5*SX 1189 XFR = X0 + REAL(IX-1)*SX + 0.5*SX 1190 IF ( FLAGLL ) THEN 1191 IXC = 1 + NINT ( MOD ( & 1192 1080.+X0+REAL(IX-1)*SX-X0I , 360. ) / SXI ) 1193 IXS0 = IXC - 1 - MXA/2 1194 IXSN = IXC + 1 + MXA/2 1195 ELSE 1196 IXC = NINT ( 1. + ( X0+REAL(IX-1)*SX - X0I ) / SXI ) 1197 IXS0 = MAX ( 1 , IXC - 1 - MXA/2 ) 1198 IXSN = MIN ( NXI , IXC + 1 + MXA/2 ) 1199 END IF 1200 DO J=IXS0, IXSN 1201 JJ=J 1202 IF ( FLAGLL ) THEN 1203 IF ( ICLOSE.NE.ICLOSE_NONE ) JJ = 1 + MOD(J-1,NXI) 1204 IF ( JJ.LT.1 .OR. JJ.GT. NXI ) CYCLE 1205 IXC = NINT((0.5*(XFL+XFR)-X0I-REAL(JJ-1)*SXI)/360.) 1206 IF ( IXC .NE. 0 ) THEN 1207 XFL = XFL - REAL(IXC) * 360. 1208 XFR = XFR - REAL(IXC) * 360. 1209 END IF 1210 ELSE 1211 JJ = J 1212 END IF 1213 XSL = MAX ( XFL , X0I + REAL(JJ-1)*SXI - 0.5*SXI ) Page 30 Source Listing WMUPDV 2014-09-16 16:49 wmupdtmd.f90 1214 XSR = MIN ( XFR , X0I + REAL(JJ-1)*SXI + 0.5*SXI ) 1215 R1 = MAX ( 0. , XSR - XSL ) / SX 1216 IF ( R1 .GT. 0 ) THEN 1217 NXA(IX,0) = NXA(IX,0) + 1 1218 NXA(IX,NXA(IX,0)) = JJ 1219 RXA(IX,NXA(IX,0)) = R1 1220 END IF 1221 END DO 1222 IF ( NXA(IX,0) .GT. 0 ) THEN 1223 RT = SUM ( RXA(IX,:) ) 1224 IF ( RT .LT. 0.7 ) THEN 1225 NXA(IX,:) = 0 1226 RXA(IX,:) = 0. 1227 END IF 1228 END IF 1229 END DO 1230 ! 1231 END IF 1232 ! 1233 ! 2.b Interpolation / averaging data for Y axis 1234 ! 1235 IF ( SY/SYI .LT. 1.0001 ) THEN 1236 MYA = 2 1237 ELSE 1238 MYA = 2 + INT(SY/SYI) 1239 END IF 1240 ! 1241 ALLOCATE ( NYA(NY,0:MYA) , RYA(NY,MYA) ) 1242 NYA = 0 1243 RYA = 0. 1244 ! 1245 IF ( MYA .EQ. 2 ) THEN 1246 ! 1247 DO IY=1, NY 1248 YR = 1. + ( Y0+REAL(IY-1)*SY - Y0I ) / SYI 1249 IF ( YR.GT.0. ) THEN 1250 J1 = INT(YR) 1251 J2 = J1 + 1 1252 R2 = MAX ( 0. , YR-REAL(J1) ) 1253 R1 = 1. - R2 1254 IF ( J1.GE.1 .AND. J1.LE.NYI .AND. R1.GT.0.05 ) THEN 1255 NYA(IY,0) = NYA(IY,0) + 1 1256 NYA(IY,NYA(IY,0)) = J1 1257 RYA(IY,NYA(IY,0)) = R1 1258 END IF 1259 IF ( J2.GE.1 .AND. J2.LE.NYI .AND. R2.GT.0.05 ) THEN 1260 NYA(IY,0) = NYA(IY,0) + 1 1261 NYA(IY,NYA(IY,0)) = J2 1262 RYA(IY,NYA(IY,0)) = R2 1263 END IF 1264 IF ( NYA(IY,0) .GT. 0 ) THEN 1265 RT = SUM ( RYA(IY,:) ) 1266 IF ( RT .LT. 0.7 ) THEN 1267 NYA(IY,:) = 0 1268 RYA(IY,:) = 0. 1269 END IF 1270 END IF Page 31 Source Listing WMUPDV 2014-09-16 16:49 wmupdtmd.f90 1271 END IF 1272 END DO 1273 ! 1274 ELSE 1275 ! 1276 DO IY=1, NY 1277 YFL = Y0 + REAL(IY-1)*SY - 0.5*SY 1278 YFR = Y0 + REAL(IY-1)*SY + 0.5*SY 1279 IYC = NINT ( 1. + ( Y0+REAL(IY-1)*SY - Y0I ) / SYI ) 1280 IYS0 = MAX ( 1 , IYC - 1 - MYA/2 ) 1281 IYSN = MIN ( NYI , IYC + 1 + MYA/2 ) 1282 DO J=IYS0, IYSN 1283 YSL = MAX ( YFL , Y0I + REAL(J-1)*SYI - 0.5*SYI ) 1284 YSR = MIN ( YFR , Y0I + REAL(J-1)*SYI + 0.5*SYI ) 1285 R1 = MAX ( 0. , YSR - YSL ) / SY 1286 IF ( R1 .GT. 0 ) THEN 1287 NYA(IY,0) = NYA(IY,0) + 1 1288 NYA(IY,NYA(IY,0)) = J 1289 RYA(IY,NYA(IY,0)) = R1 1290 END IF 1291 END DO 1292 IF ( NYA(IY,0) .GT. 0 ) THEN 1293 RT = SUM ( RYA(IY,:) ) 1294 IF ( RT .LT. 0.7 ) THEN 1295 NYA(IY,:) = 0 1296 RYA(IY,:) = 0. 1297 END IF 1298 END IF 1299 END DO 1300 ! 1301 END IF 1302 ! 1303 ! 2.c Process grid 1304 ! 1305 MAP1 = .FALSE. 1306 MAP2 = .FALSE. 1307 FACTOR = 1. 1308 ! 1309 DO IX=1, NX 1310 IF ( NXA(IX,0) .EQ. 0 ) CYCLE 1311 DO IY=1, NY 1312 IF ( NYA(IY,0) .EQ. 0 ) CYCLE 1313 IF ( MAP(IY,IX).NE.0 ) THEN 1314 VXL = 0. 1315 VYL = 0. 1316 VA = 0. 1317 VA2 = 0. 1318 WTOT = 0. 1319 DO J1=1, NXA(IX,0) 1320 JX = NXA(IX,J1) 1321 DO J2=1, NYA(IY,0) 1322 JY = NYA(IY,J2) 1323 IF ( MAPI(JY,JX) .NE. 0 ) THEN 1324 WL = RXA(IX,J1) * RYA(IY,J2) 1325 WTOT = WTOT + WL 1326 VXL = VXL + WL * VXI(JX,JY) 1327 VYL = VYL + WL * VYI(JX,JY) Page 32 Source Listing WMUPDV 2014-09-16 16:49 wmupdtmd.f90 1328 VA = VA + WL * SQRT & 1329 ( VXI(JX,JY)**2 + VYI(JX,JY)**2 ) 1330 VA2 = VA2 + WL * & 1331 ( VXI(JX,JY)**2 + VYI(JX,JY)**2 ) 1332 END IF 1333 END DO 1334 END DO 1335 IF ( WTOT .LT. 0.05 ) THEN 1336 MAP1(IX,IY) = .TRUE. 1337 ELSE 1338 MAP2(IX,IY) = .TRUE. 1339 VXL = VXL / WTOT 1340 VYL = VYL / WTOT 1341 VA = VA / WTOT 1342 VA2 = SQRT ( VA2 / WTOT ) 1343 VA0 = SQRT ( VXL**2 + VYL**2 ) 1344 IF ( CONSTP .EQ. 1 ) THEN 1345 FACTOR = MIN ( 1.25 , VA/MAX(1.E-7,VA0) ) 1346 ELSE IF ( CONSTP .EQ. 2 ) THEN 1347 FACTOR = MIN ( 1.25 , VA2/MAX(1.E-7,VA0) ) 1348 END IF 1349 VX(IX,IY) = FACTOR * VXL 1350 VY(IX,IY) = FACTOR * VYL 1351 END IF 1352 END IF 1353 END DO 1354 END DO 1355 ! 1356 ! 2.d Reconcile mask differences 1357 ! 1358 JJ = 0 1359 ICLOSE => GRIDS(IMOD)%ICLOSE 1360 ! 1361 DO 1362 IF ( JJ .GT. SWPMAX ) EXIT 1363 FLAGUP = .FALSE. 1364 MAP3 = .FALSE. 1365 JJ = JJ + 1 1366 DO IX=1, NX 1367 DO IY=1, NY 1368 IF ( MAP1(IX,IY) ) THEN 1369 VXL = 0. 1370 VYL = 0. 1371 J1 = 0 1372 IF ( FLAGLL ) THEN 1373 DO J2=IX-1, IX+1 1374 IF ( (J2.GT.1 .AND. J2.LE.NX) .OR. ICLOSE.NE.ICLOSE_NONE ) THEN 1375 JX = 1 + MOD(NX+J2-1,NX) 1376 DO JY=IY-1, IY+1 1377 IF ( JY.GT.1 .AND. JY.LE.NY ) THEN 1378 IF ( MAP2(JX,JY) ) THEN 1379 VXL = VXL + VX(JX,JY) 1380 VYL = VYL + VY(JX,JY) 1381 J1 = J1 + 1 1382 END IF 1383 END IF 1384 END DO Page 33 Source Listing WMUPDV 2014-09-16 16:49 wmupdtmd.f90 1385 END IF 1386 END DO 1387 ELSE 1388 DO JX=IX-1, IX+1 1389 IF ( JX.GT.1 .AND. JX.LE.NX ) THEN 1390 DO JY=IY-1, IY+1 1391 IF ( JY.GT.1 .AND. JY.LE.NY ) THEN 1392 IF ( MAP2(JX,JY) ) THEN 1393 VXL = VXL + VX(JX,JY) 1394 VYL = VYL + VY(JX,JY) 1395 J1 = J1 + 1 1396 END IF 1397 END IF 1398 END DO 1399 END IF 1400 END DO 1401 END IF !FLAGLL 1402 IF ( J1 .GT. 0 ) THEN 1403 VX(IX,IY) = VXL / REAL(J1) 1404 VY(IX,IY) = VYL / REAL(J1) 1405 MAP1(IX,IY) = .FALSE. 1406 MAP3(IX,IY) = .TRUE. 1407 FLAGUP = .TRUE. 1408 END IF 1409 END IF 1410 END DO 1411 END DO 1412 IF ( FLAGUP ) THEN 1413 MAP2 = MAP2 .OR. MAP3 1414 ELSE 1415 EXIT 1416 END IF 1417 END DO 1418 ! 1419 ! 3. End of routine -------------------------------------------------- / 1420 ! 1421 DEALLOCATE ( NXA, NYA, RXA, RYA ) 1422 ! 1423 RETURN 1424 ! 1425 ! Formats 1426 ! 1427 !/ 1428 !/ End of WMUPDV ----------------------------------------------------- / 1429 !/ 1430 END SUBROUTINE WMUPDV Page 34 Source Listing WMUPDV 2014-09-16 16:49 Entry Points wmupdtmd.f90 ENTRY POINTS Name wmupdtmd_mp_wmupdv_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABS Func 1082 scalar 1082,1083,1084,1085 CLGTYPE Param 1011 I(4) 4 scalar 1011,1052,1053 CONSTP Dummy 930 I(4) 4 scalar ARG,IN 1344,1346 EXTCDE Subr 1008 1008,1056,1061 FACTOR Local 1037 R(4) 4 scalar 1307,1345,1347,1349,1350 FLAGLL Local 1010 L(4) 4 scalar 1010,1092,1115,1149,1160,1190,1202 ,1372 FLAGUP Local 1041 L(4) 4 scalar 1363,1407,1412 GRIDS Local 1010 RECORD 4376 1 1 ALC,TGT 1010,1023,1024,1052,1053,1057,1058 ,1064,1065,1066,1067,1068,1069,107 0,1071,1072,1359 GTYPE Local 1011 I(4) 4 scalar PTR 1011 GTYPE Local 1052 I(4) 4 scalar 1052,1053,1057,1058 ICLOSE Local 1045 I(4) 4 scalar PTR 1072,1160,1203,1359,1374 ICLOSE Local 1072 I(4) 4 scalar 1072,1359 ICLOSE_NONE Param 1012 I(4) 4 scalar 1012,1160,1203,1374 ICLOSE_SMPL Param 1012 I(4) 4 scalar 1012 ICLOSE_TRPL Param 1012 I(4) 4 scalar 1012 IMOD Dummy 930 I(4) 4 scalar ARG,IN 1052,1057,1070,1359 IMPROC Local 1013 I(4) 4 scalar 1013 INT Func 1139 scalar 1139,1156,1238,1250 IX Local 1030 I(4) 4 scalar 1114,1117,1120,1122,1123,1148,1151 ,1153,1165,1166,1167,1170,1171,117 2,1174,1175,1177,1178,1186,1188,11 89,1192,1196,1217,1218,1219,1222,1 223,1225,1226,1309,1310,1313,1319, 1320,1324,1336,1338,1349,1350,1366 ,1368,1373,1388,1403,1404,1405,140 6 IXC Local 1032 I(4) 4 scalar 1191,1193,1194,1196,1197,1198,1205 ,1206,1207,1208 IXF0 Local 1030 I(4) 4 scalar 1093,1098,1101,1114 IXFN Local 1030 I(4) 4 scalar 1094,1099,1101,1114 IXO Local 1030 I(4) 4 scalar 1090,1098,1099,1100,1120 IXS Local 1031 I(4) 4 scalar 1116,1118,1120,1122,1123 IXS0 Local 1031 I(4) 4 scalar 1095,1100,1101,1193,1197,1200 IXSN Local 1031 I(4) 4 scalar 1096,1101,1194,1198,1200 IY Local 1030 I(4) 4 scalar 1247,1248,1255,1256,1257,1260,1261 ,1262,1264,1265,1267,1268,1276,127 7,1278,1279,1287,1288,1289,1292,12 93,1295,1296,1311,1312,1313,1321,1 322,1324,1336,1338,1349,1350,1367, 1368,1376,1390,1403,1404,1405,1406 IYC Local 1032 I(4) 4 scalar 1279,1280,1281 Page 35 Source Listing WMUPDV 2014-09-16 16:49 Symbol Table wmupdtmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References IYF0 Local 1030 I(4) 4 scalar 1106,1109,1122,1123 IYFN Local 1031 I(4) 4 scalar 1107,1109,1122,1123 IYO Local 1030 I(4) 4 scalar 1104,1106,1107,1108 IYS0 Local 1031 I(4) 4 scalar 1108,1109,1122,1123,1280,1282 IYSN Local 1031 I(4) 4 scalar 1109,1122,1123,1281,1282 J Local 1032 I(4) 4 scalar 1200,1201,1203,1211,1282,1283,1284 ,1288 J1 Local 1032 I(4) 4 scalar 1156,1157,1158,1161,1164,1166,1250 ,1251,1252,1254,1256,1319,1320,132 4,1371,1381,1395,1402,1403,1404 J2 Local 1032 I(4) 4 scalar 1157,1162,1169,1171,1251,1259,1261 ,1321,1322,1324,1373,1374,1375 JJ Local 1032 I(4) 4 scalar 1201,1203,1204,1205,1211,1213,1214 ,1218,1358,1362,1365 JMOD Dummy 930 I(4) 4 scalar ARG,IN 1023,1024,1053,1058,1064,1065,1066 ,1067,1068,1069,1071,1072 JX Local 1033 I(4) 4 scalar 1320,1323,1326,1327,1329,1331,1375 ,1378,1379,1380,1388,1389,1392,139 3,1394 JY Local 1033 I(4) 4 scalar 1322,1323,1326,1327,1329,1331,1376 ,1377,1378,1379,1380,1390,1391,139 2,1393,1394 MAP Local 1043 I(4) 4 2 1 PTR 1070,1313 MAP1 Local 1040 L(4) 4 2 0 1305,1336,1368,1405 MAP2 Local 1040 L(4) 4 2 0 1306,1338,1378,1392,1413 MAP3 Local 1041 L(4) 4 2 0 1364,1406,1413 MAPI Local 1043 I(4) 4 2 1 PTR 1071,1323 MAPSTA Local 1070 I(4) 4 2 1 PTR 1070,1071 MAX Func 1098 scalar 1098,1100,1106,1108,1158,1197,1213 ,1215,1252,1280,1283,1285,1345,134 7 MDSE Local 1013 I(4) 4 scalar 1013,1054,1059 MDSO Local 1013 I(4) 4 scalar 1013 MDSS Local 1014 I(4) 4 scalar 1014 MDST Local 1013 I(4) 4 scalar 1013 MIN Func 1099 scalar 1099,1107,1198,1214,1281,1284,1345 ,1347 MOD Func 1084 scalar 1084,1085,1116,1150,1161,1162,1191 ,1203,1375 MXA Local 1032 I(4) 4 scalar 1137,1139,1142,1146,1193,1194,1197 ,1198 MYA Local 1032 I(4) 4 scalar 1236,1238,1241,1245,1280,1281 NINT Func 1090 scalar 1090,1104,1116,1191,1196,1205,1279 NMPERR Local 1013 I(4) 4 scalar 1013 NMPSCR Local 1013 I(4) 4 scalar 1013 NX Local 1010 I(4) 4 scalar PTR 1010,1022,1040,1041,1094,1099,1142 ,1148,1186,1309,1366,1374,1375,138 9 NX Local 1023 I(4) 4 scalar 1023,1024,1064 NXA Local 1034 I(4) 4 2 1 ALC 1142,1143,1165,1166,1167,1170,1171 ,1172,1174,1177,1217,1218,1219,122 2,1225,1310,1319,1320,1421 NXI Local 1043 I(4) 4 scalar PTR 1064,1099,1118,1161,1162,1164,1169 ,1198,1203,1204 NY Local 1010 I(4) 4 scalar PTR 1010,1022,1040,1041,1107,1241,1247 Page 36 Source Listing WMUPDV 2014-09-16 16:49 Symbol Table wmupdtmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References ,1276,1311,1367,1377,1391 NY Local 1023 I(4) 4 scalar 1023,1024,1065 NYA Local 1034 I(4) 4 2 1 ALC 1241,1242,1255,1256,1257,1260,1261 ,1262,1264,1267,1287,1288,1289,129 2,1295,1312,1321,1322,1421 NYI Local 1043 I(4) 4 scalar PTR 1065,1107,1254,1259,1281 R1 Local 1035 R(4) 4 scalar 1159,1164,1167,1215,1216,1219,1253 ,1254,1257,1285,1286,1289 R2 Local 1035 R(4) 4 scalar 1158,1159,1169,1172,1252,1253,1259 ,1262 REAL Func 1117 scalar 1117,1151,1153,1158,1188,1189,1192 ,1196,1205,1207,1208,1213,1214,124 8,1252,1277,1278,1279,1283,1284,14 03,1404 RLGTYPE Param 1011 I(4) 4 scalar 1011 RT Local 1035 R(4) 4 scalar 1175,1176,1223,1224,1265,1266,1293 ,1294 RXA Local 1039 R(4) 4 2 1 ALC 1142,1144,1167,1172,1175,1178,1219 ,1223,1226,1324,1421 RYA Local 1039 R(4) 4 2 1 ALC 1241,1243,1257,1262,1265,1268,1289 ,1293,1296,1324,1421 SQRT Func 1328 scalar 1328,1342,1343 SUM Func 1175 scalar 1175,1223,1265,1293 SWPMAX Param 1362 I(4) 4 scalar 1362,1836 SX Local 1010 R(4) 4 scalar PTR 1010,1082,1084,1090,1117,1136,1139 ,1151,1153,1188,1189,1192,1196,121 5 SX Local 1068 R(4) 4 scalar 1068 SXI Local 1044 R(4) 4 scalar PTR 1068,1082,1136,1139,1151,1153,1192 ,1196,1205,1213,1214 SY Local 1010 R(4) 4 scalar PTR 1010,1083,1085,1104,1235,1238,1248 ,1277,1278,1279,1285 SY Local 1069 R(4) 4 scalar 1069 SYI Local 1044 R(4) 4 scalar PTR 1069,1083,1235,1238,1248,1279,1283 ,1284 UNDEF Dummy 930 R(4) 4 scalar ARG,IN 1076,1077 UNGTYPE Param 1011 I(4) 4 scalar 1011,1057,1058 VA Local 1037 R(4) 4 scalar 1316,1328,1341,1345 VA0 Local 1037 R(4) 4 scalar 1343,1345,1347 VA2 Local 1037 R(4) 4 scalar 1317,1330,1342,1347 VX Dummy 930 R(4) 4 2 0 ARG,OUT 1076,1122,1349,1379,1393,1403 VXI Dummy 930 R(4) 4 2 0 ARG,IN 1122,1326,1329,1331 VXL Local 1037 R(4) 4 scalar 1314,1326,1339,1343,1349,1369,1379 ,1393,1403 VY Dummy 930 R(4) 4 2 0 ARG,OUT 1077,1123,1350,1380,1394,1404 VYI Dummy 930 R(4) 4 2 0 ARG,IN 1123,1327,1329,1331 VYL Local 1037 R(4) 4 scalar 1315,1327,1340,1343,1350,1370,1380 ,1394,1404 W3GDATMD Module 1010 1010 W3SERVMD Module 1008 1008 WL Local 1038 R(4) 4 scalar 1324,1325,1326,1327,1328,1330 WMMDATMD Module 1013 1013 WMUPDV Subr 930 839,846,889,900 WTOT Local 1038 R(4) 4 scalar 1318,1325,1335,1339,1340,1341,1342 X0 Local 1010 R(4) 4 scalar PTR 1010,1084,1090,1117,1151,1153,1188 Page 37 Source Listing WMUPDV 2014-09-16 16:49 Symbol Table wmupdtmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References ,1189,1192,1196 X0 Local 1066 R(4) 4 scalar 1066 X0I Local 1044 R(4) 4 scalar PTR 1066,1084,1090,1117,1151,1153,1192 ,1196,1205,1213,1214 XFL Local 1035 R(4) 4 scalar 1188,1205,1207,1213 XFR Local 1035 R(4) 4 scalar 1189,1205,1208,1214 XR Local 1035 R(4) 4 scalar 1150,1153,1155,1156,1158 XSL Local 1035 R(4) 4 scalar 1213,1215 XSR Local 1036 R(4) 4 scalar 1214,1215 Y0 Local 1010 R(4) 4 scalar PTR 1010,1085,1104,1248,1277,1278,1279 Y0 Local 1067 R(4) 4 scalar 1067 Y0I Local 1044 R(4) 4 scalar PTR 1067,1085,1104,1248,1279,1283,1284 YFL Local 1036 R(4) 4 scalar 1277,1283 YFR Local 1036 R(4) 4 scalar 1278,1284 YR Local 1035 R(4) 4 scalar 1248,1249,1250,1252 YSL Local 1036 R(4) 4 scalar 1283,1285 YSR Local 1036 R(4) 4 scalar 1284,1285 Page 38 Source Listing WMUPDV 2014-09-16 16:49 wmupdtmd.f90 1431 !/ ------------------------------------------------------------------- / 1432 SUBROUTINE WMUPDS ( IMOD, FD, JMOD, FDI, UNDEF ) 1433 !/ 1434 !/ +-----------------------------------+ 1435 !/ | WAVEWATCH III NOAA/NCEP | 1436 !/ | H. L. Tolman | 1437 !/ | FORTRAN 90 | 1438 !/ | Last update : 06-Dec-2010 | 1439 !/ +-----------------------------------+ 1440 !/ 1441 !/ 14-Oct-2006 : Origination. ( version 3.10 ) 1442 !/ 12-Jan-2007 : General clean-up and bug fixes. ( version 3.10 ) 1443 !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) 1444 !/ (W. E. Rogers & T. J. Campbell, NRL) 1445 !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to 1446 !/ specify index closure for a grid. ( version 3.14 ) 1447 !/ (T. J. Campbell, NRL) 1448 !/ 1449 ! 1. Purpose : 1450 ! 1451 ! Interpolate vector field from input grid to model grid. 1452 ! 1453 ! 2. Method : 1454 ! 1455 ! Interpolating or averaging from input grid. 1456 ! 1457 ! 3. Parameters : 1458 ! 1459 ! Parameter list 1460 ! ---------------------------------------------------------------- 1461 ! IMOD Int. I Output model number, 1462 ! FD Int. O Output scaler field. 1463 ! JMOD Int. I Input model number, 1464 ! FDI Int. I Input scaler field. 1465 ! UNDEF Int. I Value for mapped out point and points not 1466 ! covered. 1467 ! ---------------------------------------------------------------- 1468 ! 1469 ! 4. Subroutines used : 1470 ! 1471 ! Name Type Module Description 1472 ! ---------------------------------------------------------------- 1473 ! STRACE Subr. W3ERVMD Subroutine tracing. 1474 ! EXTCDE Subr. Id. Program abort. 1475 ! ---------------------------------------------------------------- 1476 ! 1477 ! 5. Called by : 1478 ! 1479 ! Name Type Module Description 1480 ! ---------------------------------------------------------------- 1481 ! WMUPD2 Subr. WMUPDTMD Input update routine. 1482 ! ---------------------------------------------------------------- 1483 ! 1484 ! 6. Error messages : 1485 ! 1486 ! 7. Remarks : 1487 ! Page 39 Source Listing WMUPDS 2014-09-16 16:49 wmupdtmd.f90 1488 ! - Grid pointers for output grid need to be set externally. 1489 ! - If input grid does not cover point of target grid, taget grid 1490 ! values are set to UNDEF. 1491 ! 1492 ! 8. Structure : 1493 ! 1494 ! See source code. 1495 ! 1496 ! 9. Switches : 1497 ! 1498 ! !/S Enable subroutine tracing. 1499 ! !/T Enable test output 1500 ! !/T1 Test output interpolation data. 1501 ! 1502 ! 10. Source code : 1503 ! 1504 !/ ------------------------------------------------------------------- / 1505 !/ 1506 USE W3SERVMD, ONLY: EXTCDE 1507 !/ 1508 USE W3GDATMD, ONLY: NX, NY, X0, Y0, SX, SY, GRIDS, FLAGLL, & 1509 GTYPE, RLGTYPE, CLGTYPE, UNGTYPE, & 1510 ICLOSE_NONE, ICLOSE_SMPL, ICLOSE_TRPL 1511 USE WMMDATMD, ONLY: IMPROC, NMPERR, NMPSCR, MDST, MDSE, MDSO, & 1512 MDSS 1513 !/ 1514 IMPLICIT NONE 1515 !/ 1516 !/ ------------------------------------------------------------------- / 1517 !/ Parameter list 1518 !/ 1519 INTEGER, INTENT(IN) :: IMOD, JMOD 1520 REAL, INTENT(OUT) :: FD(NX,NY) 1521 REAL, INTENT(IN) :: FDI(GRIDS(JMOD)%NX,GRIDS(JMOD)%NY), & 1522 UNDEF 1523 !/ 1524 !/ ------------------------------------------------------------------- / 1525 !/ Local parameters 1526 !/ 1527 INTEGER :: IXO, IYO, IX, IY, IXF0, IXFN, IYF0, & 1528 IYFN, IXS0, IXSN, IYS0, IYSN, IXS, & 1529 MXA, MYA, J, J1, J2, IXC, IYC, JJ, & 1530 JX, JY 1531 INTEGER, ALLOCATABLE :: NXA(:,:), NYA(:,:) 1532 REAL :: XR, YR, R1, R2, RT, XFL, XFR, XSL, & 1533 XSR, YFL, YFR, YSL, YSR 1534 REAL :: FDL, WTOT, WL 1535 REAL, ALLOCATABLE :: RXA(:,:), RYA(:,:) 1536 LOGICAL :: MAP1(NX,NY), MAP2(NX,NY), & 1537 MAP3(NX,NY), FLAGUP 1538 ! 1539 INTEGER, POINTER :: NXI, NYI, MAP(:,:), MAPI(:,:) 1540 REAL, POINTER :: X0I, Y0I, SXI, SYI 1541 INTEGER, POINTER :: ICLOSE 1542 !/ 1543 !/ ------------------------------------------------------------------- / 1544 ! 0. Initialization Page 40 Source Listing WMUPDS 2014-09-16 16:49 wmupdtmd.f90 1545 ! 0.a Subroutine tracing and test output 1546 ! 1547 1548 IF ( GRIDS(IMOD)%GTYPE .EQ. CLGTYPE .OR. & 1549 GRIDS(JMOD)%GTYPE .EQ. CLGTYPE ) THEN 1550 WRITE (MDSE,'(/2A)') ' *** ERROR WMUPDS: ', & 1551 'CURVILINEAR GRID SUPPORT NOT YET IMPLEMENTED ***' 1552 CALL EXTCDE ( 999 ) 1553 ELSE IF ( GRIDS(IMOD)%GTYPE .EQ. UNGTYPE .OR. & 1554 GRIDS(JMOD)%GTYPE .EQ. UNGTYPE ) THEN 1555 WRITE (MDSE,'(/2A)') ' *** ERROR WMUPDS: ', & 1556 'UNSTRUCTURED GRID SUPPORT NOT YET IMPLEMENTED ***' 1557 CALL EXTCDE ( 999 ) 1558 END IF 1559 ! 1560 NXI => GRIDS(JMOD)%NX 1561 NYI => GRIDS(JMOD)%NY 1562 X0I => GRIDS(JMOD)%X0 1563 Y0I => GRIDS(JMOD)%Y0 1564 SXI => GRIDS(JMOD)%SX 1565 SYI => GRIDS(JMOD)%SY 1566 MAP => GRIDS(IMOD)%MAPSTA 1567 MAPI => GRIDS(JMOD)%MAPSTA 1568 ICLOSE => GRIDS(JMOD)%ICLOSE 1569 ! 1570 ! 0.b Initialize fields 1571 ! 1572 FD = UNDEF 1573 ! 1574 ! 1. Case of identical resolution and coinciding grids --------------- / 1575 ! 1576 IF ( ABS(SX/SXI-1.) .LT. 1.E-3 .AND. & 1577 ABS(SY/SYI-1.) .LT. 1.E-3 .AND. & 1578 ABS(MOD((ABS(X0-X0I))/SX+0.5,1.)-0.5) .LT. 1.E-2 .AND. & 1579 ABS(MOD((ABS(Y0-Y0I))/SY+0.5,1.)-0.5) .LT. 1.E-2 ) THEN 1580 ! 1581 ! 1.a Offsets 1582 ! 1583 IXO = NINT((X0-X0I)/SX) 1584 ! 1585 IF ( FLAGLL ) THEN 1586 IXF0 = 1 1587 IXFN = NX 1588 IXS0 = -999 1589 IXSN = -999 1590 ELSE 1591 IXF0 = MAX ( 1 , 1-IXO ) 1592 IXFN = MIN ( NX , NXI-IXO ) 1593 IXS0 = MAX ( 1 , 1+IXO ) 1594 IXSN = IXS0 + IXFN - IXF0 1595 END IF 1596 ! 1597 IYO = NINT((Y0-Y0I)/SY) 1598 ! 1599 IYF0 = MAX ( 1 , 1-IYO ) 1600 IYFN = MIN ( NY , NYI-IYO ) 1601 IYS0 = MAX ( 1 , 1+IYO ) Page 41 Source Listing WMUPDS 2014-09-16 16:49 wmupdtmd.f90 1602 IYSN = IYS0 + IYFN - IYF0 1603 ! 1604 ! 1.b Fill arrays for sea points only 1605 ! 1606 IF ( FLAGLL ) THEN 1607 DO IX=IXF0, IXFN 1608 IXS = 1 + NINT ( MOD ( & 1609 1080.+X0+(REAL(IX)-0.5)*SX-X0I , 360. ) / SX - 0.5 ) 1610 IF ( IXS .GT. NXI ) CYCLE 1611 FD(IX,IYF0:IYFN) = FDI(IXS,IYS0:IYSN) 1612 END DO 1613 ELSE 1614 DO IX=IXF0, IXFN 1615 IXS = IX + IXO 1616 FD(IX,IYF0:IYFN) = FDI(IXS,IYS0:IYSN) 1617 END DO 1618 END IF 1619 ! 1620 ! 1.c Return to calling routine 1621 ! 1622 RETURN 1623 ! 1624 END IF 1625 ! 1626 ! 2. General case --------------------------------------------------- / 1627 ! 1628 ! 2.a Interpolation / averaging data for X axis 1629 ! 1630 IF ( SX/SXI .LT. 1.0001 ) THEN 1631 MXA = 2 1632 ELSE 1633 MXA = 2 + INT(SX/SXI) 1634 END IF 1635 ! 1636 ALLOCATE ( NXA(NX,0:MXA) , RXA(NX,MXA) ) 1637 NXA = 0 1638 RXA = 0. 1639 ! 1640 IF ( MXA .EQ. 2 ) THEN 1641 ! 1642 DO IX=1, NX 1643 IF ( FLAGLL ) THEN 1644 XR = 1. + MOD & 1645 ( 1080.+X0+REAL(IX-1)*SX-X0I , 360. ) / SXI 1646 ELSE 1647 XR = 1. + ( X0+REAL(IX-1)*SX - X0I ) / SXI 1648 END IF 1649 IF ( XR.GT.0. ) THEN 1650 J1 = INT(XR) 1651 J2 = J1 + 1 1652 R2 = MAX ( 0. , XR-REAL(J1) ) 1653 R1 = 1. - R2 1654 IF ( FLAGLL .AND. ICLOSE.NE.ICLOSE_NONE ) THEN 1655 J1 = 1 + MOD(J1-1,NXI) 1656 J2 = 1 + MOD(J2-1,NXI) 1657 END IF 1658 IF ( J1.GE.1 .AND. J1.LE.NXI .AND. R1.GT.0.05 ) THEN Page 42 Source Listing WMUPDS 2014-09-16 16:49 wmupdtmd.f90 1659 NXA(IX,0) = NXA(IX,0) + 1 1660 NXA(IX,NXA(IX,0)) = J1 1661 RXA(IX,NXA(IX,0)) = R1 1662 END IF 1663 IF ( J2.GE.1 .AND. J2.LE.NXI .AND. R2.GT.0.05 ) THEN 1664 NXA(IX,0) = NXA(IX,0) + 1 1665 NXA(IX,NXA(IX,0)) = J2 1666 RXA(IX,NXA(IX,0)) = R2 1667 END IF 1668 IF ( NXA(IX,0) .GT. 0 ) THEN 1669 RT = SUM ( RXA(IX,:) ) 1670 IF ( RT .LT. 0.7 ) THEN 1671 NXA(IX,:) = 0 1672 RXA(IX,:) = 0. 1673 END IF 1674 END IF 1675 END IF 1676 END DO 1677 ! 1678 ELSE 1679 ! 1680 DO IX=1, NX 1681 ! 1682 XFL = X0 + REAL(IX-1)*SX - 0.5*SX 1683 XFR = X0 + REAL(IX-1)*SX + 0.5*SX 1684 IF ( FLAGLL ) THEN 1685 IXC = 1 + NINT ( MOD ( & 1686 1080.+X0+REAL(IX-1)*SX-X0I , 360. ) / SXI ) 1687 IXS0 = IXC - 1 - MXA/2 1688 IXSN = IXC + 1 + MXA/2 1689 ELSE 1690 IXC = NINT ( 1. + ( X0+REAL(IX-1)*SX - X0I ) / SXI ) 1691 IXS0 = MAX ( 1 , IXC - 1 - MXA/2 ) 1692 IXSN = MIN ( NXI , IXC + 1 + MXA/2 ) 1693 END IF 1694 DO J=IXS0, IXSN 1695 IF ( FLAGLL ) THEN 1696 IF ( ICLOSE.NE.ICLOSE_NONE ) JJ = 1 + MOD(J-1,NXI) 1697 IF ( JJ.LT.1 .OR. JJ.GT. NXI ) CYCLE 1698 IXC = NINT((0.5*(XFL+XFR)-X0I-REAL(JJ-1)*SXI)/360.) 1699 IF ( IXC .NE. 0 ) THEN 1700 XFL = XFL - REAL(IXC) * 360. 1701 XFR = XFR - REAL(IXC) * 360. 1702 END IF 1703 ELSE 1704 JJ = J 1705 END IF 1706 XSL = MAX ( XFL , X0I + REAL(JJ-1)*SXI - 0.5*SXI ) 1707 XSR = MIN ( XFR , X0I + REAL(JJ-1)*SXI + 0.5*SXI ) 1708 R1 = MAX ( 0. , XSR - XSL ) / SX 1709 IF ( R1 .GT. 0 ) THEN 1710 NXA(IX,0) = NXA(IX,0) + 1 1711 NXA(IX,NXA(IX,0)) = JJ 1712 RXA(IX,NXA(IX,0)) = R1 1713 END IF 1714 END DO 1715 IF ( NXA(IX,0) .GT. 0 ) THEN Page 43 Source Listing WMUPDS 2014-09-16 16:49 wmupdtmd.f90 1716 RT = SUM ( RXA(IX,:) ) 1717 IF ( RT .LT. 0.7 ) THEN 1718 NXA(IX,:) = 0 1719 RXA(IX,:) = 0. 1720 END IF 1721 END IF 1722 END DO 1723 ! 1724 END IF 1725 ! 1726 ! 2.b Interpolation / averaging data for Y axis 1727 ! 1728 IF ( SY/SYI .LT. 1.0001 ) THEN 1729 MYA = 2 1730 ELSE 1731 MYA = 2 + INT(SY/SYI) 1732 END IF 1733 ! 1734 ALLOCATE ( NYA(NY,0:MYA) , RYA(NY,MYA) ) 1735 NYA = 0 1736 RYA = 0. 1737 ! 1738 IF ( MYA .EQ. 2 ) THEN 1739 ! 1740 DO IY=1, NY 1741 YR = 1. + ( Y0+REAL(IY-1)*SY - Y0I ) / SYI 1742 IF ( YR.GT.0. ) THEN 1743 J1 = INT(YR) 1744 J2 = J1 + 1 1745 R2 = MAX ( 0. , YR-REAL(J1) ) 1746 R1 = 1. - R2 1747 IF ( J1.GE.1 .AND. J1.LE.NYI .AND. R1.GT.0.05 ) THEN 1748 NYA(IY,0) = NYA(IY,0) + 1 1749 NYA(IY,NYA(IY,0)) = J1 1750 RYA(IY,NYA(IY,0)) = R1 1751 END IF 1752 IF ( J2.GE.1 .AND. J2.LE.NYI .AND. R2.GT.0.05 ) THEN 1753 NYA(IY,0) = NYA(IY,0) + 1 1754 NYA(IY,NYA(IY,0)) = J2 1755 RYA(IY,NYA(IY,0)) = R2 1756 END IF 1757 IF ( NYA(IY,0) .GT. 0 ) THEN 1758 RT = SUM ( RYA(IY,:) ) 1759 IF ( RT .LT. 0.7 ) THEN 1760 NYA(IY,:) = 0 1761 RYA(IY,:) = 0. 1762 END IF 1763 END IF 1764 END IF 1765 END DO 1766 ! 1767 ELSE 1768 ! 1769 DO IY=1, NY 1770 YFL = Y0 + REAL(IY-1)*SY - 0.5*SY 1771 YFR = Y0 + REAL(IY-1)*SY + 0.5*SY 1772 IYC = NINT ( 1. + ( Y0+REAL(IY-1)*SY - Y0I ) / SYI ) Page 44 Source Listing WMUPDS 2014-09-16 16:49 wmupdtmd.f90 1773 IYS0 = MAX ( 1 , IYC - 1 - MYA/2 ) 1774 IYSN = MIN ( NYI , IYC + 1 + MYA/2 ) 1775 DO J=IYS0, IYSN 1776 YSL = MAX ( YFL , Y0I + REAL(J-1)*SYI - 0.5*SYI ) 1777 YSR = MIN ( YFR , Y0I + REAL(J-1)*SYI + 0.5*SYI ) 1778 R1 = MAX ( 0. , YSR - YSL ) / SY 1779 IF ( R1 .GT. 0 ) THEN 1780 NYA(IY,0) = NYA(IY,0) + 1 1781 NYA(IY,NYA(IY,0)) = J 1782 RYA(IY,NYA(IY,0)) = R1 1783 END IF 1784 END DO 1785 IF ( NYA(IY,0) .GT. 0 ) THEN 1786 RT = SUM ( RYA(IY,:) ) 1787 IF ( RT .LT. 0.7 ) THEN 1788 NYA(IY,:) = 0 1789 RYA(IY,:) = 0. 1790 END IF 1791 END IF 1792 END DO 1793 ! 1794 END IF 1795 ! 1796 ! 2.c Process grid 1797 ! 1798 MAP1 = .FALSE. 1799 MAP2 = .FALSE. 1800 ! 1801 DO IX=1, NX 1802 IF ( NXA(IX,0) .EQ. 0 ) CYCLE 1803 DO IY=1, NY 1804 IF ( NYA(IY,0) .EQ. 0 ) CYCLE 1805 IF ( MAP(IY,IX).NE.0 ) THEN 1806 FDL = 0. 1807 WTOT = 0. 1808 DO J1=1, NXA(IX,0) 1809 JX = NXA(IX,J1) 1810 DO J2=1, NYA(IY,0) 1811 JY = NYA(IY,J2) 1812 IF ( MAPI(JY,JX) .NE. 0 ) THEN 1813 WL = RXA(IX,J1) * RYA(IY,J2) 1814 WTOT = WTOT + WL 1815 FDL = FDL + WL * FDI(JX,JY) 1816 END IF 1817 END DO 1818 END DO 1819 IF ( WTOT .LT. 0.05 ) THEN 1820 MAP1(IX,IY) = .TRUE. 1821 ELSE 1822 MAP2(IX,IY) = .TRUE. 1823 FDL = FDL / WTOT 1824 FD(IX,IY) = FDL 1825 END IF 1826 END IF 1827 END DO 1828 END DO 1829 ! Page 45 Source Listing WMUPDS 2014-09-16 16:49 wmupdtmd.f90 1830 ! 2.d Reconcile mask differences 1831 ! 1832 JJ = 0 1833 ICLOSE => GRIDS(IMOD)%ICLOSE 1834 ! 1835 DO 1836 IF ( JJ .GT. SWPMAX ) EXIT 1837 FLAGUP = .FALSE. 1838 MAP3 = .FALSE. 1839 JJ = JJ + 1 1840 DO IX=1, NX 1841 DO IY=1, NY 1842 IF ( MAP1(IX,IY) ) THEN 1843 FDL = 0. 1844 J1 = 0 1845 IF ( FLAGLL ) THEN 1846 DO J2=IX-1, IX+1 1847 IF ( (J2.GT.1 .AND. J2.LE.NX) .OR. ICLOSE.NE.ICLOSE_NONE ) THEN 1848 JX = 1 + MOD(NX+J2-1,NX) 1849 DO JY=IY-1, IY+1 1850 IF ( JY.GT.1 .AND. JY.LE.NY ) THEN 1851 IF ( MAP2(JX,JY) ) THEN 1852 FDL = FDL + FD(JX,JY) 1853 J1 = J1 + 1 1854 END IF 1855 END IF 1856 END DO 1857 END IF 1858 END DO 1859 ELSE 1860 DO JX=IX-1, IX+1 1861 IF ( JX.GT.1 .AND. JX.LE.NX ) THEN 1862 DO JY=IY-1, IY+1 1863 IF ( JY.GT.1 .AND. JY.LE.NY ) THEN 1864 IF ( MAP2(JX,JY) ) THEN 1865 FDL = FDL + FD(JX,JY) 1866 J1 = J1 + 1 1867 END IF 1868 END IF 1869 END DO 1870 END IF 1871 END DO 1872 END IF !FLAGLL 1873 IF ( J1 .GT. 0 ) THEN 1874 FD(IX,IY) = FDL / REAL(J1) 1875 MAP1(IX,IY) = .FALSE. 1876 MAP3(IX,IY) = .TRUE. 1877 FLAGUP = .TRUE. 1878 END IF 1879 END IF 1880 END DO 1881 END DO 1882 IF ( FLAGUP ) THEN 1883 MAP2 = MAP2 .OR. MAP3 1884 ELSE 1885 EXIT 1886 END IF Page 46 Source Listing WMUPDS 2014-09-16 16:49 wmupdtmd.f90 1887 END DO 1888 ! 1889 ! 3. End of routine -------------------------------------------------- / 1890 ! 1891 DEALLOCATE ( NXA, NYA, RXA, RYA ) 1892 ! 1893 RETURN 1894 ! 1895 ! Formats 1896 ! 1897 !/ 1898 !/ End of WMUPDS ----------------------------------------------------- / 1899 !/ 1900 END SUBROUTINE WMUPDS ENTRY POINTS Name wmupdtmd_mp_wmupds_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABS Func 1576 scalar 1576,1577,1578,1579 CLGTYPE Param 1509 I(4) 4 scalar 1509,1548,1549 EXTCDE Subr 1506 1506,1552,1557 FD Dummy 1432 R(4) 4 2 0 ARG,OUT 1572,1611,1616,1824,1852,1865,1874 FDI Dummy 1432 R(4) 4 2 0 ARG,IN 1611,1616,1815 FDL Local 1534 R(4) 4 scalar 1806,1815,1823,1824,1843,1852,1865 ,1874 FLAGLL Local 1508 L(4) 4 scalar 1508,1585,1606,1643,1654,1684,1695 ,1845 FLAGUP Local 1537 L(4) 4 scalar 1837,1877,1882 GRIDS Local 1508 RECORD 4376 1 1 ALC,TGT 1508,1521,1548,1549,1553,1554,1560 ,1561,1562,1563,1564,1565,1566,156 7,1568,1833 GTYPE Local 1509 I(4) 4 scalar PTR 1509 GTYPE Local 1548 I(4) 4 scalar 1548,1549,1553,1554 ICLOSE Local 1541 I(4) 4 scalar PTR 1568,1654,1696,1833,1847 ICLOSE Local 1568 I(4) 4 scalar TGT 1568,1833 ICLOSE_NONE Param 1510 I(4) 4 scalar 1510,1654,1696,1847 ICLOSE_SMPL Param 1510 I(4) 4 scalar 1510 ICLOSE_TRPL Param 1510 I(4) 4 scalar 1510 IMOD Dummy 1432 I(4) 4 scalar ARG,IN 1548,1553,1566,1833 IMPROC Local 1511 I(4) 4 scalar 1511 INT Func 1633 scalar 1633,1650,1731,1743 IX Local 1527 I(4) 4 scalar 1607,1609,1611,1614,1615,1616,1642 ,1645,1647,1659,1660,1661,1664,166 5,1666,1668,1669,1671,1672,1680,16 82,1683,1686,1690,1710,1711,1712,1 715,1716,1718,1719,1801,1802,1805, 1808,1809,1813,1820,1822,1824,1840 ,1842,1846,1860,1874,1875,1876 Page 47 Source Listing WMUPDS 2014-09-16 16:49 Symbol Table wmupdtmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References IXC Local 1529 I(4) 4 scalar 1685,1687,1688,1690,1691,1692,1698 ,1699,1700,1701 IXF0 Local 1527 I(4) 4 scalar 1586,1591,1594,1607,1614 IXFN Local 1527 I(4) 4 scalar 1587,1592,1594,1607,1614 IXO Local 1527 I(4) 4 scalar 1583,1591,1592,1593,1615 IXS Local 1528 I(4) 4 scalar 1608,1610,1611,1615,1616 IXS0 Local 1528 I(4) 4 scalar 1588,1593,1594,1687,1691,1694 IXSN Local 1528 I(4) 4 scalar 1589,1594,1688,1692,1694 IY Local 1527 I(4) 4 scalar 1740,1741,1748,1749,1750,1753,1754 ,1755,1757,1758,1760,1761,1769,177 0,1771,1772,1780,1781,1782,1785,17 86,1788,1789,1803,1804,1805,1810,1 811,1813,1820,1822,1824,1841,1842, 1849,1862,1874,1875,1876 IYC Local 1529 I(4) 4 scalar 1772,1773,1774 IYF0 Local 1527 I(4) 4 scalar 1599,1602,1611,1616 IYFN Local 1528 I(4) 4 scalar 1600,1602,1611,1616 IYO Local 1527 I(4) 4 scalar 1597,1599,1600,1601 IYS0 Local 1528 I(4) 4 scalar 1601,1602,1611,1616,1773,1775 IYSN Local 1528 I(4) 4 scalar 1602,1611,1616,1774,1775 J Local 1529 I(4) 4 scalar 1694,1696,1704,1775,1776,1777,1781 J1 Local 1529 I(4) 4 scalar 1650,1651,1652,1655,1658,1660,1743 ,1744,1745,1747,1749,1808,1809,181 3,1844,1853,1866,1873,1874 J2 Local 1529 I(4) 4 scalar 1651,1656,1663,1665,1744,1752,1754 ,1810,1811,1813,1846,1847,1848 JJ Local 1529 I(4) 4 scalar 1696,1697,1698,1704,1706,1707,1711 ,1832,1836,1839 JMOD Dummy 1432 I(4) 4 scalar ARG,IN 1521,1549,1554,1560,1561,1562,1563 ,1564,1565,1567,1568 JX Local 1530 I(4) 4 scalar 1809,1812,1815,1848,1851,1852,1860 ,1861,1864,1865 JY Local 1530 I(4) 4 scalar 1811,1812,1815,1849,1850,1851,1852 ,1862,1863,1864,1865 MAP Local 1539 I(4) 4 2 1 PTR 1566,1805 MAP1 Local 1536 L(4) 4 2 0 1798,1820,1842,1875 MAP2 Local 1536 L(4) 4 2 0 1799,1822,1851,1864,1883 MAP3 Local 1537 L(4) 4 2 0 1838,1876,1883 MAPI Local 1539 I(4) 4 2 1 PTR 1567,1812 MAPSTA Local 1566 I(4) 4 2 1 PTR 1566,1567 MAX Func 1591 scalar 1591,1593,1599,1601,1652,1691,1706 ,1708,1745,1773,1776,1778 MDSE Local 1511 I(4) 4 scalar 1511,1550,1555 MDSO Local 1511 I(4) 4 scalar 1511 MDSS Local 1512 I(4) 4 scalar 1512 MDST Local 1511 I(4) 4 scalar 1511 MIN Func 1592 scalar 1592,1600,1692,1707,1774,1777 MOD Func 1578 scalar 1578,1579,1608,1644,1655,1656,1685 ,1696,1848 MXA Local 1529 I(4) 4 scalar 1631,1633,1636,1640,1687,1688,1691 ,1692 MYA Local 1529 I(4) 4 scalar 1729,1731,1734,1738,1773,1774 NINT Func 1583 scalar 1583,1597,1608,1685,1690,1698,1772 NMPERR Local 1511 I(4) 4 scalar 1511 NMPSCR Local 1511 I(4) 4 scalar 1511 Page 48 Source Listing WMUPDS 2014-09-16 16:49 Symbol Table wmupdtmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References NX Local 1508 I(4) 4 scalar PTR 1508,1520,1536,1537,1587,1592,1636 ,1642,1680,1801,1840,1847,1848,186 1 NX Local 1521 I(4) 4 scalar TGT 1521,1560 NXA Local 1531 I(4) 4 2 1 ALC 1636,1637,1659,1660,1661,1664,1665 ,1666,1668,1671,1710,1711,1712,171 5,1718,1802,1808,1809,1891 NXI Local 1539 I(4) 4 scalar PTR 1560,1592,1610,1655,1656,1658,1663 ,1692,1696,1697 NY Local 1508 I(4) 4 scalar PTR 1508,1520,1536,1537,1600,1734,1740 ,1769,1803,1841,1850,1863 NY Local 1521 I(4) 4 scalar TGT 1521,1561 NYA Local 1531 I(4) 4 2 1 ALC 1734,1735,1748,1749,1750,1753,1754 ,1755,1757,1760,1780,1781,1782,178 5,1788,1804,1810,1811,1891 NYI Local 1539 I(4) 4 scalar PTR 1561,1600,1747,1752,1774 R1 Local 1532 R(4) 4 scalar 1653,1658,1661,1708,1709,1712,1746 ,1747,1750,1778,1779,1782 R2 Local 1532 R(4) 4 scalar 1652,1653,1663,1666,1745,1746,1752 ,1755 REAL Func 1609 scalar 1609,1645,1647,1652,1682,1683,1686 ,1690,1698,1700,1701,1706,1707,174 1,1745,1770,1771,1772,1776,1777,18 74 RLGTYPE Param 1509 I(4) 4 scalar 1509 RT Local 1532 R(4) 4 scalar 1669,1670,1716,1717,1758,1759,1786 ,1787 RXA Local 1535 R(4) 4 2 1 ALC 1636,1638,1661,1666,1669,1672,1712 ,1716,1719,1813,1891 RYA Local 1535 R(4) 4 2 1 ALC 1734,1736,1750,1755,1758,1761,1782 ,1786,1789,1813,1891 SUM Func 1669 scalar 1669,1716,1758,1786 SX Local 1508 R(4) 4 scalar PTR 1508,1576,1578,1583,1609,1630,1633 ,1645,1647,1682,1683,1686,1690,170 8 SX Local 1564 R(4) 4 scalar TGT 1564 SXI Local 1540 R(4) 4 scalar PTR 1564,1576,1630,1633,1645,1647,1686 ,1690,1698,1706,1707 SY Local 1508 R(4) 4 scalar PTR 1508,1577,1579,1597,1728,1731,1741 ,1770,1771,1772,1778 SY Local 1565 R(4) 4 scalar TGT 1565 SYI Local 1540 R(4) 4 scalar PTR 1565,1577,1728,1731,1741,1772,1776 ,1777 UNDEF Dummy 1432 R(4) 4 scalar ARG,IN 1572 UNGTYPE Param 1509 I(4) 4 scalar 1509,1553,1554 W3GDATMD Module 1508 1508 W3SERVMD Module 1506 1506 WL Local 1534 R(4) 4 scalar 1813,1814,1815 WMMDATMD Module 1511 1511 WMUPDS Subr 1432 785,791,797,803,809,815,821,827,83 3,849,856,858,903 WTOT Local 1534 R(4) 4 scalar 1807,1814,1819,1823 X0 Local 1508 R(4) 4 scalar PTR 1508,1578,1583,1609,1645,1647,1682 ,1683,1686,1690 X0 Local 1562 R(4) 4 scalar TGT 1562 Page 49 Source Listing WMUPDS 2014-09-16 16:49 Symbol Table wmupdtmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References X0I Local 1540 R(4) 4 scalar PTR 1562,1578,1583,1609,1645,1647,1686 ,1690,1698,1706,1707 XFL Local 1532 R(4) 4 scalar 1682,1698,1700,1706 XFR Local 1532 R(4) 4 scalar 1683,1698,1701,1707 XR Local 1532 R(4) 4 scalar 1644,1647,1649,1650,1652 XSL Local 1532 R(4) 4 scalar 1706,1708 XSR Local 1533 R(4) 4 scalar 1707,1708 Y0 Local 1508 R(4) 4 scalar PTR 1508,1579,1597,1741,1770,1771,1772 Y0 Local 1563 R(4) 4 scalar TGT 1563 Y0I Local 1540 R(4) 4 scalar PTR 1563,1579,1597,1741,1772,1776,1777 YFL Local 1533 R(4) 4 scalar 1770,1776 YFR Local 1533 R(4) 4 scalar 1771,1777 YR Local 1532 R(4) 4 scalar 1741,1742,1743,1745 YSL Local 1533 R(4) 4 scalar 1776,1778 YSR Local 1533 R(4) 4 scalar 1777,1778 Page 50 Source Listing WMUPDS 2014-09-16 16:49 wmupdtmd.f90 1901 !/ 1902 !/ End of module WMUPDTMD -------------------------------------------- / 1903 !/ 1904 END MODULE WMUPDTMD SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References WMUPDTMD Module 2 Page 51 Source Listing WMUPDS 2014-09-16 16:49 Subprograms/Common Blocks wmupdtmd.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References WMUPD1 Subr 369 248,282 WMUPD2 Subr 653 294 WMUPDS Subr 1432 785,791,797,803,809,815,821,827,83 3,849,856,858,903 WMUPDT Subr 74 WMUPDTMD Module 2 WMUPDV Subr 930 839,846,889,900 COMPILER OPTIONS BEING USED -align nocommons -align nodcommons -align noqcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume byterecl -assume cc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_unit_star -assume old_ldout_format -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume nostd_mod_proc_name -assume norealloc_lhs -assume underscore -assume no2underscores -auto no -auto_scalar no -bintext -ccdefault default -check noargs -check noarg_temp_created -check nobounds -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check power -check noshape -check nounderflow -check nouninitialized -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D _MT -D __INTEL_COMPILER_BUILD_DATE=20120612 -D _OPENMP=201107 -D __pentium4 -D __pentium4__ -D __tune_pentium4__ -D __SSE2__ -D __SSE3__ -D __SSSE3__ -D __SSE4_1__ -D __SSE4_2__ -D __SSE__ -D __MMX__ -D __AVX__ -double_size 64 no -d_lines Page 52 Source Listing WMUPDS 2014-09-16 16:49 wmupdtmd.f90 no -Qdyncom -error_limit 30 no -f66 no -f77rtl no -fast -fpscomp nofilesfromcmd -fpscomp nogeneral -fpscomp noioformat -fpscomp noldio_spacing -fpscomp nologicals no -fpconstant -fpe3 -fprm nearest no -ftz -fp_model noprecise -fp_model fast -fp_model nostrict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -heap_arrays 0 no -threadprivate_compat -free -g0 -iface nomixed_str_len_arg -iface nono_mixed_str_len_arg no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase no -noinclude -openmp -O2 no -pad_source -real_size 32 no -recursive -reentrancy threaded no -sharable_localsaves -vec=simd -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w noargument_checking -w nodeclarations -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage -includepath : /usrx/local/intel/composerxe/tbb/include/,/usr/include/,./,/usrx/local/intel/impi/4.0.3.008/intel64/include/, /usrx/local/intel/impi/4.0.3.008/intel64/include/,/usrx/local/intel/composerxe/mkl/include/,/usrx/local/intel/composerxe/tbb/include/, /gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/,/gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/, /usr/local/include/,/usr/lib/gcc/x86_64-redhat-linux/4.4.7/include/,/usr/include/,/usr/include/ -list filename : wmupdtmd.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100