- Timestamp:
- 2014-04-06T17:28:25+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4496 r4616 75 75 # include "vectopt_loop_substitute.h90" 76 76 !!---------------------------------------------------------------------- 77 !! NEMO/OPA 3. 5 , NEMO Consortium (2013)77 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 78 78 !! $Id: dynspg_ts.F90 79 79 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 104 104 ! 105 105 END FUNCTION dyn_spg_ts_alloc 106 106 107 107 108 SUBROUTINE dyn_spg_ts( kt ) … … 290 291 ! 291 292 DO jk = 1, jpkm1 292 #if defined key_vectopt_loop293 DO jj = 1, 1 !Vector opt. => forced unrolling294 DO ji = 1, jpij295 #else296 293 DO jj = 1, jpj 297 294 DO ji = 1, jpi 298 #endif299 295 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 300 296 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) … … 324 320 DO jj = 2, jpjm1 325 321 DO ji = fs_2, fs_jpim1 ! vector opt. 326 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)327 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) / e1u(ji,jj)328 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj)329 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) / e2v(ji,jj)322 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) 323 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) 324 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) 325 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) 330 326 ! energy conserving formulation for planetary vorticity term 331 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )332 zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )327 zu_trd(ji,jj) = z1_4 * r1_e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 328 zv_trd(ji,jj) =-z1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 333 329 END DO 334 330 END DO … … 338 334 DO ji = fs_2, fs_jpim1 ! vector opt. 339 335 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 340 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)336 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 341 337 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 342 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)338 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 343 339 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 344 340 zv_trd(ji,jj) = zx1 * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 349 345 DO jj = 2, jpjm1 350 346 DO ji = fs_2, fs_jpim1 ! vector opt. 351 zu_trd(ji,jj) = + z1_12 /e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &352 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) &353 & + ftse(ji,jj ) * zwy(ji ,jj-1) &354 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )355 zv_trd(ji,jj) = - z1_12 /e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &356 & + ftse(ji,jj+1) * zwx(ji ,jj+1) &357 & + ftnw(ji,jj ) * zwx(ji-1,jj ) &358 & + ftne(ji,jj ) * zwx(ji ,jj ) )347 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 348 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 349 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 350 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 351 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 352 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 353 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & 354 & + ftne(ji,jj ) * zwx(ji ,jj ) ) 359 355 END DO 360 356 END DO … … 367 363 DO jj = 2, jpjm1 368 364 DO ji = fs_2, fs_jpim1 ! vector opt. 369 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) /e1u(ji,jj)370 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) /e2v(ji,jj)365 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) * r1_e1u(ji,jj) 366 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) * r1_e2v(ji,jj) 371 367 END DO 372 368 END DO … … 417 413 DO jj = 2, jpjm1 418 414 DO ji = fs_2, fs_jpim1 ! vector opt. 419 zu_spg = grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) /e1u(ji,jj)420 zv_spg = grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) /e2v(ji,jj)415 zu_spg = grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 416 zv_spg = grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) 421 417 zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 422 418 zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg … … 427 423 DO ji = fs_2, fs_jpim1 ! vector opt. 428 424 zu_spg = grav * z1_2 * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) & 429 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) /e1u(ji,jj)425 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) 430 426 zv_spg = grav * z1_2 * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) & 431 & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) /e2v(ji,jj)427 & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj) 432 428 zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 433 429 zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg … … 525 521 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 526 522 DO ji = 2, fs_jpim1 ! Vector opt. 527 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &528 & * ( e1 2t(ji ,jj) * zsshp2_e(ji ,jj) &529 & + e1 2t(ji+1,jj) * zsshp2_e(ji+1,jj) )530 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &531 & * ( e1 2t(ji,jj ) * zsshp2_e(ji,jj ) &532 & + e1 2t(ji,jj+1) * zsshp2_e(ji,jj+1) )523 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 524 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 525 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 526 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 527 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & 528 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 533 529 END DO 534 530 END DO … … 578 574 ! Sum over sub-time-steps to compute advective velocities 579 575 za2 = wgtbtp2(jn) 580 zu_sum (:,:) = zu_sum (:,:) + za2 * zwx (:,:) /e2u (:,:)581 zv_sum (:,:) = zv_sum (:,:) + za2 * zwy (:,:) /e1v (:,:)576 zu_sum (:,:) = zu_sum (:,:) + za2 * zwx (:,:) * r1_e2u (:,:) 577 zv_sum (:,:) = zv_sum (:,:) + za2 * zwy (:,:) * r1_e1v (:,:) 582 578 ! 583 579 ! Set next sea level: … … 585 581 DO ji = fs_2, fs_jpim1 ! vector opt. 586 582 zhdiv(ji,jj) = ( zwx(ji,jj) - zwx(ji-1,jj) & 587 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e1 2t(ji,jj)583 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e1e2t(ji,jj) 588 584 END DO 589 585 END DO … … 603 599 DO jj = 2, jpjm1 604 600 DO ji = 2, jpim1 ! NO Vector Opt. 605 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &606 & * ( e1 2t(ji ,jj ) * ssha_e(ji ,jj ) &607 & + e1 2t(ji+1,jj ) * ssha_e(ji+1,jj ) )608 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &609 & * ( e1 2t(ji ,jj ) * ssha_e(ji ,jj ) &610 & + e1 2t(ji ,jj+1) * ssha_e(ji ,jj+1) )601 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 602 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 603 & + e1e2t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 604 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 605 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 606 & + e1e2t(ji ,jj+1) * ssha_e(ji ,jj+1) ) 611 607 END DO 612 608 END DO … … 642 638 DO jj = 2, jpjm1 643 639 DO ji = 2, jpim1 644 zx1 = z1_2 * umask(ji ,jj,1) * r1_e1 2u(ji ,jj) &645 & * ( e1 2t(ji ,jj ) * zsshp2_e(ji ,jj) &646 & + e1 2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) )647 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e1 2v(ji ,jj ) &648 & * ( e1 2t(ji ,jj ) * zsshp2_e(ji ,jj ) &649 & + e1 2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) )640 zx1 = z1_2 * umask(ji ,jj,1) * r1_e1e2u(ji ,jj) & 641 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj) & 642 & + e1e2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) ) 643 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e1e2v(ji ,jj ) & 644 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj ) & 645 & + e1e2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) ) 650 646 zhust_e(ji,jj) = hu_0(ji,jj) + zx1 651 647 zhvst_e(ji,jj) = hv_0(ji,jj) + zy1 … … 664 660 DO jj = 2, jpjm1 665 661 DO ji = fs_2, fs_jpim1 ! vector opt. 666 zy1 = ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)667 zy2 = ( zwy(ji ,jj ) + zwy(ji+1,jj ) ) / e1u(ji,jj)668 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) / e2v(ji,jj)669 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) / e2v(ji,jj)670 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 671 zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 662 zy1 = ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) ) 663 zy2 = ( zwy(ji ,jj ) + zwy(ji+1,jj ) ) 664 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) 665 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) 666 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) * r1_e1u(ji,jj) 667 zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) * r1_e2v(ji,jj) 672 668 END DO 673 669 END DO … … 677 673 DO ji = fs_2, fs_jpim1 ! vector opt. 678 674 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 679 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)675 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 680 676 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 681 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)677 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 682 678 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 683 679 zv_trd(ji,jj) = zx1 * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 688 684 DO jj = 2, jpjm1 689 685 DO ji = fs_2, fs_jpim1 ! vector opt. 690 zu_trd(ji,jj) = + z1_12 /e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &691 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) &692 & + ftse(ji,jj ) * zwy(ji ,jj-1) &693 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )694 zv_trd(ji,jj) = - z1_12 /e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &695 & + ftse(ji,jj+1) * zwx(ji ,jj+1) &696 & + ftnw(ji,jj ) * zwx(ji-1,jj ) &697 & + ftne(ji,jj ) * zwx(ji ,jj ) )686 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 687 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 688 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 689 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 690 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 691 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 692 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & 693 & + ftne(ji,jj ) * zwx(ji ,jj ) ) 698 694 END DO 699 695 END DO … … 705 701 DO jj = 2, jpjm1 706 702 DO ji = fs_2, fs_jpim1 ! vector opt. 707 zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) /e1u(ji,jj)708 zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) /e2v(ji,jj)703 zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 704 zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 709 705 zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg 710 706 zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg … … 721 717 DO ji = fs_2, fs_jpim1 ! vector opt. 722 718 ! Add surface pressure gradient 723 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) /e1u(ji,jj)724 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) /e2v(ji,jj)719 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 720 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 725 721 zwx(ji,jj) = zu_spg 726 722 zwy(ji,jj) = zv_spg … … 827 823 DO jj = 1, jpjm1 828 824 DO ji = 1, jpim1 ! NO Vector Opt. 829 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &830 & * ( e1 2t(ji ,jj) * ssha(ji ,jj) &831 & + e1 2t(ji+1,jj) * ssha(ji+1,jj) )832 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &833 & * ( e1 2t(ji,jj ) * ssha(ji,jj ) &834 & + e1 2t(ji,jj+1) * ssha(ji,jj+1) )825 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 826 & * ( e1e2t(ji ,jj) * ssha(ji ,jj) & 827 & + e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 828 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 829 & * ( e1e2t(ji,jj ) * ssha(ji,jj ) & 830 & + e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 835 831 END DO 836 832 END DO … … 1071 1067 DO jj = 1, jpj 1072 1068 DO ji =1, jpi 1073 zxr2 = 1. /(e1t(ji,jj)*e1t(ji,jj))1074 zyr2 = 1. /(e2t(ji,jj)*e2t(ji,jj))1075 zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) )1069 zxr2 = 1._wp / ( e1t(ji,jj)*e1t(ji,jj) ) 1070 zyr2 = 1._wp / ( e2t(ji,jj)*e2t(ji,jj) ) 1071 zcu(ji,jj) = SQRT( grav*ht_0(ji,jj)*(zxr2 + zyr2) ) 1076 1072 END DO 1077 1073 END DO … … 1079 1075 DO jj = 1, jpj 1080 1076 DO ji =1, jpi 1081 zxr2 = 1. /(e1t(ji,jj)*e1t(ji,jj))1082 zyr2 = 1. /(e2t(ji,jj)*e2t(ji,jj))1083 zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) )1077 zxr2 = 1._wp / ( e1t(ji,jj)*e1t(ji,jj) ) 1078 zyr2 = 1._wp / ( e2t(ji,jj)*e2t(ji,jj) ) 1079 zcu(ji,jj) = SQRT( grav*ht(ji,jj)*(zxr2 + zyr2) ) 1084 1080 END DO 1085 1081 END DO … … 1092 1088 IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 1093 1089 1094 rdtbt = rdt / FLOAT(nn_baro)1090 rdtbt = rdt / REAL( nn_baro, wp ) 1095 1091 zcmax = zcmax * rdtbt 1096 1092 ! Print results
Note: See TracChangeset
for help on using the changeset viewer.
