Changeset 13295 for NEMO/trunk/src/SWE
- Timestamp:
- 2020-07-10T20:24:21+02:00 (4 years ago)
- Location:
- NEMO/trunk/src/SWE
- Files:
-
- 14 edited
-
asminc.F90 (modified) (2 diffs)
-
diawri.F90 (modified) (10 diffs)
-
domain.F90 (modified) (2 diffs)
-
dommsk.F90 (modified) (4 diffs)
-
domvvl.F90 (modified) (13 diffs)
-
dynatf.F90 (modified) (3 diffs)
-
dynkeg.F90 (modified) (4 diffs)
-
dynldf_lap_blp.F90 (modified) (6 diffs)
-
dynvor.F90 (modified) (24 diffs)
-
ldfdyn.F90 (modified) (10 diffs)
-
sbcice_cice.F90 (modified) (13 diffs)
-
step.F90 (modified) (5 diffs)
-
stepLF.F90 (modified) (5 diffs)
-
stpRK3.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/SWE/asminc.F90
r12983 r13295 416 416 DO jk = 1, jpkm1 ! zhdiv = e1e1 * div 417 417 zhdiv(:,:) = 0._wp 418 DO_2D _00_00418 DO_2D( 0, 0, 0, 0 ) 419 419 zhdiv(ji,jj) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * u_bkginc(ji ,jj,jk) & 420 420 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * u_bkginc(ji-1,jj,jk) & … … 425 425 CALL lbc_lnk( 'asminc', zhdiv, 'T', 1. ) ! lateral boundary cond. (no sign change) 426 426 ! 427 DO_2D _00_00427 DO_2D( 0, 0, 0, 0 ) 428 428 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) & 429 429 & + 0.2_wp * ( zhdiv(ji+1,jj) - zhdiv(ji ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) -
NEMO/trunk/src/SWE/diawri.F90
r12983 r13295 180 180 IF( iom_use("hu") ) THEN ! water column at u-point 181 181 z2d(:,:) = 0._wp 182 DO_2D _10_10182 DO_2D( 1, 0, 1, 0 ) 183 183 z2d(ji,jj) = 0.5_wp * ( e3t(ji ,jj,1,Kmm) * e1e2t(ji ,jj) & 184 184 & + e3t(ji+1,jj,1,Kmm) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) … … 190 190 IF( iom_use("hv") ) THEN ! water column at v-point 191 191 z2d(:,:) = 0._wp 192 DO_2D _10_10192 DO_2D( 1, 0, 1, 0 ) 193 193 z2d(ji,jj) = 0.5_wp * ( e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) & 194 194 & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) ) * r1_e1e2v(ji,jj) … … 200 200 IF( iom_use("hf") ) THEN ! water column at f-point 201 201 z2d(:,:) = 0._wp 202 DO_2D _10_10202 DO_2D( 1, 0, 1, 0 ) 203 203 z2d(ji,jj) = 0.25_wp * ( e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1) & 204 204 & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) + e3t(ji+1,jj ,1,Kmm) * e1e2t(ji+1,jj ) ) * r1_e1e2f(ji,jj) … … 216 216 zztmp = rho0 * 0.25 217 217 z2d(:,:) = 0._wp 218 DO_2D _00_00218 DO_2D( 0, 0, 0, 0 ) 219 219 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * uu(ji ,jj,mbku(ji ,jj),Kmm) )**2 & 220 220 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm) )**2 & … … 235 235 IF ( iom_use("sKE") ) THEN ! surface kinetic energy at T point 236 236 z2d(:,:) = 0._wp 237 DO_2D _00_00237 DO_2D( 0, 0, 0, 0 ) 238 238 z2d(ji,jj) = 0.25_wp * ( uu(ji ,jj,1,Kmm) * uu(ji ,jj,1,Kmm) * e1e2u(ji ,jj) * e3u(ji ,jj,1,Kmm) & 239 239 & + uu(ji-1,jj,1,Kmm) * uu(ji-1,jj,1,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,1,Kmm) & … … 251 251 IF ( iom_use("sKEf") ) THEN ! surface kinetic energy at F point 252 252 z2d(:,:) = 0._wp ! CAUTION : only valid in SWE, not with bathymetry 253 DO_2D _00_00253 DO_2D( 0, 0, 0, 0 ) 254 254 z2d(ji,jj) = 0.25_wp * ( uu(ji,jj ,1,Kmm) * uu(ji,jj ,1,Kmm) * e1e2u(ji,jj ) * e3u(ji,jj ,1,Kmm) & 255 255 & + uu(ji,jj+1,1,Kmm) * uu(ji,jj+1,1,Kmm) * e1e2u(ji,jj+1) * e3u(ji,jj+1,1,Kmm) & … … 273 273 z2d(:,:) = 0._wp 274 274 ze3 = 0._wp 275 DO_2D _10_10275 DO_2D( 1, 0, 1, 0 ) 276 276 z2d(ji,jj) = ( e2v(ji+1,jj ) * vv(ji+1,jj ,1,Kmm) - e2v(ji,jj) * vv(ji,jj,1,Kmm) & 277 277 & - e1u(ji ,jj+1) * uu(ji ,jj+1,1,Kmm) + e1u(ji,jj) * uu(ji,jj,1,Kmm) ) * r1_e1e2f(ji,jj) … … 282 282 CALL iom_put( "plavor", ff_f ) ! planetary vorticity ( f ) 283 283 ! 284 DO_2D _10_10284 DO_2D( 1, 0, 1, 0 ) 285 285 ze3 = ( e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1) & 286 286 & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) + e3t(ji+1,jj ,1,Kmm) * e1e2t(ji+1,jj ) ) * r1_e1e2f(ji,jj) … … 293 293 CALL iom_put( "relpotvor", z2d ) ! relative potential vorticity (zeta/h) 294 294 ! 295 DO_2D _10_10295 DO_2D( 1, 0, 1, 0 ) 296 296 ze3 = ( e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1) & 297 297 & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) + e3t(ji+1,jj ,1,Kmm) * e1e2t(ji+1,jj ) ) * r1_e1e2f(ji,jj) … … 304 304 CALL iom_put( "abspotvor", z2d ) ! absolute potential vorticity ( q ) 305 305 ! 306 DO_2D _10_10306 DO_2D( 1, 0, 1, 0 ) 307 307 z2d(ji,jj) = 0.5_wp * z2d(ji,jj) * z2d(ji,jj) 308 308 END_2D -
NEMO/trunk/src/SWE/domain.F90
r12983 r13295 169 169 !!anhf hf_0 = mean(ht_0*tmask) so hf = mimj( ht0 + ssht) 170 170 ! ne pas combiner avec an45 tout de suite 171 ! DO_2D _10_10171 ! DO_2D( 1, 0, 1, 0 ) 172 172 ! hf_0(ji,jj) = 0.25_wp * ( ht_0(ji,jj+1) * tmask(ji,jj+1,1) + ht_0(ji+1,jj+1) * tmask(ji+1,jj+1,1) & 173 173 ! & + ht_0(ji,jj ) * tmask(ji,jj ,1) + ht_0(ji+1,jj ) * tmask(ji+1,jj ,1) ) … … 183 183 !!an45 Ligne de cote a 45deg : e1e2t *= ( mi(umask) + mj(vmask) ) /2 184 184 !! idem pour e1e2f 185 ! DO_2D _10_10185 ! DO_2D( 1, 0, 1, 0 ) 186 186 ! zcoeff = 0.25_wp * ( umask(ji,jj+1,1) + umask(ji+1,jj+1,1) & 187 187 ! & + vmask(ji,jj ,1) + vmask(ji+1,jj ,1) ) -
NEMO/trunk/src/SWE/dommsk.F90
r12983 r13295 131 131 ! 132 132 tmask(:,:,:) = 0._wp 133 DO_2D _11_11133 DO_2D( 1, 1, 1, 1 ) 134 134 iktop = k_top(ji,jj) 135 135 ikbot = k_bot(ji,jj) … … 153 153 CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) ) 154 154 CALL iom_close( inum ) 155 DO_3D _11_11(1, jpkm1 )155 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 156 156 tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj) 157 157 END_3D … … 194 194 !!an 195 195 ! ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 ) 196 DO_2D _10_10196 DO_2D( 1, 0, 1, 0 ) 197 197 ssfmask(ji,jj) = MAX( tmask(ji,jj+1,1), tmask(ji+1,jj+1,1), & 198 198 & tmask(ji,jj ,1), tmask(ji+1,jj ,1) ) … … 245 245 DO jk = 1, jpk 246 246 zwf(:,:) = fmask(:,:,jk) 247 DO_2D _00_00247 DO_2D( 0, 0, 0, 0 ) 248 248 IF( fmask(ji,jj,jk) == 0._wp ) THEN 249 249 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & -
NEMO/trunk/src/SWE/domvvl.F90
r12983 r13295 205 205 gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 206 206 gdepw(:,:,1,Kbb) = 0.0_wp 207 DO_3D _11_11(2, jpk )207 DO_3D( 1, 1, 1, 1, 2, jpk ) 208 208 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 209 209 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) … … 253 253 ENDIF 254 254 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 255 DO_2D _11_11255 DO_2D( 1, 1, 1, 1 ) 256 256 !!gm case |gphi| >= 6 degrees is useless initialized just above by default 257 257 IF( ABS(gphit(ji,jj)) >= 6.) THEN … … 354 354 e3v(:,:,:,Kaa) = e3v(:,:,:,Kmm) 355 355 ! 356 DO_3D _11_11(1, jpk )356 DO_3D( 1, 1, 1, 1, 1, jpk ) 357 357 gdepw(ji,jj,jk,Kmm) = gdepw_0(ji,jj,jk) * (1._wp + r3t(ji,jj,Kmm)) 358 358 gdept(ji,jj,jk,Kmm) = gdept_0(ji,jj,jk) * (1._wp + r3t(ji,jj,Kmm)) … … 500 500 zwu(:,:) = 0._wp 501 501 zwv(:,:) = 0._wp 502 DO_3D _10_10(1, jpkm1 )502 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 503 503 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 504 504 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) … … 508 508 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 509 509 END_3D 510 DO_2D _11_11510 DO_2D( 1, 1, 1, 1 ) 511 511 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 512 512 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 513 513 END_2D 514 DO_3D _00_00(1, jpkm1 )514 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 515 515 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 516 516 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & … … 831 831 gdepw(:,:,1,Kmm) = 0.0_wp 832 832 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 833 DO_3D _11_11(2, jpk )833 DO_3D( 1, 1, 1, 1, 2, jpk ) 834 834 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 835 835 ! 1 for jk = mikt … … 918 918 919 919 ! t- and w- points depth (set the isf depth as it is in the initial step) 920 DO_3D _11_11(1, jpk )920 DO_3D( 1, 1, 1, 1, 1, jpk ) 921 921 gdepw(ji,jj,jk,Kmm) = gdepw_0(ji,jj,jk) * (1._wp + r3t(ji,jj,Kmm)) 922 922 gdept(ji,jj,jk,Kmm) = gdept_0(ji,jj,jk) * (1._wp + r3t(ji,jj,Kmm)) … … 1014 1014 ! 1015 1015 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean 1016 DO_2D _00_001016 DO_2D( 0, 0, 0, 0 ) 1017 1017 zc3(ji,jj) = 0.5_wp * ( e1e2t(ji ,jj) * pssh(ji ,jj) & 1018 1018 & + e1e2t(ji+1,jj) * pssh(ji+1,jj) ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj) … … 1025 1025 ! 1026 1026 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean 1027 DO_2D _00_001027 DO_2D( 0, 0, 0, 0 ) 1028 1028 zc3(ji,jj) = 0.5_wp * ( e1e2t(ji,jj ) * pssh(ji,jj ) & 1029 1029 & + e1e2t(ji,jj+1) * pssh(ji,jj+1) ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) … … 1036 1036 ! 1037 1037 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 1038 DO_2D _10_101038 DO_2D( 1, 0, 1, 0 ) 1039 1039 zc3(ji,jj) = 0.25_wp * ( e1e2t(ji ,jj ) * pssh(ji ,jj ) & 1040 1040 & + e1e2t(ji+1,jj ) * pssh(ji+1,jj ) & … … 1057 1057 CASE( 'UW' ) !* from U- to UW-point 1058 1058 ! 1059 DO_2D _00_001059 DO_2D( 0, 0, 0, 0 ) 1060 1060 zc3(ji,jj) = 0.5_wp * ( e1e2t(ji ,jj) * pssh(ji ,jj) & 1061 1061 & + e1e2t(ji+1,jj) * pssh(ji+1,jj) ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj) … … 1068 1068 CASE( 'VW' ) !* from U- to UW-point : vertical simple mean 1069 1069 ! 1070 DO_2D _00_001070 DO_2D( 0, 0, 0, 0 ) 1071 1071 zc3(ji,jj) = 0.5_wp * ( e1e2t(ji,jj ) * pssh(ji,jj ) & 1072 1072 & + e1e2t(ji,jj+1) * pssh(ji,jj+1) ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) … … 1201 1201 ssh(:,:,Kbb) = -ssh_ref 1202 1202 1203 DO_2D _11_111203 DO_2D( 1, 1, 1, 1 ) 1204 1204 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 1205 1205 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) -
NEMO/trunk/src/SWE/dynatf.F90
r12983 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) ) … … 232 232 CALL dom_vvl_interpol( ssh(:,:,Kmm), pe3u(:,:,:,Kmm), 'U' ) 233 233 CALL dom_vvl_interpol( ssh(:,:,Kmm), pe3v(:,:,:,Kmm), 'V' ) 234 DO_3D _11_11(1, jpkm1 )234 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 235 235 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) ) 236 236 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) ) … … 243 243 CALL dom_vvl_interpol( ssh(:,:,Kmm), ze3u_f, 'U' ) 244 244 CALL dom_vvl_interpol( ssh(:,:,Kmm), ze3v_f, 'V' ) 245 DO_3D _11_11(1, jpkm1 )245 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 246 246 zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 247 247 zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) -
NEMO/trunk/src/SWE/dynkeg.F90
r12983 r13295 103 103 !!an45 to be ADDED : que cas C2 - "wet points only" il suffit de x2 le terme quadratic a la coast (nn_dynkeg_adv = 2) 104 104 CASE ( nkeg_C2_wpo ) !-- Standard scheme --! 105 DO_3D _01_01(1, jpkm1 )105 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 106 106 zu = ( puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 107 107 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) ) * ( 2._wp - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) … … 113 113 ! 114 114 CASE ( nkeg_C2 ) !-- Standard scheme --! 115 DO_3D _01_01(1, jpkm1 )115 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 116 116 zu = puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 117 117 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) … … 121 121 END_3D 122 122 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! 123 DO_3D _00_00(1, jpkm1 )123 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 124 124 zu = 8._wp * ( puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 125 125 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) ) & … … 137 137 END SELECT 138 138 ! 139 DO_3D _00_00(1, jpkm1 )139 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 140 140 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 141 141 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/SWE/dynldf_lap_blp.F90
r12983 r13295 97 97 DO jk = 1, jpkm1 ! Horizontal slab 98 98 ! 99 DO_2D _01_0199 DO_2D( 0, 1, 0, 1 ) 100 100 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 101 101 !!gm open question here : e3f at before or now ? probably now... … … 112 112 END_2D 113 113 ! 114 DO_2D _00_00114 DO_2D( 0, 0, 0, 0 ) 115 115 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * ( & 116 116 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & … … 128 128 DO jk = 1, jpkm1 ! Horizontal slab 129 129 ! 130 DO_2D _01_01130 DO_2D( 0, 1, 0, 1 ) 131 131 ! ! shearing stress component (F-point) NB : ahmf has already been multiplied by fmask 132 132 zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) & … … 143 143 END_2D 144 144 ! 145 DO_2D _00_00145 DO_2D( 0, 0, 0, 0 ) 146 146 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & 147 147 & * ( ( zten(ji+1,jj ) * e2t(ji+1,jj )*e2t(ji+1,jj ) * e3t(ji+1,jj ,jk,Kmm) & … … 164 164 DO jk = 1, jpkm1 ! Horizontal slab 165 165 ! 166 DO_2D _01_01166 DO_2D( 0, 1, 0, 1 ) 167 167 ! ! shearing stress component (F-point) NB : ahmf has already been multiplied by fmask 168 168 zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) & … … 175 175 END_2D 176 176 ! 177 DO_2D _00_00177 DO_2D( 0, 0, 0, 0 ) 178 178 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & 179 179 & * ( zten(ji+1,jj ) * e2t(ji+1,jj ) * e3t(ji+1,jj ,jk,Kmm) & -
NEMO/trunk/src/SWE/dynvor.F90
r12983 r13295 232 232 CASE ( np_RVO , np_CRV ) !* relative vorticity at f-point is used 233 233 DO jk = 1, jpkm1 ! Horizontal slab 234 DO_2D _10_10234 DO_2D( 1, 0, 1, 0 ) 235 235 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 236 236 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 237 237 END_2D 238 238 IF( ln_dynvor_msk ) THEN ! mask relative vorticity 239 DO_2D _10_10239 DO_2D( 1, 0, 1, 0 ) 240 240 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 241 241 END_2D … … 255 255 zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,Kmm) 256 256 CASE ( np_RVO ) !* relative vorticity 257 DO_2D _01_01257 DO_2D( 0, 1, 0, 1 ) 258 258 zwt(ji,jj) = r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 259 259 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) & … … 261 261 END_2D 262 262 CASE ( np_MET ) !* metric term 263 DO_2D _01_01263 DO_2D( 0, 1, 0, 1 ) 264 264 zwt(ji,jj) = ( ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) & 265 265 & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) & … … 267 267 END_2D 268 268 CASE ( np_CRV ) !* Coriolis + relative vorticity 269 DO_2D _01_01269 DO_2D( 0, 1, 0, 1 ) 270 270 zwt(ji,jj) = ( ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 271 271 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) ) & … … 273 273 END_2D 274 274 CASE ( np_CME ) !* Coriolis + metric 275 DO_2D _01_01275 DO_2D( 0, 1, 0, 1 ) 276 276 zwt(ji,jj) = ( ff_t(ji,jj) * e1e2t(ji,jj) & 277 277 & + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) & … … 284 284 ! 285 285 ! !== compute and add the vorticity term trend =! 286 DO_2D _00_00286 DO_2D( 0, 0, 0, 0 ) 287 287 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & 288 288 & * ( zwt(ji+1,jj) * ( pv(ji+1,jj,jk) + pv(ji+1,jj-1,jk) ) & … … 344 344 zwz(:,:) = ff_f(:,:) 345 345 CASE ( np_RVO ) !* relative vorticity 346 DO_2D _10_10346 DO_2D( 1, 0, 1, 0 ) 347 347 zwz(ji,jj) = ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 348 348 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 349 349 END_2D 350 350 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 351 DO_2D _10_10351 DO_2D( 1, 0, 1, 0 ) 352 352 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 353 353 END_2D 354 354 ENDIF 355 355 CASE ( np_MET ) !* metric term 356 DO_2D _10_10356 DO_2D( 1, 0, 1, 0 ) 357 357 zwz(ji,jj) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 358 358 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 359 359 END_2D 360 360 CASE ( np_CRV ) !* Coriolis + relative vorticity 361 DO_2D _10_10361 DO_2D( 1, 0, 1, 0 ) 362 362 zwz(ji,jj) = ff_f(ji,jj) + ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 363 363 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 364 364 END_2D 365 365 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity (NOT the Coriolis term) 366 DO_2D _10_10366 DO_2D( 1, 0, 1, 0 ) 367 367 zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 368 368 END_2D 369 369 ENDIF 370 370 CASE ( np_CME ) !* Coriolis + metric 371 DO_2D _10_10371 DO_2D( 1, 0, 1, 0 ) 372 372 zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 373 373 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) … … 383 383 ! 384 384 ! !== compute and add the vorticity term trend =! 385 DO_2D _00_00385 DO_2D( 0, 0, 0, 0 ) 386 386 zy1 = zwy(ji,jj-1) + zwy(ji+1,jj-1) 387 387 zy2 = zwy(ji,jj ) + zwy(ji+1,jj ) … … 441 441 zwz(:,:) = ff_f(:,:) 442 442 CASE ( np_RVO ) !* relative vorticity 443 DO_2D _10_10443 DO_2D( 1, 0, 1, 0 ) 444 444 zwz(ji,jj) = ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 445 445 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 446 446 END_2D 447 447 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 448 DO_2D _10_10448 DO_2D( 1, 0, 1, 0 ) 449 449 zwz(ji,jj) = ff_f(ji,jj) * fmask(ji,jj,jk) 450 450 END_2D 451 451 ENDIF 452 452 CASE ( np_MET ) !* metric term 453 DO_2D _10_10453 DO_2D( 1, 0, 1, 0 ) 454 454 zwz(ji,jj) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 455 455 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 456 456 END_2D 457 457 CASE ( np_CRV ) !* Coriolis + relative vorticity 458 DO_2D _10_10458 DO_2D( 1, 0, 1, 0 ) 459 459 zwz(ji,jj) = ff_f(ji,jj) + ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 460 460 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 461 461 END_2D 462 462 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity (NOT the Coriolis term) 463 DO_2D _10_10463 DO_2D( 1, 0, 1, 0 ) 464 464 zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 465 465 END_2D 466 466 ENDIF 467 467 CASE ( np_CME ) !* Coriolis + metric 468 DO_2D _10_10468 DO_2D( 1, 0, 1, 0 ) 469 469 zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 470 470 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) … … 481 481 ! 482 482 ! !== compute and add the vorticity term trend =! 483 DO_2D _00_00483 DO_2D( 0, 0, 0, 0 ) 484 484 zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 485 485 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) … … 539 539 SELECT CASE( nn_een_e3f ) ! == reciprocal of e3 at F-point 540 540 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 541 DO_2D _10_10541 DO_2D( 1, 0, 1, 0 ) 542 542 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 543 543 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & … … 549 549 END_2D 550 550 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 551 DO_2D _10_10551 DO_2D( 1, 0, 1, 0 ) 552 552 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 553 553 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & … … 564 564 SELECT CASE( kvor ) !== vorticity considered ==! 565 565 CASE ( np_COR ) !* Coriolis (planetary vorticity) 566 DO_2D _10_10566 DO_2D( 1, 0, 1, 0 ) 567 567 zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj) 568 568 END_2D 569 569 CASE ( np_RVO ) !* relative vorticity 570 DO_2D _10_10570 DO_2D( 1, 0, 1, 0 ) 571 571 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 572 572 & - e1u(ji ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 573 573 END_2D 574 574 CASE ( np_MET ) !* metric term 575 DO_2D _10_10575 DO_2D( 1, 0, 1, 0 ) 576 576 zwz(ji,jj,jk) = ( ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 577 577 & - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj) 578 578 END_2D 579 579 CASE ( np_CRV ) !* Coriolis + relative vorticity 580 DO_2D _10_10580 DO_2D( 1, 0, 1, 0 ) 581 581 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 582 582 & - e1u(ji ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) & … … 584 584 END_2D 585 585 CASE ( np_CME ) !* Coriolis + metric 586 DO_2D _10_10586 DO_2D( 1, 0, 1, 0 ) 587 587 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( 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) … … 593 593 ! 594 594 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 595 DO_2D _10_10595 DO_2D( 1, 0, 1, 0 ) 596 596 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 597 597 END_2D … … 624 624 END DO 625 625 END DO 626 DO_2D _00_00626 DO_2D( 0, 0, 0, 0 ) 627 627 zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 628 628 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) … … 684 684 SELECT CASE( kvor ) !== vorticity considered ==! 685 685 CASE ( np_COR ) !* Coriolis (planetary vorticity) 686 DO_2D _10_10686 DO_2D( 1, 0, 1, 0 ) 687 687 zwz(ji,jj,jk) = ff_f(ji,jj) 688 688 END_2D 689 689 CASE ( np_RVO ) !* relative vorticity 690 DO_2D _10_10690 DO_2D( 1, 0, 1, 0 ) 691 691 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 692 692 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) & … … 694 694 END_2D 695 695 CASE ( np_MET ) !* metric term 696 DO_2D _10_10696 DO_2D( 1, 0, 1, 0 ) 697 697 zwz(ji,jj,jk) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 698 698 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 699 699 END_2D 700 700 CASE ( np_CRV ) !* Coriolis + relative vorticity 701 DO_2D _10_10701 DO_2D( 1, 0, 1, 0 ) 702 702 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( 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_CME ) !* Coriolis + metric 707 DO_2D _10_10707 DO_2D( 1, 0, 1, 0 ) 708 708 zwz(ji,jj,jk) = ff_f(ji,jj) + ( 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) … … 714 714 ! 715 715 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 716 DO_2D _10_10716 DO_2D( 1, 0, 1, 0 ) 717 717 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 718 718 END_2D … … 747 747 END DO 748 748 END DO 749 DO_2D _00_00749 DO_2D( 0, 0, 0, 0 ) 750 750 zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 751 751 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) … … 807 807 IF(lwp) WRITE(numout,*) ' change fmask value in the angles (T) ln_vorlat = ', ln_vorlat 808 808 IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN 809 DO_3D _10_10(1, jpk )809 DO_3D( 1, 0, 1, 0, 1, jpk ) 810 810 IF( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 811 811 & + tmask(ji,jj ,jk) + tmask(ji+1,jj+1,jk) == 3._wp ) fmask(ji,jj,jk) = 1._wp … … 846 846 CASE( np_ENT ) !* T-point metric term : pre-compute di(e2u)/2 and dj(e1v)/2 847 847 ALLOCATE( di_e2u_2(jpi,jpj), dj_e1v_2(jpi,jpj) ) 848 DO_2D _00_00848 DO_2D( 0, 0, 0, 0 ) 849 849 di_e2u_2(ji,jj) = ( e2u(ji,jj) - e2u(ji-1,jj ) ) * 0.5_wp 850 850 dj_e1v_2(ji,jj) = ( e1v(ji,jj) - e1v(ji ,jj-1) ) * 0.5_wp … … 854 854 CASE DEFAULT !* F-point metric term : pre-compute di(e2u)/(2*e1e2f) and dj(e1v)/(2*e1e2f) 855 855 ALLOCATE( di_e2v_2e1e2f(jpi,jpj), dj_e1u_2e1e2f(jpi,jpj) ) 856 DO_2D _10_10856 DO_2D( 1, 0, 1, 0 ) 857 857 di_e2v_2e1e2f(ji,jj) = ( e2v(ji+1,jj ) - e2v(ji,jj) ) * 0.5 * r1_e1e2f(ji,jj) 858 858 dj_e1u_2e1e2f(ji,jj) = ( e1u(ji ,jj+1) - e1u(ji,jj) ) * 0.5 * r1_e1e2f(ji,jj) -
NEMO/trunk/src/SWE/ldfdyn.F90
r12983 r13295 312 312 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate Smagorinsky arrays') 313 313 ! 314 DO_2D _11_11314 DO_2D( 1, 1, 1, 1 ) 315 315 esqt(ji,jj) = ( 2._wp * e1e2t(ji,jj) / ( e1t(ji,jj) + e2t(ji,jj) ) )**2 316 316 esqf(ji,jj) = ( 2._wp * e1e2f(ji,jj) / ( e1f(ji,jj) + e2f(ji,jj) ) )**2 … … 396 396 IF( ln_dynldf_lap ) THEN ! laplacian operator : |u| e /12 = |u/144| e 397 397 DO jk = 1, jpkm1 398 DO_2D _00_00398 DO_2D( 0, 0, 0, 0 ) 399 399 zu2pv2_ij = uu(ji ,jj ,jk,Kbb) * uu(ji ,jj ,jk,Kbb) + vv(ji ,jj ,jk,Kbb) * vv(ji ,jj ,jk,Kbb) 400 400 zu2pv2_ij_m1 = uu(ji-1,jj ,jk,Kbb) * uu(ji-1,jj ,jk,Kbb) + vv(ji ,jj-1,jk,Kbb) * vv(ji ,jj-1,jk,Kbb) … … 402 402 ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax * tmask(ji,jj,jk) ! 288= 12*12 * 2 403 403 END_2D 404 DO_2D _10_10404 DO_2D( 1, 0, 1, 0 ) 405 405 zu2pv2_ij_p1 = uu(ji ,jj+1,jk, Kbb) * uu(ji ,jj+1,jk, Kbb) + vv(ji+1,jj ,jk, Kbb) * vv(ji+1,jj ,jk, Kbb) 406 406 zu2pv2_ij = uu(ji ,jj ,jk, Kbb) * uu(ji ,jj ,jk, Kbb) + vv(ji ,jj ,jk, Kbb) * vv(ji ,jj ,jk, Kbb) … … 411 411 ELSEIF( ln_dynldf_blp ) THEN ! bilaplacian operator : sqrt( |u| e^3 /12 ) = sqrt( |u/144| e ) * e 412 412 DO jk = 1, jpkm1 413 DO_2D _00_00413 DO_2D( 0, 0, 0, 0 ) 414 414 zu2pv2_ij = uu(ji ,jj ,jk,Kbb) * uu(ji ,jj ,jk,Kbb) + vv(ji ,jj ,jk,Kbb) * vv(ji ,jj ,jk,Kbb) 415 415 zu2pv2_ij_m1 = uu(ji-1,jj ,jk,Kbb) * uu(ji-1,jj ,jk,Kbb) + vv(ji ,jj-1,jk,Kbb) * vv(ji ,jj-1,jk,Kbb) … … 417 417 ahmt(ji,jj,jk) = SQRT( SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax ) * zemax * tmask(ji,jj,jk) 418 418 END_2D 419 DO_2D _10_10419 DO_2D( 1, 0, 1, 0 ) 420 420 zu2pv2_ij_p1 = uu(ji ,jj+1,jk, Kbb) * uu(ji ,jj+1,jk, Kbb) + vv(ji+1,jj ,jk, Kbb) * vv(ji+1,jj ,jk, Kbb) 421 421 zu2pv2_ij = uu(ji ,jj ,jk, Kbb) * uu(ji ,jj ,jk, Kbb) + vv(ji ,jj ,jk, Kbb) * vv(ji ,jj ,jk, Kbb) … … 440 440 DO jk = 1, jpkm1 441 441 ! 442 DO_2D _00_00442 DO_2D( 0, 0, 0, 0 ) 443 443 zdb = ( uu(ji,jj,jk,Kbb) * r1_e2u(ji,jj) - uu(ji-1,jj,jk,Kbb) * r1_e2u(ji-1,jj) ) & 444 444 & * r1_e1t(ji,jj) * e2t(ji,jj) & … … 448 448 END_2D 449 449 ! 450 DO_2D _10_10450 DO_2D( 1, 0, 1, 0 ) 451 451 zdb = ( uu(ji,jj+1,jk,Kbb) * r1_e1u(ji,jj+1) - uu(ji,jj,jk,Kbb) * r1_e1u(ji,jj) ) & 452 452 & * r1_e2f(ji,jj) * e1f(ji,jj) & … … 462 462 DO jk = 1, jpkm1 463 463 ! 464 DO_2D _00_00464 DO_2D( 0, 0, 0, 0 ) 465 465 ! 466 466 zu2pv2_ij = uu(ji ,jj ,jk,Kbb) * uu(ji ,jj ,jk,Kbb) + vv(ji ,jj ,jk,Kbb) * vv(ji ,jj ,jk,Kbb) … … 476 476 END_2D 477 477 ! 478 DO_2D _10_10478 DO_2D( 1, 0, 1, 0 ) 479 479 ! 480 480 zu2pv2_ij_p1 = uu(ji ,jj+1,jk, kbb) * uu(ji ,jj+1,jk, kbb) + vv(ji+1,jj ,jk, kbb) * vv(ji+1,jj ,jk, kbb) … … 499 499 ! ! effective default limits are 1/12 |U|L^3 < B_hm < 1//(32*2dt) L^4 500 500 DO jk = 1, jpkm1 501 DO_2D _00_00501 DO_2D( 0, 0, 0, 0 ) 502 502 ahmt(ji,jj,jk) = SQRT( r1_8 * esqt(ji,jj) * ahmt(ji,jj,jk) ) 503 503 END_2D 504 DO_2D _10_10504 DO_2D( 1, 0, 1, 0 ) 505 505 ahmf(ji,jj,jk) = SQRT( r1_8 * esqf(ji,jj) * ahmf(ji,jj,jk) ) 506 506 END_2D -
NEMO/trunk/src/SWE/sbcice_cice.F90
r12983 r13295 219 219 ! T point to U point 220 220 ! T point to V point 221 DO_2D _10_10221 DO_2D( 1, 0, 1, 0 ) 222 222 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 223 223 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) … … 316 316 ! x comp of wind stress (CI_1) 317 317 ! U point to F point 318 DO_2D _10_11318 DO_2D( 1, 0, 1, 1 ) 319 319 ztmp(ji,jj) = 0.5 * ( fr_iu(ji,jj) * utau(ji,jj) & 320 320 + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1) … … 324 324 ! y comp of wind stress (CI_2) 325 325 ! V point to F point 326 DO_2D _11_10326 DO_2D( 1, 1, 1, 0 ) 327 327 ztmp(ji,jj) = 0.5 * ( fr_iv(ji,jj) * vtau(ji,jj) & 328 328 + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1) … … 339 339 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * rLsub 340 340 ! End of temporary code 341 DO_2D _11_11341 DO_2D( 1, 1, 1, 1 ) 342 342 IF(fr_i(ji,jj).eq.0.0) THEN 343 343 DO jl=1,ncat … … 441 441 ! x comp and y comp of surface ocean current 442 442 ! U point to F point 443 DO_2D _10_11443 DO_2D( 1, 0, 1, 1 ) 444 444 ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1) 445 445 END_2D … … 447 447 448 448 ! V point to F point 449 DO_2D _11_10449 DO_2D( 1, 1, 1, 0 ) 450 450 ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1) 451 451 END_2D … … 471 471 ! x comp and y comp of sea surface slope (on F points) 472 472 ! T point to F point 473 DO_2D _10_10473 DO_2D( 1, 0, 1, 0 ) 474 474 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) & 475 475 & + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1) … … 478 478 479 479 ! T point to F point 480 DO_2D _10_10480 DO_2D( 1, 0, 1, 0 ) 481 481 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) & 482 482 & + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1) … … 507 507 ss_iou(:,:)=0.0 508 508 ! F point to U point 509 DO_2D _00_00509 DO_2D( 0, 0, 0, 0 ) 510 510 ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 511 511 END_2D … … 517 517 ! F point to V point 518 518 519 DO_2D _10_00519 DO_2D( 1, 0, 0, 0 ) 520 520 ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 521 521 END_2D … … 601 601 CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1. ) 602 602 603 DO_2D _11_11603 DO_2D( 1, 1, 1, 1 ) 604 604 nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0) 605 605 END_2D … … 625 625 ! T point to U point 626 626 ! T point to V point 627 DO_2D _10_10627 DO_2D( 1, 0, 1, 0 ) 628 628 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 629 629 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) … … 985 985 986 986 pn(:,:)=0.0 987 DO_2D _10_10987 DO_2D( 1, 0, 1, 0 ) 988 988 pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1) 989 989 END_2D -
NEMO/trunk/src/SWE/step.F90
r12983 r13295 148 148 149 149 !!an - calcul du gradient de pression horizontal (explicit) 150 DO_3D _00_00(1, jpkm1 )150 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 151 151 uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj) 152 152 vv(ji,jj,jk,Nrhs) = vv(ji,jj,jk,Nrhs) - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj) … … 155 155 ! add wind stress forcing and layer linear friction to the RHS 156 156 z1_2rho0 = 0.5_wp * r1_rho0 157 DO_3D _00_00(1,jpkm1)157 DO_3D( 0, 0, 0, 0,1,jpkm1) 158 158 uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + z1_2rho0 * ( utau_b(ji,jj) + utau(ji,jj) ) / e3u(ji,jj,jk,Nnn) & 159 159 & - rn_rfr * uu(ji,jj,jk,Nbb) … … 172 172 IF( ln_dynadv_vec ) THEN ! vector invariant form : applied on velocity 173 173 IF( l_1st_euler ) THEN ! Euler time stepping (no Asselin filter) 174 DO_3D _00_00(1,jpkm1)174 DO_3D( 0, 0, 0, 0,1,jpkm1) 175 175 uu(ji,jj,jk,Naa) = uu(ji,jj,jk,Nbb) + rDt * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk) 176 176 vv(ji,jj,jk,Naa) = vv(ji,jj,jk,Nbb) + rDt * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk) 177 177 END_3D 178 178 ELSE ! Leap Frog time stepping + Asselin filter 179 DO_3D _11_11(1,jpkm1)179 DO_3D( 1, 1, 1, 1,1,jpkm1) 180 180 zua = uu(ji,jj,jk,Nbb) + rDt * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk) 181 181 zva = vv(ji,jj,jk,Nbb) + rDt * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk) … … 199 199 ELSE ! flux form : applied on thickness weighted velocity 200 200 IF( l_1st_euler ) THEN ! Euler time stepping (no Asselin filter) 201 DO_3D _00_00(1,jpkm1)201 DO_3D( 0, 0, 0, 0,1,jpkm1) 202 202 zue3b = e3u(ji,jj,jk,Nbb) * uu(ji,jj,jk,Nbb) 203 203 zve3b = e3v(ji,jj,jk,Nbb) * vv(ji,jj,jk,Nbb) … … 210 210 END_3D 211 211 ELSE ! Leap Frog time stepping + Asselin filter 212 DO_3D _11_11(1,jpkm1)212 DO_3D( 1, 1, 1, 1,1,jpkm1) 213 213 zue3n = e3u(ji,jj,jk,Nnn) * uu(ji,jj,jk,Nnn) 214 214 zve3n = e3v(ji,jj,jk,Nnn) * vv(ji,jj,jk,Nnn) -
NEMO/trunk/src/SWE/stepLF.F90
r12983 r13295 146 146 !IF( .NOT.ln_linssh ) CALL dom_vvl_sf_nxt_st( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 147 147 !!an - calcul du gradient de pression horizontal (explicit) 148 DO_3D _00_00(1, jpkm1 )148 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 149 149 uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj) 150 150 vv(ji,jj,jk,Nrhs) = vv(ji,jj,jk,Nrhs) - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj) … … 153 153 ! add wind stress forcing and layer linear friction to the RHS 154 154 z1_2rho0 = 0.5_wp * r1_rho0 155 DO_3D _00_00(1,jpkm1)155 DO_3D( 0, 0, 0, 0,1,jpkm1) 156 156 uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + z1_2rho0 * ( utau_b(ji,jj) + utau(ji,jj) ) / e3u(ji,jj,jk,Nnn) & 157 157 & - rn_rfr * uu(ji,jj,jk,Nbb) … … 176 176 IF( ln_dynadv_vec ) THEN ! vector invariant form : applied on velocity 177 177 IF( l_1st_euler ) THEN ! Euler time stepping (no Asselin filter) 178 DO_3D _00_00(1,jpkm1)178 DO_3D( 0, 0, 0, 0,1,jpkm1) 179 179 uu(ji,jj,jk,Naa) = uu(ji,jj,jk,Nbb) + rDt * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk) 180 180 vv(ji,jj,jk,Naa) = vv(ji,jj,jk,Nbb) + rDt * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk) 181 181 END_3D 182 182 ELSE ! Leap Frog time stepping + Asselin filter 183 DO_3D _11_11(1,jpkm1)183 DO_3D( 1, 1, 1, 1,1,jpkm1) 184 184 zua = uu(ji,jj,jk,Nbb) + rDt * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk) 185 185 zva = vv(ji,jj,jk,Nbb) + rDt * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk) … … 203 203 ELSE ! flux form : applied on thickness weighted velocity 204 204 IF( l_1st_euler ) THEN ! Euler time stepping (no Asselin filter) 205 DO_3D _00_00(1,jpkm1)205 DO_3D( 0, 0, 0, 0,1,jpkm1) 206 206 zue3b = e3u(ji,jj,jk,Nbb) * uu(ji,jj,jk,Nbb) 207 207 zve3b = e3v(ji,jj,jk,Nbb) * vv(ji,jj,jk,Nbb) … … 215 215 ELSE ! Leap Frog time stepping + Asselin filter 216 216 CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f(:,:), r3u_f(:,:), r3v_f(:,:) ) ! "now" ssh/h_0 ratio from filtrered ssh 217 DO_3D _11_11(1,jpkm1)217 DO_3D( 1, 1, 1, 1,1,jpkm1) 218 218 zue3n = e3u(ji,jj,jk,Nnn) * uu(ji,jj,jk,Nnn) 219 219 zve3n = e3v(ji,jj,jk,Nnn) * vv(ji,jj,jk,Nnn) -
NEMO/trunk/src/SWE/stpRK3.F90
r12983 r13295 145 145 ! 146 146 !!an - calcul du gradient de pression horizontal (explicit) 147 DO_3D _00_00(1, jpkm1 )147 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 148 148 uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) - grav * ( ssh(ji+1,jj,Nbb) - ssh(ji,jj,Nbb) ) * r1_e1u(ji,jj) 149 149 vv(ji,jj,jk,Nrhs) = vv(ji,jj,jk,Nrhs) - grav * ( ssh(ji,jj+1,Nbb) - ssh(ji,jj,Nbb) ) * r1_e2v(ji,jj) … … 153 153 ! add wind stress forcing and layer linear friction to the RHS 154 154 z5_6 = 5._wp/6._wp 155 DO_3D _00_00(1,jpkm1)155 DO_3D( 0, 0, 0, 0,1,jpkm1) 156 156 uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + r1_rho0 * ( z5_6*utau_b(ji,jj) + (1._wp - z5_6)*utau(ji,jj) ) / e3u(ji,jj,jk,Nbb) & 157 157 & - rn_rfr * uu(ji,jj,jk,Nbb) … … 163 163 CALL dom_qco_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) ! "after" ssh./h._0 ratio explicit 164 164 IF( ln_dynadv_vec ) THEN ! vector invariant form : applied on velocity 165 DO_3D _00_00(1,jpkm1)165 DO_3D( 0, 0, 0, 0,1,jpkm1) 166 166 uu(ji,jj,jk,Naa) = uu(ji,jj,jk,Nbb) + rDt * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk) 167 167 vv(ji,jj,jk,Naa) = vv(ji,jj,jk,Nbb) + rDt * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk) 168 168 END_3D 169 169 ELSE 170 DO_3D _00_00(1,jpkm1) ! flux form : applied on thickness weighted velocity170 DO_3D( 0, 0, 0, 0,1,jpkm1) ! flux form : applied on thickness weighted velocity 171 171 uu(ji,jj,jk,Naa) = ( uu(ji,jj,jk,Nbb )*e3u(ji,jj,jk,Nbb) & 172 172 & + rDt * uu(ji,jj,jk,Nrhs)*e3t(ji,jj,jk,Nbb) * umask(ji,jj,jk) ) & … … 203 203 ! 204 204 !!an - calcul du gradient de pression horizontal (explicit) 205 DO_3D _00_00(1, jpkm1 )205 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 206 206 uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj) 207 207 vv(ji,jj,jk,Nrhs) = vv(ji,jj,jk,Nrhs) - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj) … … 211 211 #if defined key_RK3all 212 212 z3_4 = 3._wp/4._wp 213 DO_3D _00_00(1,jpkm1)213 DO_3D( 0, 0, 0, 0,1,jpkm1) 214 214 uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + r1_rho0 * ( z3_4*utau_b(ji,jj) + (1._wp - z3_4)*utau(ji,jj) ) / e3u(ji,jj,jk,Nbb) & 215 215 & - rn_rfr * uu(ji,jj,jk,Nbb) … … 221 221 CALL dom_qco_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) ! "after" ssh./h._0 ratio explicit 222 222 IF( ln_dynadv_vec ) THEN ! vector invariant form : applied on velocity 223 DO_3D _00_00(1,jpkm1)223 DO_3D( 0, 0, 0, 0,1,jpkm1) 224 224 uu(ji,jj,jk,Naa) = uu(ji,jj,jk,Nbb) + rDt * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk) 225 225 vv(ji,jj,jk,Naa) = vv(ji,jj,jk,Nbb) + rDt * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk) 226 226 END_3D 227 227 ELSE 228 DO_3D _00_00(1,jpkm1) ! flux form : applied on thickness weighted velocity228 DO_3D( 0, 0, 0, 0,1,jpkm1) ! flux form : applied on thickness weighted velocity 229 229 uu(ji,jj,jk,Naa) = ( uu(ji,jj,jk,Nbb )*e3u(ji,jj,jk,Nbb) & 230 230 & + rDt * uu(ji,jj,jk,Nrhs)*e3t(ji,jj,jk,Nnn) * umask(ji,jj,jk) ) & … … 264 264 265 265 !!an - calcul du gradient de pression horizontal (explicit) 266 DO_3D _00_00(1, jpkm1 )266 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 267 267 uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj) 268 268 vv(ji,jj,jk,Nrhs) = vv(ji,jj,jk,Nrhs) - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj) … … 271 271 ! add wind stress forcing and layer linear friction to the RHS 272 272 z1_2rho0 = 0.5_wp * r1_rho0 273 DO_3D _00_00(1,jpkm1)273 DO_3D( 0, 0, 0, 0,1,jpkm1) 274 274 uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + z1_2rho0 * ( utau_b(ji,jj) + utau(ji,jj) ) / e3u(ji,jj,jk,Nnn) & 275 275 & - rn_rfr * uu(ji,jj,jk,Nbb) … … 280 280 CALL dom_qco_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) ! "after" ssh./h._0 ratio explicit 281 281 IF( ln_dynadv_vec ) THEN ! vector invariant form : applied on velocity 282 DO_3D _11_11(1,jpkm1)282 DO_3D( 1, 1, 1, 1,1,jpkm1) 283 283 zua = uu(ji,jj,jk,Nbb) + rDt * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk) 284 284 zva = vv(ji,jj,jk,Nbb) + rDt * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk) … … 292 292 ! 293 293 ELSE ! flux form : applied on thickness weighted velocity 294 DO_3D _11_11(1,jpkm1)294 DO_3D( 1, 1, 1, 1,1,jpkm1) 295 295 zue3n = e3u(ji,jj,jk,Nnn) * uu(ji,jj,jk,Nnn) 296 296 zve3n = e3v(ji,jj,jk,Nnn) * vv(ji,jj,jk,Nnn)
Note: See TracChangeset
for help on using the changeset viewer.
