- Timestamp:
- 2016-06-28T11:53:56+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r6140 r6748 143 143 IF( kpass == 1 ) THEN !== first pass only ==! 144 144 ! 145 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w) 145 146 DO jk = 2, jpkm1 146 147 DO jj = 2, jpjm1 … … 164 165 ! 165 166 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 167 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 166 168 DO jk = 2, jpkm1 167 169 DO jj = 2, jpjm1 … … 177 179 ! 178 180 IF( ln_traldf_blp ) THEN ! bilaplacian operator 181 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 179 182 DO jk = 2, jpkm1 180 183 DO jj = 1, jpjm1 … … 186 189 END DO 187 190 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 191 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ze3w_2, zcoef0) 188 192 DO jk = 2, jpkm1 189 193 DO jj = 1, jpjm1 … … 198 202 ! 199 203 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 204 !$OMP PARALLEL WORKSHARE 200 205 akz(:,:,:) = ah_wslp2(:,:,:) 206 !$OMP END PARALLEL WORKSHARE 201 207 ENDIF 202 208 ENDIF … … 210 216 !!---------------------------------------------------------------------- 211 217 !!gm : bug.... why (x,:,:)? (1,jpj,:) and (jpi,1,:) should be sufficient.... 218 !$OMP PARALLEL WORKSHARE 212 219 zdit (1,:,:) = 0._wp ; zdit (jpi,:,:) = 0._wp 213 220 zdjt (1,:,:) = 0._wp ; zdjt (jpi,:,:) = 0._wp 221 !$OMP END PARALLEL WORKSHARE 214 222 !!end 215 223 216 224 ! Horizontal tracer gradient 225 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 217 226 DO jk = 1, jpkm1 218 227 DO jj = 1, jpjm1 … … 224 233 END DO 225 234 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 235 !$OMP PARALLEL DO schedule(static) private(jj, ji) 226 236 DO jj = 1, jpjm1 ! bottom correction (partial bottom cell) 227 237 DO ji = 1, fs_jpim1 ! vector opt. … … 231 241 END DO 232 242 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 243 !$OMP PARALLEL DO schedule(static) private(jj, ji) 233 244 DO jj = 1, jpjm1 234 245 DO ji = 1, fs_jpim1 ! vector opt. … … 243 254 !! II - horizontal trend (full) 244 255 !!---------------------------------------------------------------------- 245 ! 246 DO jk = 1, jpkm1 ! Horizontal slab247 !248 ! !== Vertical tracer gradient249 zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1) ! level jk+1250 !251 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:) ! surface: zdkt(jk=1)=zdkt(jk=2)252 ELSE ; zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk)253 ENDIF254 DO jj = 1 , jpjm1 !== Horizontal fluxes255 DO ji = 1, fs_jpim1 ! vector opt.256 zabe 1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)257 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)258 !259 zmsku = 1. / MAX( wmask(ji+1,jj,jk ) + wmask(ji,jj,jk+1) &260 & + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk ), 1. )261 !262 zmskv = 1. / MAX( wmask(ji,jj+1,jk ) + wmask(ji,jj,jk+1) &263 & + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk ), 1. )264 !265 zcof 1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku266 zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv267 !268 zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) &269 & + zcof1 * ( zdkt (ji+1,jj) + zdk1t(ji,jj) &270 & + zdk1t(ji+1,jj) + zdkt (ji,jj) ) ) * umask(ji,jj,jk)271 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) &272 & + zcof2 * ( zdkt (ji,jj+1) + zdk1t(ji,jj) &273 & + zdk1t(ji,jj+1) + zdkt (ji,jj) ) ) * vmask(ji,jj,jk)274 275 END DO276 ! 256 !$OMP PARALLEL DO schedule(static) private(jj, ji) 257 DO jj = 1 , jpj !== Horizontal fluxes 258 DO ji = 1, jpi ! vector opt. 259 zdk1t(ji,jj) = ( ptb(ji,jj,1,jn) - ptb(ji,jj,2,jn) ) * wmask(ji,jj,2) 260 zdkt(ji,jj) = zdk1t(ji,jj) 261 END DO 262 END DO 263 !$OMP PARALLEL DO schedule(static) private(jj, ji, zmsku, zmskv, zabe1, zabe2, zcof1, zcof2) 264 DO jj = 1 , jpjm1 !== Horizontal fluxes 265 DO ji = 1, fs_jpim1 ! vector opt. 266 zabe1 = pahu(ji,jj,1) * e2_e1u(ji,jj) * e3u_n(ji,jj,1) 267 zabe2 = pahv(ji,jj,1) * e1_e2v(ji,jj) * e3v_n(ji,jj,1) 268 ! 269 zmsku = 1. / MAX( wmask(ji+1,jj,1 ) + wmask(ji,jj,2) & 270 & + wmask(ji+1,jj,2) + wmask(ji,jj,1 ), 1.) 271 ! 272 zmskv = 1. / MAX( wmask(ji,jj+1,1 ) + wmask(ji,jj,2) & 273 & + wmask(ji,jj+1,2) + wmask(ji,jj,1 ), 1.) 274 ! 275 zcof1 = - pahu(ji,jj,1) * e2u(ji,jj) * uslp(ji,jj,1) * zmsku 276 zcof2 = - pahv(ji,jj,1) * e1v(ji,jj) * vslp(ji,jj,1) * zmskv 277 ! 278 zftu(ji,jj,1 ) = ( zabe1 * zdit(ji,jj,1) & 279 & + zcof1 * ( zdkt (ji+1,jj) + zdk1t(ji,jj) & 280 & + zdk1t(ji+1,jj) + zdkt (ji,jj)) ) * umask(ji,jj,1) 281 zftv(ji,jj,1 ) = ( zabe2 * zdjt(ji,jj,1) & 282 & + zcof2 * ( zdkt (ji,jj+1) + zdk1t(ji,jj) & 283 & + zdk1t(ji,jj+1) + zdkt (ji,jj)) ) * vmask(ji,jj,1) 284 END DO 285 END DO 286 ! 287 !$OMP PARALLEL DO schedule(static) private(jj, ji) 277 288 DO jj = 2 , jpjm1 !== horizontal divergence and add to pta 278 289 DO ji = fs_2, fs_jpim1 ! vector opt. 279 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) & 280 & + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) & 281 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 282 END DO 283 END DO 284 END DO ! End of slab 290 pta(ji,jj,1,jn) = pta(ji,jj,1,jn) + zsign * (zftu(ji,jj,1) - zftu(ji-1,jj,1) & 291 & + zftv(ji,jj,1) - zftv(ji,jj-1,1) ) & 292 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,1) 293 END DO 294 END DO 295 DO jk = 2, jpkm1 296 !$OMP PARALLEL DO schedule(static) private(jj, ji) 297 DO jj = 1 , jpj !== Horizontal fluxes 298 DO ji = 1, jpi ! vector opt. 299 zdk1t(ji,jj) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) 300 zdkt(ji,jj) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 301 END DO 302 END DO 303 !$OMP PARALLEL DO schedule(static) private(jj, ji, zmsku, zmskv, zabe1, zabe2, zcof1, zcof2) 304 DO jj = 1 , jpjm1 !== Horizontal fluxes 305 DO ji = 1, fs_jpim1 ! vector opt. 306 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 307 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 308 ! 309 zmsku = 1. / MAX( wmask(ji+1,jj,jk ) + wmask(ji,jj,jk+1) & 310 & + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk ), 1.) 311 ! 312 zmskv = 1. / MAX( wmask(ji,jj+1,jk ) + wmask(ji,jj,jk+1) & 313 & + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk ), 1.) 314 ! 315 zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 316 zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 317 ! 318 zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) & 319 & + zcof1 * ( zdkt (ji+1,jj) + zdk1t(ji,jj) & 320 & + zdk1t(ji+1,jj) + zdkt (ji,jj)) ) * umask(ji,jj,jk) 321 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 322 & + zcof2 * ( zdkt (ji,jj+1) + zdk1t(ji,jj) & 323 & + zdk1t(ji,jj+1) + zdkt (ji,jj)) ) * vmask(ji,jj,jk) 324 END DO 325 END DO 326 ! 327 !$OMP PARALLEL DO schedule(static) private(jj, ji) 328 DO jj = 2 , jpjm1 !== horizontal divergence and add to pta 329 DO ji = fs_2, fs_jpim1 ! vector opt. 330 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (zftu(ji,jj,jk) - zftu(ji-1,jj,jk) & 331 & + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) & 332 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 333 END DO 334 END DO 335 END DO 336 285 337 286 338 !!---------------------------------------------------------------------- … … 288 340 !!---------------------------------------------------------------------- 289 341 ! 342 !$OMP PARALLEL WORKSHARE 290 343 ztfw(1,:,:) = 0._wp ; ztfw(jpi,:,:) = 0._wp 291 344 ! … … 294 347 ! ! Surface and bottom vertical fluxes set to zero 295 348 ztfw(:,:, 1 ) = 0._wp ; ztfw(:,:,jpk) = 0._wp 349 !$OMP END PARALLEL WORKSHARE 296 350 351 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w, zcoef3, zcoef4) 297 352 DO jk = 2, jpkm1 ! interior (2=<jk=<jpk-1) 298 353 DO jj = 2, jpjm1 … … 321 376 ! !== add the vertical 33 flux ==! 322 377 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 378 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 323 379 DO jk = 2, jpkm1 324 380 DO jj = 1, jpjm1 … … 334 390 SELECT CASE( kpass ) 335 391 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 392 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 336 393 DO jk = 2, jpkm1 337 394 DO jj = 1, jpjm1 … … 344 401 END DO 345 402 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb and ptbb gradients, resp. 403 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 346 404 DO jk = 2, jpkm1 347 405 DO jj = 1, jpjm1 … … 356 414 ENDIF 357 415 ! 416 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 358 417 DO jk = 1, jpkm1 !== Divergence of vertical fluxes added to pta ==! 359 418 DO jj = 2, jpjm1 … … 379 438 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 380 439 z2d(:,:) = zftu(ji,jj,1) 440 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 381 441 DO jk = 2, jpkm1 382 442 DO jj = 2, jpjm1 … … 388 448 !!gm CAUTION I think there is an error of sign when using BLP operator.... 389 449 !!gm a multiplication by zsign is required (to be checked twice !) 450 !$OMP PARALLEL WORKSHARE 390 451 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 452 !$OMP END PARALLEL WORKSHARE 391 453 CALL lbc_lnk( z2d, 'U', -1. ) 392 454 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 393 455 ! 456 !$OMP PARALLEL WORKSHARE 394 457 z2d(:,:) = zftv(ji,jj,1) 458 !$OMP END PARALLEL WORKSHARE 459 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 395 460 DO jk = 2, jpkm1 396 461 DO jj = 2, jpjm1 … … 400 465 END DO 401 466 END DO 467 !$OMP PARALLEL WORKSHARE 402 468 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 469 !$OMP END PARALLEL WORKSHARE 403 470 CALL lbc_lnk( z2d, 'V', -1. ) 404 471 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction
Note: See TracChangeset
for help on using the changeset viewer.
