Changeset 7698 for trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
- Timestamp:
- 2017-02-18T10:02:03+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r7646 r7698 97 97 !!---------------------------------------------------------------------- 98 98 INTEGER, INTENT( in ) :: kt ! ocean time-step index 99 INTEGER :: jk, jj, ji 99 100 ! 100 101 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 109 110 CASE ( np_ENE ) !* energy conserving scheme 110 111 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 111 ztrdu(:,:,:) = ua(:,:,:) 112 ztrdv(:,:,:) = va(:,:,:) 112 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 113 DO jk = 1, jpk 114 DO jj = 1, jpj 115 DO ji = 1, jpi 116 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 117 ztrdv(ji,jj,jk) = va(ji,jj,jk) 118 END DO 119 END DO 120 END DO 113 121 CALL vor_ene( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 114 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 115 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 122 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 123 DO jk = 1, jpk 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 127 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 128 END DO 129 END DO 130 END DO 116 131 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 117 ztrdu(:,:,:) = ua(:,:,:) 118 ztrdv(:,:,:) = va(:,:,:) 132 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 133 DO jk = 1, jpk 134 DO jj = 1, jpj 135 DO ji = 1, jpi 136 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 137 ztrdv(ji,jj,jk) = va(ji,jj,jk) 138 END DO 139 END DO 140 END DO 119 141 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 120 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 121 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 142 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 143 DO jk = 1, jpk 144 DO jj = 1, jpj 145 DO ji = 1, jpi 146 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 147 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 148 END DO 149 END DO 150 END DO 122 151 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 123 152 ELSE ! total vorticity trend … … 128 157 CASE ( np_ENS ) !* enstrophy conserving scheme 129 158 IF( l_trddyn ) THEN ! trend diagnostics: splitthe trend in two 130 ztrdu(:,:,:) = ua(:,:,:) 131 ztrdv(:,:,:) = va(:,:,:) 159 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 160 DO jk = 1, jpk 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 164 ztrdv(ji,jj,jk) = va(ji,jj,jk) 165 END DO 166 END DO 167 END DO 132 168 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 133 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 134 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 169 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 170 DO jk = 1, jpk 171 DO jj = 1, jpj 172 DO ji = 1, jpi 173 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 174 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 175 END DO 176 END DO 177 END DO 135 178 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 136 ztrdu(:,:,:) = ua(:,:,:) 137 ztrdv(:,:,:) = va(:,:,:) 179 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 180 DO jk = 1, jpk 181 DO jj = 1, jpj 182 DO ji = 1, jpi 183 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 184 ztrdv(ji,jj,jk) = va(ji,jj,jk) 185 END DO 186 END DO 187 END DO 138 188 CALL vor_ens( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 139 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 140 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 189 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 190 DO jk = 1, jpk 191 DO jj = 1, jpj 192 DO ji = 1, jpi 193 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 194 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 195 END DO 196 END DO 197 END DO 141 198 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 142 199 ELSE ! total vorticity trend … … 147 204 CASE ( np_MIX ) !* mixed ene-ens scheme 148 205 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 149 ztrdu(:,:,:) = ua(:,:,:) 150 ztrdv(:,:,:) = va(:,:,:) 206 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 207 DO jk = 1, jpk 208 DO jj = 1, jpj 209 DO ji = 1, jpi 210 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 211 ztrdv(ji,jj,jk) = va(ji,jj,jk) 212 END DO 213 END DO 214 END DO 151 215 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend (ens) 152 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 153 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 216 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 217 DO jk = 1, jpk 218 DO jj = 1, jpj 219 DO ji = 1, jpi 220 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 221 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 222 END DO 223 END DO 224 END DO 154 225 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 155 ztrdu(:,:,:) = ua(:,:,:) 156 ztrdv(:,:,:) = va(:,:,:) 226 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 227 DO jk = 1, jpk 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 231 ztrdv(ji,jj,jk) = va(ji,jj,jk) 232 END DO 233 END DO 234 END DO 157 235 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend (ene) 158 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 159 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 236 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 237 DO jk = 1, jpk 238 DO jj = 1, jpj 239 DO ji = 1, jpi 240 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 241 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 242 END DO 243 END DO 244 END DO 160 245 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 161 246 ELSE ! total vorticity trend … … 167 252 CASE ( np_EEN ) !* energy and enstrophy conserving scheme 168 253 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 169 ztrdu(:,:,:) = ua(:,:,:) 170 ztrdv(:,:,:) = va(:,:,:) 254 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 255 DO jk = 1, jpk 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 259 ztrdv(ji,jj,jk) = va(ji,jj,jk) 260 END DO 261 END DO 262 END DO 171 263 CALL vor_een( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 172 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 173 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 264 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 265 DO jk = 1, jpk 266 DO jj = 1, jpj 267 DO ji = 1, jpi 268 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 269 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 270 END DO 271 END DO 272 END DO 174 273 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 175 ztrdu(:,:,:) = ua(:,:,:) 176 ztrdv(:,:,:) = va(:,:,:) 274 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 275 DO jk = 1, jpk 276 DO jj = 1, jpj 277 DO ji = 1, jpi 278 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 279 ztrdv(ji,jj,jk) = va(ji,jj,jk) 280 END DO 281 END DO 282 END DO 177 283 CALL vor_een( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 178 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 179 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 284 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 285 DO jk = 1, jpk 286 DO jj = 1, jpj 287 DO ji = 1, jpi 288 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 289 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 290 END DO 291 END DO 292 END DO 180 293 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 181 294 ELSE ! total vorticity trend … … 244 357 SELECT CASE( kvor ) !== vorticity considered ==! 245 358 CASE ( np_COR ) !* Coriolis (planetary vorticity) 246 zwz(:,:) = ff_f(:,:) 359 !$OMP PARALLEL DO schedule(static) private(jj,ji) 360 DO jj = 1, jpj 361 DO ji = 1, jpi 362 zwz(ji,jj) = ff_f(ji,jj) 363 END DO 364 END DO 247 365 CASE ( np_RVO ) !* relative vorticity 366 !$OMP PARALLEL DO schedule(static) private(jj,ji) 248 367 DO jj = 1, jpjm1 249 368 DO ji = 1, fs_jpim1 ! vector opt. … … 253 372 END DO 254 373 CASE ( np_MET ) !* metric term 374 !$OMP PARALLEL DO schedule(static) private(jj,ji) 255 375 DO jj = 1, jpjm1 256 376 DO ji = 1, fs_jpim1 ! vector opt. … … 261 381 END DO 262 382 CASE ( np_CRV ) !* Coriolis + relative vorticity 383 !$OMP PARALLEL DO schedule(static) private(jj,ji) 263 384 DO jj = 1, jpjm1 264 385 DO ji = 1, fs_jpim1 ! vector opt. … … 269 390 END DO 270 391 CASE ( np_CME ) !* Coriolis + metric 392 !$OMP PARALLEL DO schedule(static) private(jj,ji) 271 393 DO jj = 1, jpjm1 272 394 DO ji = 1, fs_jpim1 ! vector opt. … … 282 404 ! 283 405 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 406 !$OMP PARALLEL DO schedule(static) private(jj,ji) 284 407 DO jj = 1, jpjm1 285 408 DO ji = 1, fs_jpim1 ! vector opt. … … 290 413 291 414 IF( ln_sco ) THEN 292 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 293 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 294 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 415 !$OMP PARALLEL DO schedule(static) private(jj,ji) 416 DO jj = 1, jpj 417 DO ji = 1, jpi 418 zwz(ji,jj) = zwz(ji,jj) / e3f_n(ji,jj,jk) 419 zwx(ji,jj) = e2u(ji,jj) * e3u_n(ji,jj,jk) * pun(ji,jj,jk) 420 zwy(ji,jj) = e1v(ji,jj) * e3v_n(ji,jj,jk) * pvn(ji,jj,jk) 421 END DO 422 END DO 295 423 ELSE 296 zwx(:,:) = e2u(:,:) * pun(:,:,jk) 297 zwy(:,:) = e1v(:,:) * pvn(:,:,jk) 424 !$OMP PARALLEL DO schedule(static) private(jj,ji) 425 DO jj = 1, jpj 426 DO ji = 1, jpi 427 zwx(ji,jj) = e2u(ji,jj) * pun(ji,jj,jk) 428 zwy(ji,jj) = e1v(ji,jj) * pvn(ji,jj,jk) 429 END DO 430 END DO 298 431 ENDIF 299 432 ! !== compute and add the vorticity term trend =! 433 !$OMP PARALLEL DO schedule(static) private(jj, ji, zy1, zy2, zx1, zx2) 300 434 DO jj = 2, jpjm1 301 435 DO ji = fs_2, fs_jpim1 ! vector opt. … … 487 621 SELECT CASE( nn_een_e3f ) ! == reciprocal of e3 at F-point 488 622 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 623 !$OMP PARALLEL DO schedule(static) private(jj,ji,ze3) 489 624 DO jj = 1, jpjm1 490 625 DO ji = 1, fs_jpim1 ! vector opt. … … 497 632 END DO 498 633 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 634 !$OMP PARALLEL DO schedule(static) private(jj,ji,ze3,zmsk) 499 635 DO jj = 1, jpjm1 500 636 DO ji = 1, fs_jpim1 ! vector opt. … … 512 648 SELECT CASE( kvor ) !== vorticity considered ==! 513 649 CASE ( np_COR ) !* Coriolis (planetary vorticity) 650 !$OMP PARALLEL DO schedule(static) private(jj,ji) 514 651 DO jj = 1, jpjm1 515 652 DO ji = 1, fs_jpim1 ! vector opt. … … 518 655 END DO 519 656 CASE ( np_RVO ) !* relative vorticity 657 !$OMP PARALLEL DO schedule(static) private(jj,ji) 520 658 DO jj = 1, jpjm1 521 659 DO ji = 1, fs_jpim1 ! vector opt. … … 526 664 END DO 527 665 CASE ( np_MET ) !* metric term 666 !$OMP PARALLEL DO schedule(static) private(jj,ji) 528 667 DO jj = 1, jpjm1 529 668 DO ji = 1, fs_jpim1 ! vector opt. … … 534 673 END DO 535 674 CASE ( np_CRV ) !* Coriolis + relative vorticity 675 !$OMP PARALLEL DO schedule(static) private(jj,ji) 536 676 DO jj = 1, jpjm1 537 677 DO ji = 1, fs_jpim1 ! vector opt. … … 542 682 END DO 543 683 CASE ( np_CME ) !* Coriolis + metric 684 !$OMP PARALLEL DO schedule(static) private(jj,ji) 544 685 DO jj = 1, jpjm1 545 686 DO ji = 1, fs_jpim1 ! vector opt. … … 555 696 ! 556 697 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 698 !$OMP PARALLEL DO schedule(static) private(jj,ji) 557 699 DO jj = 1, jpjm1 558 700 DO ji = 1, fs_jpim1 ! vector opt. … … 565 707 ! 566 708 ! !== horizontal fluxes ==! 567 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 568 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 709 !$OMP PARALLEL DO schedule(static) private(jj,ji) 710 DO jj = 1, jpj 711 DO ji = 1, jpi 712 zwx(ji,jj) = e2u(ji,jj) * e3u_n(ji,jj,jk) * pun(ji,jj,jk) 713 zwy(ji,jj) = e1v(ji,jj) * e3v_n(ji,jj,jk) * pvn(ji,jj,jk) 714 END DO 715 END DO 569 716 570 717 ! !== compute and add the vorticity term trend =! 571 718 jj = 2 572 719 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 720 573 721 DO ji = 2, jpi ! split in 2 parts due to vector opt. 574 722 ztne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) … … 577 725 ztsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 578 726 END DO 727 !$OMP PARALLEL 728 !$OMP DO schedule(static) private(jj,ji) 579 729 DO jj = 3, jpj 580 730 DO ji = fs_2, jpi ! vector opt. ok because we start at jj = 3 … … 585 735 END DO 586 736 END DO 737 !$OMP DO schedule(static) private(jj,ji,zua,zva) 587 738 DO jj = 2, jpjm1 588 739 DO ji = fs_2, fs_jpim1 ! vector opt. … … 595 746 END DO 596 747 END DO 748 !$OMP END PARALLEL 597 749 ! ! =============== 598 750 END DO ! End of slab … … 649 801 IF(lwp) WRITE(numout,*) ' change fmask value in the angles (T) ln_vorlat = ', ln_vorlat 650 802 IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN 803 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 651 804 DO jk = 1, jpk 652 805 DO jj = 2, jpjm1
Note: See TracChangeset
for help on using the changeset viewer.
