Page 1 Source Listing WAVNU1 2014-09-16 16:50 w3dispmd.f90 1 !/ ------------------------------------------------------------------- / 2 MODULE W3DISPMD 3 !/ 4 !/ +-----------------------------------+ 5 !/ | WAVEWATCH III NOAA/NCEP | 6 !/ | H. L. Tolman | 7 !/ | FORTRAN 90 | 8 !/ | Last update : 29-May-2009 | 9 !/ +-----------------------------------+ 10 !/ 11 !/ 30-Nov-1999 : Fortran 90 version. ( version 2.00 ) 12 !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) 13 !/ 14 !/ Copyright 2009 National Weather Service (NWS), 15 !/ National Oceanic and Atmospheric Administration. All rights 16 !/ reserved. WAVEWATCH III is a trademark of the NWS. 17 !/ No unauthorized use without permission. 18 !/ 19 ! 1. Purpose : 20 ! 21 ! A set of routines for solving the dispersion relation. 22 ! 23 ! 2. Variables and types : 24 ! 25 ! All variables are retated to the interpolation tables. See 26 ! DISTAB for a more comprehensive description. 27 ! 28 ! Name Type Scope Description 29 ! ---------------------------------------------------------------- 30 ! NAR1D I.P. Public Nmmer of elements in interpolation 31 ! array. 32 ! DFAC R.P. Public Value of KH at deep boundary. 33 ! EWN1 R.A. Public Wavenumber array. 34 ! ECG1 R.A. Public Group velocity array. 35 ! N1MAX Int. Public Actual maximum position in array. 36 ! DSIE Real Public SI step. 37 ! ---------------------------------------------------------------- 38 ! 39 ! 3. Subroutines and functions : 40 ! 41 ! Name Type Scope Description 42 ! ---------------------------------------------------------------- 43 ! WAVNU1 Subr. Public Solve dispersion using lookup table. 44 ! WAVNU2 Subr. Public Solve dispersion relation itteratively. 45 ! DISTAB Subr. Public Fill interpolation tables. 46 ! ---------------------------------------------------------------- 47 ! 48 ! 4. Subroutines and functions used : 49 ! 50 ! Name Type Module Description 51 ! ---------------------------------------------------------------- 52 ! STRACE Subr. W3SERVMD Subroutine tracing ( !/S ) 53 ! ---------------------------------------------------------------- 54 ! 55 ! 5. Remarks : 56 ! 57 ! 6. Switches : Page 2 Source Listing WAVNU1 2014-09-16 16:50 w3dispmd.f90 58 ! 59 ! !/S Enable subroutine tracing. 60 ! 61 ! 7. Source code : 62 ! 63 !/ ------------------------------------------------------------------- / 64 !/ 65 PUBLIC 66 !/ 67 !/ Set up of public interpolation table ------------------------------ / 68 !/ 69 INTEGER, PARAMETER :: NAR1D = 121 70 REAL, PARAMETER :: DFAC = 6. 71 !/ 72 INTEGER :: N1MAX 73 REAL :: ECG1(0:NAR1D), EWN1(0:NAR1D), DSIE 74 !/ 75 !/ Set up of public subroutines -------------------------------------- / 76 !/ 77 CONTAINS 78 !/ ------------------------------------------------------------------- / 79 SUBROUTINE WAVNU1 (SI,H,K,CG) 80 !/ 81 !/ +-----------------------------------+ 82 !/ | WAVEWATCH III NOAA/NCEP | 83 !/ | H. L. Tolman | 84 !/ | FORTRAN 90 | 85 !/ | Last update : 30-Nov-1999 | 86 !/ +-----------------------------------+ 87 !/ 88 !/ 04-Nov-1990 : Final FORTRAN 77 ( version 1.18 ) 89 !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 90 !/ 91 ! 1. Purpose : 92 ! 93 ! Calculate wavenumber and group velocity from the interpolation 94 ! array filled by DISTAB from a given intrinsic frequency and the 95 ! waterdepth. 96 ! 97 ! 2. Method : 98 ! 99 ! Linear interpolation from one-dimensional array. 100 ! 101 ! 3. Parameters used : 102 ! 103 ! Parameter list 104 ! ---------------------------------------------------------------- 105 ! SI Real I Intrinsic frequency (moving frame) (rad/s) 106 ! H Real I Waterdepth (m) 107 ! K Real O Wavenumber (rad/m) 108 ! CG Real O Group velocity (m/s) 109 ! ---------------------------------------------------------------- 110 ! 111 ! 4. Error messages : 112 ! 113 ! - None. 114 ! Page 3 Source Listing WAVNU1 2014-09-16 16:50 w3dispmd.f90 115 ! 5. Called by : 116 ! 117 ! - Any main program 118 ! 119 ! 6. Subroutines used : 120 ! 121 ! - None 122 ! 123 ! 7. Remarks : 124 ! 125 ! - Calculated si* is always made positive without checks : check in 126 ! main program assumed ! 127 ! - Depth is unlimited. 128 ! 129 ! 8. Structure : 130 ! 131 ! +---------------------------------------------+ 132 ! | calculate non-dimensional frequency | 133 ! |---------------------------------------------| 134 ! | T si* in range ? F | 135 ! |----------------------|----------------------| 136 ! | calculate k* and cg* | deep water approx. | 137 ! | calculate output | | 138 ! | parameters | | 139 ! +---------------------------------------------+ 140 ! 141 ! 9. Switches : 142 ! 143 ! !/S Enable subroutine tracing. 144 ! 145 ! 10. Source code : 146 ! 147 !/ ------------------------------------------------------------------- / 148 !/ 149 USE CONSTANTS, ONLY : GRAV 150 ! 151 IMPLICIT NONE 152 !/ 153 !/ ------------------------------------------------------------------- / 154 !/ Parameter list 155 !/ 156 REAL, INTENT(IN) :: SI, H 157 REAL, INTENT(OUT) :: K, CG 158 !/ 159 !/ ------------------------------------------------------------------- / 160 !/ Local parameters 161 !/ 162 INTEGER :: I1, I2 163 REAL :: SQRTH, SIX, R1, R2 164 !/ 165 !/ ------------------------------------------------------------------- / 166 !/ 167 ! 168 SQRTH = SQRT(H) 169 SIX = SI * SQRTH 170 I1 = INT(SIX/DSIE) 171 ! Page 4 Source Listing WAVNU1 2014-09-16 16:50 w3dispmd.f90 172 IF (I1.LE.N1MAX.AND.I1.GE.1) THEN 173 I2 = I1 + 1 174 R1 = SIX/DSIE - REAL(I1) 175 R2 = 1. - R1 176 K = ( R2*EWN1(I1) + R1*EWN1(I2) ) / H 177 CG = ( R2*ECG1(I1) + R1*ECG1(I2) ) * SQRTH 178 ELSE 179 K = SI*SI/GRAV 180 CG = 0.5 * GRAV / SI 181 END IF 182 ! 183 RETURN 184 !/ 185 !/ End of WAVNU1 ----------------------------------------------------- / 186 !/ 187 END SUBROUTINE WAVNU1 ENTRY POINTS Name w3dispmd_mp_wavnu1_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References CG Dummy 79 R(4) 4 scalar ARG,OUT 177,180 CONSTANTS Module 149 149 DSIE Local 170 R(4) 4 scalar 170,174,410,420,429 ECG1 Local 177 R(4) 4 1 122 177,415,423,432 EWN1 Local 176 R(4) 4 1 122 176,414,422,431 GRAV Param 149 R(4) 4 scalar 149,179,180 H Dummy 79 R(4) 4 scalar ARG,IN 168,176 I1 Local 162 I(4) 4 scalar 170,172,173,174,176,177 I2 Local 162 I(4) 4 scalar 173,176,177 INT Func 170 scalar 170 K Dummy 79 R(4) 4 scalar ARG,OUT 176,179 N1MAX Local 172 I(4) 4 scalar 172,407,410,419,428 R1 Local 163 R(4) 4 scalar 174,175,176,177 R2 Local 163 R(4) 4 scalar 175,176,177 REAL Func 174 scalar 174 SI Dummy 79 R(4) 4 scalar ARG,IN 169,179,180 SIX Local 163 R(4) 4 scalar 169,170,174 SQRT Func 168 scalar 168 SQRTH Local 163 R(4) 4 scalar 168,169,177 WAVNU1 Subr 79 Page 5 Source Listing WAVNU1 2014-09-16 16:50 w3dispmd.f90 188 !/ ------------------------------------------------------------------- / 189 SUBROUTINE WAVNU2 (W,H,K,CG,EPS,NMAX,ICON) 190 !/ 191 !/ +-----------------------------------+ 192 !/ | WAVEWATCH III NOAA/NCEP | 193 !/ | H. L. Tolman | 194 !/ | FORTRAN 90 | 195 !/ | Last update : 30-Nov-1999 | 196 !/ +-----------------------------------+ 197 !/ 198 !/ 17-Jul-1990 : Final FORTRAN 77 ( version 1.18 ) 199 !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 200 !/ 201 ! 1. Purpose : 202 ! 203 ! Calculation of wavenumber K from a given angular 204 ! frequency W and waterdepth H. 205 ! 206 ! 2. Method : 207 ! 208 ! Used equation : 209 ! 2 210 ! W = G*K*TANH(K*H) 211 ! 212 ! Because of the nature of the equation, K is calculated 213 ! with an itterative procedure. 214 ! 215 ! 3. Parameters : 216 ! 217 ! Parameter list 218 ! ---------------------------------------------------------------- 219 ! W Real I Angular frequency 220 ! H Real I Waterdepth 221 ! K Real O Wavenumber ( same sign as W ) 222 ! CG Real O Group velocity (same sign as W) 223 ! EPS Real I Wanted max. difference between K and Kold 224 ! NMAX Int. I Max number of repetitions in calculation 225 ! ICON Int. O Contol counter ( See error messages ) 226 ! ---------------------------------------------------------------- 227 ! 228 ! 9. Switches : 229 ! 230 ! !/S Enable subroutine tracing. 231 ! 232 ! 10. Source code : 233 ! 234 !/ ------------------------------------------------------------------- / 235 !/ 236 USE CONSTANTS, ONLY : GRAV 237 ! 238 IMPLICIT NONE 239 !/ 240 !/ ------------------------------------------------------------------- / 241 !/ Parameter list 242 !/ 243 INTEGER, INTENT(IN) :: NMAX 244 INTEGER, INTENT(OUT) :: ICON Page 6 Source Listing WAVNU2 2014-09-16 16:50 w3dispmd.f90 245 REAL, INTENT(IN) :: W, H, EPS 246 REAL, INTENT(OUT) :: CG, K 247 !/ 248 !/ ------------------------------------------------------------------- / 249 !/ Local parameters 250 !/ 251 INTEGER :: I 252 REAL :: F, W0, FD, DIF, RDIF, KOLD 253 !/ 254 !/ ------------------------------------------------------------------- / 255 !/ 256 ! 257 ! Initialisations : 258 ! 259 CG = 0 260 KOLD = 0 261 ICON = 0 262 W0 = ABS(W) 263 ! 264 ! 1st approach : 265 ! 266 IF (W0.LT.SQRT(GRAV/H)) THEN 267 K = W0/SQRT(GRAV*H) 268 ELSE 269 K = W0*W0/GRAV 270 END IF 271 ! 272 ! Refinement : 273 ! 274 DO I=1, NMAX 275 DIF = ABS(K-KOLD) 276 IF (K.NE.0) THEN 277 RDIF = DIF/K 278 ELSE 279 RDIF = 0 280 END IF 281 IF (DIF .LT. EPS .AND. RDIF .LT. EPS) THEN 282 ICON = 1 283 GOTO 100 284 ELSE 285 KOLD = K 286 F = GRAV*KOLD*TANH(KOLD*H)-W0**2 287 IF (KOLD*H.GT.25) THEN 288 FD = GRAV*TANH(KOLD*H) 289 ELSE 290 FD = GRAV*TANH(KOLD*H) + GRAV*KOLD*H/((COSH(KOLD*H))**2) 291 END IF 292 K = KOLD - F/FD 293 END IF 294 END DO 295 ! 296 DIF = ABS(K-KOLD) 297 RDIF = DIF/K 298 IF (DIF .LT. EPS .AND. RDIF .LT. EPS) ICON = 1 299 100 CONTINUE 300 IF (2*K*H.GT.25) THEN 301 CG = W0/K * 0.5 Page 7 Source Listing WAVNU2 2014-09-16 16:50 w3dispmd.f90 302 ELSE 303 CG = W0/K * 0.5*(1+(2*K*H/SINH(2*K*H))) 304 END IF 305 IF (W.LT.0.0) THEN 306 K = (-1)*K 307 CG = CG*(-1) 308 END IF 309 ! 310 RETURN 311 !/ 312 !/ End of WAVNU2 ----------------------------------------------------- / 313 !/ 314 END SUBROUTINE WAVNU2 ENTRY POINTS Name w3dispmd_mp_wavnu2_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 100 Label 299 283 ABS Func 262 scalar 262,275,296 CG Dummy 189 R(4) 4 scalar ARG,OUT 259,301,303,307 CONSTANTS Module 236 236 COSH Func 290 scalar 290 DIF Local 252 R(4) 4 scalar 275,277,281,296,297,298 EPS Dummy 189 R(4) 4 scalar ARG,IN 281,298 F Local 252 R(4) 4 scalar 286,292 FD Local 252 R(4) 4 scalar 288,290,292 GRAV Param 236 R(4) 4 scalar 236,266,267,269,286,288,290 H Dummy 189 R(4) 4 scalar ARG,IN 266,267,286,287,288,290,300,303 I Local 251 I(4) 4 scalar 274 ICON Dummy 189 I(4) 4 scalar ARG,OUT 261,282,298 K Dummy 189 R(4) 4 scalar ARG,OUT 267,269,275,276,277,285,292,296,29 7,300,301,303,306 KOLD Local 252 R(4) 4 scalar 260,275,285,286,287,288,290,292,29 6 NMAX Dummy 189 I(4) 4 scalar ARG,IN 274 RDIF Local 252 R(4) 4 scalar 277,279,281,297,298 SINH Func 303 scalar 303 SQRT Func 266 scalar 266,267 TANH Func 286 scalar 286,288,290 W Dummy 189 R(4) 4 scalar ARG,IN 262,305 W0 Local 252 R(4) 4 scalar 262,266,267,269,286,301,303 WAVNU2 Subr 189 421,430 Page 8 Source Listing WAVNU2 2014-09-16 16:50 w3dispmd.f90 315 !/ ------------------------------------------------------------------- / 316 SUBROUTINE DISTAB 317 !/ 318 !/ +-----------------------------------+ 319 !/ | WAVEWATCH III NOAA/NCEP | 320 !/ | H. L. Tolman | 321 !/ | FORTRAN 90 | 322 !/ | Last update : 30-Nov-1990 | 323 !/ +-----------------------------------+ 324 !/ 325 !/ 04-Nov-1990 : Final FORTRAN 77 ( version 1.18 ) 326 !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) 327 !/ 328 ! 1. Purpose : 329 ! 330 ! Fill interpolation arrays for the calculation of wave parameters 331 ! according to the linear (Airy) wave theory given the intrinsic 332 ! frequency. 333 ! 334 ! 2. Method : 335 ! 336 ! For a given set of non-dimensional frequencies the interpolation 337 ! arrays with non-dimensional depths and group velocity are filled. 338 ! The following non-dimensional parameters are used : 339 ! 340 ! frequency f*SQRT(h/g) = f* 341 ! depth kh = k* 342 ! group vel. c/SQRT(gh) = c* 343 ! 344 ! Where k is the wavenumber, h the depth f the intrinsic frequency, 345 ! g the acceleration of gravity and c the group velocity. 346 ! 347 ! 3. Parameters : 348 ! 349 ! See module documentation. 350 ! 351 ! 4. Error messages : 352 ! 353 ! - None. 354 ! 355 ! 5. Called by : 356 ! 357 ! - W3GRID 358 ! - Any main program. 359 ! 360 ! 6. Subroutines used : 361 ! 362 ! - WAVNU2 (solve dispersion relation) 363 ! 364 ! 7. Remarks : 365 ! 366 ! - In the filling of the arrays H = 1. is assumed and the factor 367 ! SQRT (g) is moved from the interpolation to the filling 368 ! procedure thus : 369 ! 370 ! k* = k 371 ! Page 9 Source Listing DISTAB 2014-09-16 16:50 w3dispmd.f90 372 ! c* = cg/SQRT(g) 373 ! 374 ! 8. Structure 375 ! 376 ! ----------------------------------- 377 ! include common block 378 ! calculate parameters 379 ! fill zero-th position of arrays 380 ! fill middle positions of arrays 381 ! fill last positions of arrays 382 ! ----------------------------------- 383 ! 384 ! 9. Switches : 385 ! 386 ! !/S Enable subroutine tracing. 387 ! 388 ! 10. Source code : 389 ! 390 !/ ------------------------------------------------------------------- / 391 !/ 392 USE CONSTANTS, ONLY : GRAV 393 ! 394 IMPLICIT NONE 395 !/ 396 !/ ------------------------------------------------------------------- / 397 !/ Local parameters 398 !/ 399 INTEGER :: I, ICON 400 REAL :: DEPTH, CG, SIMAX, SI, K 401 !/ 402 !/ ------------------------------------------------------------------- / 403 !/ 404 ! 405 ! Calculate parameters ----------------------------------------------- * 406 ! 407 N1MAX = NAR1D - 1 408 DEPTH = 1. 409 SIMAX = SQRT (GRAV * DFAC) 410 DSIE = SIMAX / REAL(N1MAX) 411 ! 412 ! Fill zero-th position of arrays ------------------------------------ * 413 ! 414 EWN1(0) = 0. 415 ECG1(0) = SQRT(GRAV) 416 ! 417 ! Fill middle positions of arrays ------------------------------------ * 418 ! 419 DO I=1, N1MAX 420 SI = REAL(I)*DSIE 421 CALL WAVNU2 (SI,DEPTH,K,CG,1E-7,15,ICON) 422 EWN1(I) = K 423 ECG1(I) = CG 424 END DO 425 ! 426 ! Fill last positions of arrays -------------------------------------- * 427 ! 428 I = N1MAX+1 Page 10 Source Listing DISTAB 2014-09-16 16:50 w3dispmd.f90 429 SI = REAL(I)*DSIE 430 CALL WAVNU2 (SI,DEPTH,K,CG,1E-7,15,ICON) 431 EWN1(I) = K 432 ECG1(I) = CG 433 ! 434 RETURN 435 !/ 436 !/ End of DISTAB ----------------------------------------------------- / 437 !/ 438 END SUBROUTINE DISTAB ENTRY POINTS Name w3dispmd_mp_distab_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References CG Local 400 R(4) 4 scalar 421,423,430,432 CONSTANTS Module 392 392 DEPTH Local 400 R(4) 4 scalar 408,421,430 DFAC Param 409 R(4) 4 scalar 409 DISTAB Subr 316 GRAV Param 392 R(4) 4 scalar 392,409,415 I Local 399 I(4) 4 scalar 419,420,422,423,428,429,431,432 ICON Local 399 I(4) 4 scalar 421,430 K Local 400 R(4) 4 scalar 421,422,430,431 NAR1D Param 407 I(4) 4 scalar 73,407 REAL Func 410 scalar 410,420,429 SI Local 400 R(4) 4 scalar 420,421,429,430 SIMAX Local 400 R(4) 4 scalar 409,410 SQRT Func 409 scalar 409,415 Page 11 Source Listing DISTAB 2014-09-16 16:50 w3dispmd.f90 439 !/ 440 !/ End of module W3DISPMD -------------------------------------------- / 441 !/ 442 END MODULE W3DISPMD SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References W3DISPMD Module 2 Page 12 Source Listing DISTAB 2014-09-16 16:50 Subprograms/Common Blocks w3dispmd.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References DISTAB Subr 316 W3DISPMD Module 2 WAVNU1 Subr 79 WAVNU2 Subr 189 421,430 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__ -D __AVX__ -double_size 64 no -d_lines no -Qdyncom -error_limit 30 no -f66 no -f77rtl no -fast -fpscomp nofilesfromcmd -fpscomp nogeneral Page 13 Source Listing DISTAB 2014-09-16 16:50 w3dispmd.f90 -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 : w3dispmd.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100