Changeset 497 for trunk/NEMO/OFF_SRC/LDF/ldfslp.F90
- Timestamp:
- 2006-09-12T13:03:53+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OFF_SRC/LDF/ldfslp.F90 (modified) (28 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OFF_SRC/LDF/ldfslp.F90
r343 r497 20 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 21 USE in_out_manager ! I/O manager 22 USE prtctl ! Print control 22 23 23 24 IMPLICIT NONE … … 46 47 # include "vectopt_loop_substitute.h90" 47 48 !!---------------------------------------------------------------------- 48 !! OPA 9.0 , LOCEAN-IPSL (2005) 49 !! $Header$ 50 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 49 !! OPA 9.0 , LOCEAN-IPSL (2005) 51 50 !!---------------------------------------------------------------------- 52 51 … … 69 68 !! of 10cm/s) 70 69 !! A horizontal shapiro filter is applied to the slopes 71 !! 'key_s_coord' defined:add to the previously computed slopes70 !! ln_sco=T, s-coordinate, add to the previously computed slopes 72 71 !! the slope of the model level surface. 73 72 !! macro-tasked on horizontal slab (jk-loop) (2, jpk-1) 74 73 !! [slopes already set to zero at level 1, and to zero or the ocean 75 !! bottom slope ( 'key_s_coord' defined) at level jpk in inildf]74 !! bottom slope (ln_sco=T) at level jpk in inildf] 76 75 !! 77 76 !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and j-slopes … … 83 82 !! 8.1 ! 99-10 (A. Jouzeau) NEW profile 84 83 !! 8.5 ! 99-10 (G. Madec) Free form, F90 84 !! 9.0 ! 05-10 (A. Beckmann) correction for s-coordinates 85 85 !!---------------------------------------------------------------------- 86 86 !! * Modules used … … 97 97 !! * Local declarations 98 98 INTEGER :: ji, jj, jk ! dummy loop indices 99 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integer 100 #if defined key_partial_steps 101 INTEGER :: iku, ikv ! temporary integers 102 #endif 99 INTEGER :: ii0, ii1, ij0, ij1, & ! temporary integer 100 & iku, ikv ! " " 103 101 REAL(wp) :: & 104 zeps, zmg, zm05g, zcoef1, zcoef2, & ! temporary scalars 105 zau, zbu, zav, zbv, & 106 zai, zbi, zaj, zbj, & 107 zcofu, zcofv, zcofw, & 108 z1u, z1v, z1wu, z1wv, & 102 zeps, zmg, zm05g, & ! temporary scalars 103 zcoef1, zcoef2, zcoef3, & ! 104 zau, zbu, zav, zbv, & 105 zai, zbi, zaj, zbj, & 106 zcofu, zcofv, zcofw, & 107 z1u, z1v, z1wu, z1wv, & 109 108 zalpha 110 109 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zww … … 138 137 END DO 139 138 140 #if defined key_partial_steps 141 ! partial steps correction at the bottom ocean level (zps_hde routine) 142 # if defined key_vectopt_loop && ! defined key_autotasking 143 jj = 1 144 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 139 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level (zps_hde routine) 140 # if defined key_vectopt_loop && ! defined key_mpp_omp 141 jj = 1 142 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 145 143 # else 146 DO jj = 1, jpjm1147 DO ji = 1, jpim1148 # endif 149 ! last ocean level150 iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1151 ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1152 zgru(ji,jj,iku) = gru(ji,jj)153 zgrv(ji,jj,ikv) = grv(ji,jj)154 # if ! defined key_vectopt_loop || defined key_ autotasking155 END DO156 # endif 157 END DO158 #endif 144 DO jj = 1, jpjm1 145 DO ji = 1, jpim1 146 # endif 147 ! last ocean level 148 iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1 149 ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1 150 zgru(ji,jj,iku) = gru(ji,jj) 151 zgrv(ji,jj,ikv) = grv(ji,jj) 152 # if ! defined key_vectopt_loop || defined key_mpp_omp 153 END DO 154 # endif 155 END DO 156 ENDIF 159 157 160 158 ! Slopes of isopycnal surfaces just below the mixed layer … … 203 201 ! uslp and vslp output in zwz and zww, resp. 204 202 zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 205 #if defined key_s_coord206 203 zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha) & 207 & + zalpha * uslpml(ji,jj) & 208 & * ( fsdepu(ji,jj,jk) - .5*fse3u(ji,jj,1) ) & 209 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5. ) ) & 210 & * umask(ji,jj,jk) 204 & + zalpha * uslpml(ji,jj) & 205 & * 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) & 206 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5. ) ) * umask(ji,jj,jk) 211 207 zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 212 208 zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha) & 213 & + zalpha * vslpml(ji,jj) & 214 & * ( fsdepv(ji,jj,jk) - .5*fse3v(ji,jj,1) ) & 215 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) & 216 & * vmask(ji,jj,jk) 217 #else 218 ! z-coord and partial steps slope computed in the same way 219 zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha) & 220 & + zalpha * uslpml(ji,jj) & 221 & * ( fsdept(ji,jj,jk) - .5*fse3u(ji,jj,1)) & 222 & / MAX (hmlpt(ji,jj),hmlpt(ji+1,jj),5.) ) & 223 & * umask (ji,jj,jk) 224 zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj+1,jk)) 225 zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha) & 226 & + zalpha * vslpml(ji,jj) & 227 & * ( fsdept(ji,jj,jk) - .5*fse3v(ji,jj,1)) & 228 & / MAX(hmlpt(ji,jj),hmlpt(ji,jj+1),5.) ) & 229 & * vmask (ji,jj,jk) 230 #endif 209 & + zalpha * vslpml(ji,jj) & 210 & * 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) & 211 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 231 212 END DO 232 213 END DO … … 292 273 END DO 293 274 END DO 294 295 296 IF( lk_sco ) THEN297 ! Add the slope of level surfaces298 ! -----------------------------------299 ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done300 ! in inildf, ldfslp never called301 ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces302 ! is added to the slope of isopycnal surfaces.303 ! c a u t i o n : minus sign as fsdep has positive value304 305 DO jj = 2, jpjm1306 DO ji = fs_2, fs_jpim1 ! vector opt.307 uslp(ji,jj,jk) = uslp(ji,jj,jk) - 1. / e1u(ji,jj) &308 & * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) )309 vslp(ji,jj,jk) = vslp(ji,jj,jk) - 1. / e2v(ji,jj) &310 & * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) )311 END DO312 END DO313 ENDIF314 275 315 276 … … 354 315 zbj = MIN( zwy (ji,jj,jk), -100.*ABS(zaj), -7.e+3/fse3w(ji,jj,jk)*ABS(zaj) ) 355 316 ! wslpi and wslpj output in zwz and zww, resp. 356 zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj,jk-1)) 357 zwz(ji,jj,jk) = ( zai / ( zbi - zeps) * ( 1. - zalpha ) & 358 & + zalpha * wslpiml(ji,jj) & 359 & * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) ) & 360 & * tmask (ji,jj,jk) 361 zww(ji,jj,jk) = ( zaj / ( zbj - zeps) * ( 1. - zalpha ) & 362 & + zalpha * wslpjml(ji,jj) & 363 & * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) ) & 364 & * tmask (ji,jj,jk) 317 zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) 318 zcoef3 = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. ) 319 zwz(ji,jj,jk) = ( zai / ( zbi - zeps) * ( 1. - zalpha ) & 320 & + zcoef3 * wslpiml(ji,jj) * zalpha ) * tmask (ji,jj,jk) 321 zww(ji,jj,jk) = ( zaj / ( zbj - zeps) * ( 1. - zalpha ) & 322 & + zcoef3 * wslpjml(ji,jj) * zalpha ) * tmask (ji,jj,jk) 365 323 END DO 366 324 END DO … … 424 382 END DO 425 383 426 IF( lk_sco ) THEN427 428 ! Slope of level surfaces429 ! -----------------------430 ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done431 ! in inildf, ldfslp never called432 ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces433 ! is added to the slope of isopycnal surfaces.434 435 DO jj = 2, jpjm1436 DO ji = fs_2, fs_jpim1 ! vector opt.437 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) - 1. / e1t(ji,jj) &438 & * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) )439 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) - 1. / e2t(ji,jj) &440 & * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) )441 END DO442 END DO443 ENDIF444 384 445 385 ! III. Specific grid points … … 474 414 ! III Lateral boundary conditions on all slopes (uslp , vslp, 475 415 ! ------------------------------- wslpi, wslpj ) 476 CALL lbc_lnk( uslp , 'U', -1. ) 477 CALL lbc_lnk( vslp , 'V', -1. ) 478 CALL lbc_lnk( wslpi, 'W', -1. ) 479 CALL lbc_lnk( wslpj, 'W', -1. ) 416 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 417 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 418 419 IF(ln_ctl) THEN 420 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 421 CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 422 ENDIF 480 423 481 424 END SUBROUTINE ldf_slp … … 546 489 ! mask for mixed layer 547 490 DO jk = 1, jpk 548 # if defined key_vectopt_loop && ! defined key_ autotasking491 # if defined key_vectopt_loop && ! defined key_mpp_omp 549 492 jj = 1 550 493 DO ji = 1, jpij ! vector opt. (forced unrolling) … … 560 503 omlmask(ji,jj,jk) = 0.e0 561 504 ENDIF 562 # if ! defined key_vectopt_loop || defined key_ autotasking505 # if ! defined key_vectopt_loop || defined key_mpp_omp 563 506 END DO 564 507 # endif … … 578 521 zwy(:,jpj) = 0.e0 579 522 zwy(jpi,:) = 0.e0 580 # if defined key_vectopt_loop && ! defined key_ autotasking523 # if defined key_vectopt_loop && ! defined key_mpp_omp 581 524 jj = 1 582 525 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) … … 591 534 & * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) ) & 592 535 & / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. ) 593 # if ! defined key_vectopt_loop || defined key_ autotasking536 # if ! defined key_vectopt_loop || defined key_mpp_omp 594 537 END DO 595 538 # endif … … 599 542 600 543 ! Slope at u points 601 # if defined key_vectopt_loop && ! defined key_ autotasking544 # if defined key_vectopt_loop && ! defined key_mpp_omp 602 545 jj = 1 603 546 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) … … 616 559 ! uslpml 617 560 uslpml (ji,jj) = zau / ( zbu - zeps ) * umask (ji,jj,ik) 618 # if ! defined key_vectopt_loop || defined key_ autotasking561 # if ! defined key_vectopt_loop || defined key_mpp_omp 619 562 END DO 620 563 # endif … … 628 571 zwy ( :, jpj) = 0.e0 629 572 zwy ( jpi, :) = 0.e0 630 # if defined key_vectopt_loop && ! defined key_ autotasking573 # if defined key_vectopt_loop && ! defined key_mpp_omp 631 574 jj = 1 632 575 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) … … 640 583 & * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) ) & 641 584 & / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. ) 642 # if ! defined key_vectopt_loop || defined key_ autotasking585 # if ! defined key_vectopt_loop || defined key_mpp_omp 643 586 END DO 644 587 # endif … … 649 592 650 593 ! Slope at v points 651 # if defined key_vectopt_loop && ! defined key_ autotasking594 # if defined key_vectopt_loop && ! defined key_mpp_omp 652 595 jj = 1 653 596 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) … … 666 609 ! vslpml 667 610 vslpml (ji,jj) = zav / ( zbv - zeps ) * vmask (ji,jj,ik) 668 # if ! defined key_vectopt_loop || defined key_ autotasking611 # if ! defined key_vectopt_loop || defined key_mpp_omp 669 612 END DO 670 613 # endif … … 680 623 ! Local vertical density gradient evaluated from N^2 681 624 ! zwy = d/dz(prd)= - mk ( prd ) / grav * pn2 -- at w point 682 # if defined key_vectopt_loop && ! defined key_ autotasking625 # if defined key_vectopt_loop && ! defined key_mpp_omp 683 626 jj = 1 684 627 DO ji = 1, jpij ! vector opt. (forced unrolling) … … 692 635 zwy (ji,jj) = zm05g * pn2 (ji,jj,ik) * & 693 636 & ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. ) 694 # if ! defined key_vectopt_loop || defined key_ autotasking637 # if ! defined key_vectopt_loop || defined key_mpp_omp 695 638 END DO 696 639 # endif … … 698 641 699 642 ! Slope at w point 700 # if defined key_vectopt_loop && ! defined key_ autotasking643 # if defined key_vectopt_loop && ! defined key_mpp_omp 701 644 jj = 1 702 645 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) … … 728 671 wslpiml (ji,jj) = zai / ( zbi - zeps) * tmask (ji,jj,ik) 729 672 wslpjml (ji,jj) = zaj / ( zbj - zeps) * tmask (ji,jj,ik) 730 # if ! defined key_vectopt_loop || defined key_ autotasking673 # if ! defined key_vectopt_loop || defined key_mpp_omp 731 674 END DO 732 675 # endif … … 780 723 781 724 IF( ln_traldf_hor ) THEN 725 IF(lwp) THEN 726 WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 727 ENDIF 782 728 783 729 ! geopotential diffusion in s-coordinates on tracers and/or momentum … … 790 736 DO jj = 2, jpjm1 791 737 DO ji = fs_2, fs_jpim1 ! vector opt. 792 uslp (ji,jj,jk) = -1. / e1u(ji,jj) * umask(ji,jj,jk) & 793 & * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) 794 vslp (ji,jj,jk) = -1. / e2v(ji,jj) * vmask(ji,jj,jk) & 795 & * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) 796 wslpi(ji,jj,jk) = -1. / e1t(ji,jj) * tmask(ji,jj,jk) & 797 & * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) ) 798 wslpj(ji,jj,jk) = -1. / e2t(ji,jj) * tmask(ji,jj,jk) & 799 & * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) ) 738 uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk) 739 vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk) 740 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 741 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 800 742 END DO 801 743 END DO … … 803 745 804 746 ! Lateral boundary conditions on the slopes 805 CALL lbc_lnk( uslp , 'U', -1. ) 806 CALL lbc_lnk( vslp , 'V', -1. ) 807 CALL lbc_lnk( wslpi, 'W', -1. ) 808 CALL lbc_lnk( wslpj, 'W', -1. ) 747 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 748 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 809 749 ENDIF 810 750
Note: See TracChangeset
for help on using the changeset viewer.
