Changeset 3884
- Timestamp:
- 2013-04-22T13:25:29+02:00 (11 years ago)
- Location:
- branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 edited
-
DIA/diawri.F90 (modified) (1 diff)
-
DOM/domvvl.F90 (modified) (34 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r3867 r3884 146 146 CALL iom_put( "toce" , z3d ) ! heat content 147 147 CALL iom_put( "sst" , z3d(:,:,1) ) ! sea surface heat content 148 CALL iom_put( "sst2" , z3d(:,:,1) * z3d(:,:,1) ) ! sea surface content of squared temperature 148 z3d(:,:,1) = tsn(:,:,1,jp_tem) * z3d(:,:,1) 149 CALL iom_put( "sst2" , z3d(:,:,1) ) ! sea surface content of squared temperature 149 150 z3d(:,:,:) = tsn(:,:,:,jp_sal) * fse3t_n(:,:,:) 150 151 CALL iom_put( "soce" , z3d ) ! salinity content 151 152 CALL iom_put( "sss" , z3d(:,:,1) ) ! sea surface salinity content 152 CALL iom_put( "sss2" , z3d(:,:,1) * z3d(:,:,1) ) ! sea surface content of squared salinity 153 z3d(:,:,1) = tsn(:,:,1,jp_sal) * z3d(:,:,1) 154 CALL iom_put( "sss2" , z3d(:,:,1) ) ! sea surface content of squared salinity 153 155 ELSE 154 156 CALL iom_put( "toce" , tsn(:,:,:,jp_tem) ) ! temperature -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r3871 r3884 18 18 !! dom_vvl_rst : read/write restart file 19 19 !! dom_vvl_ctl : Check the vvl options 20 !! dom_vvl_orca_fix : Recompute some area-weighted interpolations of vertical scale factors 21 !! : to account for manual changes to e[1,2][u,v] in some Straits 20 22 !!---------------------------------------------------------------------- 21 23 !! * Modules used … … 35 37 36 38 !! * Routine accessibility 37 PUBLIC dom_vvl_init ! called by domain.F90 38 PUBLIC dom_vvl_sf_nxt ! called by step.F90 39 PUBLIC dom_vvl_sf_swp ! called by step.F90 40 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 39 PUBLIC dom_vvl_init ! called by domain.F90 40 PUBLIC dom_vvl_sf_nxt ! called by step.F90 41 PUBLIC dom_vvl_sf_swp ! called by step.F90 42 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 43 PRIVATE dom_vvl_orca_fix ! called by dom_vvl_interpol 41 44 42 45 !!* Namelist nam_vvl … … 52 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td ! thickness diffusion transport 53 56 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf ! low frequency part of hz divergence 54 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_t_b, e3t_t_n, e3t_t_a ! baroclinic scale factors 57 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n ! baroclinic scale factors 58 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a ! baroclinic scale factors 55 59 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_e3t ! retoring period for scale factors 56 60 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence … … 76 80 IF( ln_vvl_zstar ) dom_vvl_alloc = 0 77 81 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 78 ALLOCATE( e3t_t_b(jpi,jpj,jpk) , e3t_t_n(jpi,jpj,jpk) , e3t_t_a(jpi,jpj,jpk) , &79 & un_td (jpi,jpj,jpk) , vn_td (jpi,jpj,jpk), STAT = dom_vvl_alloc )82 ALLOCATE( tilde_e3t_b(jpi,jpj,jpk) , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) , & 83 & un_td (jpi,jpj,jpk) , vn_td (jpi,jpj,jpk) , STAT = dom_vvl_alloc ) 80 84 IF( lk_mpp ) CALL mpp_sum ( dom_vvl_alloc ) 81 85 IF( dom_vvl_alloc /= 0 ) CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') … … 100 104 !! - interpolate scale factors 101 105 !! 102 !! ** Action : - fse3t_(n/b) and e3t_t_(n/b)106 !! ** Action : - fse3t_(n/b) and tilde_e3t_(n/b) 103 107 !! - Regrid: fse3(u/v)_n 104 108 !! fse3(u/v)_b … … 130 134 IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' ) 131 135 132 ! Read or initialize fse3t_(b/n), e3t_t_(b/n) and hdiv_lf (and e3t_a(jpk))133 ! ======================================================================== 136 ! Read or initialize fse3t_(b/n), tilde_e3t_(b/n) and hdiv_lf (and e3t_a(jpk)) 137 ! ============================================================================ 134 138 CALL dom_vvl_rst( nit000, 'READ' ) 135 139 fse3t_a(:,:,jpk) = e3t_0(:,:,jpk) 136 140 137 141 ! Reconstruction of all vertical scale factors at now and before time steps 138 ! ========================================================================= 142 ! ============================================================================= 139 143 ! Horizontal scale factor interpolations 140 144 ! -------------------------------------- … … 178 182 frq_rst_e3t(:,:) = 2.e0_wp * rpi / ( 30.e0_wp * 86400.e0_wp ) 179 183 frq_rst_hdv(:,:) = 2.e0_wp * rpi / ( 5.e0_wp * 86400.e0_wp ) 184 ! Use these next two to emulate z-star using z-tilde 185 frq_rst_e3t(:,:) = 0.e0_wp 186 frq_rst_hdv(:,:) = 1.e0_wp / rdt 180 187 ENDIF 181 188 … … 200 207 !! to the "baroclinic" level thickness. 201 208 !! 202 !! ** Action : - hdiv_lf : restoring towards full baroclinic divergence in z_tilde case203 !! - e3t_t_a: after increment of vertical scale factor204 !! in z_tilde case209 !! ** Action : - hdiv_lf : restoring towards full baroclinic divergence in z_tilde case 210 !! - tilde_e3t_a: after increment of vertical scale factor 211 !! in z_tilde case 205 212 !! - fse3(t/u/v)_a 206 213 !! … … 271 278 ! II - after z_tilde increments of vertical scale factors 272 279 ! ======================================================= 273 e3t_t_a(:,:,:) = 0.e0 ! e3t_t_a used to store tendency terms280 tilde_e3t_a(:,:,:) = 0.0_wp ! tilde_e3t_a used to store tendency terms 274 281 275 282 ! 1 - High frequency divergence term 276 283 ! ---------------------------------- 277 IF( ln_vvl_ztilde ) THEN ! z_tilde case284 IF( ln_vvl_ztilde ) THEN ! z_tilde case 278 285 DO jk = 1, jpkm1 279 e3t_t_a(:,:,jk) = e3t_t_a(:,:,jk) - ( fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) )280 END DO 281 ELSE ! layer case286 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 287 END DO 288 ELSE ! layer case 282 289 DO jk = 1, jpkm1 283 e3t_t_a(:,:,jk) = e3t_t_a(:,:,jk) -fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) )290 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) 284 291 END DO 285 292 END IF … … 289 296 IF( ln_vvl_ztilde ) THEN 290 297 DO jk = 1, jpk 291 e3t_t_a(:,:,jk) = e3t_t_a(:,:,jk) - frq_rst_e3t(:,:) * e3t_t_b(:,:,jk)298 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk) 292 299 END DO 293 300 END IF … … 301 308 DO jj = 1, jpjm1 302 309 DO ji = 1, fs_jpim1 ! vector opt. 303 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * re2u_e1u(ji,jj) * ( e3t_t_b(ji,jj,jk) - e3t_t_b(ji+1,jj ,jk) )304 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * ( e3t_t_b(ji,jj,jk) - e3t_t_b(ji ,jj+1,jk) )310 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * re2u_e1u(ji,jj) * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 311 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 305 312 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 306 313 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) … … 319 326 DO jj = 2, jpjm1 320 327 DO ji = fs_2, fs_jpim1 ! vector opt. 321 e3t_t_a(ji,jj,jk) = e3t_t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) &322 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) )&323 & * r1_e12t(ji,jj)328 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 329 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 330 & ) * r1_e12t(ji,jj) 324 331 END DO 325 332 END DO … … 339 346 z2dt = 2.e0 * rdt 340 347 ENDIF 341 CALL lbc_lnk( e3t_t_a(:,:,:), 'T', 1. )342 e3t_t_a(:,:,:) = e3t_t_b(:,:,:) + z2dt * tmask(:,:,:) * e3t_t_a(:,:,:)348 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1. ) 349 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 343 350 344 351 ! Maximum deformation control … … 348 355 ze3t(:,:,jpk) = 0.e0 349 356 DO jk = 1, jpkm1 350 ze3t(:,:,jk) = e3t_t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)357 ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 351 358 END DO 352 359 z_tmax = MAXVAL( ze3t(:,:,:) ) 360 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 353 361 z_tmin = MINVAL( ze3t(:,:,:) ) 362 IF( lk_mpp ) CALL mpp_min( z_tmin ) ! min over the global domain 354 363 ! - ML - test: for the moment, stop simulation for too large e3_t variations 355 364 IF( ( z_tmax .GT. z_def_max ) .OR. ( z_tmin .LT. - z_def_max ) ) THEN 356 ijk_max = MAXLOC( ze3t(:,:,:) ) 357 ijk_min = MINLOC( ze3t(:,:,:) ) 358 WRITE(numout, *) 'MAX( e3t_t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 359 WRITE(numout, *) 'at i, j, k=', ijk_max 360 WRITE(numout, *) 'MIN( e3t_t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 361 WRITE(numout, *) 'at i, j, k=', ijk_min 362 CALL ctl_stop('MAX( ABS( e3t_t_a(:,:,:) ) / e3t_0(:,:,:) ) too high') 365 IF( lk_mpp ) THEN 366 CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3) ) 367 CALL mpp_minloc( ze3t, tmask, z_tmin, ijk_min(1), ijk_min(2), ijk_min(3) ) 368 ELSE 369 ijk_max = MAXLOC( ze3t(:,:,:) ) 370 ijk_max(1) = ijk_max(1) + nimpp - 1 371 ijk_max(2) = ijk_max(2) + njmpp - 1 372 ijk_min = MINLOC( ze3t(:,:,:) ) 373 ijk_min(1) = ijk_min(1) + nimpp - 1 374 ijk_min(2) = ijk_min(2) + njmpp - 1 375 ENDIF 376 IF (lwp) THEN 377 WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 378 WRITE(numout, *) 'at i, j, k=', ijk_max 379 WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 380 WRITE(numout, *) 'at i, j, k=', ijk_min 381 CALL ctl_warn('MAX( ABS( tilde_e3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high') 382 ENDIF 363 383 ENDIF 364 384 ! - ML - end test 365 ! - ML - This will cause a baroclinicity error if the ctl_stop above is not used366 e3t_t_a(:,:,:) = MIN( e3t_t_a(:,:,:), z_def_max * e3t_0(:,:,:) )367 e3t_t_a(:,:,:) = MAX( e3t_t_a(:,:,:), - z_def_max * e3t_0(:,:,:) )385 ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 386 tilde_e3t_a(:,:,:) = MIN( tilde_e3t_a(:,:,:), z_def_max * e3t_0(:,:,:) ) 387 tilde_e3t_a(:,:,:) = MAX( tilde_e3t_a(:,:,:), - z_def_max * e3t_0(:,:,:) ) 368 388 369 389 ! Add "tilda" part to the after scale factor 370 390 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 371 fse3t_a(:,:,:) = e3t_0(:,:,:) + e3t_t_a(:,:,:)391 fse3t_a(:,:,:) = e3t_0(:,:,:) + tilde_e3t_a(:,:,:) 372 392 373 393 ! III - Barotropic repartition of the sea surface height over the baroclinic profile … … 375 395 ! add e3t(n-1) "star" Asselin-filtered 376 396 DO jk = 1, jpkm1 377 fse3t_a(:,:,jk) = fse3t_a(:,:,jk) + fse3t_b(:,:,jk) - e3t_0(:,:,jk) - e3t_t_b(:,:,jk)397 fse3t_a(:,:,jk) = fse3t_a(:,:,jk) + fse3t_b(:,:,jk) - e3t_0(:,:,jk) - tilde_e3t_b(:,:,jk) 378 398 END DO 379 399 ! add ( ssh increment + "baroclinicity error" ) proportionnaly to e3t(n) … … 383 403 zht(:,:) = 0. 384 404 DO jk = 1, jpkm1 385 zht(:,:) = zht(:,:) + e3t_t_a(:,:,jk) * tmask(:,:,jk)405 zht(:,:) = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk) 386 406 END DO 387 407 z_scale(:,:) = ( ssha(:,:) - sshb(:,:) - zht(:,:) ) / ( ht_0(:,:) + sshn(:,:) + 1. - tmask(:,:,1) ) … … 393 413 394 414 IF( ln_vvl_dbg ) THEN ! - ML - test: control prints for debuging 415 ! 416 IF( lwp ) WRITE(numout, *) 'kt =', kt 395 417 IF ( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 396 WRITE(numout, *) 'kt =', kt397 WRITE(numout, *) 'MAXVAL(abs(SUM(e3t_t_a))) =', &398 & MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) )418 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) ) 419 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 420 IF( lwp ) WRITE(numout, *) 'MAXVAL(abs(SUM(tilde_e3t_a))) =', z_tmax 399 421 END IF 422 ! 400 423 zht(:,:) = 0.e0 401 424 DO jk = 1, jpkm1 402 425 zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 403 426 END DO 404 WRITE(numout, *) 'MAXVAL(abs(ht_0+sshn-SUM(fse3t_n))) =', & 405 & MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 427 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 428 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 429 IF( lwp ) WRITE(numout, *) 'MAXVAL(abs(ht_0+sshn-SUM(fse3t_n))) =', z_tmax 430 ! 406 431 zht(:,:) = 0.e0 407 432 DO jk = 1, jpkm1 408 433 zht(:,:) = zht(:,:) + fse3t_a(:,:,jk) * tmask(:,:,jk) 409 434 END DO 410 WRITE(numout, *) 'MAXVAL(abs(ht_0+ssha-SUM(fse3t_a))) =', & 411 & MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 435 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 436 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 437 IF( lwp ) WRITE(numout, *) 'MAXVAL(abs(ht_0+ssha-SUM(fse3t_a))) =', z_tmax 438 ! 412 439 END IF 413 440 … … 439 466 !! - recompute depths and water height fields 440 467 !! 441 !! ** Action : - fse3t_(b/n), e3t_t_(b/n) and fse3(u/v)_n ready for next time step468 !! ** Action : - fse3t_(b/n), tilde_e3t_(b/n) and fse3(u/v)_n ready for next time step 442 469 !! - Recompute: 443 470 !! fse3(u/v)_b … … 473 500 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 474 501 IF( neuler == 0 .AND. kt == nit000 ) THEN 475 e3t_t_b(:,:,:) = e3t_t_n(:,:,:)502 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 476 503 ELSE 477 e3t_t_b(:,:,:) = e3t_t_n(:,:,:) + atfp * ( e3t_t_b(:,:,:) - 2.e0 * e3t_t_n(:,:,:) + e3t_t_a(:,:,:) )504 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) + atfp * ( tilde_e3t_b(:,:,:) - 2.e0 * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 478 505 ENDIF 479 e3t_t_n(:,:,:) = e3t_t_a(:,:,:)506 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 480 507 ENDIF 481 508 fse3t_n(:,:,:) = fse3t_a(:,:,:) … … 553 580 !! * Local declarations 554 581 INTEGER :: ji, jj, jk ! dummy loop indices 582 LOGICAL :: l_is_orca ! local logical 555 583 !!---------------------------------------------------------------------- 556 584 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_interpol') 585 ! 586 l_is_orca = .FALSE. 587 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) l_is_orca = .TRUE. ! ORCA R2 configuration - will need to correct some locations 588 557 589 SELECT CASE ( pout ) 558 590 ! ! ------------------------------------- ! … … 563 595 DO jj = 1, jpjm1 564 596 DO ji = 1, fs_jpim1 ! vector opt. 565 pe3_out(ji,jj,jk) = 0.5 * umask(ji,jj,jk) * r1_e12u(ji,jj) 597 pe3_out(ji,jj,jk) = 0.5 * umask(ji,jj,jk) * r1_e12u(ji,jj) & 566 598 & * ( e12t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 567 599 & + e12t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) … … 569 601 END DO 570 602 END DO 603 ! 604 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 571 605 ! boundary conditions 572 606 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1. ) … … 579 613 DO jj = 1, jpjm1 580 614 DO ji = 1, fs_jpim1 ! vector opt. 581 pe3_out(ji,jj,jk) = 0.5 * vmask(ji,jj,jk) * r1_e12v(ji,jj) 615 pe3_out(ji,jj,jk) = 0.5 * vmask(ji,jj,jk) * r1_e12v(ji,jj) & 582 616 & * ( e12t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 583 617 & + e12t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) … … 585 619 END DO 586 620 END DO 621 ! 622 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 587 623 ! boundary conditions 588 624 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1. ) … … 595 631 DO jj = 1, jpjm1 596 632 DO ji = 1, fs_jpim1 ! vector opt. 597 pe3_out(ji,jj,jk) = 0.5 * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj) 633 pe3_out(ji,jj,jk) = 0.5 * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj) & 598 634 & * ( e12u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 599 635 & + e12u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) … … 601 637 END DO 602 638 END DO 639 ! 640 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 603 641 ! boundary conditions 604 642 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1. ) … … 612 650 DO jk = 2, jpk 613 651 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1. - 0.5 * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) & 614 & + 652 & + 0.5 * tmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) ) 615 653 END DO 616 654 ! ! -------------------------------------- ! … … 622 660 DO jk = 2, jpk 623 661 pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1. - 0.5 * umask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) ) & 624 & + 662 & + 0.5 * umask(:,:,jk) * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) ) 625 663 END DO 626 664 ! ! -------------------------------------- ! … … 632 670 DO jk = 2, jpk 633 671 pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1. - 0.5 * vmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) ) & 634 & + 672 & + 0.5 * vmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) ) 635 673 END DO 636 674 END SELECT 675 ! 637 676 638 677 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_interpol') 639 678 640 679 END SUBROUTINE dom_vvl_interpol 641 642 680 643 681 SUBROUTINE dom_vvl_rst( kt, cdrw ) … … 666 704 id1 = iom_varid( numror, 'fse3t_b', ldstop = .FALSE. ) 667 705 id2 = iom_varid( numror, 'fse3t_n', ldstop = .FALSE. ) 668 id3 = iom_varid( numror, ' e3t_t_b', ldstop = .FALSE. )669 id4 = iom_varid( numror, ' e3t_t_n', ldstop = .FALSE. )706 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 707 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 670 708 id5 = iom_varid( numror, 'hdif_lf', ldstop = .FALSE. ) 671 709 ! ! --------- ! … … 691 729 ! ! ----------------------- ! 692 730 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 693 CALL iom_get( numror, jpdom_autoglo, ' e3t_t_b', e3t_t_b(:,:,:) )694 CALL iom_get( numror, jpdom_autoglo, ' e3t_t_n', e3t_t_n(:,:,:) )731 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 732 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 695 733 ELSE ! one at least array is missing 696 e3t_t_b(:,:,:) = 0.e0697 e3t_t_n(:,:,:) = 0.e0734 tilde_e3t_b(:,:,:) = 0.e0 735 tilde_e3t_n(:,:,:) = 0.e0 698 736 ENDIF 699 737 ! ! ------------ ! … … 712 750 fse3t_n(:,:,:) = e3t_0(:,:,:) 713 751 IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 714 e3t_t_b(:,:,:) = 0.e0715 e3t_t_n(:,:,:) = 0.e0752 tilde_e3t_b(:,:,:) = 0.e0 753 tilde_e3t_n(:,:,:) = 0.e0 716 754 IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0.e0 717 755 END IF … … 729 767 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 730 768 ! ! ----------------------- ! 731 CALL iom_rstput( kt, nitrst, numrow, ' e3t_t_b', e3t_t_b(:,:,:) )732 CALL iom_rstput( kt, nitrst, numrow, ' e3t_t_n', e3t_t_n(:,:,:) )769 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 770 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 733 771 END IF 734 772 ! ! -------------! … … 794 832 END SUBROUTINE dom_vvl_ctl 795 833 834 SUBROUTINE dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 835 !!--------------------------------------------------------------------- 836 !! *** ROUTINE dom_vvl_orca_fix *** 837 !! 838 !! ** Purpose : Correct surface weighted, horizontally interpolated, 839 !! scale factors at locations that have been individually 840 !! modified in domhgr. Such modifications break the 841 !! relationship between e12t and e1u*e2u etc. 842 !! Recompute some scale factors ignoring the modified metric. 843 !!---------------------------------------------------------------------- 844 !! * Arguments 845 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pe3_in ! input e3 to be interpolated 846 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: pe3_out ! output interpolated e3 847 CHARACTER(LEN=*), INTENT( in ) :: pout ! grid point of out scale factors 848 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW' 849 !! * Local declarations 850 INTEGER :: ji, jj, jk ! dummy loop indices 851 INTEGER :: ij0, ij1, ii0, ii1 ! dummy loop indices 852 ! ! ===================== 853 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 854 ! ! ===================== 855 IF( nn_cla == 0 ) THEN 856 ! 857 ii0 = 139 ; ii1 = 140 ! Gibraltar Strait (e2u was modified) 858 ij0 = 102 ; ij1 = 102 859 DO jk = 1, jpkm1 860 DO jj = mj0(ij0), mj1(ij1) 861 DO ji = mi0(ii0), mi1(ii1) 862 SELECT CASE ( pout ) 863 CASE( 'U' ) 864 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) & 865 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 866 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 867 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk) 868 CASE( 'F' ) 869 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) & 870 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) & 871 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 872 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk) 873 END SELECT 874 END DO 875 END DO 876 END DO 877 ! 878 ii0 = 160 ; ii1 = 160 ! Bab el Mandeb (e2u and e1v were modified) 879 ij0 = 88 ; ij1 = 88 880 DO jk = 1, jpkm1 881 DO jj = mj0(ij0), mj1(ij1) 882 DO ji = mi0(ii0), mi1(ii1) 883 SELECT CASE ( pout ) 884 CASE( 'U' ) 885 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) & 886 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 887 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 888 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk) 889 CASE( 'V' ) 890 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) & 891 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 892 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 893 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk) 894 CASE( 'F' ) 895 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) & 896 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) & 897 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 898 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk) 899 END SELECT 900 END DO 901 END DO 902 END DO 903 ENDIF 904 905 ii0 = 145 ; ii1 = 146 ! Danish Straits (e2u was modified) 906 ij0 = 116 ; ij1 = 116 907 DO jk = 1, jpkm1 908 DO jj = mj0(ij0), mj1(ij1) 909 DO ji = mi0(ii0), mi1(ii1) 910 SELECT CASE ( pout ) 911 CASE( 'U' ) 912 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) & 913 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 914 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 915 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk) 916 CASE( 'F' ) 917 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) & 918 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) & 919 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 920 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk) 921 END SELECT 922 END DO 923 END DO 924 END DO 925 ENDIF 926 ! 927 ! ! ===================== 928 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration 929 ! ! ===================== 930 ! 931 ii0 = 281 ; ii1 = 282 ! Gibraltar Strait (e2u was modified) 932 ij0 = 200 ; ij1 = 200 933 DO jk = 1, jpkm1 934 DO jj = mj0(ij0), mj1(ij1) 935 DO ji = mi0(ii0), mi1(ii1) 936 SELECT CASE ( pout ) 937 CASE( 'U' ) 938 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) & 939 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 940 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 941 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk) 942 CASE( 'F' ) 943 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) & 944 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) & 945 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 946 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk) 947 END SELECT 948 END DO 949 END DO 950 END DO 951 ! 952 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u was modified) 953 ij0 = 208 ; ij1 = 208 954 DO jk = 1, jpkm1 955 DO jj = mj0(ij0), mj1(ij1) 956 DO ji = mi0(ii0), mi1(ii1) 957 SELECT CASE ( pout ) 958 CASE( 'U' ) 959 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) & 960 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 961 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 962 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk) 963 CASE( 'F' ) 964 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) & 965 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) & 966 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 967 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk) 968 END SELECT 969 END DO 970 END DO 971 END DO 972 ! 973 ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v was modified) 974 ij0 = 124 ; ij1 = 125 975 DO jk = 1, jpkm1 976 DO jj = mj0(ij0), mj1(ij1) 977 DO ji = mi0(ii0), mi1(ii1) 978 SELECT CASE ( pout ) 979 CASE( 'V' ) 980 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) & 981 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 982 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 983 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk) 984 END SELECT 985 END DO 986 END DO 987 END DO 988 ! 989 ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v was modified) [closed from bathy_11 on] 990 ij0 = 124 ; ij1 = 125 991 DO jk = 1, jpkm1 992 DO jj = mj0(ij0), mj1(ij1) 993 DO ji = mi0(ii0), mi1(ii1) 994 SELECT CASE ( pout ) 995 CASE( 'V' ) 996 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) & 997 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 998 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 999 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk) 1000 END SELECT 1001 END DO 1002 END DO 1003 END DO 1004 ! 1005 ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v was modified) 1006 ij0 = 124 ; ij1 = 125 1007 DO jk = 1, jpkm1 1008 DO jj = mj0(ij0), mj1(ij1) 1009 DO ji = mi0(ii0), mi1(ii1) 1010 SELECT CASE ( pout ) 1011 CASE( 'V' ) 1012 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) & 1013 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 1014 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 1015 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk) 1016 END SELECT 1017 END DO 1018 END DO 1019 END DO 1020 ! 1021 ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v was modified) 1022 ij0 = 124 ; ij1 = 125 1023 DO jk = 1, jpkm1 1024 DO jj = mj0(ij0), mj1(ij1) 1025 DO ji = mi0(ii0), mi1(ii1) 1026 SELECT CASE ( pout ) 1027 CASE( 'V' ) 1028 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) & 1029 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 1030 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 1031 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk) 1032 END SELECT 1033 END DO 1034 END DO 1035 END DO 1036 ! 1037 ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v was modified) 1038 ij0 = 141 ; ij1 = 142 1039 DO jk = 1, jpkm1 1040 DO jj = mj0(ij0), mj1(ij1) 1041 DO ji = mi0(ii0), mi1(ii1) 1042 SELECT CASE ( pout ) 1043 CASE( 'V' ) 1044 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) & 1045 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 1046 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 1047 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk) 1048 END SELECT 1049 END DO 1050 END DO 1051 END DO 1052 ! 1053 ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v was modified) 1054 ij0 = 141 ; ij1 = 142 1055 DO jk = 1, jpkm1 1056 DO jj = mj0(ij0), mj1(ij1) 1057 DO ji = mi0(ii0), mi1(ii1) 1058 SELECT CASE ( pout ) 1059 CASE( 'V' ) 1060 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) & 1061 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 1062 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 1063 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk) 1064 END SELECT 1065 END DO 1066 END DO 1067 END DO 1068 ENDIF 1069 ! ! ===================== 1070 IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN ! ORCA R05 configuration 1071 ! ! ===================== 1072 ! 1073 ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u was modified) 1074 ij0 = 327 ; ij1 = 327 1075 DO jk = 1, jpkm1 1076 DO jj = mj0(ij0), mj1(ij1) 1077 DO ji = mi0(ii0), mi1(ii1) 1078 SELECT CASE ( pout ) 1079 CASE( 'U' ) 1080 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) & 1081 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 1082 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 1083 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk) 1084 CASE( 'F' ) 1085 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) & 1086 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) & 1087 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 1088 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk) 1089 END SELECT 1090 END DO 1091 END DO 1092 END DO 1093 ! 1094 ii0 = 627 ; ii1 = 628 ! Bosphorus Strait (e2u was modified) 1095 ij0 = 343 ; ij1 = 343 1096 DO jk = 1, jpkm1 1097 DO jj = mj0(ij0), mj1(ij1) 1098 DO ji = mi0(ii0), mi1(ii1) 1099 SELECT CASE ( pout ) 1100 CASE( 'U' ) 1101 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) & 1102 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 1103 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 1104 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk) 1105 CASE( 'F' ) 1106 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) & 1107 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) & 1108 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 1109 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk) 1110 END SELECT 1111 END DO 1112 END DO 1113 END DO 1114 ! 1115 ii0 = 93 ; ii1 = 94 ! Sumba Strait (e2u was modified) 1116 ij0 = 232 ; ij1 = 232 1117 DO jk = 1, jpkm1 1118 DO jj = mj0(ij0), mj1(ij1) 1119 DO ji = mi0(ii0), mi1(ii1) 1120 SELECT CASE ( pout ) 1121 CASE( 'U' ) 1122 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) & 1123 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 1124 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 1125 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk) 1126 CASE( 'F' ) 1127 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) & 1128 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) & 1129 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 1130 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk) 1131 END SELECT 1132 END DO 1133 END DO 1134 END DO 1135 ! 1136 ii0 = 103 ; ii1 = 103 ! Ombai Strait (e2u was modified) 1137 ij0 = 232 ; ij1 = 232 1138 DO jk = 1, jpkm1 1139 DO jj = mj0(ij0), mj1(ij1) 1140 DO ji = mi0(ii0), mi1(ii1) 1141 SELECT CASE ( pout ) 1142 CASE( 'U' ) 1143 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) & 1144 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 1145 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 1146 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk) 1147 CASE( 'F' ) 1148 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) & 1149 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) & 1150 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 1151 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk) 1152 END SELECT 1153 END DO 1154 END DO 1155 END DO 1156 ! 1157 ii0 = 15 ; ii1 = 15 ! Palk Strait (e2u was modified) 1158 ij0 = 270 ; ij1 = 270 1159 DO jk = 1, jpkm1 1160 DO jj = mj0(ij0), mj1(ij1) 1161 DO ji = mi0(ii0), mi1(ii1) 1162 SELECT CASE ( pout ) 1163 CASE( 'U' ) 1164 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) & 1165 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 1166 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 1167 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk) 1168 CASE( 'F' ) 1169 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) & 1170 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) & 1171 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 1172 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk) 1173 END SELECT 1174 END DO 1175 END DO 1176 END DO 1177 ! 1178 ii0 = 87 ; ii1 = 87 ! Lombok Strait (e1v was modified) 1179 ij0 = 232 ; ij1 = 233 1180 DO jk = 1, jpkm1 1181 DO jj = mj0(ij0), mj1(ij1) 1182 DO ji = mi0(ii0), mi1(ii1) 1183 SELECT CASE ( pout ) 1184 CASE( 'V' ) 1185 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) & 1186 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 1187 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 1188 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk) 1189 END SELECT 1190 END DO 1191 END DO 1192 END DO 1193 ! 1194 ii0 = 662 ; ii1 = 662 ! Bab el Mandeb (e1v was modified) 1195 ij0 = 276 ; ij1 = 276 1196 DO jk = 1, jpkm1 1197 DO jj = mj0(ij0), mj1(ij1) 1198 DO ji = mi0(ii0), mi1(ii1) 1199 SELECT CASE ( pout ) 1200 CASE( 'V' ) 1201 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) & 1202 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 1203 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 1204 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk) 1205 END SELECT 1206 END DO 1207 END DO 1208 END DO 1209 ENDIF 1210 END SUBROUTINE dom_vvl_orca_fix 1211 796 1212 !!====================================================================== 797 1213 END MODULE domvvl
Note: See TracChangeset
for help on using the changeset viewer.
