Changeset 13295 for NEMO/trunk/src/OCE/DYN
- Timestamp:
- 2020-07-10T20:24:21+02:00 (4 years ago)
- Location:
- NEMO/trunk/src/OCE/DYN
- Files:
-
- 17 edited
-
divhor.F90 (modified) (1 diff)
-
dynadv_cen2.F90 (modified) (4 diffs)
-
dynadv_ubs.F90 (modified) (6 diffs)
-
dynatf.F90 (modified) (3 diffs)
-
dynatf_qco.F90 (modified) (3 diffs)
-
dynhpg.F90 (modified) (25 diffs)
-
dynkeg.F90 (modified) (3 diffs)
-
dynldf_iso.F90 (modified) (8 diffs)
-
dynldf_lap_blp.F90 (modified) (2 diffs)
-
dynspg.F90 (modified) (6 diffs)
-
dynspg_exp.F90 (modified) (1 diff)
-
dynspg_ts.F90 (modified) (42 diffs)
-
dynvor.F90 (modified) (27 diffs)
-
dynzad.F90 (modified) (3 diffs)
-
dynzdf.F90 (modified) (23 diffs)
-
sshwzv.F90 (modified) (4 diffs)
-
wet_dry.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DYN/divhor.F90
r13237 r13295 77 77 ENDIF 78 78 ! 79 DO_3D _00_00(1, jpkm1 )79 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 80 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) & -
NEMO/trunk/src/OCE/DYN/dynadv_cen2.F90
r13237 r13295 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 _10_1074 DO_2D( 1, 0, 1, 0 ) 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 _00_0080 DO_2D( 0, 0, 0, 0 ) 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 _00_00100 DO_2D( 0, 0, 0, 0 ) 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 103 103 END_2D 104 104 IF( ln_linssh ) THEN ! linear free surface: advection through the surface 105 DO_2D _00_00105 DO_2D( 0, 0, 0, 0 ) 106 106 zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm) 107 107 zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm) … … 109 109 ENDIF 110 110 DO jk = 2, jpkm1 ! interior advective fluxes 111 DO_2D _01_01111 DO_2D( 0, 1, 0, 1 ) 112 112 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 113 113 END_2D 114 DO_2D _00_00114 DO_2D( 0, 0, 0, 0 ) 115 115 zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj ,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) ) 116 116 zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji ,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) ) 117 117 END_2D 118 118 END DO 119 DO_3D _00_00(1, jpkm1 )119 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 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/trunk/src/OCE/DYN/dynadv_ubs.F90
r13237 r13295 108 108 zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 109 109 ! 110 DO_2D _00_00110 DO_2D( 0, 0, 0, 0 ) 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 _10_10138 DO_2D( 1, 0, 1, 0 ) 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 _00_00170 DO_2D( 0, 0, 0, 0 ) 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 _00_00189 DO_2D( 0, 0, 0, 0 ) 190 190 zfu_uw(ji,jj,jpk) = 0._wp 191 191 zfv_vw(ji,jj,jpk) = 0._wp … … 194 194 END_2D 195 195 IF( ln_linssh ) THEN ! constant volume : advection through the surface 196 DO_2D _00_00196 DO_2D( 0, 0, 0, 0 ) 197 197 zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm) 198 198 zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm) … … 200 200 ENDIF 201 201 DO jk = 2, jpkm1 ! interior fluxes 202 DO_2D _01_01202 DO_2D( 0, 1, 0, 1 ) 203 203 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 204 204 END_2D 205 DO_2D _00_00205 DO_2D( 0, 0, 0, 0 ) 206 206 zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) ) 207 207 zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) ) 208 208 END_2D 209 209 END DO 210 DO_3D _00_00(1, jpkm1 )210 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 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/trunk/src/OCE/DYN/dynatf.F90
r13237 r13295 197 197 IF( ln_linssh ) THEN ! Fixed volume ! 198 198 ! ! =============! 199 DO_3D _11_11(1, jpkm1 )199 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 200 200 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 201 201 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 233 233 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' ) 234 234 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' ) 235 DO_3D _11_11(1, jpkm1 )235 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 236 236 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 237 237 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 244 244 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' ) 245 245 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' ) 246 DO_3D _11_11(1, jpkm1 )246 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 247 247 zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 248 248 zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) -
NEMO/trunk/src/OCE/DYN/dynatf_qco.F90
r13237 r13295 140 140 IF( ln_linssh ) THEN ! Fixed volume ! 141 141 ! ! =============! 142 DO_3D _11_11(1, jpkm1 )142 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 143 143 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 144 144 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 150 150 IF( ln_dynadv_vec ) THEN ! Asselin filter applied on velocity 151 151 ! Before filtered scale factor at (u/v)-points 152 DO_3D _11_11(1, jpkm1 )152 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 153 153 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 154 154 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 157 157 ELSE ! Asselin filter applied on thickness weighted velocity 158 158 ! 159 DO_3D _11_11(1, jpkm1 )159 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 160 160 zue3a = ( 1._wp + r3u(ji,jj,Kaa) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kaa) 161 161 zve3a = ( 1._wp + r3v(ji,jj,Kaa) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kaa) -
NEMO/trunk/src/OCE/DYN/dynhpg.F90
r13288 r13295 257 257 258 258 ! Surface value 259 DO_2D _00_00259 DO_2D( 0, 0, 0, 0 ) 260 260 zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 261 261 ! hydrostatic pressure gradient … … 269 269 ! 270 270 ! interior value (2=<jk=<jpkm1) 271 DO_3D _00_00(2, jpkm1 )271 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 272 272 zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 273 273 ! hydrostatic pressure gradient … … 319 319 320 320 ! Surface value (also valid in partial step case) 321 DO_2D _00_00321 DO_2D( 0, 0, 0, 0 ) 322 322 zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 323 323 ! hydrostatic pressure gradient … … 330 330 331 331 ! interior value (2=<jk=<jpkm1) 332 DO_3D _00_00(2, jpkm1 )332 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 333 333 zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 334 334 ! hydrostatic pressure gradient … … 346 346 347 347 ! partial steps correction at the last level (use zgru & zgrv computed in zpshde.F90) 348 DO_2D _00_00348 DO_2D( 0, 0, 0, 0 ) 349 349 iku = mbku(ji,jj) 350 350 ikv = mbkv(ji,jj) … … 411 411 ! 412 412 IF( ln_wd_il ) THEN 413 DO_2D _00_00413 DO_2D( 0, 0, 0, 0 ) 414 414 ll_tmp1 = MIN( ssh(ji,jj,Kmm) , ssh(ji+1,jj,Kmm) ) > & 415 415 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. & … … 452 452 453 453 ! Surface value 454 DO_2D _00_00454 DO_2D( 0, 0, 0, 0 ) 455 455 ! hydrostatic pressure gradient along s-surfaces 456 456 zhpi(ji,jj,1) = & … … 481 481 482 482 ! interior value (2=<jk=<jpkm1) 483 DO_3D _00_00(2, jpkm1 )483 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 484 484 ! hydrostatic pressure gradient along s-surfaces 485 485 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj) & … … 563 563 !===== Compute surface value ===================================================== 564 564 !================================================================================== 565 DO_2D _00_00565 DO_2D( 0, 0, 0, 0 ) 566 566 ikt = mikt(ji,jj) 567 567 iktp1i = mikt(ji+1,jj) … … 592 592 !================================================================================== 593 593 ! interior value (2=<jk=<jpkm1) 594 DO_3D _00_00(2, jpkm1 )594 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 595 595 ! hydrostatic pressure gradient along s-surfaces 596 596 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj) & … … 643 643 IF( ln_wd_il ) THEN 644 644 ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 645 DO_2D _00_00645 DO_2D( 0, 0, 0, 0 ) 646 646 ll_tmp1 = MIN( ssh(ji,jj,Kmm) , ssh(ji+1,jj,Kmm) ) > & 647 647 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. & … … 699 699 !!bug gm Not a true bug, but... dzz=e3w for dzx, dzy verify what it is really 700 700 701 DO_3D _00_00(2, jpkm1 )701 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 702 702 drhoz(ji,jj,jk) = rhd (ji ,jj ,jk) - rhd (ji,jj,jk-1) 703 703 dzz (ji,jj,jk) = gde3w(ji ,jj ,jk) - gde3w(ji,jj,jk-1) … … 716 716 !!bug gm idem for drhox, drhoy et ji=jpi and jj=jpj 717 717 718 DO_3D _00_00(2, jpkm1 )718 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 719 719 cffw = 2._wp * drhoz(ji ,jj ,jk) * drhoz(ji,jj,jk-1) 720 720 … … 784 784 ! true if gde3w(:,:,:) is really defined as the sum of the e3w scale factors as, it seems to me, it should be 785 785 786 DO_2D _00_00786 DO_2D( 0, 0, 0, 0 ) 787 787 rho_k(ji,jj,1) = -grav * ( e3w(ji,jj,1,Kmm) - gde3w(ji,jj,1) ) & 788 788 & * ( rhd(ji,jj,1) & … … 795 795 !!bug gm : optimisation: 1/10 and 1/12 the division should be done before the loop 796 796 797 DO_3D _00_00(2, jpkm1 )797 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 798 798 799 799 rho_k(ji,jj,jk) = zcoef0 * ( rhd (ji,jj,jk) + rhd (ji,jj,jk-1) ) & … … 830 830 ! Surface value 831 831 ! --------------- 832 DO_2D _00_00832 DO_2D( 0, 0, 0, 0 ) 833 833 zhpi(ji,jj,1) = ( rho_k(ji+1,jj ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 834 834 zhpj(ji,jj,1) = ( rho_k(ji ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) … … 845 845 ! interior value (2=<jk=<jpkm1) 846 846 ! ---------------- 847 DO_3D _00_00(2, jpkm1 )847 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 848 848 ! hydrostatic pressure gradient along s-surfaces 849 849 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) & … … 911 911 IF( ln_wd_il ) THEN 912 912 ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 913 DO_2D _00_00913 DO_2D( 0, 0, 0, 0 ) 914 914 ll_tmp1 = MIN( ssh(ji,jj,Kmm) , ssh(ji+1,jj,Kmm) ) > & 915 915 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. & … … 960 960 961 961 ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate 962 DO_2D _11_11962 DO_2D( 1, 1, 1, 1 ) 963 963 jk = mbkt(ji,jj) 964 964 IF( jk <= 1 ) THEN ; zrhh(ji,jj, : ) = 0._wp … … 973 973 974 974 ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 975 DO_2D _11_11975 DO_2D( 1, 1, 1, 1 ) 976 976 zdept(ji,jj,1) = 0.5_wp * e3w(ji,jj,1,Kmm) - ssh(ji,jj,Kmm) * znad 977 977 END_2D 978 978 979 DO_3D _11_11(2, jpk )979 DO_3D( 1, 1, 1, 1, 2, jpk ) 980 980 zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) 981 981 END_3D … … 990 990 991 991 ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)" 992 DO_2D _01_01992 DO_2D( 0, 1, 0, 1 ) 993 993 zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1), & 994 994 & csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm) … … 999 999 1000 1000 ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)" 1001 DO_3D _01_01(2, jpkm1 )1001 DO_3D( 0, 1, 0, 1, 2, jpkm1 ) 1002 1002 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + & 1003 1003 & integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk), & … … 1009 1009 1010 1010 ! Prepare zsshu_n and zsshv_n 1011 DO_2D _00_001011 DO_2D( 0, 0, 0, 0 ) 1012 1012 !!gm BUG ? if it is ssh at u- & v-point then it should be: 1013 1013 ! zsshu_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji+1,jj) * ssh(ji+1,jj,Kmm)) * & … … 1024 1024 CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 1025 1025 1026 DO_2D _00_001026 DO_2D( 0, 0, 0, 0 ) 1027 1027 zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) * znad) 1028 1028 zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) * znad) 1029 1029 END_2D 1030 1030 1031 DO_3D _00_00(2, jpkm1 )1031 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1032 1032 zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm) 1033 1033 zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm) 1034 1034 END_3D 1035 1035 1036 DO_3D _00_00(1, jpkm1 )1036 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1037 1037 zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm) 1038 1038 zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm) 1039 1039 END_3D 1040 1040 1041 DO_3D _00_00(1, jpkm1 )1041 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1042 1042 zu(ji,jj,jk) = MIN( zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) ) ) 1043 1043 zu(ji,jj,jk) = MAX( zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) ) ) … … 1047 1047 1048 1048 1049 DO_3D _00_00(1, jpkm1 )1049 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1050 1050 zpwes = 0._wp; zpwed = 0._wp 1051 1051 zpnss = 0._wp; zpnsd = 0._wp -
NEMO/trunk/src/OCE/DYN/dynkeg.F90
r13226 r13295 101 101 ! 102 102 CASE ( nkeg_C2 ) !-- Standard scheme --! 103 DO_3D _01_01(1, jpkm1 )103 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 104 104 zu = puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 105 105 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) … … 109 109 END_3D 110 110 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! 111 DO_3D _00_00(1, jpkm1 )111 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 112 112 zu = 8._wp * ( puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 113 113 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) ) & … … 125 125 END SELECT 126 126 ! 127 DO_3D _00_00(1, jpkm1 )127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 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/trunk/src/OCE/DYN/dynldf_iso.F90
r13237 r13295 128 128 IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 129 129 ! 130 DO_3D _00_00(1, jpk )130 DO_3D( 0, 0, 0, 0, 1, jpk ) 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) … … 168 168 169 169 IF( ln_zps ) THEN ! z-coordinate - partial steps : min(e3u) 170 DO_2D _00_01170 DO_2D( 0, 0, 0, 1 ) 171 171 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) & 172 172 & * MIN( e3u(ji ,jj,jk,Kmm), & … … 183 183 END_2D 184 184 ELSE ! other coordinate system (zco or sco) : e3t 185 DO_2D _00_01185 DO_2D( 0, 0, 0, 1 ) 186 186 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) & 187 187 & * e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e1t(ji,jj) … … 199 199 200 200 ! j-flux at f-point 201 DO_2D _10_10201 DO_2D( 1, 0, 1, 0 ) 202 202 zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) & 203 203 & * e1f(ji,jj) * e3f(ji,jj,jk) * r1_e2f(ji,jj) … … 219 219 ! i-flux at f-point | t | 220 220 221 DO_2D _00_10221 DO_2D( 0, 0, 1, 0 ) 222 222 zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) & 223 223 & * e2f(ji,jj) * e3f(ji,jj,jk) * r1_e1f(ji,jj) … … 235 235 ! j-flux at t-point 236 236 IF( ln_zps ) THEN ! z-coordinate - partial steps : min(e3u) 237 DO_2D _01_10237 DO_2D( 0, 1, 1, 0 ) 238 238 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) & 239 239 & * MIN( e3v(ji,jj ,jk,Kmm), & … … 250 250 END_2D 251 251 ELSE ! other coordinate system (zco or sco) : e3t 252 DO_2D _01_10252 DO_2D( 0, 1, 1, 0 ) 253 253 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) & 254 254 & * e1t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e2t(ji,jj) … … 268 268 ! Second derivative (divergence) and add to the general trend 269 269 ! ----------------------------------------------------------- 270 DO_2D _00_00270 DO_2D( 0, 0, 0, 0 ) 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/trunk/src/OCE/DYN/dynldf_lap_blp.F90
r13237 r13295 73 73 DO jk = 1, jpkm1 ! Horizontal slab 74 74 ! ! =============== 75 DO_2D _01_0175 DO_2D( 0, 1, 0, 1 ) 76 76 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 77 77 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) & ! ahmf already * by fmask … … 84 84 END_2D 85 85 ! 86 DO_2D _00_0086 DO_2D( 0, 0, 0, 0 ) 87 87 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * ( & ! * by umask is mandatory for dyn_ldf_blp use 88 88 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & -
NEMO/trunk/src/OCE/DYN/dynspg.F90
r12489 r13295 95 95 .OR. ln_ice_embd ) THEN ! embedded sea-ice 96 96 ! 97 DO_2D _00_0097 DO_2D( 0, 0, 0, 0 ) 98 98 spgu(ji,jj) = 0._wp 99 99 spgv(ji,jj) = 0._wp … … 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 _00_00104 DO_2D( 0, 0, 0, 0 ) 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 _00_00119 DO_2D( 0, 0, 0, 0 ) 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 _00_00126 DO_2D( 0, 0, 0, 0 ) 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) … … 136 136 zgrho0r = - grav * r1_rho0 137 137 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zgrho0r 138 DO_2D _00_00138 DO_2D( 0, 0, 0, 0 ) 139 139 spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 140 140 spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) … … 143 143 ENDIF 144 144 ! 145 DO_3D _00_00(1, jpkm1 )145 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 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/trunk/src/OCE/DYN/dynspg_exp.F90
r12489 r13295 74 74 IF( ln_linssh ) THEN !* linear free surface : add the surface pressure gradient trend 75 75 ! 76 DO_2D _00_0076 DO_2D( 0, 0, 0, 0 ) 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 _00_00(1, jpkm1 )81 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 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/trunk/src/OCE/DYN/dynspg_ts.F90
r13289 r13295 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 _00_00266 DO_2D( 0, 0, 0, 0 ) 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 … … 271 271 END_2D 272 272 ELSE ! now suface pressure gradient 273 DO_2D _00_00273 DO_2D( 0, 0, 0, 0 ) 274 274 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( pssh(ji+1,jj ,Kmm) - pssh(ji ,jj ,Kmm) ) * r1_e1u(ji,jj) 275 275 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( pssh(ji ,jj+1,Kmm) - pssh(ji ,jj ,Kmm) ) * r1_e2v(ji,jj) … … 279 279 ENDIF 280 280 ! 281 DO_2D _00_00281 DO_2D( 0, 0, 0, 0 ) 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) … … 291 291 IF( ln_apr_dyn ) THEN 292 292 IF( ln_bt_fw ) THEN ! FORWARD integration: use kt+1/2 pressure (NOW+1/2) 293 DO_2D _00_00293 DO_2D( 0, 0, 0, 0 ) 294 294 zu_frc(ji,jj) = zu_frc(ji,jj) + grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 295 295 zv_frc(ji,jj) = zv_frc(ji,jj) + grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) … … 297 297 ELSE ! CENTRED integration: use kt-1/2 + kt+1/2 pressure (NOW) 298 298 zztmp = grav * r1_2 299 DO_2D _00_00299 DO_2D( 0, 0, 0, 0 ) 300 300 zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) & 301 301 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) … … 309 309 ! ! ---------------------------------- ! 310 310 IF( ln_bt_fw ) THEN ! Add wind forcing 311 DO_2D _00_00311 DO_2D( 0, 0, 0, 0 ) 312 312 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu(ji,jj,Kmm) 313 313 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_rho0 * vtau(ji,jj) * r1_hv(ji,jj,Kmm) … … 315 315 ELSE 316 316 zztmp = r1_rho0 * r1_2 317 DO_2D _00_00317 DO_2D( 0, 0, 0, 0 ) 318 318 zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu(ji,jj,Kmm) 319 319 zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv(ji,jj,Kmm) … … 475 475 ! 476 476 ! ! ocean u- and v-depth at mid-step (separate DO-loops remove the need of a lbc_lnk) 477 DO_2D _11_10477 DO_2D( 1, 1, 1, 0 ) 478 478 zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj) & 479 479 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 480 480 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) * ssumask(ji,jj) 481 481 END_2D 482 DO_2D _10_11482 DO_2D( 1, 0, 1, 1 ) 483 483 zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj) & 484 484 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & … … 515 515 !-- ssh = ssh - delta_t' * [ frc + div( flux ) ] --! 516 516 !-------------------------------------------------------------------------! 517 DO_2D _00_00517 DO_2D( 0, 0, 0, 0 ) 518 518 zhdiv = ( zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1) ) * r1_e1e2t(ji,jj) 519 519 ssha_e(ji,jj) = ( sshn_e(ji,jj) - rDt_e * ( zssh_frc(ji,jj) + zhdiv ) ) * ssmask(ji,jj) … … 541 541 ! Sea Surface Height at u-,v-points (vvl case only) 542 542 IF( .NOT.ln_linssh ) THEN 543 DO_2D _00_00543 DO_2D( 0, 0, 0, 0 ) 544 544 zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 545 545 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & … … 561 561 ! ! Surface pressure gradient 562 562 zldg = ( 1._wp - rn_scal_load ) * grav ! local factor 563 DO_2D _00_00563 DO_2D( 0, 0, 0, 0 ) 564 564 zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 565 565 zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) … … 579 579 ! Add tidal astronomical forcing if defined 580 580 IF ( ln_tide .AND. ln_tide_pot ) THEN 581 DO_2D _00_00581 DO_2D( 0, 0, 0, 0 ) 582 582 zu_trd(ji,jj) = zu_trd(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 583 583 zv_trd(ji,jj) = zv_trd(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) … … 588 588 !jth do implicitly instead 589 589 IF ( .NOT. ll_wd ) THEN ! Revert to explicit for bit comparison tests in non wad runs 590 DO_2D _00_00590 DO_2D( 0, 0, 0, 0 ) 591 591 zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 592 592 zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) … … 606 606 !------------------------------------------------------------------------------------------------------------------------! 607 607 IF( ln_dynadv_vec .OR. ln_linssh ) THEN !* Vector form 608 DO_2D _00_00608 DO_2D( 0, 0, 0, 0 ) 609 609 ua_e(ji,jj) = ( un_e(ji,jj) & 610 610 & + rDt_e * ( zu_spg(ji,jj) & … … 621 621 ! 622 622 ELSE !* Flux form 623 DO_2D _00_00623 DO_2D( 0, 0, 0, 0 ) 624 624 ! ! hu_e, hv_e hold depth at jn, zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2 625 625 ! ! backward interpolated depth used in spg terms at jn+1/2 … … 645 645 !jth implicit bottom friction: 646 646 IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 647 DO_2D _00_00647 DO_2D( 0, 0, 0, 0 ) 648 648 ua_e(ji,jj) = ua_e(ji,jj) /(1.0 - rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj)) 649 649 va_e(ji,jj) = va_e(ji,jj) /(1.0 - rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj)) … … 712 712 IF (ln_bt_fw) THEN 713 713 IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN 714 DO_2D _11_11714 DO_2D( 1, 1, 1, 1 ) 715 715 zun_save = un_adv(ji,jj) 716 716 zvn_save = vn_adv(ji,jj) … … 743 743 ELSE 744 744 ! At this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points 745 DO_2D _10_10745 DO_2D( 1, 0, 1, 0 ) 746 746 zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 747 747 & * ( e1e2t(ji ,jj) * pssh(ji ,jj,Kaa) & … … 975 975 ! Max courant number for ext. grav. waves 976 976 ! 977 DO_2D _00_00977 DO_2D( 0, 0, 0, 0 ) 978 978 zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 979 979 zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) … … 1100 1100 SELECT CASE( nn_een_e3f ) !* ff_f/e3 at F-point 1101 1101 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 1102 DO_2D _10_101102 DO_2D( 1, 0, 1, 0 ) 1103 1103 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 1104 1104 & ht(ji ,jj ) + ht(ji+1,jj ) ) * 0.25_wp … … 1106 1106 END_2D 1107 1107 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 1108 DO_2D _10_101108 DO_2D( 1, 0, 1, 0 ) 1109 1109 zwz(ji,jj) = ( ht (ji ,jj+1) + ht (ji+1,jj+1) & 1110 1110 & + ht (ji ,jj ) + ht (ji+1,jj ) ) & … … 1117 1117 ! 1118 1118 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 1119 DO_2D _01_011119 DO_2D( 0, 1, 0, 1 ) 1120 1120 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 1121 1121 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) … … 1126 1126 CASE( np_EET ) != EEN scheme using e3t energy conserving scheme 1127 1127 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 1128 DO_2D _01_011128 DO_2D( 0, 1, 0, 1 ) 1129 1129 z1_ht = ssmask(ji,jj) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 1130 1130 ftne(ji,jj) = ( ff_f(ji-1,jj ) + ff_f(ji ,jj ) + ff_f(ji ,jj-1) ) * z1_ht … … 1159 1159 ! 1160 1160 !zhf(:,:) = hbatf(:,:) 1161 DO_2D _10_101161 DO_2D( 1, 0, 1, 0 ) 1162 1162 zhf(ji,jj) = ( ht_0 (ji,jj ) + ht_0 (ji+1,jj ) & 1163 1163 & + ht_0 (ji,jj+1) + ht_0 (ji+1,jj+1) ) & … … 1178 1178 CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp ) 1179 1179 ! JC: TBC. hf should be greater than 0 1180 DO_2D _11_111180 DO_2D( 1, 1, 1, 1 ) 1181 1181 IF( zhf(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zhf(ji,jj) 1182 1182 END_2D … … 1201 1201 SELECT CASE( nvor_scheme ) 1202 1202 CASE( np_ENT ) ! enstrophy conserving scheme (f-point) 1203 DO_2D _00_001203 DO_2D( 0, 0, 0, 0 ) 1204 1204 z1_hu = ssumask(ji,jj) / ( phu(ji,jj) + 1._wp - ssumask(ji,jj) ) 1205 1205 z1_hv = ssvmask(ji,jj) / ( phv(ji,jj) + 1._wp - ssvmask(ji,jj) ) … … 1214 1214 ! 1215 1215 CASE( np_ENE , np_MIX ) ! energy conserving scheme (t-point) ENE or MIX 1216 DO_2D _00_001216 DO_2D( 0, 0, 0, 0 ) 1217 1217 zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj) 1218 1218 zy2 = ( zhV(ji,jj ) + zhV(ji+1,jj ) ) * r1_e1u(ji,jj) … … 1225 1225 ! 1226 1226 CASE( np_ENS ) ! enstrophy conserving scheme (f-point) 1227 DO_2D _00_001227 DO_2D( 0, 0, 0, 0 ) 1228 1228 zy1 = r1_8 * ( zhV(ji ,jj-1) + zhV(ji+1,jj-1) & 1229 1229 & + zhV(ji ,jj ) + zhV(ji+1,jj ) ) * r1_e1u(ji,jj) … … 1235 1235 ! 1236 1236 CASE( np_EET , np_EEN ) ! energy & enstrophy scheme (using e3t or e3f) 1237 DO_2D _00_001237 DO_2D( 0, 0, 0, 0 ) 1238 1238 zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zhV(ji ,jj ) & 1239 1239 & + ftnw(ji+1,jj) * zhV(ji+1,jj ) & … … 1269 1269 ! 1270 1270 IF( ln_wd_dl_rmp ) THEN 1271 DO_2D _11_111271 DO_2D( 1, 1, 1, 1 ) 1272 1272 IF ( pssh(ji,jj) + ht_0(ji,jj) > 2._wp * rn_wdmin1 ) THEN 1273 1273 ! IF ( pssh(ji,jj) + ht_0(ji,jj) > rn_wdmin2 ) THEN … … 1280 1280 END_2D 1281 1281 ELSE 1282 DO_2D _11_111282 DO_2D( 1, 1, 1, 1 ) 1283 1283 IF ( pssh(ji,jj) + ht_0(ji,jj) > rn_wdmin1 ) THEN ; ptmsk(ji,jj) = 1._wp 1284 1284 ELSE ; ptmsk(ji,jj) = 0._wp … … 1308 1308 !!---------------------------------------------------------------------- 1309 1309 ! 1310 DO_2D _11_101310 DO_2D( 1, 1, 1, 0 ) 1311 1311 IF ( phU(ji,jj) > 0._wp ) THEN ; pUmsk(ji,jj) = pTmsk(ji ,jj) 1312 1312 ELSE ; pUmsk(ji,jj) = pTmsk(ji+1,jj) … … 1316 1316 END_2D 1317 1317 ! 1318 DO_2D _10_111318 DO_2D( 1, 0, 1, 1 ) 1319 1319 IF ( phV(ji,jj) > 0._wp ) THEN ; pVmsk(ji,jj) = pTmsk(ji,jj ) 1320 1320 ELSE ; pVmsk(ji,jj) = pTmsk(ji,jj+1) … … 1338 1338 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zcpx, zcpy 1339 1339 !!---------------------------------------------------------------------- 1340 DO_2D _00_001340 DO_2D( 0, 0, 0, 0 ) 1341 1341 ll_tmp1 = MIN( pshn(ji,jj) , pshn(ji+1,jj) ) > & 1342 1342 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. & … … 1407 1407 IF( ln_isfcav ) THEN ! top+bottom friction (ocean cavities) 1408 1408 1409 DO_2D _00_001409 DO_2D( 0, 0, 0, 0 ) 1410 1410 pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 1411 1411 pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) 1412 1412 END_2D 1413 1413 ELSE ! bottom friction only 1414 DO_2D _00_001414 DO_2D( 0, 0, 0, 0 ) 1415 1415 pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) 1416 1416 pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) … … 1422 1422 IF( ln_bt_fw ) THEN ! FORWARD integration: use NOW bottom baroclinic velocities 1423 1423 1424 DO_2D _00_001424 DO_2D( 0, 0, 0, 0 ) 1425 1425 ikbu = mbku(ji,jj) 1426 1426 ikbv = mbkv(ji,jj) … … 1430 1430 ELSE ! CENTRED integration: use BEFORE bottom baroclinic velocities 1431 1431 1432 DO_2D _00_001432 DO_2D( 0, 0, 0, 0 ) 1433 1433 ikbu = mbku(ji,jj) 1434 1434 ikbv = mbkv(ji,jj) … … 1440 1440 IF( ln_wd_il ) THEN ! W/D : use the "clipped" bottom friction !!gm explain WHY, please ! 1441 1441 zztmp = -1._wp / rDt_e 1442 DO_2D _00_001442 DO_2D( 0, 0, 0, 0 ) 1443 1443 pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) * wdrampu(ji,jj) * MAX( & 1444 1444 & r1_hu(ji,jj,Kmm) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp ) … … 1448 1448 ELSE ! use "unclipped" drag (even if explicit friction is used in 3D calculation) 1449 1449 1450 DO_2D _00_001450 DO_2D( 0, 0, 0, 0 ) 1451 1451 pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj) 1452 1452 pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj) … … 1460 1460 IF( ln_bt_fw ) THEN ! FORWARD integration: use NOW top baroclinic velocity 1461 1461 1462 DO_2D _00_001462 DO_2D( 0, 0, 0, 0 ) 1463 1463 iktu = miku(ji,jj) 1464 1464 iktv = mikv(ji,jj) … … 1468 1468 ELSE ! CENTRED integration: use BEFORE top baroclinic velocity 1469 1469 1470 DO_2D _00_001470 DO_2D( 0, 0, 0, 0 ) 1471 1471 iktu = miku(ji,jj) 1472 1472 iktv = mikv(ji,jj) … … 1478 1478 ! ! use "unclipped" top drag (even if explicit friction is used in 3D calculation) 1479 1479 1480 DO_2D _00_001480 DO_2D( 0, 0, 0, 0 ) 1481 1481 pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj) 1482 1482 pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj) -
NEMO/trunk/src/OCE/DYN/dynvor.F90
r13286 r13295 231 231 CASE ( np_RVO ) !* relative vorticity 232 232 DO jk = 1, jpkm1 ! Horizontal slab 233 DO_2D _10_10233 DO_2D( 1, 0, 1, 0 ) 234 234 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 235 235 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 236 236 END_2D 237 237 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity 238 DO_2D _10_10238 DO_2D( 1, 0, 1, 0 ) 239 239 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 240 240 END_2D … … 246 246 CASE ( np_CRV ) !* Coriolis + relative vorticity 247 247 DO jk = 1, jpkm1 ! Horizontal slab 248 DO_2D _10_10248 DO_2D( 1, 0, 1, 0 ) 249 249 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 250 250 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 251 251 END_2D 252 252 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity 253 DO_2D _10_10253 DO_2D( 1, 0, 1, 0 ) 254 254 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 255 255 END_2D … … 269 269 zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,Kmm) 270 270 CASE ( np_RVO ) !* relative vorticity 271 DO_2D _01_01271 DO_2D( 0, 1, 0, 1 ) 272 272 zwt(ji,jj) = r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 273 273 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) & … … 275 275 END_2D 276 276 CASE ( np_MET ) !* metric term 277 DO_2D _01_01277 DO_2D( 0, 1, 0, 1 ) 278 278 zwt(ji,jj) = ( ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) & 279 279 & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) & … … 281 281 END_2D 282 282 CASE ( np_CRV ) !* Coriolis + relative vorticity 283 DO_2D _01_01283 DO_2D( 0, 1, 0, 1 ) 284 284 zwt(ji,jj) = ( ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 285 285 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) ) & … … 287 287 END_2D 288 288 CASE ( np_CME ) !* Coriolis + metric 289 DO_2D _01_01289 DO_2D( 0, 1, 0, 1 ) 290 290 zwt(ji,jj) = ( ff_t(ji,jj) * e1e2t(ji,jj) & 291 291 & + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) & … … 298 298 ! 299 299 ! !== compute and add the vorticity term trend =! 300 DO_2D _00_00300 DO_2D( 0, 0, 0, 0 ) 301 301 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & 302 302 & * ( zwt(ji+1,jj) * ( pv(ji+1,jj,jk) + pv(ji+1,jj-1,jk) ) & … … 358 358 zwz(:,:) = ff_f(:,:) 359 359 CASE ( np_RVO ) !* relative vorticity 360 DO_2D _10_10360 DO_2D( 1, 0, 1, 0 ) 361 361 zwz(ji,jj) = ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 362 362 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 363 363 END_2D 364 364 CASE ( np_MET ) !* metric term 365 DO_2D _10_10365 DO_2D( 1, 0, 1, 0 ) 366 366 zwz(ji,jj) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 367 367 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 368 368 END_2D 369 369 CASE ( np_CRV ) !* Coriolis + relative vorticity 370 DO_2D _10_10370 DO_2D( 1, 0, 1, 0 ) 371 371 zwz(ji,jj) = ff_f(ji,jj) + ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 372 372 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 373 373 END_2D 374 374 CASE ( np_CME ) !* Coriolis + metric 375 DO_2D _10_10375 DO_2D( 1, 0, 1, 0 ) 376 376 zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 377 377 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) … … 382 382 ! 383 383 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 384 DO_2D _10_10384 DO_2D( 1, 0, 1, 0 ) 385 385 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 386 386 END_2D … … 396 396 ENDIF 397 397 ! !== compute and add the vorticity term trend =! 398 DO_2D _00_00398 DO_2D( 0, 0, 0, 0 ) 399 399 zy1 = zwy(ji,jj-1) + zwy(ji+1,jj-1) 400 400 zy2 = zwy(ji,jj ) + zwy(ji+1,jj ) … … 454 454 zwz(:,:) = ff_f(:,:) 455 455 CASE ( np_RVO ) !* relative vorticity 456 DO_2D _10_10456 DO_2D( 1, 0, 1, 0 ) 457 457 zwz(ji,jj) = ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 458 458 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 459 459 END_2D 460 460 CASE ( np_MET ) !* metric term 461 DO_2D _10_10461 DO_2D( 1, 0, 1, 0 ) 462 462 zwz(ji,jj) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 463 463 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 464 464 END_2D 465 465 CASE ( np_CRV ) !* Coriolis + relative vorticity 466 DO_2D _10_10466 DO_2D( 1, 0, 1, 0 ) 467 467 zwz(ji,jj) = ff_f(ji,jj) + ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 468 468 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 469 469 END_2D 470 470 CASE ( np_CME ) !* Coriolis + metric 471 DO_2D _10_10471 DO_2D( 1, 0, 1, 0 ) 472 472 zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 473 473 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) … … 478 478 ! 479 479 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 480 DO_2D _10_10480 DO_2D( 1, 0, 1, 0 ) 481 481 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 482 482 END_2D … … 492 492 ENDIF 493 493 ! !== compute and add the vorticity term trend =! 494 DO_2D _00_00494 DO_2D( 0, 0, 0, 0 ) 495 495 zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 496 496 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) … … 550 550 SELECT CASE( nn_een_e3f ) ! == reciprocal of e3 at F-point 551 551 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 552 DO_2D _10_10552 DO_2D( 1, 0, 1, 0 ) 553 553 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 554 554 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & … … 560 560 END_2D 561 561 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 562 DO_2D _10_10562 DO_2D( 1, 0, 1, 0 ) 563 563 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 564 564 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & … … 575 575 SELECT CASE( kvor ) !== vorticity considered ==! 576 576 CASE ( np_COR ) !* Coriolis (planetary vorticity) 577 DO_2D _10_10577 DO_2D( 1, 0, 1, 0 ) 578 578 zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj) 579 579 END_2D 580 580 CASE ( np_RVO ) !* relative vorticity 581 DO_2D _10_10581 DO_2D( 1, 0, 1, 0 ) 582 582 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 583 583 & - e1u(ji ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 584 584 END_2D 585 585 CASE ( np_MET ) !* metric term 586 DO_2D _10_10586 DO_2D( 1, 0, 1, 0 ) 587 587 zwz(ji,jj,jk) = ( ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 588 588 & - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj) 589 589 END_2D 590 590 CASE ( np_CRV ) !* Coriolis + relative vorticity 591 DO_2D _10_10591 DO_2D( 1, 0, 1, 0 ) 592 592 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 593 593 & - e1u(ji ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) & … … 595 595 END_2D 596 596 CASE ( np_CME ) !* Coriolis + metric 597 DO_2D _10_10597 DO_2D( 1, 0, 1, 0 ) 598 598 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 599 599 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj) … … 604 604 ! 605 605 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 606 DO_2D _10_10606 DO_2D( 1, 0, 1, 0 ) 607 607 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 608 608 END_2D … … 635 635 END DO 636 636 END DO 637 DO_2D _00_00637 DO_2D( 0, 0, 0, 0 ) 638 638 zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 639 639 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) … … 695 695 SELECT CASE( kvor ) !== vorticity considered ==! 696 696 CASE ( np_COR ) !* Coriolis (planetary vorticity) 697 DO_2D _10_10697 DO_2D( 1, 0, 1, 0 ) 698 698 zwz(ji,jj,jk) = ff_f(ji,jj) 699 699 END_2D 700 700 CASE ( np_RVO ) !* relative vorticity 701 DO_2D _10_10701 DO_2D( 1, 0, 1, 0 ) 702 702 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 703 703 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) & … … 705 705 END_2D 706 706 CASE ( np_MET ) !* metric term 707 DO_2D _10_10707 DO_2D( 1, 0, 1, 0 ) 708 708 zwz(ji,jj,jk) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 709 709 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 710 710 END_2D 711 711 CASE ( np_CRV ) !* Coriolis + relative vorticity 712 DO_2D _10_10712 DO_2D( 1, 0, 1, 0 ) 713 713 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 714 714 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) & … … 716 716 END_2D 717 717 CASE ( np_CME ) !* Coriolis + metric 718 DO_2D _10_10718 DO_2D( 1, 0, 1, 0 ) 719 719 zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 720 720 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) … … 725 725 ! 726 726 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 727 DO_2D _10_10727 DO_2D( 1, 0, 1, 0 ) 728 728 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 729 729 END_2D … … 758 758 END DO 759 759 END DO 760 DO_2D _00_00760 DO_2D( 0, 0, 0, 0 ) 761 761 zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 762 762 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) … … 818 818 IF(lwp) WRITE(numout,*) ' change fmask value in the angles (T) ln_vorlat = ', ln_vorlat 819 819 IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN 820 DO_3D _10_10(1, jpk )820 DO_3D( 1, 0, 1, 0, 1, jpk ) 821 821 IF( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 822 822 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) == 3._wp ) fmask(ji,jj,jk) = 1._wp … … 857 857 CASE( np_ENT ) !* T-point metric term : pre-compute di(e2u)/2 and dj(e1v)/2 858 858 ALLOCATE( di_e2u_2(jpi,jpj), dj_e1v_2(jpi,jpj) ) 859 DO_2D _00_00859 DO_2D( 0, 0, 0, 0 ) 860 860 di_e2u_2(ji,jj) = ( e2u(ji,jj) - e2u(ji-1,jj ) ) * 0.5_wp 861 861 dj_e1v_2(ji,jj) = ( e1v(ji,jj) - e1v(ji ,jj-1) ) * 0.5_wp … … 865 865 CASE DEFAULT !* F-point metric term : pre-compute di(e2u)/(2*e1e2f) and dj(e1v)/(2*e1e2f) 866 866 ALLOCATE( di_e2v_2e1e2f(jpi,jpj), dj_e1u_2e1e2f(jpi,jpj) ) 867 DO_2D _10_10867 DO_2D( 1, 0, 1, 0 ) 868 868 di_e2v_2e1e2f(ji,jj) = ( e2v(ji+1,jj ) - e2v(ji,jj) ) * 0.5 * r1_e1e2f(ji,jj) 869 869 dj_e1u_2e1e2f(ji,jj) = ( e1u(ji ,jj+1) - e1u(ji,jj) ) * 0.5 * r1_e1e2f(ji,jj) -
NEMO/trunk/src/OCE/DYN/dynzad.F90
r13237 r13295 78 78 79 79 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 80 DO_2D _01_0180 DO_2D( 0, 1, 0, 1 ) 81 81 zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 82 82 END_2D 83 DO_2D _00_0083 DO_2D( 0, 0, 0, 0 ) 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) ) … … 88 88 ! 89 89 ! Surface and bottom advective fluxes set to zero 90 DO_2D _00_0090 DO_2D( 0, 0, 0, 0 ) 91 91 zwuw(ji,jj, 1 ) = 0._wp 92 92 zwvw(ji,jj, 1 ) = 0._wp … … 95 95 END_2D 96 96 ! 97 DO_3D _00_00(1, jpkm1 )97 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 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) -
NEMO/trunk/src/OCE/DYN/dynzdf.F90
r13286 r13295 107 107 ! ! time stepping except vertical diffusion 108 108 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity 109 DO_3D _00_00(1, jpkm1 )109 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 110 110 puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kbb) + rDt * puu(ji,jj,jk,Krhs) ) * umask(ji,jj,jk) 111 111 pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kbb) + rDt * pvv(ji,jj,jk,Krhs) ) * vmask(ji,jj,jk) 112 112 END_3D 113 113 ELSE ! applied on thickness weighted velocity 114 DO_3D _00_00(1, jpkm1 )114 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 115 115 puu(ji,jj,jk,Kaa) = ( e3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb ) & 116 116 & + rDt * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Krhs) ) & … … 127 127 ! G. Madec : in linear free surface, e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) = e3u_0, so systematic use of e3u(:,:,:,Kaa) 128 128 IF( ln_drgimp .AND. ln_dynspg_ts ) THEN 129 DO_3D _00_00(1, jpkm1 ) ! remove barotropic velocities129 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! remove barotropic velocities 130 130 puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - uu_b(ji,jj,Kaa) ) * umask(ji,jj,jk) 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 _00_00133 DO_2D( 0, 0, 0, 0 ) 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) … … 142 142 END_2D 143 143 IF( ln_isfcav ) THEN ! Ocean cavities (ISF) 144 DO_2D _00_00144 DO_2D( 0, 0, 0, 0 ) 145 145 iku = miku(ji,jj) ! top ocean level at u- and v-points 146 146 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) … … 162 162 SELECT CASE( nldf_dyn ) 163 163 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 164 DO_3D _00_00(1, jpkm1 )164 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 165 165 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 166 166 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point … … 176 176 END_3D 177 177 CASE DEFAULT ! iso-level lateral mixing 178 DO_3D _00_00(1, jpkm1 )178 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 179 179 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & ! after scale factor at U-point 180 180 & + r_vvl * e3u(ji,jj,jk,Kaa) … … 190 190 END_3D 191 191 END SELECT 192 DO_2D _00_00192 DO_2D( 0, 0, 0, 0 ) 193 193 zwi(ji,jj,1) = 0._wp 194 194 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & … … 203 203 SELECT CASE( nldf_dyn ) 204 204 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 205 DO_3D _00_00(1, jpkm1 )205 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 206 206 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 207 207 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point … … 215 215 END_3D 216 216 CASE DEFAULT ! iso-level lateral mixing 217 DO_3D _00_00(1, jpkm1 )217 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 218 218 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 219 219 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point … … 227 227 END_3D 228 228 END SELECT 229 DO_2D _00_00229 DO_2D( 0, 0, 0, 0 ) 230 230 zwi(ji,jj,1) = 0._wp 231 231 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) … … 241 241 ! 242 242 IF ( ln_drgimp ) THEN ! implicit bottom friction 243 DO_2D _00_00243 DO_2D( 0, 0, 0, 0 ) 244 244 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 245 245 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) & … … 248 248 END_2D 249 249 IF ( ln_isfcav ) THEN ! top friction (always implicit) 250 DO_2D _00_00250 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 252 252 iku = miku(ji,jj) ! ocean top level at u- and v-points … … 273 273 !----------------------------------------------------------------------- 274 274 ! 275 DO_3D _00_00(2, jpkm1 )275 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 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 _00_00279 DO_2D( 0, 0, 0, 0 ) 280 280 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & 281 281 & + r_vvl * e3u(ji,jj,1,Kaa) … … 283 283 & / ( ze3ua * rho0 ) * umask(ji,jj,1) 284 284 END_2D 285 DO_3D _00_00(2, jpkm1 )285 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 286 286 puu(ji,jj,jk,Kaa) = puu(ji,jj,jk,Kaa) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * puu(ji,jj,jk-1,Kaa) 287 287 END_3D 288 288 ! 289 DO_2D _00_00289 DO_2D( 0, 0, 0, 0 ) 290 290 puu(ji,jj,jpkm1,Kaa) = puu(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1) 291 291 END_2D 292 DO_3DS _00_00(jpk-2, 1, -1 )292 DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 ) 293 293 puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - zws(ji,jj,jk) * puu(ji,jj,jk+1,Kaa) ) / zwd(ji,jj,jk) 294 294 END_3D … … 301 301 SELECT CASE( nldf_dyn ) 302 302 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzv) 303 DO_3D _00_00(1, jpkm1 )303 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 304 304 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 305 305 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point … … 315 315 END_3D 316 316 CASE DEFAULT ! iso-level lateral mixing 317 DO_3D _00_00(1, jpkm1 )317 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 318 318 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 319 319 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point … … 329 329 END_3D 330 330 END SELECT 331 DO_2D _00_00331 DO_2D( 0, 0, 0, 0 ) 332 332 zwi(ji,jj,1) = 0._wp 333 333 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & … … 342 342 SELECT CASE( nldf_dyn ) 343 343 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 344 DO_3D _00_00(1, jpkm1 )344 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 345 345 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 346 346 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point … … 354 354 END_3D 355 355 CASE DEFAULT ! iso-level lateral mixing 356 DO_3D _00_00(1, jpkm1 )356 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 357 357 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 358 358 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point … … 366 366 END_3D 367 367 END SELECT 368 DO_2D _00_00368 DO_2D( 0, 0, 0, 0 ) 369 369 zwi(ji,jj,1) = 0._wp 370 370 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) … … 379 379 ! 380 380 IF( ln_drgimp ) THEN 381 DO_2D _00_00381 DO_2D( 0, 0, 0, 0 ) 382 382 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 383 383 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & … … 386 386 END_2D 387 387 IF ( ln_isfcav ) THEN 388 DO_2D _00_00388 DO_2D( 0, 0, 0, 0 ) 389 389 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) 390 390 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & … … 410 410 !----------------------------------------------------------------------- 411 411 ! 412 DO_3D _00_00(2, jpkm1 )412 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 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 _00_00416 DO_2D( 0, 0, 0, 0 ) 417 417 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & 418 418 & + r_vvl * e3v(ji,jj,1,Kaa) … … 420 420 & / ( ze3va * rho0 ) * vmask(ji,jj,1) 421 421 END_2D 422 DO_3D _00_00(2, jpkm1 )422 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 423 423 pvv(ji,jj,jk,Kaa) = pvv(ji,jj,jk,Kaa) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * pvv(ji,jj,jk-1,Kaa) 424 424 END_3D 425 425 ! 426 DO_2D _00_00426 DO_2D( 0, 0, 0, 0 ) 427 427 pvv(ji,jj,jpkm1,Kaa) = pvv(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1) 428 428 END_2D 429 DO_3DS _00_00(jpk-2, 1, -1 )429 DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 ) 430 430 pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - zws(ji,jj,jk) * pvv(ji,jj,jk+1,Kaa) ) / zwd(ji,jj,jk) 431 431 END_3D -
NEMO/trunk/src/OCE/DYN/sshwzv.F90
r13286 r13295 178 178 ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t) 179 179 ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way) 180 DO_2D _00_00180 DO_2D( 0, 0, 0, 0 ) 181 181 zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 182 182 END_2D … … 358 358 zdt = 2._wp * rn_Dt ! 2*rn_Dt and not rDt (for restartability) 359 359 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 360 DO_3D _00_00(1, jpkm1 )360 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 361 361 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 362 362 Cu_adv(ji,jj,jk) = zdt * & … … 375 375 END_3D 376 376 ELSE 377 DO_3D _00_00(1, jpkm1 )377 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 378 378 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 379 379 Cu_adv(ji,jj,jk) = zdt * & … … 393 393 ! 394 394 IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN ! Quick check if any breaches anywhere 395 DO_3DS _11_11(jpkm1, 2, -1 )395 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 396 396 ! 397 397 zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) ) -
NEMO/trunk/src/OCE/DYN/wet_dry.F90
r13237 r13295 174 174 ! 175 175 wdmask(:,:) = 1._wp 176 DO_2D _01_01176 DO_2D( 0, 1, 0, 1 ) 177 177 ! 178 178 IF( tmask(ji,jj,1) < 0.5_wp ) CYCLE ! we don't care about land cells … … 198 198 wdramp(:,:) = min((ht_0(:,:) + psshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp) 199 199 !jth assume don't need a lbc_lnk here 200 DO_2D _10_10200 DO_2D( 1, 0, 1, 0 ) 201 201 wdrampu(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji+1,jj) ) 202 202 wdrampv(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji,jj+1) ) … … 211 211 jflag = 0 ! flag indicating if any further iterations are needed 212 212 ! 213 DO_2D _01_01213 DO_2D( 0, 1, 0, 1 ) 214 214 IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE 215 215 IF( ht_0(ji,jj) > zdepwd ) CYCLE … … 307 307 zwdlmtv(:,:) = 1._wp 308 308 ! 309 DO_2D _01_01309 DO_2D( 0, 1, 0, 1 ) 310 310 ! 311 311 IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE ! we don't care about land cells … … 333 333 jflag = 0 ! flag indicating if any further iterations are needed 334 334 ! 335 DO_2D _01_01335 DO_2D( 0, 1, 0, 1 ) 336 336 ! 337 337 IF( tmask(ji, jj, 1 ) < 0.5_wp ) CYCLE
Note: See TracChangeset
for help on using the changeset viewer.
