- Timestamp:
- 2017-12-01T18:44:09+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r8509 r8882 13 13 !! - ! 2010-11 (G. Madec) add mbk. arrays associated to the deepest ocean level 14 14 !! - ! 2013-04 (F. Roquet, G. Madec) use of eosbn2 instead of local hard coded alpha and beta 15 !! 4.0 ! 2017-04 (G. Madec) ln_trabbl namelist variable instead of a CPP key 15 16 !!---------------------------------------------------------------------- 16 #if defined key_trabbl 17 !!---------------------------------------------------------------------- 18 !! 'key_trabbl' or bottom boundary layer 17 19 18 !!---------------------------------------------------------------------- 20 19 !! tra_bbl_alloc : allocate trabbl arrays … … 36 35 USE lbclnk ! ocean lateral boundary conditions 37 36 USE prtctl ! Print control 38 USE wrk_nemo ! Memory Allocation39 37 USE timing ! Timing 40 38 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 49 47 PUBLIC bbl ! routine called by trcbbl.F90 and dtadyn.F90 50 48 51 LOGICAL, PUBLIC, PARAMETER :: lk_trabbl = .TRUE. !: bottom boundary layer flag52 53 49 ! !!* Namelist nambbl * 50 LOGICAL , PUBLIC :: ln_trabbl !: bottom boundary layer flag 54 51 INTEGER , PUBLIC :: nn_bbl_ldf !: =1 : diffusive bbl or not (=0) 55 52 INTEGER , PUBLIC :: nn_bbl_adv !: =1/2 : advective bbl or not (=0) … … 82 79 !! *** FUNCTION tra_bbl_alloc *** 83 80 !!---------------------------------------------------------------------- 84 ALLOCATE( utr_bbl (jpi,jpj) , ahu_bbl (jpi,jpj) , mbku_d 85 & vtr_bbl (jpi,jpj) , ahv_bbl (jpi,jpj) , mbkv_d 86 & ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) , 87 & e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , 81 ALLOCATE( utr_bbl (jpi,jpj) , ahu_bbl (jpi,jpj) , mbku_d(jpi,jpj) , mgrhu(jpi,jpj) , & 82 & vtr_bbl (jpi,jpj) , ahv_bbl (jpi,jpj) , mbkv_d(jpi,jpj) , mgrhv(jpi,jpj) , & 83 & ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) , & 84 & e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , STAT=tra_bbl_alloc ) 88 85 ! 89 86 IF( lk_mpp ) CALL mpp_sum ( tra_bbl_alloc ) … … 106 103 INTEGER, INTENT( in ) :: kt ! ocean time-step 107 104 ! 108 REAL(wp), POINTER, DIMENSION(:,:,:) ::ztrdt, ztrds109 !!---------------------------------------------------------------------- 110 ! 111 IF( nn_timing == 1 )CALL timing_start( 'tra_bbl')112 ! 113 IF( l_trdtra ) THEN !* Save the input trends114 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds)105 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 106 !!---------------------------------------------------------------------- 107 ! 108 IF( ln_timing ) CALL timing_start( 'tra_bbl') 109 ! 110 IF( l_trdtra ) THEN !* Save the T-S input trends 111 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 115 112 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 116 113 ztrds(:,:,:) = tsa(:,:,:,jp_sal) … … 150 147 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 151 148 CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 152 CALL wrk_dealloc( jpi, jpj, jpk,ztrdt, ztrds )153 ENDIF 154 ! 155 IF( nn_timing == 1) CALL timing_stop( 'tra_bbl')149 DEALLOCATE( ztrdt, ztrds ) 150 ENDIF 151 ! 152 IF( ln_timing ) CALL timing_stop( 'tra_bbl') 156 153 ! 157 154 END SUBROUTINE tra_bbl … … 186 183 INTEGER :: ik ! local integers 187 184 REAL(wp) :: zbtr ! local scalars 188 REAL(wp), POINTER, DIMENSION(:,:) :: zptb 189 !!---------------------------------------------------------------------- 190 ! 191 IF( nn_timing == 1 ) CALL timing_start('tra_bbl_dif') 192 ! 193 CALL wrk_alloc( jpi, jpj, zptb ) 185 REAL(wp), DIMENSION(jpi,jpj) :: zptb ! workspace 186 !!---------------------------------------------------------------------- 187 ! 188 IF( ln_timing ) CALL timing_start('tra_bbl_dif') 194 189 ! 195 190 DO jn = 1, kjpt ! tracer loop … … 216 211 END DO ! end tracer 217 212 ! ! =========== 218 CALL wrk_dealloc( jpi, jpj, zptb ) 219 ! 220 IF( nn_timing == 1 ) CALL timing_stop('tra_bbl_dif') 213 ! 214 IF( ln_timing ) CALL timing_stop('tra_bbl_dif') 221 215 ! 222 216 END SUBROUTINE tra_bbl_dif … … 249 243 !!---------------------------------------------------------------------- 250 244 ! 251 IF( nn_timing == 1 )CALL timing_start( 'tra_bbl_adv')245 IF( ln_timing ) CALL timing_start( 'tra_bbl_adv') 252 246 ! ! =========== 253 247 DO jn = 1, kjpt ! tracer loop … … 301 295 ! 302 296 END DO 303 ! ! =========== 304 END DO ! end tracer 305 ! ! =========== 306 IF( nn_timing == 1 ) CALL timing_stop( 'tra_bbl_adv') 297 ! ! =========== 298 END DO ! end tracer 299 ! ! =========== 300 ! 301 IF( ln_timing ) CALL timing_stop( 'tra_bbl_adv') 307 302 ! 308 303 END SUBROUTINE tra_bbl_adv … … 349 344 !!---------------------------------------------------------------------- 350 345 ! 351 IF( nn_timing == 1 )CALL timing_start( 'bbl')346 IF( ln_timing ) CALL timing_start( 'bbl') 352 347 ! 353 348 IF( kt == kit000 ) THEN … … 480 475 ENDIF 481 476 ! 482 IF( nn_timing == 1 )CALL timing_stop( 'bbl')477 IF( ln_timing ) CALL timing_stop( 'bbl') 483 478 ! 484 479 END SUBROUTINE bbl … … 494 489 !! called by nemo_init at the first timestep (kit000) 495 490 !!---------------------------------------------------------------------- 496 INTEGER :: ji, jj ! dummy loop indices 497 INTEGER :: ii0, ii1, ij0, ij1 ! local integer 498 INTEGER :: ios ! - - 499 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 500 ! 501 NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl 502 !!---------------------------------------------------------------------- 503 ! 504 IF( nn_timing == 1 ) CALL timing_start( 'tra_bbl_init') 491 INTEGER :: ji, jj ! dummy loop indices 492 INTEGER :: ii0, ii1, ij0, ij1, ios ! local integer 493 REAL(wp), DIMENSION(jpi,jpj) :: zmbk ! workspace 494 !! 495 NAMELIST/nambbl/ ln_trabbl, nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl 496 !!---------------------------------------------------------------------- 497 ! 498 IF( ln_timing ) CALL timing_start( 'tra_bbl_init') 505 499 ! 506 500 REWIND( numnam_ref ) ! Namelist nambbl in reference namelist : Bottom boundary layer scheme … … 519 513 WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation' 520 514 WRITE(numout,*) '~~~~~~~~~~~~' 521 WRITE(numout,*) ' Namelist nambbl : set bbl parameters' 522 WRITE(numout,*) ' diffusive bbl (=1) or not (=0) nn_bbl_ldf = ', nn_bbl_ldf 523 WRITE(numout,*) ' advective bbl (=1/2) or not (=0) nn_bbl_adv = ', nn_bbl_adv 524 WRITE(numout,*) ' diffusive bbl coefficient rn_ahtbbl = ', rn_ahtbbl, ' m2/s' 525 WRITE(numout,*) ' advective bbl coefficient rn_gambbl = ', rn_gambbl, ' s' 526 ENDIF 527 515 WRITE(numout,*) ' Namelist nambbl : set bbl parameters' 516 WRITE(numout,*) ' bottom boundary layer flag ln_trabbl = ', ln_trabbl 517 ENDIF 518 IF( .NOT.ln_trabbl ) RETURN 519 ! 520 IF(lwp) THEN 521 WRITE(numout,*) ' diffusive bbl (=1) or not (=0) nn_bbl_ldf = ', nn_bbl_ldf 522 WRITE(numout,*) ' advective bbl (=1/2) or not (=0) nn_bbl_adv = ', nn_bbl_adv 523 WRITE(numout,*) ' diffusive bbl coefficient rn_ahtbbl = ', rn_ahtbbl, ' m2/s' 524 WRITE(numout,*) ' advective bbl coefficient rn_gambbl = ', rn_gambbl, ' s' 525 ENDIF 526 ! 528 527 ! ! allocate trabbl arrays 529 528 IF( tra_bbl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' ) 530 529 ! 531 530 IF( nn_bbl_adv == 1 ) WRITE(numout,*) ' * Advective BBL using upper velocity' 532 531 IF( nn_bbl_adv == 2 ) WRITE(numout,*) ' * Advective BBL using velocity = F( delta rho)' 533 532 ! 534 533 ! !* vertical index of "deep" bottom u- and v-points 535 534 DO jj = 1, jpjm1 ! (the "shelf" bottom k-indices are mbku and mbkv) … … 540 539 END DO 541 540 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 542 CALL wrk_alloc( jpi, jpj, zmbk )543 541 zmbk(:,:) = REAL( mbku_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'U',1.) ; mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 544 542 zmbk(:,:) = REAL( mbkv_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 545 CALL wrk_dealloc( jpi, jpj, zmbk ) 546 543 ! 547 544 !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 548 545 mgrhu(:,:) = 0 ; mgrhv(:,:) = 0 … … 570 567 ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 571 568 ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 572 573 ! 574 IF( nn_timing == 1 ) CALL timing_stop( 'tra_bbl_init') 569 ! 570 IF( ln_timing ) CALL timing_stop( 'tra_bbl_init') 575 571 ! 576 572 END SUBROUTINE tra_bbl_init 577 578 #else579 !!----------------------------------------------------------------------580 !! Dummy module : No bottom boundary layer scheme581 !!----------------------------------------------------------------------582 LOGICAL, PUBLIC, PARAMETER :: lk_trabbl = .FALSE. !: bbl flag583 CONTAINS584 SUBROUTINE tra_bbl_init ! Dummy routine585 END SUBROUTINE tra_bbl_init586 SUBROUTINE tra_bbl( kt ) ! Dummy routine587 WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt588 END SUBROUTINE tra_bbl589 #endif590 573 591 574 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
