Changeset 461 for trunk/NEMO/OPA_SRC/LDF/ldfslp.F90
- Timestamp:
- 2006-05-10T19:15:54+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/LDF/ldfslp.F90 (modified) (27 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/LDF/ldfslp.F90
r258 r461 49 49 !!---------------------------------------------------------------------- 50 50 !! OPA 9.0 , LOCEAN-IPSL (2005) 51 !! $Header$52 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt53 51 !!---------------------------------------------------------------------- 54 52 … … 71 69 !! of 10cm/s) 72 70 !! A horizontal shapiro filter is applied to the slopes 73 !! 'key_s_coord' defined:add to the previously computed slopes71 !! ln_sco=T, s-coordinate, add to the previously computed slopes 74 72 !! the slope of the model level surface. 75 73 !! macro-tasked on horizontal slab (jk-loop) (2, jpk-1) 76 74 !! [slopes already set to zero at level 1, and to zero or the ocean 77 !! bottom slope ( 'key_s_coord' defined) at level jpk in inildf]75 !! bottom slope (ln_sco=T) at level jpk in inildf] 78 76 !! 79 77 !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and j-slopes … … 85 83 !! 8.1 ! 99-10 (A. Jouzeau) NEW profile 86 84 !! 8.5 ! 99-10 (G. Madec) Free form, F90 85 !! 9.0 ! 05-10 (A. Beckmann) correction for s-coordinates 87 86 !!---------------------------------------------------------------------- 88 87 !! * Modules used … … 99 98 !! * Local declarations 100 99 INTEGER :: ji, jj, jk ! dummy loop indices 101 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integer 102 #if defined key_partial_steps 103 INTEGER :: iku, ikv ! temporary integers 104 #endif 100 INTEGER :: ii0, ii1, ij0, ij1, & ! temporary integer 101 & iku, ikv ! " " 105 102 REAL(wp) :: & 106 zeps, zmg, zm05g, zcoef1, zcoef2, & ! temporary scalars 107 zau, zbu, zav, zbv, & 108 zai, zbi, zaj, zbj, & 109 zcofu, zcofv, zcofw, & 110 z1u, z1v, z1wu, z1wv, & 103 zeps, zmg, zm05g, & ! temporary scalars 104 zcoef1, zcoef2, zcoef3, & ! 105 zau, zbu, zav, zbv, & 106 zai, zbi, zaj, zbj, & 107 zcofu, zcofv, zcofw, & 108 z1u, z1v, z1wu, z1wv, & 111 109 zalpha 112 110 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zww … … 140 138 END DO 141 139 142 #if defined key_partial_steps 143 ! partial steps correction at the bottom ocean level (zps_hde routine) 144 # if defined key_vectopt_loop && ! defined key_autotasking 145 jj = 1 146 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 140 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level (zps_hde routine) 141 # if defined key_vectopt_loop && ! defined key_mpp_omp 142 jj = 1 143 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 147 144 # else 148 DO jj = 1, jpjm1149 DO ji = 1, jpim1150 # endif 151 ! last ocean level152 iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1153 ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1154 zgru(ji,jj,iku) = gru(ji,jj)155 zgrv(ji,jj,ikv) = grv(ji,jj)156 # if ! defined key_vectopt_loop || defined key_ autotasking157 END DO158 # endif 159 END DO160 #endif 145 DO jj = 1, jpjm1 146 DO ji = 1, jpim1 147 # endif 148 ! last ocean level 149 iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1 150 ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1 151 zgru(ji,jj,iku) = gru(ji,jj) 152 zgrv(ji,jj,ikv) = grv(ji,jj) 153 # if ! defined key_vectopt_loop || defined key_mpp_omp 154 END DO 155 # endif 156 END DO 157 ENDIF 161 158 162 159 ! Slopes of isopycnal surfaces just below the mixed layer … … 205 202 ! uslp and vslp output in zwz and zww, resp. 206 203 zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 207 #if defined key_s_coord208 204 zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha) & 209 & + zalpha * uslpml(ji,jj) & 210 & * ( fsdepu(ji,jj,jk) - .5*fse3u(ji,jj,1) ) & 211 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5. ) ) & 212 & * umask(ji,jj,jk) 205 & + zalpha * uslpml(ji,jj) & 206 & * 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) & 207 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5. ) ) * umask(ji,jj,jk) 213 208 zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 214 209 zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha) & 215 & + zalpha * vslpml(ji,jj) & 216 & * ( fsdepv(ji,jj,jk) - .5*fse3v(ji,jj,1) ) & 217 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) & 218 & * vmask(ji,jj,jk) 219 #else 220 ! z-coord and partial steps slope computed in the same way 221 zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha) & 222 & + zalpha * uslpml(ji,jj) & 223 & * ( fsdept(ji,jj,jk) - .5*fse3u(ji,jj,1)) & 224 & / MAX (hmlpt(ji,jj),hmlpt(ji+1,jj),5.) ) & 225 & * umask (ji,jj,jk) 226 zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj+1,jk)) 227 zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha) & 228 & + zalpha * vslpml(ji,jj) & 229 & * ( fsdept(ji,jj,jk) - .5*fse3v(ji,jj,1)) & 230 & / MAX(hmlpt(ji,jj),hmlpt(ji,jj+1),5.) ) & 231 & * vmask (ji,jj,jk) 232 #endif 210 & + zalpha * vslpml(ji,jj) & 211 & * 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) & 212 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 233 213 END DO 234 214 END DO … … 294 274 END DO 295 275 END DO 296 297 298 IF( lk_sco ) THEN299 ! Add the slope of level surfaces300 ! -----------------------------------301 ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done302 ! in inildf, ldfslp never called303 ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces304 ! is added to the slope of isopycnal surfaces.305 ! c a u t i o n : minus sign as fsdep has positive value306 307 DO jj = 2, jpjm1308 DO ji = fs_2, fs_jpim1 ! vector opt.309 uslp(ji,jj,jk) = uslp(ji,jj,jk) - 1. / e1u(ji,jj) &310 & * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) )311 vslp(ji,jj,jk) = vslp(ji,jj,jk) - 1. / e2v(ji,jj) &312 & * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) )313 END DO314 END DO315 ENDIF316 276 317 277 … … 356 316 zbj = MIN( zwy (ji,jj,jk), -100.*ABS(zaj), -7.e+3/fse3w(ji,jj,jk)*ABS(zaj) ) 357 317 ! wslpi and wslpj output in zwz and zww, resp. 358 zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj,jk-1)) 359 zwz(ji,jj,jk) = ( zai / ( zbi - zeps) * ( 1. - zalpha ) & 360 & + zalpha * wslpiml(ji,jj) & 361 & * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) ) & 362 & * tmask (ji,jj,jk) 363 zww(ji,jj,jk) = ( zaj / ( zbj - zeps) * ( 1. - zalpha ) & 364 & + zalpha * wslpjml(ji,jj) & 365 & * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) ) & 366 & * tmask (ji,jj,jk) 318 zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) 319 zcoef3 = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. ) 320 zwz(ji,jj,jk) = ( zai / ( zbi - zeps) * ( 1. - zalpha ) & 321 & + zcoef3 * wslpiml(ji,jj) * zalpha ) * tmask (ji,jj,jk) 322 zww(ji,jj,jk) = ( zaj / ( zbj - zeps) * ( 1. - zalpha ) & 323 & + zcoef3 * wslpjml(ji,jj) * zalpha ) * tmask (ji,jj,jk) 367 324 END DO 368 325 END DO … … 426 383 END DO 427 384 428 IF( lk_sco ) THEN429 430 ! Slope of level surfaces431 ! -----------------------432 ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done433 ! in inildf, ldfslp never called434 ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces435 ! is added to the slope of isopycnal surfaces.436 437 DO jj = 2, jpjm1438 DO ji = fs_2, fs_jpim1 ! vector opt.439 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) - 1. / e1t(ji,jj) &440 & * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) )441 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) - 1. / e2t(ji,jj) &442 & * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) )443 END DO444 END DO445 ENDIF446 385 447 386 ! III. Specific grid points … … 476 415 ! III Lateral boundary conditions on all slopes (uslp , vslp, 477 416 ! ------------------------------- wslpi, wslpj ) 478 CALL lbc_lnk( uslp , 'U', -1. ) 479 CALL lbc_lnk( vslp , 'V', -1. ) 480 CALL lbc_lnk( wslpi, 'W', -1. ) 481 CALL lbc_lnk( wslpj, 'W', -1. ) 417 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 418 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 482 419 483 420 IF(ln_ctl) THEN … … 553 490 ! mask for mixed layer 554 491 DO jk = 1, jpk 555 # if defined key_vectopt_loop && ! defined key_ autotasking492 # if defined key_vectopt_loop && ! defined key_mpp_omp 556 493 jj = 1 557 494 DO ji = 1, jpij ! vector opt. (forced unrolling) … … 567 504 omlmask(ji,jj,jk) = 0.e0 568 505 ENDIF 569 # if ! defined key_vectopt_loop || defined key_ autotasking506 # if ! defined key_vectopt_loop || defined key_mpp_omp 570 507 END DO 571 508 # endif … … 585 522 zwy(:,jpj) = 0.e0 586 523 zwy(jpi,:) = 0.e0 587 # if defined key_vectopt_loop && ! defined key_ autotasking524 # if defined key_vectopt_loop && ! defined key_mpp_omp 588 525 jj = 1 589 526 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) … … 598 535 & * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) ) & 599 536 & / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. ) 600 # if ! defined key_vectopt_loop || defined key_ autotasking537 # if ! defined key_vectopt_loop || defined key_mpp_omp 601 538 END DO 602 539 # endif … … 606 543 607 544 ! Slope at u points 608 # if defined key_vectopt_loop && ! defined key_ autotasking545 # if defined key_vectopt_loop && ! defined key_mpp_omp 609 546 jj = 1 610 547 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) … … 623 560 ! uslpml 624 561 uslpml (ji,jj) = zau / ( zbu - zeps ) * umask (ji,jj,ik) 625 # if ! defined key_vectopt_loop || defined key_ autotasking562 # if ! defined key_vectopt_loop || defined key_mpp_omp 626 563 END DO 627 564 # endif … … 635 572 zwy ( :, jpj) = 0.e0 636 573 zwy ( jpi, :) = 0.e0 637 # if defined key_vectopt_loop && ! defined key_ autotasking574 # if defined key_vectopt_loop && ! defined key_mpp_omp 638 575 jj = 1 639 576 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) … … 647 584 & * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) ) & 648 585 & / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. ) 649 # if ! defined key_vectopt_loop || defined key_ autotasking586 # if ! defined key_vectopt_loop || defined key_mpp_omp 650 587 END DO 651 588 # endif … … 656 593 657 594 ! Slope at v points 658 # if defined key_vectopt_loop && ! defined key_ autotasking595 # if defined key_vectopt_loop && ! defined key_mpp_omp 659 596 jj = 1 660 597 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) … … 673 610 ! vslpml 674 611 vslpml (ji,jj) = zav / ( zbv - zeps ) * vmask (ji,jj,ik) 675 # if ! defined key_vectopt_loop || defined key_ autotasking612 # if ! defined key_vectopt_loop || defined key_mpp_omp 676 613 END DO 677 614 # endif … … 687 624 ! Local vertical density gradient evaluated from N^2 688 625 ! zwy = d/dz(prd)= - mk ( prd ) / grav * pn2 -- at w point 689 # if defined key_vectopt_loop && ! defined key_ autotasking626 # if defined key_vectopt_loop && ! defined key_mpp_omp 690 627 jj = 1 691 628 DO ji = 1, jpij ! vector opt. (forced unrolling) … … 699 636 zwy (ji,jj) = zm05g * pn2 (ji,jj,ik) * & 700 637 & ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. ) 701 # if ! defined key_vectopt_loop || defined key_ autotasking638 # if ! defined key_vectopt_loop || defined key_mpp_omp 702 639 END DO 703 640 # endif … … 705 642 706 643 ! Slope at w point 707 # if defined key_vectopt_loop && ! defined key_ autotasking644 # if defined key_vectopt_loop && ! defined key_mpp_omp 708 645 jj = 1 709 646 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) … … 735 672 wslpiml (ji,jj) = zai / ( zbi - zeps) * tmask (ji,jj,ik) 736 673 wslpjml (ji,jj) = zaj / ( zbj - zeps) * tmask (ji,jj,ik) 737 # if ! defined key_vectopt_loop || defined key_ autotasking674 # if ! defined key_vectopt_loop || defined key_mpp_omp 738 675 END DO 739 676 # endif … … 787 724 788 725 IF( ln_traldf_hor .OR. ln_dynldf_hor ) THEN 726 IF(lwp) THEN 727 WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 728 ENDIF 789 729 790 730 ! geopotential diffusion in s-coordinates on tracers and/or momentum … … 797 737 DO jj = 2, jpjm1 798 738 DO ji = fs_2, fs_jpim1 ! vector opt. 799 uslp (ji,jj,jk) = -1. / e1u(ji,jj) * umask(ji,jj,jk) & 800 & * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) 801 vslp (ji,jj,jk) = -1. / e2v(ji,jj) * vmask(ji,jj,jk) & 802 & * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) 803 wslpi(ji,jj,jk) = -1. / e1t(ji,jj) * tmask(ji,jj,jk) & 804 & * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) ) 805 wslpj(ji,jj,jk) = -1. / e2t(ji,jj) * tmask(ji,jj,jk) & 806 & * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) ) 739 uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk) 740 vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk) 741 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 742 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 807 743 END DO 808 744 END DO … … 810 746 811 747 ! Lateral boundary conditions on the slopes 812 CALL lbc_lnk( uslp , 'U', -1. ) 813 CALL lbc_lnk( vslp , 'V', -1. ) 814 CALL lbc_lnk( wslpi, 'W', -1. ) 815 CALL lbc_lnk( wslpj, 'W', -1. ) 748 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 749 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 816 750 ENDIF 817 751
Note: See TracChangeset
for help on using the changeset viewer.
