Changeset 11099 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/tests/VORTEX/MY_SRC/domvvl.F90
- Timestamp:
- 2019-06-11T15:59:58+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/tests/VORTEX/MY_SRC/domvvl.F90
r10572 r11099 106 106 !! - Regrid: e3(u/v)_n 107 107 !! e3(u/v)_b 108 !! e3w _n108 !! e3w(:,:,:,Kmm) 109 109 !! e3(u/v)w_b 110 110 !! e3(u/v)w_n 111 !! gdept _n, gdepw_n and gde3w_n111 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 112 112 !! - h(t/u/v)_0 113 113 !! - frq_rst_e3t and frq_rst_hdv … … 131 131 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 132 132 CALL dom_vvl_rst( nit000, 'READ' ) 133 e3t _a(:,:,jpk) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all133 e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all 134 134 ! 135 135 ! !== Set of all other vertical scale factors ==! (now and before) 136 136 ! ! Horizontal interpolation of e3t 137 CALL dom_vvl_interpol( e3t _b(:,:,:), e3u_b(:,:,:), 'U' ) ! from T to U138 CALL dom_vvl_interpol( e3t _n(:,:,:), e3u_n(:,:,:), 'U' )139 CALL dom_vvl_interpol( e3t _b(:,:,:), e3v_b(:,:,:), 'V' ) ! from T to V140 CALL dom_vvl_interpol( e3t _n(:,:,:), e3v_n(:,:,:), 'V' )141 CALL dom_vvl_interpol( e3u _n(:,:,:), e3f_n(:,:,:), 'F' ) ! from U to F137 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) ! from T to U 138 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 139 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) ! from T to V 140 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 141 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) ! from U to F 142 142 ! ! Vertical interpolation of e3t,u,v 143 CALL dom_vvl_interpol( e3t _n(:,:,:), e3w_n (:,:,:), 'W' ) ! from T to W144 CALL dom_vvl_interpol( e3t _b(:,:,:), e3w_b (:,:,:), 'W' )145 CALL dom_vvl_interpol( e3u _n(:,:,:), e3uw_n(:,:,:), 'UW' ) ! from U to UW146 CALL dom_vvl_interpol( e3u _b(:,:,:), e3uw_b(:,:,:), 'UW' )147 CALL dom_vvl_interpol( e3v _n(:,:,:), e3vw_n(:,:,:), 'VW' ) ! from V to UW148 CALL dom_vvl_interpol( e3v _b(:,:,:), e3vw_b(:,:,:), 'VW' )143 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) ! from T to W 144 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3w (:,:,:,Kbb), 'W' ) 145 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) ! from U to UW 146 CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 147 CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) ! from V to UW 148 CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 149 149 150 150 ! We need to define e3[tuv]_a for AGRIF initialisation (should not be a problem for the restartability...) 151 e3t _a(:,:,:) = e3t_n(:,:,:)152 e3u _a(:,:,:) = e3u_n(:,:,:)153 e3v _a(:,:,:) = e3v_n(:,:,:)151 e3t(:,:,:,Kaa) = e3t(:,:,:,Kmm) 152 e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) 153 e3v(:,:,:,Kaa) = e3v(:,:,:,Kmm) 154 154 ! 155 155 ! !== depth of t and w-point ==! (set the isf depth as it is in the initial timestep) 156 gdept _n(:,:,1) = 0.5_wp * e3w_n(:,:,1) ! reference to the ocean surface (used for MLD and light penetration)157 gdepw _n(:,:,1) = 0.0_wp158 gde3w _n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) ! reference to a common level z=0 for hpg159 gdept _b(:,:,1) = 0.5_wp * e3w_b(:,:,1)160 gdepw _b(:,:,1) = 0.0_wp156 gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) ! reference to the ocean surface (used for MLD and light penetration) 157 gdepw(:,:,1,Kmm) = 0.0_wp 158 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) ! reference to a common level z=0 for hpg 159 gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 160 gdepw(:,:,1,Kbb) = 0.0_wp 161 161 DO jk = 2, jpk ! vertical sum 162 162 DO jj = 1,jpj … … 165 165 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 166 166 ! ! 0.5 where jk = mikt 167 !!gm ??????? BUG ? gdept _n as well as gde3w_ndoes not include the thickness of ISF ??167 !!gm ??????? BUG ? gdept(:,:,:,Kmm) as well as gde3w does not include the thickness of ISF ?? 168 168 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 169 gdepw _n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)170 gdept _n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk)) &171 & + (1-zcoef) * ( gdept _n(ji,jj,jk-1) + e3w_n(ji,jj,jk))172 gde3w _n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)173 gdepw _b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1)174 gdept _b(ji,jj,jk) = zcoef * ( gdepw_b(ji,jj,jk ) + 0.5 * e3w_b(ji,jj,jk)) &175 & + (1-zcoef) * ( gdept _b(ji,jj,jk-1) + e3w_b(ji,jj,jk))169 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 170 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 171 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 172 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 173 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 174 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 175 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 176 176 END DO 177 177 END DO … … 179 179 ! 180 180 ! !== thickness of the water column !! (ocean portion only) 181 ht _n(:,:) = e3t_n(:,:,1) * tmask(:,:,1) !!gm BUG : this should be 1/2 * e3w(k=1) ....182 hu _b(:,:) = e3u_b(:,:,1) * umask(:,:,1)183 hu _n(:,:) = e3u_n(:,:,1) * umask(:,:,1)184 hv _b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)185 hv _n(:,:) = e3v_n(:,:,1) * vmask(:,:,1)181 ht(:,:) = e3t(:,:,1,Kmm) * tmask(:,:,1) !!gm BUG : this should be 1/2 * e3w(k=1) .... 182 hu(:,:,Kbb) = e3u(:,:,1,Kbb) * umask(:,:,1) 183 hu(:,:,Kmm) = e3u(:,:,1,Kmm) * umask(:,:,1) 184 hv(:,:,Kbb) = e3v(:,:,1,Kbb) * vmask(:,:,1) 185 hv(:,:,Kmm) = e3v(:,:,1,Kmm) * vmask(:,:,1) 186 186 DO jk = 2, jpkm1 187 ht _n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)188 hu _b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)189 hu _n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)190 hv _b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)191 hv _n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)187 ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 188 hu(:,:,Kbb) = hu(:,:,Kbb) + e3u(:,:,jk,Kbb) * umask(:,:,jk) 189 hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 190 hv(:,:,Kbb) = hv(:,:,Kbb) + e3v(:,:,jk,Kbb) * vmask(:,:,jk) 191 hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 192 192 END DO 193 193 ! 194 194 ! !== inverse of water column thickness ==! (u- and v- points) 195 r1_hu _b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF196 r1_hu _n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) )197 r1_hv _b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )198 r1_hv _n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) )195 r1_hu(:,:,Kbb) = ssumask(:,:) / ( hu(:,:,Kbb) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF 196 r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 197 r1_hv(:,:,Kbb) = ssvmask(:,:) / ( hv(:,:,Kbb) + 1._wp - ssvmask(:,:) ) 198 r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) 199 199 200 200 ! !== z_tilde coordinate case ==! (Restoring frequencies) … … 321 321 ! ! --------------------------------------------- ! 322 322 ! 323 z_scale(:,:) = ( ssh a(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) )323 z_scale(:,:) = ( ssh(:,:,Kaa) - ssh(:,:,Kbb) ) * ssmask(:,:) / ( ht_0(:,:) + ssh(:,:,Kmm) + 1. - ssmask(:,:) ) 324 324 DO jk = 1, jpkm1 325 ! formally this is the same as e3t _a= e3t_0*(1+ssha/ht_0)326 e3t _a(:,:,jk) = e3t_b(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)325 ! formally this is the same as e3t(:,:,:,Kaa) = e3t_0*(1+ssha/ht_0) 326 e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kbb) + e3t(:,:,jk,Kmm) * z_scale(:,:) * tmask(:,:,jk) 327 327 END DO 328 328 ! … … 337 337 zht(:,:) = 0._wp 338 338 DO jk = 1, jpkm1 339 zhdiv(:,:) = zhdiv(:,:) + e3t _n(:,:,jk) * hdivn(:,:,jk)340 zht (:,:) = zht (:,:) + e3t _n(:,:,jk) * tmask(:,:,jk)339 zhdiv(:,:) = zhdiv(:,:) + e3t(:,:,jk,Kmm) * hdiv(:,:,jk) 340 zht (:,:) = zht (:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 341 341 END DO 342 342 zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) ) … … 348 348 DO jk = 1, jpkm1 349 349 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:) & 350 & * ( hdiv_lf(:,:,jk) - e3t _n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) )350 & * ( hdiv_lf(:,:,jk) - e3t(:,:,jk,Kmm) * ( hdiv(:,:,jk) - zhdiv(:,:) ) ) 351 351 END DO 352 352 ENDIF … … 361 361 IF( ln_vvl_ztilde ) THEN ! z_tilde case 362 362 DO jk = 1, jpkm1 363 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t _n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) )363 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t(:,:,jk,Kmm) * ( hdiv(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 364 364 END DO 365 365 ELSE ! layer case 366 366 DO jk = 1, jpkm1 367 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - e3t _n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk)367 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - e3t(:,:,jk,Kmm) * ( hdiv(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 368 368 END DO 369 369 ENDIF … … 476 476 zht(:,:) = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk) 477 477 END DO 478 z_scale(:,:) = - zht(:,:) / ( ht_0(:,:) + ssh n(:,:) + 1. - ssmask(:,:) )478 z_scale(:,:) = - zht(:,:) / ( ht_0(:,:) + ssh(:,:,Kmm) + 1. - ssmask(:,:) ) 479 479 DO jk = 1, jpkm1 480 dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t _n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)480 dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t(:,:,jk,Kmm) * z_scale(:,:) * tmask(:,:,jk) 481 481 END DO 482 482 … … 486 486 ! ! ---baroclinic part--------- ! 487 487 DO jk = 1, jpkm1 488 e3t _a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk)488 e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kaa) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 489 489 END DO 490 490 ENDIF … … 501 501 zht(:,:) = 0.0_wp 502 502 DO jk = 1, jpkm1 503 zht(:,:) = zht(:,:) + e3t _n(:,:,jk) * tmask(:,:,jk)504 END DO 505 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssh n(:,:) - zht(:,:) ) )503 zht(:,:) = zht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 504 END DO 505 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssh(:,:,Kmm) - zht(:,:) ) ) 506 506 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 507 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t _n))) =', z_tmax507 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t(:,:,:,Kmm)))) =', z_tmax 508 508 ! 509 509 zht(:,:) = 0.0_wp 510 510 DO jk = 1, jpkm1 511 zht(:,:) = zht(:,:) + e3t _a(:,:,jk) * tmask(:,:,jk)512 END DO 513 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssh a(:,:) - zht(:,:) ) )511 zht(:,:) = zht(:,:) + e3t(:,:,jk,Kaa) * tmask(:,:,jk) 512 END DO 513 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssh(:,:,Kaa) - zht(:,:) ) ) 514 514 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 515 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t _a))) =', z_tmax515 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t(:,:,:,Kaa)))) =', z_tmax 516 516 ! 517 517 zht(:,:) = 0.0_wp 518 518 DO jk = 1, jpkm1 519 zht(:,:) = zht(:,:) + e3t _b(:,:,jk) * tmask(:,:,jk)520 END DO 521 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssh b(:,:) - zht(:,:) ) )519 zht(:,:) = zht(:,:) + e3t(:,:,jk,Kbb) * tmask(:,:,jk) 520 END DO 521 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssh(:,:,Kbb) - zht(:,:) ) ) 522 522 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 523 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t _b))) =', z_tmax524 ! 525 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssh b(:,:) ) )523 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t(:,:,:,Kbb)))) =', z_tmax 524 ! 525 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssh(:,:,Kbb) ) ) 526 526 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 527 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssh b))) =', z_tmax528 ! 529 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssh n(:,:) ) )527 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssh(:,:,Kbb)))) =', z_tmax 528 ! 529 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssh(:,:,Kmm) ) ) 530 530 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 531 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssh n))) =', z_tmax532 ! 533 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssh a(:,:) ) )531 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssh(:,:,Kmm)))) =', z_tmax 532 ! 533 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssh(:,:,Kaa) ) ) 534 534 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 535 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssh a))) =', z_tmax535 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssh(:,:,Kaa)))) =', z_tmax 536 536 END IF 537 537 … … 540 540 ! *********************************** ! 541 541 542 CALL dom_vvl_interpol( e3t _a(:,:,:), e3u_a(:,:,:), 'U' )543 CALL dom_vvl_interpol( e3t _a(:,:,:), e3v_a(:,:,:), 'V' )542 CALL dom_vvl_interpol( e3t(:,:,:,Kaa), e3u(:,:,:,Kaa), 'U' ) 543 CALL dom_vvl_interpol( e3t(:,:,:,Kaa), e3v(:,:,:,Kaa), 'V' ) 544 544 545 545 ! *********************************** ! … … 547 547 ! *********************************** ! 548 548 549 hu _a(:,:) = e3u_a(:,:,1) * umask(:,:,1)550 hv _a(:,:) = e3v_a(:,:,1) * vmask(:,:,1)549 hu(:,:,Kaa) = e3u(:,:,1,Kaa) * umask(:,:,1) 550 hv(:,:,Kaa) = e3v(:,:,1,Kaa) * vmask(:,:,1) 551 551 DO jk = 2, jpkm1 552 hu _a(:,:) = hu_a(:,:) + e3u_a(:,:,jk) * umask(:,:,jk)553 hv _a(:,:) = hv_a(:,:) + e3v_a(:,:,jk) * vmask(:,:,jk)552 hu(:,:,Kaa) = hu(:,:,Kaa) + e3u(:,:,jk,Kaa) * umask(:,:,jk) 553 hv(:,:,Kaa) = hv(:,:,Kaa) + e3v(:,:,jk,Kaa) * vmask(:,:,jk) 554 554 END DO 555 555 ! ! Inverse of the local depth 556 556 !!gm BUG ? don't understand the use of umask_i here ..... 557 r1_hu _a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) )558 r1_hv _a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) )557 r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 558 r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 559 559 ! 560 560 IF( ln_timing ) CALL timing_stop('dom_vvl_sf_nxt') … … 578 578 !! - Recompute: 579 579 !! e3(u/v)_b 580 !! e3w _n580 !! e3w(:,:,:,Kmm) 581 581 !! e3(u/v)w_b 582 582 !! e3(u/v)w_n 583 !! gdept _n, gdepw_n and gde3w_n583 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 584 584 !! h(u/v) and h(u/v)r 585 585 !! … … 615 615 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 616 616 ENDIF 617 gdept _b(:,:,:) = gdept_n(:,:,:)618 gdepw _b(:,:,:) = gdepw_n(:,:,:)619 620 e3t _n(:,:,:) = e3t_a(:,:,:)621 e3u _n(:,:,:) = e3u_a(:,:,:)622 e3v _n(:,:,:) = e3v_a(:,:,:)617 gdept(:,:,:,Kbb) = gdept(:,:,:,Kmm) 618 gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm) 619 620 e3t(:,:,:,Kmm) = e3t(:,:,:,Kaa) 621 e3u(:,:,:,Kmm) = e3u(:,:,:,Kaa) 622 e3v(:,:,:,Kmm) = e3v(:,:,:,Kaa) 623 623 624 624 ! Compute all missing vertical scale factor and depths … … 626 626 ! Horizontal scale factor interpolations 627 627 ! -------------------------------------- 628 ! - ML - e3u _b and e3v_bare allready computed in dynnxt629 ! - JC - hu _b, hv_b, hur_b, hvr_b also628 ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are allready computed in dynnxt 629 ! - JC - hu(:,:,Kbb), hv(:,:,Kbb), hur_b, hvr_b also 630 630 631 CALL dom_vvl_interpol( e3u _n(:,:,:), e3f_n(:,:,:), 'F' )631 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 632 632 633 633 ! Vertical scale factor interpolations 634 CALL dom_vvl_interpol( e3t _n(:,:,:), e3w_n(:,:,:), 'W' )635 CALL dom_vvl_interpol( e3u _n(:,:,:), e3uw_n(:,:,:), 'UW' )636 CALL dom_vvl_interpol( e3v _n(:,:,:), e3vw_n(:,:,:), 'VW' )637 CALL dom_vvl_interpol( e3t _b(:,:,:), e3w_b(:,:,:), 'W' )638 CALL dom_vvl_interpol( e3u _b(:,:,:), e3uw_b(:,:,:), 'UW' )639 CALL dom_vvl_interpol( e3v _b(:,:,:), e3vw_b(:,:,:), 'VW' )634 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w(:,:,:,Kmm), 'W' ) 635 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 636 CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 637 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3w(:,:,:,Kbb), 'W' ) 638 CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 639 CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 640 640 641 641 ! t- and w- points depth (set the isf depth as it is in the initial step) 642 gdept _n(:,:,1) = 0.5_wp * e3w_n(:,:,1)643 gdepw _n(:,:,1) = 0.0_wp644 gde3w _n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)642 gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 643 gdepw(:,:,1,Kmm) = 0.0_wp 644 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 645 645 DO jk = 2, jpk 646 646 DO jj = 1,jpj … … 649 649 ! 1 for jk = mikt 650 650 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 651 gdepw _n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)652 gdept _n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk) ) &653 & + (1-zcoef) * ( gdept _n(ji,jj,jk-1) + e3w_n(ji,jj,jk) )654 gde3w _n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)651 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 652 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 653 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 654 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 655 655 END DO 656 656 END DO … … 659 659 ! Local depth and Inverse of the local depth of the water 660 660 ! ------------------------------------------------------- 661 hu _n(:,:) = hu_a(:,:) ; r1_hu_n(:,:) = r1_hu_a(:,:)662 hv _n(:,:) = hv_a(:,:) ; r1_hv_n(:,:) = r1_hv_a(:,:)663 ! 664 ht _n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)661 hu(:,:,Kmm) = hu(:,:,Kaa) ; r1_hu(:,:,Kmm) = r1_hu(:,:,Kaa) 662 hv(:,:,Kmm) = hv(:,:,Kaa) ; r1_hv(:,:,Kmm) = r1_hv(:,:,Kaa) 663 ! 664 ht(:,:) = e3t(:,:,1,Kmm) * tmask(:,:,1) 665 665 DO jk = 2, jpkm1 666 ht _n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)666 ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 667 667 END DO 668 668 … … 806 806 IF( ln_rstart ) THEN !* Read the restart file 807 807 CALL rst_read_open ! open the restart file if necessary 808 CALL iom_get( numror, jpdom_autoglo, 'sshn' , ssh n, ldxios = lrxios )808 CALL iom_get( numror, jpdom_autoglo, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 809 809 ! 810 810 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 817 817 ! ! --------- ! 818 818 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 819 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t _b(:,:,:), ldxios = lrxios )820 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t _n(:,:,:), ldxios = lrxios )819 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 820 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 821 821 ! needed to restart if land processor not computed 822 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t _b and e3t_nfound in restart files'822 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 823 823 WHERE ( tmask(:,:,:) == 0.0_wp ) 824 e3t _n(:,:,:) = e3t_0(:,:,:)825 e3t _b(:,:,:) = e3t_0(:,:,:)824 e3t(:,:,:,Kmm) = e3t_0(:,:,:) 825 e3t(:,:,:,Kbb) = e3t_0(:,:,:) 826 826 END WHERE 827 827 IF( neuler == 0 ) THEN 828 e3t _b(:,:,:) = e3t_n(:,:,:)828 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 829 829 ENDIF 830 830 ELSE IF( id1 > 0 ) THEN 831 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t _nnot found in restart files'831 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 832 832 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 833 833 IF(lwp) write(numout,*) 'neuler is forced to 0' 834 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t _b(:,:,:), ldxios = lrxios )835 e3t _n(:,:,:) = e3t_b(:,:,:)834 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 835 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 836 836 neuler = 0 837 837 ELSE IF( id2 > 0 ) THEN 838 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t _bnot found in restart files'838 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 839 839 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 840 840 IF(lwp) write(numout,*) 'neuler is forced to 0' 841 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t _n(:,:,:), ldxios = lrxios )842 e3t _b(:,:,:) = e3t_n(:,:,:)841 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 842 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 843 843 neuler = 0 844 844 ELSE 845 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t _nnot found in restart file'845 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 846 846 IF(lwp) write(numout,*) 'Compute scale factor from sshn' 847 847 IF(lwp) write(numout,*) 'neuler is forced to 0' 848 848 DO jk = 1, jpk 849 e3t _n(:,:,jk) = e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) &849 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 850 850 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 851 851 & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk)) 852 852 END DO 853 e3t _b(:,:,:) = e3t_n(:,:,:)853 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 854 854 neuler = 0 855 855 ENDIF … … 888 888 IF( cn_cfg == 'wad' ) THEN 889 889 ! Wetting and drying test case 890 CALL usr_def_istate( gdept _b, tmask, tsb, ub, vb, sshb)891 ts n (:,:,:,:) = tsb (:,:,:,:) ! set now values from to before ones892 ssh n (:,:) = sshb(:,:)893 u n (:,:,:) = ub (:,:,:)894 v n (:,:,:) = vb (:,:,:)890 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 891 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 892 ssh (:,:,Kmm) = ssh(:,:,Kbb) 893 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 894 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 895 895 ELSE 896 896 ! if not test case 897 ssh n(:,:) = -ssh_ref898 ssh b(:,:) = -ssh_ref897 ssh(:,:,Kmm) = -ssh_ref 898 ssh(:,:,Kbb) = -ssh_ref 899 899 900 900 DO jj = 1, jpj … … 902 902 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 903 903 904 ssh b(ji,jj) = rn_wdmin1 - (ht_0(ji,jj) )905 ssh n(ji,jj) = rn_wdmin1 - (ht_0(ji,jj) )906 ssh a(ji,jj) = rn_wdmin1 - (ht_0(ji,jj) )904 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 905 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 906 ssh(ji,jj,Kaa) = rn_wdmin1 - (ht_0(ji,jj) ) 907 907 ENDIF 908 908 ENDDO … … 912 912 ! Adjust vertical metrics for all wad 913 913 DO jk = 1, jpk 914 e3t _n(:,:,jk) = e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) &914 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 915 915 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 916 916 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 917 917 END DO 918 e3t _b(:,:,:) = e3t_n(:,:,:)918 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 919 919 920 920 DO ji = 1, jpi … … 928 928 ELSE 929 929 ! 930 ! usr_def_istate called here only to get ssh b, that is needed to initialize e3t_b and e3t_n931 CALL usr_def_istate( gdept_0, tmask, ts b, ub, vb, sshb)930 ! usr_def_istate called here only to get ssh(:,:,Kbb), that is needed to initialize e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) 931 CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 932 932 ! usr_def_istate will be called again in istate_init to initialize ts(bn), ssh(bn), u(bn) and v(bn) 933 933 ! 934 934 DO jk=1,jpk 935 e3t _b(:,:,jk) = e3t_0(:,:,jk) * ( ht_0(:,:) + sshb(:,:) ) &935 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 936 936 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 937 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) ! make sure e3t _b!= 0 on land points937 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) ! make sure e3t(:,:,:,Kbb) != 0 on land points 938 938 END DO 939 e3t _n(:,:,:) = e3t_b(:,:,:)940 ssh n(:,:) = sshb(:,:) ! needed later for gde3w941 !!$ e3t _n(:,:,:)=e3t_0(:,:,:)942 !!$ e3t _b(:,:,:)=e3t_0(:,:,:)939 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 940 ssh(:,:,Kmm) = ssh(:,:,Kbb) ! needed later for gde3w 941 !!$ e3t(:,:,:,Kmm)=e3t_0(:,:,:) 942 !!$ e3t(:,:,:,Kbb)=e3t_0(:,:,:) 943 943 ! 944 944 END IF ! end of ll_wd edits … … 958 958 ! ! all cases ! 959 959 ! ! --------- ! 960 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t _b(:,:,:), ldxios = lwxios )961 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t _n(:,:,:), ldxios = lwxios )960 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lwxios ) 961 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios ) 962 962 ! ! ----------------------- ! 963 963 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases !
Note: See TracChangeset
for help on using the changeset viewer.
