- Timestamp:
- 2014-12-02T10:38:20+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r4812 r4946 28 28 USE zdfmxl ! mixed layer depth 29 29 USE eosbn2 ! equation of states 30 ! 31 USE in_out_manager ! I/O manager 30 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 USE in_out_manager ! I/O manager32 33 USE prtctl ! Print control 33 34 USE wrk_nemo ! work arrays … … 139 140 END DO 140 141 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 141 # if defined key_vectopt_loop142 DO jj = 1, 1143 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)144 # else145 142 DO jj = 1, jpjm1 146 143 DO ji = 1, jpim1 147 # endif148 144 ! IF should be useless check zpshde (PM) 149 145 IF ( mbku(ji,jj) > 1 ) zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) … … 304 300 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 305 301 zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp ) 306 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 307 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 302 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) & 303 & + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 304 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) & 305 & + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 308 306 309 307 !!gm modif to suppress omlmask.... (as in Griffies operator) … … 415 413 uslp(ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 416 414 vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 417 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5 418 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5 415 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) & 416 & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5 417 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) & 418 & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5 419 419 END DO 420 420 END DO … … 469 469 REAL(wp) :: zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 470 470 REAL(wp) :: zdzrho_raw 471 REAL(wp) :: zbeta0472 471 REAL(wp), POINTER, DIMENSION(:,:) :: z1_mlbw 473 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalbet474 472 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zdxrho , zdyrho, zdzrho ! Horizontal and vertical density gradients 475 473 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zti_mlb, ztj_mlb ! for Griffies operator only … … 479 477 ! 480 478 CALL wrk_alloc( jpi,jpj, z1_mlbw ) 481 CALL wrk_alloc( jpi,jpj,jpk, zalbet )482 479 CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 ) 483 480 CALL wrk_alloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 ) … … 486 483 ! Some preliminary calculation ! 487 484 !--------------------------------! 488 !489 CALL eos_alpbet( tsb, zalbet, zbeta0 ) !== before local thermal/haline expension ratio at T-points ==!490 485 ! 491 486 DO jl = 0, 1 !== unmasked before density i- j-, k-gradients ==! … … 499 494 zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) ! j-gradient of T & S at v-point 500 495 zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 501 zdxrho_raw = ( - zalbet(ji+ip,jj ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj)502 zdyrho_raw = ( - zalbet(ji ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)503 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( 496 zdxrho_raw = ( - rab_b(ji+ip,jj ,jk,jp_tem) * zdit + rab_b(ji+ip,jj ,jk,jp_sal) * zdis ) / e1u(ji,jj) 497 zdyrho_raw = ( - rab_b(ji ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji ,jj+jp,jk,jp_sal) * zdjs ) / e2v(ji,jj) 498 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 504 499 zdyrho(ji ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 505 500 END DO … … 507 502 END DO 508 503 ! 509 IF( ln_zps.and.l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 510 # if defined key_vectopt_loop 511 DO jj = 1, 1 512 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 513 # else 504 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 514 505 DO jj = 1, jpjm1 515 506 DO ji = 1, jpim1 516 # endif517 507 iku = mbku(ji,jj) ; ikv = mbkv(ji,jj) ! last ocean level (u- & v-points) 518 508 zdit = gtsu(ji,jj,jp_tem) ; zdjt = gtsv(ji,jj,jp_tem) ! i- & j-gradient of Temperature 519 509 zdis = gtsu(ji,jj,jp_sal) ; zdjs = gtsv(ji,jj,jp_sal) ! i- & j-gradient of Salinity 520 zdxrho_raw = ( - zalbet(ji+ip,jj ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj)521 zdyrho_raw = ( - zalbet(ji ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)510 zdxrho_raw = ( - rab_b(ji+ip,jj ,iku,jp_tem) * zdit + rab_b(ji+ip,jj ,iku,jp_sal) * zdis ) / e1u(ji,jj) 511 zdyrho_raw = ( - rab_b(ji ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji ,jj+jp,ikv,jp_sal) * zdjs ) / e2v(ji,jj) 522 512 zdxrho(ji+ip,jj ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 523 513 zdyrho(ji ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) … … 539 529 zdks = 0._wp 540 530 ENDIF 541 zdzrho_raw = ( - zalbet(ji ,jj ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp)542 zdzrho(ji ,jj ,jk, kp) = - MIN( - repsln,zdzrho_raw ) ! force zdzrho >= repsln531 zdzrho_raw = ( - rab_b(ji,jj,jk,jp_tem) * zdkt + rab_b(ji,jj,jk,jp_sal) * zdks ) / fse3w(ji,jj,jk+kp) 532 zdzrho(ji,jj,jk,kp) = - MIN( - repsln, zdzrho_raw ) ! force zdzrho >= repsln 543 533 END DO 544 534 END DO … … 684 674 ! 685 675 CALL wrk_dealloc( jpi,jpj, z1_mlbw ) 686 CALL wrk_dealloc( jpi,jpj,jpk, zalbet )687 676 CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 ) 688 677 CALL wrk_dealloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 ) … … 735 724 ! !== surface mixed layer mask ! 736 725 DO jk = 1, jpk ! =1 inside the mixed layer, =0 otherwise 737 # if defined key_vectopt_loop738 DO jj = 1, 1739 DO ji = 1, jpij ! vector opt. (forced unrolling)740 # else741 726 DO jj = 1, jpj 742 727 DO ji = 1, jpi 743 # endif744 728 ik = nmln(ji,jj) - 1 745 729 IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN ; omlmask(ji,jj,jk) = 1._wp … … 761 745 !----------------------------------------------------------------------- 762 746 ! 763 # if defined key_vectopt_loop764 DO jj = 1, 1765 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)766 # else767 747 DO jj = 2, jpjm1 768 748 DO ji = 2, jpim1 769 # endif770 749 ! !== Slope at u- & v-points just below the Mixed Layer ==! 771 750 !
Note: See TracChangeset
for help on using the changeset viewer.
