- Timestamp:
- 2020-01-27T15:31:53+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcpl.F90
r12077 r12340 40 40 END TYPE 41 41 ! 42 !! * Substitutions 43 # include "do_loop_substitute.h90" 42 44 !!---------------------------------------------------------------------- 43 45 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 360 362 ! ----------------------------------------------------------------------------------------- 361 363 ! case we open a cell but no neigbour cells available to get an estimate of T and S 362 DO jk = 1,jpk-1 363 DO jj = 1,jpj 364 DO ji = 1,jpi 365 IF (tmask(ji,jj,jk) == 1._wp .AND. ts(ji,jj,jk,2,Kmm) == 0._wp) & 366 & CALL ctl_stop('STOP', 'failing to fill all new weet cell, & 367 & try increase nn_drown or activate XXXX & 368 & in your domain cfg computation' ) 369 END DO 370 END DO 371 END DO 364 DO_3D_11_11( 1,jpk-1 ) 365 IF (tmask(ji,jj,jk) == 1._wp .AND. ts(ji,jj,jk,2,Kmm) == 0._wp) & 366 & CALL ctl_stop('STOP', 'failing to fill all new weet cell, & 367 & try increase nn_drown or activate XXXX & 368 & in your domain cfg computation' ) 369 END_3D 372 370 ! 373 371 END SUBROUTINE isfcpl_tra … … 404 402 DO jk = 1, jpk ! Horizontal slab 405 403 ! 1.1: get volume flux before coupling (>0 out) 406 DO jj = 2, jpjm1 407 DO ji = 2, jpim1 408 zqvolb(ji,jj,jk) = ( e2u(ji,jj) * ze3u_b(ji,jj,jk) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj ) * ze3u_b(ji-1,jj ,jk) * uu(ji-1,jj ,jk,Kmm) & 409 & + e1v(ji,jj) * ze3v_b(ji,jj,jk) * vv(ji,jj,jk,Kmm) - e1v(ji ,jj-1) * ze3v_b(ji ,jj-1,jk) * vv(ji ,jj-1,jk,Kmm) ) & 410 & * ztmask_b(ji,jj,jk) 411 END DO 412 ENDDO 404 DO_2D_00_00 405 zqvolb(ji,jj,jk) = ( e2u(ji,jj) * ze3u_b(ji,jj,jk) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj ) * ze3u_b(ji-1,jj ,jk) * uu(ji-1,jj ,jk,Kmm) & 406 & + e1v(ji,jj) * ze3v_b(ji,jj,jk) * vv(ji,jj,jk,Kmm) - e1v(ji ,jj-1) * ze3v_b(ji ,jj-1,jk) * vv(ji ,jj-1,jk,Kmm) ) & 407 & * ztmask_b(ji,jj,jk) 408 END_2D 413 409 ! 414 410 ! 1.2: get volume flux after coupling (>0 out) … … 418 414 vv(:,:,jk,Kmm) = vv(:,:,jk,Kmm) * vmask(:,:,jk) 419 415 ! compute volume flux divergence after coupling 420 DO jj = 2, jpjm1 421 DO ji = 2, jpim1 422 zqvoln(ji,jj,jk) = ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj ) * e3u(ji-1,jj ,jk,Kmm) * uu(ji-1,jj ,jk,Kmm) & 423 & + e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) - e1v(ji ,jj-1) * e3v(ji ,jj-1,jk,Kmm) * vv(ji ,jj-1,jk,Kmm) ) & 424 & * tmask(ji,jj,jk) 425 END DO 426 ENDDO 416 DO_2D_00_00 417 zqvoln(ji,jj,jk) = ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj ) * e3u(ji-1,jj ,jk,Kmm) * uu(ji-1,jj ,jk,Kmm) & 418 & + e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) - e1v(ji ,jj-1) * e3v(ji ,jj-1,jk,Kmm) * vv(ji ,jj-1,jk,Kmm) ) & 419 & * tmask(ji,jj,jk) 420 END_2D 427 421 ! 428 422 ! 1.3: get 3d volume flux difference (before - after cpl) (>0 out) … … 433 427 ! 2.0: include the contribution of the vertical velocity in the volume flux correction 434 428 ! 435 DO jj = 2, jpjm1 436 DO ji = 2, jpim1 437 ! 438 ikt = mikt(ji,jj) 439 IF ( ikt > 1 .AND. ssmask(ji,jj) == 1 ) THEN 440 risfcpl_vol(ji,jj,ikt) = risfcpl_vol(ji,jj,ikt) + SUM(zqvolb(ji,jj,1:ikt-1)) ! test sign 441 ENDIF 442 ! 443 END DO 444 ENDDO 429 DO_2D_00_00 430 ! 431 ikt = mikt(ji,jj) 432 IF ( ikt > 1 .AND. ssmask(ji,jj) == 1 ) THEN 433 risfcpl_vol(ji,jj,ikt) = risfcpl_vol(ji,jj,ikt) + SUM(zqvolb(ji,jj,1:ikt-1)) ! test sign 434 ENDIF 435 ! 436 END_2D 445 437 ! 446 438 CALL lbc_lnk( 'iscpl', risfcpl_vol, 'T', 1. )
Note: See TracChangeset
for help on using the changeset viewer.