- Timestamp:
- 2011-12-11T16:00:26+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r2715 r3211 35 35 REAL(wp) :: r1_6 = 1./ 6. ! 1/6 ratio 36 36 37 !! * Control permutation of array indices 38 # include "oce_ftrans.h90" 39 # include "dom_oce_ftrans.h90" 40 # include "trc_oce_ftrans.h90" 41 37 42 !! * Substitutions 38 43 # include "domzgr_substitute.h90" … … 85 90 INTEGER , INTENT(in ) :: kjpt ! number of tracers 86 91 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 87 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 88 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 89 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 92 93 !! DCSE_NEMO: This style defeats ftrans 94 ! REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 95 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 96 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 97 98 !FTRANS pun pvn pwn :I :I :z 99 !FTRANS ptb ptn :I :I :z : 100 !FTRANS pta :I :I :z : 101 REAL(wp), INTENT(in ) :: pun(jpi,jpj,jpk) ! ocean velocity component (u) 102 REAL(wp), INTENT(in ) :: pvn(jpi,jpj,jpk) ! ocean velocity component (v) 103 REAL(wp), INTENT(in ) :: pwn(jpi,jpj,jpk) ! ocean velocity component (w) 104 REAL(wp), INTENT(in ) :: ptb(jpi,jpj,jpk,kjpt) ! tracer fields (before) 105 REAL(wp), INTENT(in ) :: ptn(jpi,jpj,jpk,kjpt) ! tracer fields (now) 106 REAL(wp), INTENT(inout) :: pta(jpi,jpj,jpk,kjpt) ! tracer trend 107 90 108 !!---------------------------------------------------------------------- 91 109 … … 107 125 CALL tra_adv_cen2_k( kt, cdtype, pwn, ptn, pta, kjpt ) 108 126 ! 127 128 !! * Reset control of array index permutation 129 !FTRANS CLEAR 130 # include "oce_ftrans.h90" 131 # include "dom_oce_ftrans.h90" 132 # include "trc_oce_ftrans.h90" 133 109 134 END SUBROUTINE tra_adv_qck 110 135 … … 118 143 USE oce , ONLY: zwx => ua ! ua used as workspace 119 144 USE wrk_nemo, ONLY: zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3 ! 3D workspace 145 146 !! DCSE_NEMO: need additional directives for renamed module variables 147 !FTRANS zwx zfu zfc zfd :I :I :z 148 120 149 ! 121 150 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 123 152 INTEGER , INTENT(in ) :: kjpt ! number of tracers 124 153 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 125 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun ! i-velocity components 126 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 127 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 154 155 !! DCSE_NEMO: This style defeats ftrans 156 ! REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun ! i-velocity components 157 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 158 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 159 160 !FTRANS pun :I :I :z 161 !FTRANS ptb ptn pta :I :I :z : 162 REAL(wp), INTENT(in ) :: pun(jpi,jpj,jpk) ! i-velocity component 163 REAL(wp), INTENT(in ) :: ptb(jpi,jpj,jpk,kjpt) ! tracer field (before) 164 REAL(wp), INTENT(in ) :: ptn(jpi,jpj,jpk,kjpt) ! tracer field (now) 165 REAL(wp), INTENT(inout) :: pta(jpi,jpj,jpk,kjpt) ! tracer trend 166 128 167 !! 129 168 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 140 179 zfd(:,:,:) = 0.0 ; zwx(:,:,:) = 0.0 141 180 ! 181 #if defined key_z_first 182 !--- Computation of the upstream and downstream value of the tracer and the mask 183 DO jj = 2, jpjm1 184 DO ji = 2, jpim1 185 DO jk = 1, jpkm1 186 #else 142 187 DO jk = 1, jpkm1 143 188 ! 144 !--- Computation of the u stream and downstream value of the tracer and the mask189 !--- Computation of the upstream and downstream value of the tracer and the mask 145 190 DO jj = 2, jpjm1 146 191 DO ji = fs_2, fs_jpim1 ! vector opt. 192 #endif 147 193 ! Upstream in the x-direction for the tracer 148 194 zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn) … … 158 204 ! --------------------------- 159 205 ! 206 #if defined key_z_first 207 DO jj = 2, jpjm1 208 DO ji = 2, jpim1 209 DO jk = 1, jpkm1 210 #else 160 211 DO jk = 1, jpkm1 161 212 DO jj = 2, jpjm1 162 213 DO ji = fs_2, fs_jpim1 ! vector opt. 214 #endif 163 215 zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) ) ! if pun > 0 : zdir = 1 otherwise zdir = 0 164 216 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk) ! FU in the x-direction for T … … 167 219 END DO 168 220 ! 221 #if defined key_z_first 222 DO jj = 2, jpjm1 223 DO ji = 2, jpim1 224 DO jk = 1, jpkm1 225 zdt = p2dt(jk) 226 #else 169 227 DO jk = 1, jpkm1 170 228 zdt = p2dt(jk) 171 229 DO jj = 2, jpjm1 172 230 DO ji = fs_2, fs_jpim1 ! vector opt. 231 #endif 173 232 zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) ) ! if pun > 0 : zdir = 1 otherwise zdir = 0 174 233 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * fse3u(ji,jj,jk) … … 187 246 ! 188 247 ! Mask at the T-points in the x-direction (mask=0 or mask=1) 248 #if defined key_z_first 249 DO jj = 2, jpjm1 250 DO ji = 2, jpim1 251 DO jk = 1, jpkm1 252 #else 189 253 DO jk = 1, jpkm1 190 254 DO jj = 2, jpjm1 191 255 DO ji = fs_2, fs_jpim1 ! vector opt. 256 #endif 192 257 zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 193 258 END DO … … 198 263 ! 199 264 ! Tracer flux on the x-direction 265 #if defined key_z_first 266 DO jj = 2, jpjm1 267 DO ji = 2, jpim1 268 DO jk = 1, jpkm1 269 #else 200 270 DO jk = 1, jpkm1 201 !202 271 DO jj = 2, jpjm1 203 272 DO ji = fs_2, fs_jpim1 ! vector opt. 273 #endif 204 274 zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) ) ! if pun > 0 : zdir = 1 otherwise zdir = 0 205 275 !--- If the second ustream point is a land point … … 210 280 END DO 211 281 END DO 282 #if defined key_z_first 283 END DO 284 ! Computation of the trend 285 DO jj = 2, jpjm1 286 DO ji = 2, jpim1 287 DO jk = 1, jpkm1 288 #else 212 289 ! 213 290 ! Computation of the trend 214 291 DO jj = 2, jpjm1 215 292 DO ji = fs_2, fs_jpim1 ! vector opt. 293 #endif 216 294 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 217 295 ! horizontal advective trends … … 230 308 IF( wrk_not_released(3, 1,2,3) ) CALL ctl_stop('tra_adv_qck_i: failed to release workspace arrays') 231 309 ! 310 311 !! * Reset control of array index permutation 312 !FTRANS CLEAR 313 # include "oce_ftrans.h90" 314 # include "dom_oce_ftrans.h90" 315 # include "trc_oce_ftrans.h90" 316 232 317 END SUBROUTINE tra_adv_qck_i 233 318 … … 241 326 USE oce , ONLY: zwy => ua ! ua used as workspace 242 327 USE wrk_nemo, ONLY: zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3 ! 3D workspace 328 329 !! DCSE_NEMO: need additional directives for renamed module variables 330 !FTRANS zwy zfu zfc zfd :I :I :z 331 243 332 ! 244 333 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 246 335 INTEGER , INTENT(in ) :: kjpt ! number of tracers 247 336 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 248 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pvn ! j-velocity components 249 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 250 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 337 338 !! DCSE_NEMO: This style defeats ftrans 339 ! REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pvn ! j-velocity components 340 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 341 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 342 343 !FTRANS pvn :I :I :z 344 !FTRANS ptb ptn pta :I :I :z : 345 REAL(wp), INTENT(in ) :: pvn(jpi,jpj,jpk) ! j-velocity component 346 REAL(wp), INTENT(in ) :: ptb(jpi,jpj,jpk,kjpt) ! tracer field (before) 347 REAL(wp), INTENT(in ) :: ptn(jpi,jpj,jpk,kjpt) ! tracer field (now) 348 REAL(wp), INTENT(inout) :: pta(jpi,jpj,jpk,kjpt) ! tracer trend 349 251 350 !! 252 351 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 264 363 zfd(:,:,:) = 0.0 ; zwy(:,:,:) = 0.0 265 364 ! 365 #if defined key_z_first 366 !--- Computation of the ustream and downstream value of the tracer and the mask 367 DO jj = 2, jpjm1 368 DO ji = 2, jpim1 369 DO jk = 1, jpkm1 370 #else 266 371 DO jk = 1, jpkm1 267 372 ! … … 269 374 DO jj = 2, jpjm1 270 375 DO ji = fs_2, fs_jpim1 ! vector opt. 376 #endif 271 377 ! Upstream in the x-direction for the tracer 272 378 zfc(ji,jj,jk) = ptb(ji,jj-1,jk,jn) … … 283 389 ! --------------------------- 284 390 ! 391 #if defined key_z_first 392 DO jj = 2, jpjm1 393 DO ji = 2, jpim1 394 DO jk = 1, jpkm1 395 #else 285 396 DO jk = 1, jpkm1 286 397 DO jj = 2, jpjm1 287 398 DO ji = fs_2, fs_jpim1 ! vector opt. 399 #endif 288 400 zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) ) ! if pun > 0 : zdir = 1 otherwise zdir = 0 289 401 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk) ! FU in the x-direction for T … … 292 404 END DO 293 405 ! 406 #if defined key_z_first 407 DO jj = 2, jpjm1 408 DO ji = 2, jpim1 409 DO jk = 1, jpkm1 410 zdt = p2dt(jk) 411 #else 294 412 DO jk = 1, jpkm1 295 413 zdt = p2dt(jk) 296 414 DO jj = 2, jpjm1 297 415 DO ji = fs_2, fs_jpim1 ! vector opt. 416 #endif 298 417 zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) ) ! if pun > 0 : zdir = 1 otherwise zdir = 0 299 418 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * fse3v(ji,jj,jk) … … 313 432 ! 314 433 ! Mask at the T-points in the x-direction (mask=0 or mask=1) 434 #if defined key_z_first 435 DO jj = 2, jpjm1 436 DO ji = 2, jpim1 437 DO jk = 1, jpkm1 438 #else 315 439 DO jk = 1, jpkm1 316 440 DO jj = 2, jpjm1 317 441 DO ji = fs_2, fs_jpim1 ! vector opt. 442 #endif 318 443 zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 319 444 END DO … … 324 449 ! 325 450 ! Tracer flux on the x-direction 451 #if defined key_z_first 452 DO jj = 2, jpjm1 453 DO ji = 2, jpim1 454 DO jk = 1, jpkm1 455 #else 326 456 DO jk = 1, jpkm1 327 457 ! 328 458 DO jj = 2, jpjm1 329 459 DO ji = fs_2, fs_jpim1 ! vector opt. 460 #endif 330 461 zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) ) ! if pun > 0 : zdir = 1 otherwise zdir = 0 331 462 !--- If the second ustream point is a land point … … 336 467 END DO 337 468 END DO 469 #if defined key_z_first 470 END DO 471 ! Computation of the trend 472 DO jj = 2, jpjm1 473 DO ji = 2, jpim1 474 DO jk = 1, jpkm1 475 #else 338 476 ! 339 477 ! Computation of the trend 340 478 DO jj = 2, jpjm1 341 479 DO ji = fs_2, fs_jpim1 ! vector opt. 480 #endif 342 481 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 343 482 ! horizontal advective trends … … 361 500 IF( wrk_not_released(3, 1,2,3) ) CALL ctl_stop('tra_adv_qck_j: failed to release workspace arrays') 362 501 ! 502 503 !! * Reset control of array index permutation 504 !FTRANS CLEAR 505 # include "oce_ftrans.h90" 506 # include "dom_oce_ftrans.h90" 507 # include "trc_oce_ftrans.h90" 508 363 509 END SUBROUTINE tra_adv_qck_j 364 510 … … 370 516 !!---------------------------------------------------------------------- 371 517 USE oce, ONLY: zwz => ua ! ua used as workspace 518 519 !! DCSE_NEMO: need additional directives for renamed module variables 520 !FTRANS zwz :I :I :z 521 372 522 ! 373 523 INTEGER , INTENT(in ) :: kt ! ocean time-step index 374 524 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 375 525 INTEGER , INTENT(in ) :: kjpt ! number of tracers 376 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pwn ! vertical velocity 377 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptn ! before and now tracer fields 378 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 526 527 !! DCSE_NEMO: This style defeats ftrans 528 ! REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pwn ! vertical velocity 529 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptn ! tracer fields (now) 530 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 531 532 !FTRANS pwn :I :I :z 533 !FTRANS ptn pta :I :I :z : 534 REAL(wp), INTENT(in ) :: pwn(jpi,jpj,jpk) ! vertical velocity 535 REAL(wp), INTENT(in ) :: ptn(jpi,jpj,jpk,kjpt) ! tracer fields (now) 536 REAL(wp), INTENT(inout) :: pta(jpi,jpj,jpk,kjpt) ! tracer trend 537 379 538 ! 380 539 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 393 552 ENDIF 394 553 ! 554 #if defined key_z_first 555 DO jj = 2, jpjm1 556 DO ji = 2, jpim1 557 DO jk = 2, jpkm1 ! Interior point: second order centered tracer flux at w-point 558 #else 395 559 DO jk = 2, jpkm1 ! Interior point: second order centered tracer flux at w-point 396 560 DO jj = 2, jpjm1 397 561 DO ji = fs_2, fs_jpim1 ! vector opt. 562 #endif 398 563 zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) 399 564 END DO … … 401 566 END DO 402 567 ! 568 #if defined key_z_first 569 DO jj = 2, jpjm1 570 DO ji = 2, jpim1 571 DO jk = 1, jpkm1 !== Tracer flux divergence added to the general trend ==! 572 #else 403 573 DO jk = 1, jpkm1 !== Tracer flux divergence added to the general trend ==! 404 574 DO jj = 2, jpjm1 405 575 DO ji = fs_2, fs_jpim1 ! vector opt. 576 #endif 406 577 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 407 578 ! k- vertical advective trends … … 417 588 END DO 418 589 ! 590 591 !! * Reset control of array index permutation 592 !FTRANS CLEAR 593 # include "oce_ftrans.h90" 594 # include "dom_oce_ftrans.h90" 595 # include "trc_oce_ftrans.h90" 596 419 597 END SUBROUTINE tra_adv_cen2_k 420 598 … … 427 605 !! ** Method : 428 606 !!---------------------------------------------------------------------- 429 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pfu ! second upwind point 430 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pfd ! first douwning point 431 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pfc ! the central point (or the first upwind point) 432 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: puc ! input as Courant number ; output as flux 607 608 !! DCSE_NEMO: This style defeats ftrans 609 610 ! REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pfu ! second upwind point 611 ! REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pfd ! first douwning point 612 ! REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pfc ! the central point (or the first upwind point) 613 ! REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: puc ! input as Courant number ; output as flux 614 615 !FTRANS pfu pfd pfc puc :I :I :z 616 REAL(wp), INTENT(in ) :: pfu(jpi,jpj,jpk) ! second upwind point 617 REAL(wp), INTENT(in ) :: pfd(jpi,jpj,jpk) ! first douwning point 618 REAL(wp), INTENT(in ) :: pfc(jpi,jpj,jpk) ! the central point (or the first upwind point) 619 REAL(wp), INTENT(inout) :: puc(jpi,jpj,jpk) ! input as Courant number ; output as flux 620 433 621 !! 434 622 INTEGER :: ji, jj, jk ! dummy loop indices … … 437 625 !---------------------------------------------------------------------- 438 626 627 #if defined key_z_first 628 DO jj = 1, jpj 629 DO ji = 1, jpi 630 DO jk = 1, jpkm1 631 #else 439 632 DO jk = 1, jpkm1 440 633 DO jj = 1, jpj 441 634 DO ji = 1, jpi 635 #endif 442 636 zc = puc(ji,jj,jk) ! Courant number 443 637 zcurv = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk)
Note: See TracChangeset
for help on using the changeset viewer.
