Changeset 3598 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
- Timestamp:
- 2012-11-19T14:35:09+01:00 (11 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90 (modified) (40 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r3294 r3598 8 8 !! NEMO 1.0 ! 2002-08 (G. Madec) free form + modules 9 9 !! - ! 2004-01 (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl 10 !! 3.3 ! 2009-11 (G. Madec) merge trabbl and trabbl_adv + style + optimization 11 !! - ! 2010-04 (G. Madec) Campin & Goosse advective bbl 10 !! 3.3 ! 2009-11 (G. Madec) merge trabbl and trabbl_adv + style + optimization 11 !! - ! 2010-04 (G. Madec) Campin & Goosse advective bbl 12 12 !! - ! 2010-06 (C. Ethe, G. Madec) merge TRA-TRC 13 13 !! - ! 2010-11 (G. Madec) add mbk. arrays associated to the deepest ocean level … … 30 30 USE trdmod_oce ! trends: ocean variables 31 31 USE trdtra ! trends: active tracers 32 USE iom ! IOM server 32 USE iom ! IOM server 33 33 USE in_out_manager ! I/O manager 34 34 USE lbclnk ! ocean lateral boundary conditions … … 49 49 LOGICAL, PUBLIC, PARAMETER :: lk_trabbl = .TRUE. !: bottom boundary layer flag 50 50 51 ! !!* Namelist nambbl * 51 ! !!* Namelist nambbl * 52 52 INTEGER , PUBLIC :: nn_bbl_ldf = 0 !: =1 : diffusive bbl or not (=0) 53 53 INTEGER , PUBLIC :: nn_bbl_adv = 0 !: =1/2 : advective bbl or not (=0) … … 58 58 59 59 LOGICAL , PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 60 60 61 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: utr_bbl , vtr_bbl ! u- (v-) transport in the bottom boundary layer 62 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: ahu_bbl , ahv_bbl ! masked diffusive bbl coeff. at u & v-pts 63 63 64 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbku_d , mbkv_d ! vertical index of the "lower" bottom ocean U/V-level65 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: mgrhu , mgrhv ! = +/-1, sign of grad(H) in u-(v-)direction66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_0, ahv_bbl_0 ! diffusive bbl flux coefficients at u and v-points67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3u_bbl_0, e3v_bbl_0 ! thichness of the bbl (e3) at u and v-points68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_e1e2t ! inverse of the cell surface at t-point [1/m2]64 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: mbku_d , mbkv_d ! vertical index of the "lower" bottom ocean U/V-level (PUBLIC for TAM) 65 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: mgrhu , mgrhv ! = +/-1, sign of grad(H) in u-(v-)direction (PUBLIC for TAM) 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_0, ahv_bbl_0 ! diffusive bbl flux coefficients at u and v-points 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: e3u_bbl_0, e3v_bbl_0 ! thichness of the bbl (e3) at u and v-points (PUBLIC for TAM) 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: r1_e1e2t ! inverse of the cell surface at t-point [1/m2] (PUBLIC for TAM) 69 69 70 70 !! * Substitutions … … 95 95 !!---------------------------------------------------------------------- 96 96 !! *** ROUTINE bbl *** 97 !! 98 !! ** Purpose : Compute the before tracer (t & s) trend associated 97 !! 98 !! ** Purpose : Compute the before tracer (t & s) trend associated 99 99 !! with the bottom boundary layer and add it to the general 100 100 !! trend of tracer equations. … … 103 103 !! diffusive and/or advective contribution to the tracer trend 104 104 !! is added to the general tracer trend 105 !!---------------------------------------------------------------------- 106 INTEGER, INTENT( in ) :: kt ! ocean time-step 105 !!---------------------------------------------------------------------- 106 INTEGER, INTENT( in ) :: kt ! ocean time-step 107 107 !! 108 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds … … 112 112 ! 113 113 IF( l_trdtra ) THEN !* Save ta and sa trends 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 115 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 115 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 116 116 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 117 117 ENDIF 118 118 119 119 IF( l_bbl ) CALL bbl( kt, nit000, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl) 120 120 121 121 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl 122 122 ! … … 125 125 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & 126 126 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 127 ! lateral boundary conditions ; just need for outputs 127 ! lateral boundary conditions ; just need for outputs 128 128 CALL lbc_lnk( ahu_bbl, 'U', 1. ) ; CALL lbc_lnk( ahv_bbl, 'V', 1. ) 129 CALL iom_put( "ahu_bbl", ahu_bbl ) ! bbl diffusive flux i-coef 129 CALL iom_put( "ahu_bbl", ahu_bbl ) ! bbl diffusive flux i-coef 130 130 CALL iom_put( "ahv_bbl", ahv_bbl ) ! bbl diffusive flux j-coef 131 131 ! … … 138 138 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv - Ta: ', mask1=tmask, & 139 139 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 140 ! lateral boundary conditions ; just need for outputs 140 ! lateral boundary conditions ; just need for outputs 141 141 CALL lbc_lnk( utr_bbl, 'U', 1. ) ; CALL lbc_lnk( vtr_bbl, 'V', 1. ) 142 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 142 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 143 143 CALL iom_put( "voce_bbl", vtr_bbl ) ! bbl j-transport 144 144 ! … … 150 150 CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbl, ztrdt ) 151 151 CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_bbl, ztrds ) 152 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 152 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 153 153 ENDIF 154 154 ! … … 161 161 !!---------------------------------------------------------------------- 162 162 !! *** ROUTINE tra_bbl_dif *** 163 !! 163 !! 164 164 !! ** Purpose : Computes the bottom boundary horizontal and vertical 165 !! advection terms. 166 !! 167 !! ** Method : 165 !! advection terms. 166 !! 167 !! ** Method : 168 168 !! * diffusive bbl (nn_bbl_ldf=1) : 169 169 !! When the product grad( rho) * grad(h) < 0 (where grad is an … … 179 179 !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 180 180 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 181 !!---------------------------------------------------------------------- 181 !!---------------------------------------------------------------------- 182 182 ! 183 183 INTEGER , INTENT(in ) :: kjpt ! number of tracers 184 184 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 185 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 185 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 186 186 ! 187 187 INTEGER :: ji, jj, jn ! dummy loop indices … … 202 202 #else 203 203 DO jj = 1, jpj 204 DO ji = 1, jpi 204 DO ji = 1, jpi 205 205 #endif 206 206 ik = mbkt(ji,jj) ! bottom T-level index … … 233 233 ! 234 234 END SUBROUTINE tra_bbl_dif 235 235 236 236 237 237 SUBROUTINE tra_bbl_adv( ptb, pta, kjpt ) … … 239 239 !! *** ROUTINE trc_bbl *** 240 240 !! 241 !! ** Purpose : Compute the before passive tracer trend associated 241 !! ** Purpose : Compute the before passive tracer trend associated 242 242 !! with the bottom boundary layer and add it to the general trend 243 243 !! of tracer equations. 244 244 !! ** Method : advective bbl (nn_bbl_adv = 1 or 2) : 245 245 !! nn_bbl_adv = 1 use of the ocean near bottom velocity as bbl velocity 246 !! nn_bbl_adv = 2 follow Campin and Goosse (1999) implentation i.e. 247 !! transport proportional to the along-slope density gradient 246 !! nn_bbl_adv = 2 follow Campin and Goosse (1999) implentation i.e. 247 !! transport proportional to the along-slope density gradient 248 248 !! 249 249 !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 250 250 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 251 !!---------------------------------------------------------------------- 251 !!---------------------------------------------------------------------- 252 252 INTEGER , INTENT(in ) :: kjpt ! number of tracers 253 253 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 254 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 254 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 255 255 ! 256 256 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 264 264 ! ! =========== 265 265 DO jn = 1, kjpt ! tracer loop 266 ! ! =========== 266 ! ! =========== 267 267 # if defined key_vectopt_loop 268 268 DO jj = 1, 1 … … 282 282 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 283 283 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 284 ! 284 ! 285 285 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 286 286 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) … … 288 288 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 289 289 END DO 290 ! 290 ! 291 291 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 292 292 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr … … 299 299 ikvd = mbkv_d(ji,jj) ; ikvs = mbkv(ji,jj) 300 300 zv_bbl = ABS( vtr_bbl(ji,jj) ) 301 ! 301 ! 302 302 ! up -slope T-point (shelf bottom point) 303 303 zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 304 304 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 305 305 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 306 ! 306 ! 307 307 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 308 308 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) … … 330 330 !!---------------------------------------------------------------------- 331 331 !! *** ROUTINE bbl *** 332 !! 332 !! 333 333 !! ** Purpose : Computes the bottom boundary horizontal and vertical 334 !! advection terms. 335 !! 336 !! ** Method : 334 !! advection terms. 335 !! 336 !! ** Method : 337 337 !! * diffusive bbl (nn_bbl_ldf=1) : 338 338 !! When the product grad( rho) * grad(h) < 0 (where grad is an … … 353 353 !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 354 354 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 355 !!---------------------------------------------------------------------- 355 !!---------------------------------------------------------------------- 356 356 ! 357 357 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 399 399 - 0.121555e-07 ) * pfh 400 400 !!---------------------------------------------------------------------- 401 401 402 402 ! 403 403 IF( nn_timing == 1 ) CALL timing_start( 'bbl') 404 404 ! 405 CALL wrk_alloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 406 ! 407 405 CALL wrk_alloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 406 ! 407 408 408 IF( kt == kit000 ) THEN 409 409 IF(lwp) WRITE(numout,*) … … 411 411 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 412 412 ENDIF 413 413 414 414 ! !* bottom temperature, salinity, velocity and depth 415 415 #if defined key_vectopt_loop … … 426 426 ! 427 427 zub(ji,jj) = un(ji,jj,mbku(ji,jj)) ! bottom velocity 428 zvb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 428 zvb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 429 429 END DO 430 430 END DO 431 431 432 432 ! !-------------------! 433 433 IF( nn_bbl_ldf == 1 ) THEN ! diffusive bbl ! 434 434 ! !-------------------! 435 435 DO jj = 1, jpjm1 ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 436 DO ji = 1, jpim1 437 ! ! i-direction 436 DO ji = 1, jpim1 437 ! ! i-direction 438 438 zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) ) ! T, S anomalie, and depth 439 439 zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0 … … 442 442 zgdrho = ( fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) ) & 443 443 & - ( zsb(ji+1,jj) - zsb(ji,jj) ) ) * umask(ji,jj,1) 444 ! 444 ! 445 445 zsign = SIGN( 0.5, - zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of ( i-gradient * i-slope ) 446 446 ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj) ! masked diffusive flux coeff. 447 447 ! 448 ! ! j-direction 448 ! ! j-direction 449 449 zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) ) ! T, S anomalie, and depth 450 450 zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0 … … 453 453 zgdrho = ( fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) ) & 454 454 & - ( zsb(ji,jj+1) - zsb(ji,jj) ) ) * vmask(ji,jj,1) 455 ! 455 ! 456 456 zsign = SIGN( 0.5, -zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of ( j-gradient * j-slope ) 457 457 ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) … … 475 475 zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 476 476 ! ! masked bbl i-gradient of density 477 zgdrho = ( fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) ) & 477 zgdrho = ( fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) ) & 478 478 & - ( zsb(ji+1,jj) - zsb(ji,jj) ) ) * umask(ji,jj,1) 479 ! 479 ! 480 480 zsign = SIGN( 0.5, - zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of i-gradient * i-slope 481 481 zsigna= SIGN( 0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) ) ) ! sign of u * i-slope … … 489 489 zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 490 490 ! ! masked bbl j-gradient of density 491 zgdrho = ( fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) ) & 491 zgdrho = ( fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) ) & 492 492 & - ( zsb(ji,jj+1) - zsb(ji,jj) ) ) * vmask(ji,jj,1) 493 493 zsign = SIGN( 0.5, - zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of j-gradient * j-slope … … 513 513 zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 514 514 zgdrho = fsbeta( zt, zs, zh ) & 515 & * ( fsalbt( zt, zs, zh ) * ( ztb(iid,jj) - ztb(iis,jj) ) & 515 & * ( fsalbt( zt, zs, zh ) * ( ztb(iid,jj) - ztb(iis,jj) ) & 516 516 & - ( zsb(iid,jj) - zsb(iis,jj) ) ) * umask(ji,jj,1) 517 517 zgdrho = MAX( 0.e0, zgdrho ) ! only if shelf is denser than deep … … 530 530 zh = 0.5 * ( zdep(ji,jj) + zdep(ji,jj+1) ) 531 531 zgdrho = fsbeta( zt, zs, zh ) & 532 & * ( fsalbt( zt, zs, zh ) * ( ztb(ji,ijd) - ztb(ji,ijs) ) & 532 & * ( fsalbt( zt, zs, zh ) * ( ztb(ji,ijd) - ztb(ji,ijs) ) & 533 533 & - ( zsb(ji,ijd) - zsb(ji,ijs) ) ) * vmask(ji,jj,1) 534 534 zgdrho = MAX( 0.e0, zgdrho ) ! only if shelf is denser than deep … … 542 542 ENDIF 543 543 ! 544 CALL wrk_dealloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 544 CALL wrk_dealloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 545 545 ! 546 546 IF( nn_timing == 1 ) CALL timing_stop( 'bbl') … … 567 567 IF( nn_timing == 1 ) CALL timing_start( 'tra_bbl_init') 568 568 ! 569 CALL wrk_alloc( jpi, jpj, zmbk ) 569 CALL wrk_alloc( jpi, jpj, zmbk ) 570 570 ! 571 571 … … 588 588 ! ! allocate trabbl arrays 589 589 IF( tra_bbl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' ) 590 590 591 591 IF( nn_bbl_adv == 1 ) WRITE(numout,*) ' * Advective BBL using upper velocity' 592 592 IF( nn_bbl_adv == 2 ) WRITE(numout,*) ' * Advective BBL using velocity = F( delta rho)' … … 597 597 ! !* inverse of surface of T-cells 598 598 r1_e1e2t(:,:) = 1._wp / ( e1t(:,:) * e2t(:,:) ) 599 599 600 600 ! !* vertical index of "deep" bottom u- and v-points 601 601 DO jj = 1, jpjm1 ! (the "shelf" bottom k-indices are mbku and mbkv) … … 605 605 END DO 606 606 END DO 607 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 607 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 608 608 zmbk(:,:) = REAL( mbku_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'U',1.) ; mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 609 609 zmbk(:,:) = REAL( mbkv_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) … … 611 611 !* sign of grad(H) at u- and v-points 612 612 mgrhu(jpi,:) = 0. ; mgrhu(:,jpj) = 0. ; mgrhv(jpi,:) = 0. ; mgrhv(:,jpj) = 0. 613 DO jj = 1, jpjm1 613 DO jj = 1, jpjm1 614 614 DO ji = 1, jpim1 615 615 mgrhu(ji,jj) = INT( SIGN( 1.e0, fsdept_0(ji+1,jj,mbkt(ji+1,jj)) - fsdept_0(ji,jj,mbkt(ji,jj)) ) ) … … 618 618 END DO 619 619 620 DO jj = 1, jpjm1 !* bbl thickness at u- (v-) point 620 DO jj = 1, jpjm1 !* bbl thickness at u- (v-) point 621 621 DO ji = 1, jpim1 ! minimum of top & bottom e3u_0 (e3v_0) 622 e3u_bbl_0(ji,jj) = MIN( fse3u_0(ji,jj,mbkt(ji+1,jj )), fse3u_0(ji,jj,mbkt(ji,jj)) ) 623 e3v_bbl_0(ji,jj) = MIN( fse3v_0(ji,jj,mbkt(ji ,jj+1)), fse3v_0(ji,jj,mbkt(ji,jj)) ) 624 END DO 622 e3u_bbl_0(ji,jj) = MIN( fse3u_0(ji,jj,mbkt(ji+1,jj )), fse3u_0(ji,jj,mbkt(ji,jj)) ) 623 e3v_bbl_0(ji,jj) = MIN( fse3v_0(ji,jj,mbkt(ji ,jj+1)), fse3v_0(ji,jj,mbkt(ji,jj)) ) 624 END DO 625 625 END DO 626 626 CALL lbc_lnk( e3u_bbl_0, 'U', 1. ) ; CALL lbc_lnk( e3v_bbl_0, 'V', 1. ) ! lateral boundary conditions 627 627 628 ! !* masked diffusive flux coefficients 628 ! !* masked diffusive flux coefficients 629 629 ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:) * umask(:,:,1) 630 630 ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:) * vmask(:,:,1) … … 636 636 CASE ( 2 ) ! ORCA_R2 637 637 ij0 = 102 ; ij1 = 102 ! Gibraltar enhancement of BBL 638 ii0 = 139 ; ii1 = 140 638 ii0 = 139 ; ii1 = 140 639 639 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 640 640 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) … … 647 647 CASE ( 4 ) ! ORCA_R4 648 648 ij0 = 52 ; ij1 = 52 ! Gibraltar enhancement of BBL 649 ii0 = 70 ; ii1 = 71 649 ii0 = 70 ; ii1 = 71 650 650 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 651 651 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) … … 654 654 ENDIF 655 655 ! 656 CALL wrk_dealloc( jpi, jpj, zmbk ) 656 CALL wrk_dealloc( jpi, jpj, zmbk ) 657 657 ! 658 658 IF( nn_timing == 1 ) CALL timing_stop( 'tra_bbl_init')
Note: See TracChangeset
for help on using the changeset viewer.
