Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
- Timestamp:
- 2017-03-03T12:46:59+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
r7698 r7753 97 97 !!---------------------------------------------------------------------- 98 98 INTEGER, INTENT( in ) :: kt ! ocean time-step index 99 INTEGER :: jk, jj, ji100 99 ! 101 100 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 110 109 CASE ( np_ENE ) !* energy conserving scheme 111 110 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 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 111 ztrdu(:,:,:) = ua(:,:,:) 112 ztrdv(:,:,:) = va(:,:,:) 121 113 CALL vor_ene( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 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 114 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 115 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 131 116 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 117 ztrdu(:,:,:) = ua(:,:,:) 118 ztrdv(:,:,:) = va(:,:,:) 141 119 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 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 120 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 121 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 151 122 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 152 123 ELSE ! total vorticity trend … … 157 128 CASE ( np_ENS ) !* enstrophy conserving scheme 158 129 IF( l_trddyn ) THEN ! trend diagnostics: splitthe trend in two 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 130 ztrdu(:,:,:) = ua(:,:,:) 131 ztrdv(:,:,:) = va(:,:,:) 168 132 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 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 133 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 134 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 178 135 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 136 ztrdu(:,:,:) = ua(:,:,:) 137 ztrdv(:,:,:) = va(:,:,:) 188 138 CALL vor_ens( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 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 139 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 140 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 198 141 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 199 142 ELSE ! total vorticity trend … … 204 147 CASE ( np_MIX ) !* mixed ene-ens scheme 205 148 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 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 149 ztrdu(:,:,:) = ua(:,:,:) 150 ztrdv(:,:,:) = va(:,:,:) 215 151 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend (ens) 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 152 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 153 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 225 154 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 155 ztrdu(:,:,:) = ua(:,:,:) 156 ztrdv(:,:,:) = va(:,:,:) 235 157 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend (ene) 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 158 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 159 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 245 160 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 246 161 ELSE ! total vorticity trend … … 252 167 CASE ( np_EEN ) !* energy and enstrophy conserving scheme 253 168 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 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 169 ztrdu(:,:,:) = ua(:,:,:) 170 ztrdv(:,:,:) = va(:,:,:) 263 171 CALL vor_een( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 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 172 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 173 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 273 174 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 175 ztrdu(:,:,:) = ua(:,:,:) 176 ztrdv(:,:,:) = va(:,:,:) 283 177 CALL vor_een( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 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 178 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 179 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 293 180 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 294 181 ELSE ! total vorticity trend … … 357 244 SELECT CASE( kvor ) !== vorticity considered ==! 358 245 CASE ( np_COR ) !* Coriolis (planetary vorticity) 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 246 zwz(:,:) = ff_f(:,:) 365 247 CASE ( np_RVO ) !* relative vorticity 366 !$OMP PARALLEL DO schedule(static) private(jj,ji)367 248 DO jj = 1, jpjm1 368 249 DO ji = 1, fs_jpim1 ! vector opt. … … 372 253 END DO 373 254 CASE ( np_MET ) !* metric term 374 !$OMP PARALLEL DO schedule(static) private(jj,ji)375 255 DO jj = 1, jpjm1 376 256 DO ji = 1, fs_jpim1 ! vector opt. … … 381 261 END DO 382 262 CASE ( np_CRV ) !* Coriolis + relative vorticity 383 !$OMP PARALLEL DO schedule(static) private(jj,ji)384 263 DO jj = 1, jpjm1 385 264 DO ji = 1, fs_jpim1 ! vector opt. … … 390 269 END DO 391 270 CASE ( np_CME ) !* Coriolis + metric 392 !$OMP PARALLEL DO schedule(static) private(jj,ji)393 271 DO jj = 1, jpjm1 394 272 DO ji = 1, fs_jpim1 ! vector opt. … … 404 282 ! 405 283 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 406 !$OMP PARALLEL DO schedule(static) private(jj,ji)407 284 DO jj = 1, jpjm1 408 285 DO ji = 1, fs_jpim1 ! vector opt. … … 413 290 414 291 IF( ln_sco ) THEN 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 292 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 293 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 294 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 423 295 ELSE 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 296 zwx(:,:) = e2u(:,:) * pun(:,:,jk) 297 zwy(:,:) = e1v(:,:) * pvn(:,:,jk) 431 298 ENDIF 432 299 ! !== compute and add the vorticity term trend =! 433 !$OMP PARALLEL DO schedule(static) private(jj, ji, zy1, zy2, zx1, zx2)434 300 DO jj = 2, jpjm1 435 301 DO ji = fs_2, fs_jpim1 ! vector opt. … … 621 487 SELECT CASE( nn_een_e3f ) ! == reciprocal of e3 at F-point 622 488 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 623 !$OMP PARALLEL DO schedule(static) private(jj,ji,ze3)624 489 DO jj = 1, jpjm1 625 490 DO ji = 1, fs_jpim1 ! vector opt. … … 632 497 END DO 633 498 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)635 499 DO jj = 1, jpjm1 636 500 DO ji = 1, fs_jpim1 ! vector opt. … … 648 512 SELECT CASE( kvor ) !== vorticity considered ==! 649 513 CASE ( np_COR ) !* Coriolis (planetary vorticity) 650 !$OMP PARALLEL DO schedule(static) private(jj,ji)651 514 DO jj = 1, jpjm1 652 515 DO ji = 1, fs_jpim1 ! vector opt. … … 655 518 END DO 656 519 CASE ( np_RVO ) !* relative vorticity 657 !$OMP PARALLEL DO schedule(static) private(jj,ji)658 520 DO jj = 1, jpjm1 659 521 DO ji = 1, fs_jpim1 ! vector opt. … … 664 526 END DO 665 527 CASE ( np_MET ) !* metric term 666 !$OMP PARALLEL DO schedule(static) private(jj,ji)667 528 DO jj = 1, jpjm1 668 529 DO ji = 1, fs_jpim1 ! vector opt. … … 673 534 END DO 674 535 CASE ( np_CRV ) !* Coriolis + relative vorticity 675 !$OMP PARALLEL DO schedule(static) private(jj,ji)676 536 DO jj = 1, jpjm1 677 537 DO ji = 1, fs_jpim1 ! vector opt. … … 682 542 END DO 683 543 CASE ( np_CME ) !* Coriolis + metric 684 !$OMP PARALLEL DO schedule(static) private(jj,ji)685 544 DO jj = 1, jpjm1 686 545 DO ji = 1, fs_jpim1 ! vector opt. … … 696 555 ! 697 556 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 698 !$OMP PARALLEL DO schedule(static) private(jj,ji)699 557 DO jj = 1, jpjm1 700 558 DO ji = 1, fs_jpim1 ! vector opt. … … 707 565 ! 708 566 ! !== horizontal fluxes ==! 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 567 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 568 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 716 569 717 570 ! !== compute and add the vorticity term trend =! 718 571 jj = 2 719 572 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 720 721 573 DO ji = 2, jpi ! split in 2 parts due to vector opt. 722 574 ztne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) … … 725 577 ztsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 726 578 END DO 727 !$OMP PARALLEL728 !$OMP DO schedule(static) private(jj,ji)729 579 DO jj = 3, jpj 730 580 DO ji = fs_2, jpi ! vector opt. ok because we start at jj = 3 … … 735 585 END DO 736 586 END DO 737 !$OMP DO schedule(static) private(jj,ji,zua,zva)738 587 DO jj = 2, jpjm1 739 588 DO ji = fs_2, fs_jpim1 ! vector opt. … … 746 595 END DO 747 596 END DO 748 !$OMP END PARALLEL749 597 ! ! =============== 750 598 END DO ! End of slab … … 801 649 IF(lwp) WRITE(numout,*) ' change fmask value in the angles (T) ln_vorlat = ', ln_vorlat 802 650 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)804 651 DO jk = 1, jpk 805 652 DO jj = 2, jpjm1
Note: See TracChangeset
for help on using the changeset viewer.
