- Timestamp:
- 2011-12-11T16:00:26+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r2715 r3211 46 46 PUBLIC ssh_nxt ! called by step.F90 47 47 48 !! * Control permutation of array indices 49 # include "oce_ftrans.h90" 50 # include "dom_oce_ftrans.h90" 51 # include "sbc_oce_ftrans.h90" 52 # include "domvvl_ftrans.h90" 53 # include "obc_oce_ftrans.h90" 54 #if defined key_asminc 55 # include "asminc_ftrans.h90" 56 #endif 57 48 58 !! * Substitutions 49 59 # include "domzgr_substitute.h90" … … 78 88 USE oce , ONLY: z3d => ta ! ta used as 3D workspace 79 89 USE wrk_nemo, ONLY: zhdiv => wrk_2d_1 , z2d => wrk_2d_2 ! 2D workspace 90 !! DCSE_NEMO: need additional directives for renamed module variables 91 !FTRANS z3d :I :I :z 80 92 ! 81 93 INTEGER, INTENT(in) :: kt ! time step … … 100 112 DO jj = 1, jpjm1 101 113 DO ji = 1, jpim1 ! caution: use of Vector Opt. not possible 114 #if defined key_z_first 115 zcoefu = 0.5 * umask_1(ji,jj) / ( e1u(ji,jj) * e2u(ji,jj) ) 116 zcoefv = 0.5 * vmask_1(ji,jj) / ( e1v(ji,jj) * e2v(ji,jj) ) 117 zcoeff = 0.25 * umask_1(ji,jj) * umask_1(ji,jj+1) 118 #else 102 119 zcoefu = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 103 120 zcoefv = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 104 121 zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 122 #endif 105 123 sshu_b(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshb(ji ,jj) & 106 124 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) … … 117 135 DO jj = 1, jpjm1 118 136 DO ji = 1, jpim1 ! NO Vector Opt. 137 #if defined key_z_first 138 sshf_n(ji,jj) = 0.5 * umask_1(ji,jj) * umask_1(ji,jj+1) & 139 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 140 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 141 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 142 #else 119 143 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 120 144 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 121 145 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 122 146 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 147 #endif 123 148 END DO 124 149 END DO … … 131 156 IF( lk_vvl ) THEN ! Regridding: Update Now Vertical coord. ! (only in vvl case) 132 157 ! !------------------------------------------! 158 #if defined key_z_first 159 fsdept(:,:,1:jpkm1) = fsdept_n(:,:,1:jpkm1) ! now local depths stored in fsdep. arrays 160 fsdepw(:,:,1:jpkm1) = fsdepw_n(:,:,1:jpkm1) 161 fsde3w(:,:,1:jpkm1) = fsde3w_n(:,:,1:jpkm1) 162 ! 163 fse3t (:,:,1:jpkm1) = fse3t_n (:,:,1:jpkm1) ! vertical scale factors stored in fse3. arrays 164 fse3u (:,:,1:jpkm1) = fse3u_n (:,:,1:jpkm1) 165 fse3v (:,:,1:jpkm1) = fse3v_n (:,:,1:jpkm1) 166 fse3f (:,:,1:jpkm1) = fse3f_n (:,:,1:jpkm1) 167 fse3w (:,:,1:jpkm1) = fse3w_n (:,:,1:jpkm1) 168 fse3uw(:,:,1:jpkm1) = fse3uw_n(:,:,1:jpkm1) 169 fse3vw(:,:,1:jpkm1) = fse3vw_n(:,:,1:jpkm1) 170 #else 133 171 DO jk = 1, jpkm1 134 172 fsdept(:,:,jk) = fsdept_n(:,:,jk) ! now local depths stored in fsdep. arrays … … 144 182 fse3vw(:,:,jk) = fse3vw_n(:,:,jk) 145 183 END DO 184 #endif 146 185 ! 147 186 hu(:,:) = hu_0(:,:) + sshu_n(:,:) ! now ocean depth (at u- and v-points) 148 187 hv(:,:) = hv_0(:,:) + sshv_n(:,:) 149 188 ! ! now masked inverse of the ocean depth (at u- and v-points) 189 #if defined key_z_first 190 hur(:,:) = umask_1(:,:) / ( hu(:,:) + 1._wp - umask_1(:,:) ) 191 hvr(:,:) = vmask_1(:,:) / ( hv(:,:) + 1._wp - vmask_1(:,:) ) 192 #else 150 193 hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1._wp - umask(:,:,1) ) 151 194 hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1._wp - vmask(:,:,1) ) 195 #endif 152 196 ! 153 197 ENDIF … … 162 206 ! !------------------------------! 163 207 zhdiv(:,:) = 0._wp 208 #if defined key_z_first 209 DO jj = 1, jpj 210 DO ji = 1, jpi 211 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 212 zhdiv(ji,jj) = zhdiv(ji,jj) + fse3t(ji,jj,jk) * hdivn(ji,jj,jk) 213 END DO 214 END DO 215 END DO 216 #else 164 217 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 165 218 zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) 166 219 END DO 220 #endif 167 221 ! ! Sea surface elevation time stepping 168 222 ! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used 169 223 ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp 170 224 z1_rau0 = 0.5 / rau0 225 #if defined key_z_first 226 ssha(:,:) = ( sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * tmask_1(:,:) 227 #else 171 228 ssha(:,:) = ( sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * tmask(:,:,1) 229 #endif 172 230 173 231 #if defined key_agrif … … 189 247 DO jj = 1, jpjm1 190 248 DO ji = 1, jpim1 ! NO Vector Opt. 249 #if defined key_z_first 250 sshu_a(ji,jj) = 0.5 * umask_1(ji,jj) / ( e1u(ji ,jj) * e2u(ji ,jj) ) & 251 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha(ji ,jj) & 252 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) ) 253 sshv_a(ji,jj) = 0.5 * vmask_1(ji,jj) / ( e1v(ji,jj ) * e2v(ji,jj ) ) & 254 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha(ji,jj ) & 255 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) ) 256 #else 191 257 sshu_a(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) ) & 192 258 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha(ji ,jj) & … … 195 261 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha(ji,jj ) & 196 262 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) ) 263 #endif 197 264 END DO 198 265 END DO … … 212 279 ! !------------------------------! 213 280 z1_2dt = 1.e0 / z2dt 281 #if defined key_z_first 282 DO jj = 1, jpj 283 DO ji = 1, jpi 284 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 285 wn(ji,jj,jk) = wn(ji,jj,jk+1) & 286 & - fse3t_n(ji,jj,jk) * hdivn(ji,jj,jk) & 287 & - ( fse3t_a(ji,jj,jk) - fse3t_b(ji,jj,jk) ) & 288 & * tmask(ji,jj,jk) * z1_2dt 289 #if defined key_bdy 290 wn(ji,jj,jk) = wn(ji,jj,jk) * bdytmask(ji,jj) 291 #endif 292 END DO 293 END DO 294 END DO 295 #else 214 296 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 215 297 ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise … … 221 303 #endif 222 304 END DO 305 #endif 223 306 224 307 ! !------------------------------! … … 231 314 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 232 315 z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:) 316 #if defined key_z_first 317 DO jj = 1, jpj 318 DO ji = 1, jpi 319 DO jk = 1, jpk 320 z3d(ji,jj,jk) = wn(ji,jj,jk) * z2d(ji,jj) 321 END DO 322 END DO 323 END DO 324 #else 233 325 DO jk = 1, jpk 234 326 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 235 327 END DO 328 #endif 236 329 CALL iom_put( "w_masstr" , z3d ) 237 330 CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) … … 286 379 DO jj = 1, jpjm1 ! ssh now at f-point 287 380 DO ji = 1, jpim1 ! NO Vector Opt. 381 #if defined key_z_first 382 sshf_n(ji,jj) = 0.5 * umask_1(ji,jj) * umask_1(ji,jj+1) & 383 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 384 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 385 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 386 #else 288 387 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 289 388 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 290 389 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 291 390 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 391 #endif 292 392 END DO 293 393 END DO … … 298 398 DO jj = 1, jpj 299 399 DO ji = 1, jpi ! before <-- now filtered 400 #if defined key_z_first 401 sshb (ji,jj) = sshn (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) & 402 & - zec * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask_1(ji,jj) 403 #else 300 404 sshb (ji,jj) = sshn (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) & 301 405 & - zec * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1) 406 #endif 302 407 sshn (ji,jj) = ssha (ji,jj) ! now <-- after 303 408 sshu_n(ji,jj) = sshu_a(ji,jj) … … 307 412 DO jj = 1, jpjm1 ! ssh now at f-point 308 413 DO ji = 1, jpim1 ! NO Vector Opt. 414 #if defined key_z_first 415 sshf_n(ji,jj) = 0.5 * umask_1(ji,jj) * umask_1(ji,jj+1) & 416 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 417 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 418 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 419 #else 309 420 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 310 421 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 311 422 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 312 423 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 424 #endif 313 425 END DO 314 426 END DO … … 317 429 DO jj = 1, jpjm1 ! ssh before at u- & v-points 318 430 DO ji = 1, jpim1 ! NO Vector Opt. 431 #if defined key_z_first 432 sshu_b(ji,jj) = 0.5 * umask_1(ji,jj) / ( e1u(ji ,jj) * e2u(ji ,jj) ) & 433 & * ( e1t(ji ,jj) * e2t(ji ,jj) * sshb(ji ,jj) & 434 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 435 sshv_b(ji,jj) = 0.5 * vmask_1(ji,jj) / ( e1v(ji,jj ) * e2v(ji,jj ) ) & 436 & * ( e1t(ji,jj ) * e2t(ji,jj ) * sshb(ji,jj ) & 437 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 438 #else 319 439 sshu_b(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) ) & 320 440 & * ( e1t(ji ,jj) * e2t(ji ,jj) * sshb(ji ,jj) & … … 323 443 & * ( e1t(ji,jj ) * e2t(ji,jj ) * sshb(ji,jj ) & 324 444 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 445 #endif 325 446 END DO 326 447 END DO
Note: See TracChangeset
for help on using the changeset viewer.
