- Timestamp:
- 2015-12-16T10:25:22+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r5836 r6060 70 70 71 71 !! * Substitutions 72 # include "domzgr_substitute.h90"73 72 # include "vectopt_loop_substitute.h90" 74 73 !!---------------------------------------------------------------------- … … 112 111 IF( nn_timing == 1 ) CALL timing_start( 'tra_bbl') 113 112 ! 114 IF( l_trdtra ) THEN !* Save t a and satrends113 IF( l_trdtra ) THEN !* Save the input trends 115 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 116 115 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) … … 132 131 ! 133 132 END IF 134 133 ! 135 134 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl 136 135 ! … … 146 145 END IF 147 146 148 IF( l_trdtra ) THEN ! s ave the horizontal diffusive trends for further diagnostics147 IF( l_trdtra ) THEN ! send the trends for further diagnostics 149 148 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 150 149 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) … … 211 210 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 212 211 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) & 213 & / ( e1e2t(ji,jj) * fse3t(ji,jj,ik))212 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik) 214 213 END DO 215 214 END DO … … 263 262 ! 264 263 ! ! up -slope T-point (shelf bottom point) 265 zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus)264 zbtr = r1_e1e2t(iis,jj) / e3t_n(iis,jj,ikus) 266 265 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 267 266 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 268 267 ! 269 268 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 270 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk)269 zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,jk) 271 270 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 272 271 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 273 272 END DO 274 273 ! 275 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud)274 zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,ikud) 276 275 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 277 276 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra … … 285 284 ! 286 285 ! up -slope T-point (shelf bottom point) 287 zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs)286 zbtr = r1_e1e2t(ji,ijs) / e3t_n(ji,ijs,ikvs) 288 287 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 289 288 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 290 289 ! 291 290 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 292 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk)291 zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,jk) 293 292 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 294 293 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 295 294 END DO 296 295 ! ! down-slope T-point (deep bottom point) 297 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd)296 zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,ikvd) 298 297 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 299 298 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra … … 302 301 ! 303 302 END DO 304 ! ! =========== 305 END DO ! end tracer 306 ! ! =========== 307 ! 303 ! ! =========== 304 END DO ! end tracer 305 ! ! =========== 308 306 IF( nn_timing == 1 ) CALL timing_stop( 'tra_bbl_adv') 309 307 ! … … 340 338 INTEGER , INTENT(in ) :: kit000 ! first time step index 341 339 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 342 ! !340 ! 343 341 INTEGER :: ji, jj ! dummy loop indices 344 342 INTEGER :: ik ! local integers … … 365 363 zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal) 366 364 ! 367 zdep(ji,jj) = fsdept(ji,jj,ik)! bottom T-level reference depth365 zdep(ji,jj) = gdept_n(ji,jj,ik) ! bottom T-level reference depth 368 366 zub (ji,jj) = un(ji,jj,mbku(ji,jj)) ! bottom velocity 369 367 zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj)) … … 401 399 ! 402 400 ENDIF 403 401 ! 404 402 ! !-------------------! 405 403 IF( nn_bbl_adv /= 0 ) THEN ! advective bbl ! … … 500 498 INTEGER :: ios ! - - 501 499 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 502 ! !500 ! 503 501 NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl 504 502 !!---------------------------------------------------------------------- … … 506 504 IF( nn_timing == 1 ) CALL timing_start( 'tra_bbl_init') 507 505 ! 508 CALL wrk_alloc( jpi, jpj, zmbk )509 !510 511 506 REWIND( numnam_ref ) ! Namelist nambbl in reference namelist : Bottom boundary layer scheme 512 507 READ ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901) 513 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp )514 508 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp ) 509 ! 515 510 REWIND( numnam_cfg ) ! Namelist nambbl in configuration namelist : Bottom boundary layer scheme 516 511 READ ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 ) 517 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp )512 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp ) 518 513 IF(lwm) WRITE ( numond, nambbl ) 519 514 ! … … 545 540 END DO 546 541 ! 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 ) 547 543 zmbk(:,:) = REAL( mbku_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'U',1.) ; mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 548 544 zmbk(:,:) = REAL( mbkv_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 545 CALL wrk_dealloc( jpi, jpj, zmbk ) 549 546 550 547 !* sign of grad(H) at u- and v-points … … 593 590 ENDIF 594 591 ! 595 CALL wrk_dealloc( jpi, jpj, zmbk )596 !597 592 IF( nn_timing == 1 ) CALL timing_stop( 'tra_bbl_init') 598 593 !
Note: See TracChangeset
for help on using the changeset viewer.
