- Timestamp:
- 2020-12-02T14:55:21+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3
- Files:
-
- 16 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette@13 292sette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/divhor.F90
r13295 r13998 77 77 ENDIF 78 78 ! 79 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 80 hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) &79 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Horizontal divergence ==! 80 hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) & 81 81 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) & 82 82 & + e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) * vv(ji,jj ,jk,Kmm) & -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynadv_cen2.F90
r13295 r13998 72 72 zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 73 73 zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 74 DO_2D( 1, 0, 1, 0 ) 74 DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes (at T- and F-point) 75 75 zfu_t(ji+1,jj ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) ) 76 76 zfv_f(ji ,jj ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) … … 78 78 zfv_t(ji ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) ) 79 79 END_2D 80 DO_2D( 0, 0, 0, 0 ) 80 DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes 81 81 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 82 82 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & … … 98 98 ! !== Vertical advection ==! 99 99 ! 100 DO_2D( 0, 0, 0, 0 ) 100 DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero 101 101 zfu_uw(ji,jj,jpk) = 0._wp ; zfv_vw(ji,jj,jpk) = 0._wp 102 102 zfu_uw(ji,jj, 1 ) = 0._wp ; zfv_vw(ji,jj, 1 ) = 0._wp … … 109 109 ENDIF 110 110 DO jk = 2, jpkm1 ! interior advective fluxes 111 DO_2D( 0, 1, 0, 1 ) 111 DO_2D( 0, 1, 0, 1 ) ! 1/4 * Vertical transport 112 112 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 113 113 END_2D … … 117 117 END_2D 118 118 END DO 119 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 119 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 120 120 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 121 121 & / e3u(ji,jj,jk,Kmm) -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynadv_ubs.F90
r13295 r13998 108 108 zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 109 109 ! 110 DO_2D( 0, 0, 0, 0 ) 110 DO_2D( 0, 0, 0, 0 ) ! laplacian 111 111 zlu_uu(ji,jj,jk,1) = ( puu (ji+1,jj ,jk,Kbb) - 2.*puu (ji,jj,jk,Kbb) + puu (ji-1,jj ,jk,Kbb) ) * umask(ji,jj,jk) 112 112 zlv_vv(ji,jj,jk,1) = ( pvv (ji ,jj+1,jk,Kbb) - 2.*pvv (ji,jj,jk,Kbb) + pvv (ji ,jj-1,jk,Kbb) ) * vmask(ji,jj,jk) … … 136 136 zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 137 137 ! 138 DO_2D( 1, 0, 1, 0 ) 138 DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes at T- and F-point 139 139 zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) ) 140 140 zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) ) … … 168 168 & * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) - gamma1 * zl_v ) 169 169 END_2D 170 DO_2D( 0, 0, 0, 0 ) 170 DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes 171 171 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 172 172 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & … … 187 187 ! ! Vertical advection ! 188 188 ! ! ==================== ! 189 DO_2D( 0, 0, 0, 0 ) 189 DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero 190 190 zfu_uw(ji,jj,jpk) = 0._wp 191 191 zfv_vw(ji,jj,jpk) = 0._wp … … 208 208 END_2D 209 209 END DO 210 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 210 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 211 211 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 212 212 & / e3u(ji,jj,jk,Kmm) -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynatf.F90
r13295 r13998 34 34 USE dynspg_ts ! surface pressure gradient: split-explicit scheme 35 35 USE domvvl ! variable volume 36 USE bdy_oce , ONLY: ln_bdy36 USE bdy_oce , ONLY : ln_bdy 37 37 USE bdydta ! ocean open boundary conditions 38 38 USE bdydyn ! ocean open boundary conditions … … 50 50 USE prtctl ! Print control 51 51 USE timing ! Timing 52 USE zdfdrg , ONLY : ln_drgice_imp, rCdU_top 52 53 #if defined key_agrif 53 54 USE agrif_oce_interp … … 120 121 REAL(wp) :: zve3a, zve3n, zve3b, z1_2dt ! - - 121 122 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve, zwfld 123 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zutau, zvtau 122 124 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze3t_f, ze3u_f, ze3v_f, zua, zva 123 125 !!---------------------------------------------------------------------- … … 321 323 ENDIF 322 324 ! 325 IF ( iom_use("utau") ) THEN 326 IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 327 ALLOCATE(zutau(jpi,jpj)) 328 DO_2D( 0, 0, 0, 0 ) 329 jk = miku(ji,jj) 330 zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * puu(ji,jj,jk,Kaa) 331 END_2D 332 CALL iom_put( "utau", zutau(:,:) ) 333 DEALLOCATE(zutau) 334 ELSE 335 CALL iom_put( "utau", utau(:,:) ) 336 ENDIF 337 ENDIF 338 ! 339 IF ( iom_use("vtau") ) THEN 340 IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 341 ALLOCATE(zvtau(jpi,jpj)) 342 DO_2D( 0, 0, 0, 0 ) 343 jk = mikv(ji,jj) 344 zvtau(ji,jj) = vtau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * pvv(ji,jj,jk,Kaa) 345 END_2D 346 CALL iom_put( "vtau", zvtau(:,:) ) 347 DEALLOCATE(zvtau) 348 ELSE 349 CALL iom_put( "vtau", vtau(:,:) ) 350 ENDIF 351 ENDIF 352 ! 323 353 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' nxt - puu(:,:,:,Kaa): ', mask1=umask, & 324 354 & tab3d_2=pvv(:,:,:,Kaa), clinfo2=' pvv(:,:,:,Kaa): ' , mask2=vmask ) -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynkeg.F90
r13295 r13998 125 125 END SELECT 126 126 ! 127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== grad( KE ) added to the general momentum trends ==! 128 128 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 129 129 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynldf_iso.F90
r13295 r13998 128 128 IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 129 129 ! 130 DO_3D( 0, 0, 0, 0, 1, jpk ) 130 DO_3D( 0, 0, 0, 0, 1, jpk ) ! set the slopes of iso-level 131 131 uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 132 132 vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) … … 268 268 ! Second derivative (divergence) and add to the general trend 269 269 ! ----------------------------------------------------------- 270 DO_2D( 0, 0, 0, 0 ) 270 DO_2D( 0, 0, 0, 0 ) !!gm Question vectop possible??? !!bug 271 271 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( ziut(ji+1,jj) - ziut(ji,jj ) & 272 272 & + zjuf(ji ,jj) - zjuf(ji,jj-1) ) * r1_e1e2u(ji,jj) & -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynldf_lap_blp.F90
r13513 r13998 94 94 END_2D 95 95 ! 96 DO_2D( 0, 0, 0, 0 ) 96 DO_2D( 0, 0, 0, 0 ) ! - curl( curl) + grad( div ) 97 97 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * ( & ! * by umask is mandatory for dyn_ldf_blp use 98 98 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynspg.F90
r13295 r13998 102 102 IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN !== Atmospheric pressure gradient (added later in time-split case) ==! 103 103 zg_2 = grav * 0.5 104 DO_2D( 0, 0, 0, 0 ) 104 DO_2D( 0, 0, 0, 0 ) ! gradient of Patm using inverse barometer ssh 105 105 spgu(ji,jj) = spgu(ji,jj) + zg_2 * ( ssh_ib (ji+1,jj) - ssh_ib (ji,jj) & 106 106 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) … … 117 117 CALL upd_tide(zt0step, Kmm) 118 118 ! 119 DO_2D( 0, 0, 0, 0 ) 119 DO_2D( 0, 0, 0, 0 ) ! add tide potential forcing 120 120 spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 121 121 spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) … … 124 124 IF (ln_scal_load) THEN 125 125 zld = rn_scal_load * grav 126 DO_2D( 0, 0, 0, 0 ) 126 DO_2D( 0, 0, 0, 0 ) ! add scalar approximation for load potential 127 127 spgu(ji,jj) = spgu(ji,jj) + zld * ( pssh(ji+1,jj,Kmm) - pssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 128 128 spgv(ji,jj) = spgv(ji,jj) + zld * ( pssh(ji,jj+1,Kmm) - pssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) … … 143 143 ENDIF 144 144 ! 145 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 145 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Add all terms to the general trend 146 146 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 147 147 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj) -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynspg_exp.F90
r13295 r13998 74 74 IF( ln_linssh ) THEN !* linear free surface : add the surface pressure gradient trend 75 75 ! 76 DO_2D( 0, 0, 0, 0 ) 76 DO_2D( 0, 0, 0, 0 ) ! now surface pressure gradient 77 77 spgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 78 78 spgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 79 79 END_2D 80 80 ! 81 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 81 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Add it to the general trend 82 82 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 83 83 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj) -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynspg_ts.F90
r13895 r13998 264 264 IF( ln_wd_il ) THEN ! W/D : limiter applied to spgspg 265 265 CALL wad_spg( pssh(:,:,Kmm), zcpx, zcpy ) ! Calculating W/D gravity filters, zcpx and zcpy 266 DO_2D( 0, 0, 0, 0 ) 266 DO_2D( 0, 0, 0, 0 ) ! SPG with the application of W/D gravity filters 267 267 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( pssh(ji+1,jj ,Kmm) - pssh(ji ,jj ,Kmm) ) & 268 268 & * r1_e1u(ji,jj) * zcpx(ji,jj) * wdrampu(ji,jj) !jth … … 279 279 ENDIF 280 280 ! 281 DO_2D( 0, 0, 0, 0 ) 281 DO_2D( 0, 0, 0, 0 ) ! Remove coriolis term (and possibly spg) from barotropic trend 282 282 zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj) 283 283 zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj) … … 477 477 #if defined key_qcoTest_FluxForm 478 478 ! ! 'key_qcoTest_FluxForm' : simple ssh average 479 DO_2D( 1, 1, 1, 0 ) 479 DO_2D( 1, 1, 1, 0 ) ! not jpi-column 480 480 zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * ( zsshp2_e(ji,jj) + zsshp2_e(ji+1,jj ) ) * ssumask(ji,jj) 481 481 END_2D … … 485 485 #else 486 486 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 487 DO_2D( 1, 1, 1, 0 ) 487 DO_2D( 1, 1, 1, 0 ) ! not jpi-column 488 488 zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj) & 489 489 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 490 490 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) * ssumask(ji,jj) 491 491 END_2D 492 DO_2D( 1, 0, 1, 1 ) 492 DO_2D( 1, 0, 1, 1 ) ! not jpj-row 493 493 zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj) & 494 494 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & … … 950 950 CALL iom_get( numror, jpdom_auto, 'ub2_i_b' , ub2_i_b(:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios ) 951 951 CALL iom_get( numror, jpdom_auto, 'vb2_i_b' , vb2_i_b(:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios ) 952 ELSE 953 ub2_i_b(:,:) = 0._wp ; vb2_i_b(:,:) = 0._wp ! used in the 1st update of agrif 952 954 ENDIF 953 955 #endif … … 955 957 IF(lwp) WRITE(numout,*) 956 958 IF(lwp) WRITE(numout,*) ' ==>>> start from rest: set barotropic values to 0' 957 ub2_b (:,:) = 0._wp ; vb2_b(:,:) = 0._wp ! used in the 1st interpol of agrif958 un_adv (:,:) = 0._wp ; vn_adv(:,:) = 0._wp ! used in the 1st interpol of agrif959 un_bf (:,:) = 0._wp ; vn_bf(:,:) = 0._wp ! used in the 1st update of agrif959 ub2_b (:,:) = 0._wp ; vb2_b (:,:) = 0._wp ! used in the 1st interpol of agrif 960 un_adv (:,:) = 0._wp ; vn_adv (:,:) = 0._wp ! used in the 1st interpol of agrif 961 un_bf (:,:) = 0._wp ; vn_bf (:,:) = 0._wp ! used in the 1st update of agrif 960 962 #if defined key_agrif 961 IF ( .NOT.Agrif_Root() ) THEN 962 ub2_i_b(:,:) = 0._wp ; vb2_i_b(:,:) = 0._wp ! used in the 1st update of agrif 963 ENDIF 963 ub2_i_b(:,:) = 0._wp ; vb2_i_b(:,:) = 0._wp ! used in the 1st update of agrif 964 964 #endif 965 965 ENDIF … … 1295 1295 !!---------------------------------------------------------------------- 1296 1296 ! 1297 DO_2D( 1, 1, 1, 0 ) 1297 DO_2D( 1, 1, 1, 0 ) ! not jpi-column 1298 1298 IF ( phU(ji,jj) > 0._wp ) THEN ; pUmsk(ji,jj) = pTmsk(ji ,jj) 1299 1299 ELSE ; pUmsk(ji,jj) = pTmsk(ji+1,jj) … … 1303 1303 END_2D 1304 1304 ! 1305 DO_2D( 1, 0, 1, 1 ) 1305 DO_2D( 1, 0, 1, 1 ) ! not jpj-row 1306 1306 IF ( phV(ji,jj) > 0._wp ) THEN ; pVmsk(ji,jj) = pTmsk(ji,jj ) 1307 1307 ELSE ; pVmsk(ji,jj) = pTmsk(ji,jj+1) … … 1391 1391 ! !== Set the barotropic drag coef. ==! 1392 1392 ! 1393 IF( ln_isfcav ) THEN ! top+bottom friction (ocean cavities)1393 IF( ln_isfcav.OR.ln_drgice_imp ) THEN ! top+bottom friction (ocean cavities) 1394 1394 1395 1395 DO_2D( 0, 0, 0, 0 ) … … 1442 1442 ! !== TOP stress contribution from baroclinic velocities ==! (no W/D case) 1443 1443 ! 1444 IF( ln_isfcav ) THEN1444 IF( ln_isfcav.OR.ln_drgice_imp ) THEN 1445 1445 ! 1446 1446 IF( ln_bt_fw ) THEN ! FORWARD integration: use NOW top baroclinic velocity -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynvor.F90
r13734 r13998 223 223 REAL(wp) :: zx1, zy1, zx2, zy2 ! local scalars 224 224 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwt ! 2D workspace 225 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwz ! 3D workspace 225 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwz ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined 226 226 !!---------------------------------------------------------------------- 227 227 ! … … 248 248 ENDIF 249 249 END DO 250 CALL lbc_lnk( 'dynvor', zwz, 'F', 1. )250 CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 251 251 ! 252 252 END SELECT … … 591 591 REAL(wp) :: zua, zva ! local scalars 592 592 REAL(wp) :: zmsk, ze3f ! local scalars 593 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy , z1_e3f594 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse595 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zwz593 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy , z1_e3f 594 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse 595 REAL(wp), DIMENSION(jpi,jpj,jpkm1) :: zwz ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined 596 596 !!---------------------------------------------------------------------- 597 597 ! … … 740 740 REAL(wp) :: zua, zva ! local scalars 741 741 REAL(wp) :: zmsk, z1_e3t ! local scalars 742 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy743 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse744 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zwz742 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy 743 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse 744 REAL(wp), DIMENSION(jpi,jpj,jpkm1) :: zwz ! 3D workspace, avoid lbc_lnk on jpk that is not defined 745 745 !!---------------------------------------------------------------------- 746 746 ! -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynzad.F90
r13295 r13998 71 71 ENDIF 72 72 73 IF( l_trddyn ) THEN ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends73 IF( l_trddyn ) THEN ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends 74 74 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 75 75 ztrdu(:,:,:) = puu(:,:,:,Krhs) … … 77 77 ENDIF 78 78 79 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical80 DO_2D( 0, 1, 0, 1 ) 79 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 80 DO_2D( 0, 1, 0, 1 ) ! vertical fluxes 81 81 zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 82 82 END_2D 83 DO_2D( 0, 0, 0, 0 ) 83 DO_2D( 0, 0, 0, 0 ) ! vertical momentum advection at w-point 84 84 zwuw(ji,jj,jk) = ( zww(ji+1,jj ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) ) 85 85 zwvw(ji,jj,jk) = ( zww(ji ,jj+1) + zww(ji,jj) ) * ( pvv(ji,jj,jk-1,Kmm) - pvv(ji,jj,jk,Kmm) ) … … 95 95 END_2D 96 96 ! 97 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 97 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Vertical momentum advection at u- and v-points 98 98 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 99 99 & / e3u(ji,jj,jk,Kmm) … … 102 102 END_3D 103 103 104 IF( l_trddyn ) THEN ! save the vertical advection trends for diagnostic104 IF( l_trddyn ) THEN ! save the vertical advection trends for diagnostic 105 105 ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 106 106 ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) … … 108 108 DEALLOCATE( ztrdu, ztrdv ) 109 109 ENDIF 110 ! ! Control print110 ! ! Control print 111 111 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' zad - Ua: ', mask1=umask, & 112 112 & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynzdf.F90
r13295 r13998 131 131 pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - vv_b(ji,jj,Kaa) ) * vmask(ji,jj,jk) 132 132 END_3D 133 DO_2D( 0, 0, 0, 0 ) 133 DO_2D( 0, 0, 0, 0 ) ! Add bottom/top stress due to barotropic component only 134 134 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 135 135 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) … … 141 141 pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va 142 142 END_2D 143 IF( ln_isfcav ) THEN ! Ocean cavities (ISF)143 IF( ln_isfcav.OR.ln_drgice_imp ) THEN ! Ocean cavities (ISF) 144 144 DO_2D( 0, 0, 0, 0 ) 145 145 iku = miku(ji,jj) ! top ocean level at u- and v-points … … 190 190 END_3D 191 191 END SELECT 192 DO_2D( 0, 0, 0, 0 ) 192 DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions 193 193 zwi(ji,jj,1) = 0._wp 194 194 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & … … 227 227 END_3D 228 228 END SELECT 229 DO_2D( 0, 0, 0, 0 ) 229 DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions 230 230 zwi(ji,jj,1) = 0._wp 231 231 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) … … 247 247 zwd(ji,jj,iku) = zwd(ji,jj,iku) - rDt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 248 248 END_2D 249 IF ( ln_isfcav ) THEN ! top friction (always implicit)249 IF ( ln_isfcav.OR.ln_drgice_imp ) THEN ! top friction (always implicit) 250 250 DO_2D( 0, 0, 0, 0 ) 251 251 !!gm top Cd is masked (=0 outside cavities) no need of test on mik>=2 ==>> it has been suppressed … … 273 273 !----------------------------------------------------------------------- 274 274 ! 275 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 275 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 276 276 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 277 277 END_3D 278 278 ! 279 DO_2D( 0, 0, 0, 0 ) 279 DO_2D( 0, 0, 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 280 280 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & 281 281 & + r_vvl * e3u(ji,jj,1,Kaa) … … 287 287 END_3D 288 288 ! 289 DO_2D( 0, 0, 0, 0 ) 289 DO_2D( 0, 0, 0, 0 ) !== thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk ==! 290 290 puu(ji,jj,jpkm1,Kaa) = puu(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1) 291 291 END_2D … … 329 329 END_3D 330 330 END SELECT 331 DO_2D( 0, 0, 0, 0 ) 331 DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions 332 332 zwi(ji,jj,1) = 0._wp 333 333 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & … … 366 366 END_3D 367 367 END SELECT 368 DO_2D( 0, 0, 0, 0 ) 368 DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions 369 369 zwi(ji,jj,1) = 0._wp 370 370 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) … … 385 385 zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va 386 386 END_2D 387 IF ( ln_isfcav ) THEN387 IF ( ln_isfcav.OR.ln_drgice_imp ) THEN 388 388 DO_2D( 0, 0, 0, 0 ) 389 389 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) … … 410 410 !----------------------------------------------------------------------- 411 411 ! 412 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 412 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 413 413 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 414 414 END_3D 415 415 ! 416 DO_2D( 0, 0, 0, 0 ) 416 DO_2D( 0, 0, 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 417 417 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & 418 418 & + r_vvl * e3v(ji,jj,1,Kaa) … … 424 424 END_3D 425 425 ! 426 DO_2D( 0, 0, 0, 0 ) 426 DO_2D( 0, 0, 0, 0 ) !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk ==! 427 427 pvv(ji,jj,jpkm1,Kaa) = pvv(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1) 428 428 END_2D -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/sshwzv.F90
r13915 r13998 206 206 ELSE !== Quasi-Eulerian vertical coordinate ==! ('key_qco') 207 207 ! !==========================================! 208 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence208 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 209 209 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) & 210 210 & + r1_Dt * ( e3t(:,:,jk,Kaa) & … … 398 398 ! 399 399 IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN ! Quick check if any breaches anywhere 400 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 400 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! or scan Courant criterion and partition ! w where necessary 401 401 ! 402 402 zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) ) -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/wet_dry.F90
r13295 r13998 57 57 REAL(wp), PUBLIC :: ssh_ref !: height of z=0 with respect to the geoid; 58 58 59 LOGICAL, PUBLIC :: ll_wd !: Wetting/drying activation switch if either ln_wd_il or ln_wd_dl59 LOGICAL, PUBLIC :: ll_wd = .FALSE. !: Wetting/drying activation switch (ln_wd_il or ln_wd_dl) <- default def if wad_init not called 60 60 61 61 PUBLIC wad_init ! initialisation routine called by step.F90 … … 111 111 112 112 r_rn_wdmin1 = 1 / rn_wdmin1 113 ll_wd = .FALSE.114 113 IF( ln_wd_il .OR. ln_wd_dl ) THEN 115 114 ll_wd = .TRUE. … … 307 306 zwdlmtv(:,:) = 1._wp 308 307 ! 309 DO_2D( 0, 1, 0, 1 ) 308 DO_2D( 0, 1, 0, 1 ) ! Horizontal Flux in u and v direction 310 309 ! 311 310 IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE ! we don't care about land cells
Note: See TracChangeset
for help on using the changeset viewer.