Changeset 10425 for NEMO/trunk/tests/VORTEX/MY_SRC
- Timestamp:
- 2018-12-19T22:54:16+01:00 (6 years ago)
- Location:
- NEMO/trunk/tests/VORTEX/MY_SRC
- Files:
-
- 3 edited
-
domvvl.F90 (modified) (14 diffs)
-
usrdef_istate.F90 (modified) (1 diff)
-
usrdef_zgr.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/tests/VORTEX/MY_SRC/domvvl.F90
r10074 r10425 79 79 & dtilde_e3t_a(jpi,jpj,jpk) , un_td (jpi,jpj,jpk) , vn_td (jpi,jpj,jpk) , & 80 80 & STAT = dom_vvl_alloc ) 81 IF( lk_mpp ) CALL mpp_sum (dom_vvl_alloc )82 IF( dom_vvl_alloc /= 0 ) CALL ctl_ warn('dom_vvl_alloc: failed to allocate arrays')81 CALL mpp_sum ( 'domvvl', dom_vvl_alloc ) 82 IF( dom_vvl_alloc /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_alloc: failed to allocate arrays' ) 83 83 un_td = 0._wp 84 84 vn_td = 0._wp … … 86 86 IF( ln_vvl_ztilde ) THEN 87 87 ALLOCATE( frq_rst_e3t(jpi,jpj) , frq_rst_hdv(jpi,jpj) , hdiv_lf(jpi,jpj,jpk) , STAT= dom_vvl_alloc ) 88 IF( lk_mpp ) CALL mpp_sum (dom_vvl_alloc )89 IF( dom_vvl_alloc /= 0 ) CALL ctl_ warn('dom_vvl_alloc: failed to allocate arrays')88 CALL mpp_sum ( 'domvvl', dom_vvl_alloc ) 89 IF( dom_vvl_alloc /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_alloc: failed to allocate arrays' ) 90 90 ENDIF 91 91 ! … … 234 234 END DO 235 235 END DO 236 IF( cn_cfg == "orca" .AND. nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 237 ii0 = 103 ; ii1 = 111 238 ij0 = 128 ; ij1 = 135 ; 239 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 240 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rdt 236 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 237 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 238 ii0 = 103 ; ii1 = 111 239 ij0 = 128 ; ij1 = 135 ; 240 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 241 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rdt 242 ENDIF 241 243 ENDIF 242 244 ENDIF … … 408 410 ! ! d - thickness diffusion transport: boundary conditions 409 411 ! (stored for tracer advction and continuity equation) 410 CALL lbc_lnk_multi( un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp)412 CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 411 413 412 414 ! 4 - Time stepping of baroclinic scale factors … … 419 421 z2dt = 2.0_wp * rdt 420 422 ENDIF 421 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp )423 CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 422 424 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 423 425 … … 429 431 END DO 430 432 z_tmax = MAXVAL( ze3t(:,:,:) ) 431 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain433 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 432 434 z_tmin = MINVAL( ze3t(:,:,:) ) 433 IF( lk_mpp ) CALL mpp_min(z_tmin ) ! min over the global domain435 CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 434 436 ! - ML - test: for the moment, stop simulation for too large e3_t variations 435 437 IF( ( z_tmax > rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 436 438 IF( lk_mpp ) THEN 437 CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3))438 CALL mpp_minloc( ze3t, tmask, z_tmin, ijk_min(1), ijk_min(2), ijk_min(3))439 CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 440 CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 439 441 ELSE 440 442 ijk_max = MAXLOC( ze3t(:,:,:) ) … … 450 452 WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 451 453 WRITE(numout, *) 'at i, j, k=', ijk_min 452 CALL ctl_ warn('MAX( ABS( tilde_e3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high')454 CALL ctl_stop( 'STOP', 'MAX( ABS( tilde_e3t_a(:,:,: ) ) / e3t_0(:,:,:) ) too high') 453 455 ENDIF 454 456 ENDIF … … 493 495 IF ( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 494 496 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) ) 495 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain497 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 496 498 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(tilde_e3t_a))) =', z_tmax 497 499 END IF … … 502 504 END DO 503 505 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 504 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain506 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 505 507 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 506 508 ! … … 510 512 END DO 511 513 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 512 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain514 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 513 515 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 514 516 ! … … 518 520 END DO 519 521 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 520 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain522 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 521 523 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax 522 524 ! 523 525 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshb(:,:) ) ) 524 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain526 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 525 527 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshb))) =', z_tmax 526 528 ! 527 529 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshn(:,:) ) ) 528 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain530 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 529 531 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshn))) =', z_tmax 530 532 ! 531 533 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssha(:,:) ) ) 532 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain534 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 533 535 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssha))) =', z_tmax 534 536 END IF … … 711 713 END DO 712 714 END DO 713 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )715 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 714 716 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 715 717 ! … … 724 726 END DO 725 727 END DO 726 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )728 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 727 729 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 728 730 ! … … 738 740 END DO 739 741 END DO 740 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp )742 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 741 743 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 742 744 ! -
NEMO/trunk/tests/VORTEX/MY_SRC/usrdef_istate.F90
r10074 r10425 136 136 END DO 137 137 138 CALL lbc_lnk( pu, 'U', -1. )139 CALL lbc_lnk( pv, 'V', -1. )138 CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1. ) 139 CALL lbc_lnk( 'usrdef_istate', pv, 'V', -1. ) 140 140 ! 141 141 END SUBROUTINE usr_def_istate -
NEMO/trunk/tests/VORTEX/MY_SRC/usrdef_zgr.F90
r10074 r10425 192 192 z2d(:,:) = REAL( jpkm1 , wp ) ! flat bottom 193 193 ! 194 CALL lbc_lnk( z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed)194 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) 195 195 ! 196 196 k_bot(:,:) = INT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere
Note: See TracChangeset
for help on using the changeset viewer.
