Changeset 7698
- Timestamp:
- 2017-02-18T10:02:03+01:00 (7 years ago)
- Location:
- trunk/NEMOGCM
- Files:
-
- 122 edited
-
NEMO/LIM_SRC_3/limadv_umx.F90 (modified) (30 diffs)
-
NEMO/LIM_SRC_3/limdyn.F90 (modified) (2 diffs)
-
NEMO/LIM_SRC_3/limhdf.F90 (modified) (3 diffs)
-
NEMO/LIM_SRC_3/limistate.F90 (modified) (14 diffs)
-
NEMO/LIM_SRC_3/limitd_me.F90 (modified) (35 diffs)
-
NEMO/LIM_SRC_3/limitd_th.F90 (modified) (24 diffs)
-
NEMO/LIM_SRC_3/limrhg.F90 (modified) (20 diffs)
-
NEMO/LIM_SRC_3/limrst.F90 (modified) (5 diffs)
-
NEMO/LIM_SRC_3/limsbc.F90 (modified) (11 diffs)
-
NEMO/LIM_SRC_3/limthd.F90 (modified) (10 diffs)
-
NEMO/LIM_SRC_3/limthd_da.F90 (modified) (3 diffs)
-
NEMO/LIM_SRC_3/limthd_lac.F90 (modified) (10 diffs)
-
NEMO/LIM_SRC_3/limtrp.F90 (modified) (17 diffs)
-
NEMO/LIM_SRC_3/limupdate1.F90 (modified) (4 diffs)
-
NEMO/LIM_SRC_3/limupdate2.F90 (modified) (8 diffs)
-
NEMO/LIM_SRC_3/limvar.F90 (modified) (29 diffs)
-
NEMO/LIM_SRC_3/limwri.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/BDY/bdy_oce.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/DIA/dia25h.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/DIA/diaar5.F90 (modified) (13 diffs)
-
NEMO/OPA_SRC/DIA/diacfl.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/DIA/diahsb.F90 (modified) (10 diffs)
-
NEMO/OPA_SRC/DIA/diaptr.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/DIA/diawri.F90 (modified) (30 diffs)
-
NEMO/OPA_SRC/DOM/depth_e3.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DOM/domain.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/DOM/domhgr.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/DOM/dommsk.F90 (modified) (12 diffs)
-
NEMO/OPA_SRC/DOM/domvvl.F90 (modified) (26 diffs)
-
NEMO/OPA_SRC/DOM/domzgr.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/DOM/dtatsd.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/DOM/istate.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DYN/divhor.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynbfr.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/DYN/dynhpg.F90 (modified) (14 diffs)
-
NEMO/OPA_SRC/DYN/dynkeg.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DYN/dynldf.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DYN/dynnxt.F90 (modified) (12 diffs)
-
NEMO/OPA_SRC/DYN/dynspg.F90 (modified) (7 diffs)
-
NEMO/OPA_SRC/DYN/dynspg_ts.F90 (modified) (49 diffs)
-
NEMO/OPA_SRC/DYN/dynvor.F90 (modified) (24 diffs)
-
NEMO/OPA_SRC/DYN/dynzad.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/DYN/dynzdf.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/DYN/dynzdf_imp.F90 (modified) (22 diffs)
-
NEMO/OPA_SRC/DYN/sshwzv.F90 (modified) (10 diffs)
-
NEMO/OPA_SRC/ICB/icbini.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/LBC/lib_mpp.F90 (modified) (10 diffs)
-
NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/LDF/ldfdyn.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/LDF/ldfslp.F90 (modified) (16 diffs)
-
NEMO/OPA_SRC/LDF/ldftra.F90 (modified) (27 diffs)
-
NEMO/OPA_SRC/SBC/albedo.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/SBC/geo2ocean.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/SBC/sbcblk.F90 (modified) (25 diffs)
-
NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/SBC/sbcice_lim.F90 (modified) (15 diffs)
-
NEMO/OPA_SRC/SBC/sbcmod.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/SBC/sbcrnf.F90 (modified) (17 diffs)
-
NEMO/OPA_SRC/SBC/sbcssm.F90 (modified) (8 diffs)
-
NEMO/OPA_SRC/SBC/sbcssr.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/TRA/eosbn2.F90 (modified) (20 diffs)
-
NEMO/OPA_SRC/TRA/traadv.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/TRA/traadv_fct.F90 (modified) (20 diffs)
-
NEMO/OPA_SRC/TRA/traadv_mle.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/TRA/traadv_mus.F90 (modified) (11 diffs)
-
NEMO/OPA_SRC/TRA/trabbc.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/TRA/trabbl.F90 (modified) (13 diffs)
-
NEMO/OPA_SRC/TRA/tradmp.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/TRA/traldf.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/TRA/traldf_iso.F90 (modified) (16 diffs)
-
NEMO/OPA_SRC/TRA/tranxt.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/TRA/traqsr.F90 (modified) (16 diffs)
-
NEMO/OPA_SRC/TRA/trasbc.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/TRA/trazdf.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/TRA/trazdf_imp.F90 (modified) (10 diffs)
-
NEMO/OPA_SRC/TRA/zpshde.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/USR/usrdef_closea.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/USR/usrdef_hgr.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/USR/usrdef_istate.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/USR/usrdef_sbc.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/USR/usrdef_zgr.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/ZDF/zdfbfr.F90 (modified) (11 diffs)
-
NEMO/OPA_SRC/ZDF/zdfddm.F90 (modified) (7 diffs)
-
NEMO/OPA_SRC/ZDF/zdfevd.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/ZDF/zdfmxl.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/ZDF/zdftke.F90 (modified) (39 diffs)
-
NEMO/OPA_SRC/ZDF/zdftmx.F90 (modified) (35 diffs)
-
NEMO/OPA_SRC/step.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zagg.F90 (modified) (2 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90 (modified) (2 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90 (modified) (13 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90 (modified) (9 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90 (modified) (12 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90 (modified) (6 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90 (modified) (2 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90 (modified) (2 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 (modified) (12 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90 (modified) (20 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90 (modified) (14 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90 (modified) (11 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90 (modified) (9 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90 (modified) (26 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90 (modified) (16 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90 (modified) (6 diffs)
-
NEMO/TOP_SRC/PISCES/trcini_pisces.F90 (modified) (1 diff)
-
NEMO/TOP_SRC/TRP/trcadv.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/TRP/trcbbl.F90 (modified) (3 diffs)
-
NEMO/TOP_SRC/TRP/trcldf.F90 (modified) (3 diffs)
-
NEMO/TOP_SRC/TRP/trcnxt.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/TRP/trcrad.F90 (modified) (8 diffs)
-
NEMO/TOP_SRC/TRP/trcsbc.F90 (modified) (9 diffs)
-
NEMO/TOP_SRC/TRP/trczdf.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/trcice.F90 (modified) (2 diffs)
-
NEMO/TOP_SRC/trcini.F90 (modified) (3 diffs)
-
NEMO/TOP_SRC/trcrst.F90 (modified) (2 diffs)
-
NEMO/TOP_SRC/trcstp.F90 (modified) (4 diffs)
-
SETTE/prepare_job.sh (modified) (5 diffs)
-
SETTE/sette.sh (modified) (38 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90
r7646 r7698 75 75 ! upstream advection with initial mass fluxes & intermediate update 76 76 ! -------------------------------------------------------------------- 77 !$OMP PARALLEL 78 !$OMP DO schedule(static) private(jj,ji,zfp_ui,zfm_ui,zfp_vj,zfm_vj) 77 79 DO jj = 1, jpjm1 ! upstream tracer flux in the i and j direction 78 80 DO ji = 1, fs_jpim1 ! vector opt. … … 86 88 END DO 87 89 90 !$OMP DO schedule(static) private(jj,ji,ztra) 88 91 DO jj = 2, jpjm1 ! total intermediate advective trends 89 92 DO ji = fs_2, fs_jpim1 ! vector opt. … … 95 98 END DO 96 99 END DO 100 !$OMP END PARALLEL 97 101 CALL lbc_lnk( zt_ups, 'T', 1. ) ! Lateral boundary conditions (unchanged sign) 98 102 … … 101 105 SELECT CASE( nn_limadv_ord ) 102 106 CASE ( 20 ) ! centered second order 107 !$OMP PARALLEL DO schedule(static) private(jj,ji) 103 108 DO jj = 2, jpjm1 104 109 DO ji = fs_2, fs_jpim1 ! vector opt. … … 111 116 CALL macho( kt, nn_limadv_ord, pdt, ptc, puc, pvc, pubox, pvbox, zt_u, zt_v ) 112 117 ! 118 !$OMP PARALLEL DO schedule(static) private(jj,ji) 113 119 DO jj = 2, jpjm1 114 120 DO ji = fs_2, fs_jpim1 ! vector opt. … … 122 128 ! antidiffusive flux : high order minus low order 123 129 ! -------------------------------------------------- 130 !$OMP PARALLEL DO schedule(static) private(jj,ji) 124 131 DO jj = 2, jpjm1 125 132 DO ji = fs_2, fs_jpim1 ! vector opt. … … 136 143 ! final trend with corrected fluxes 137 144 ! ------------------------------------ 145 !$OMP PARALLEL DO schedule(static) private(jj,ji,ztra) 138 146 DO jj = 2, jpjm1 139 147 DO ji = fs_2, fs_jpim1 ! vector opt. … … 187 195 ! 188 196 ! !-- advective form update in zzt --! 197 !$OMP PARALLEL DO schedule(static) private(jj,ji) 189 198 DO jj = 2, jpjm1 190 199 DO ji = fs_2, fs_jpim1 ! vector opt. … … 205 214 ! 206 215 ! !-- advective form update in zzt --! 216 !$OMP PARALLEL DO schedule(static) private(jj,ji) 207 217 DO jj = 2, jpjm1 208 218 DO ji = fs_2, fs_jpim1 … … 253 263 ! 254 264 ! !-- Laplacian in i-direction --! 265 !$OMP PARALLEL DO schedule(static) private(jj,ji) 255 266 DO jj = 2, jpjm1 ! First derivative (gradient) 256 267 DO ji = 1, fs_jpim1 … … 265 276 ! 266 277 ! !-- BiLaplacian in i-direction --! 278 !$OMP PARALLEL DO schedule(static) private(jj,ji) 267 279 DO jj = 2, jpjm1 ! Third derivative 268 280 DO ji = 1, fs_jpim1 … … 281 293 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 282 294 ! 295 !$OMP PARALLEL DO schedule(static) private(jj,ji) 283 296 DO jj = 1, jpj 284 297 DO ji = 1, fs_jpim1 ! vector opt. … … 290 303 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 291 304 ! 305 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu) 292 306 DO jj = 1, jpj 293 307 DO ji = 1, fs_jpim1 ! vector opt. … … 301 315 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 302 316 ! 317 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2) 303 318 DO jj = 1, jpj 304 319 DO ji = 1, fs_jpim1 ! vector opt. … … 315 330 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 316 331 ! 332 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2) 317 333 DO jj = 1, jpj 318 334 DO ji = 1, fs_jpim1 ! vector opt. … … 329 345 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 330 346 ! 347 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2,zdx4) 331 348 DO jj = 1, jpj 332 349 DO ji = 1, fs_jpim1 ! vector opt. … … 380 397 ! 381 398 ! !-- Laplacian in j-direction --! 399 !$OMP PARALLEL 400 !$OMP DO schedule(static) private(jj,ji) 382 401 DO jj = 1, jpjm1 ! First derivative (gradient) 383 402 DO ji = fs_2, fs_jpim1 … … 385 404 END DO 386 405 END DO 406 !$OMP DO schedule(static) private(jj,ji) 387 407 DO jj = 2, jpjm1 ! Second derivative (Laplacian) 388 408 DO ji = fs_2, fs_jpim1 … … 390 410 END DO 391 411 END DO 412 !$OMP END PARALLEL 392 413 CALL lbc_lnk( ztv2, 'T', 1. ) 393 414 ! 394 415 ! !-- BiLaplacian in j-direction --! 416 !$OMP PARALLEL 417 !$OMP DO schedule(static) private(jj,ji) 395 418 DO jj = 1, jpjm1 ! First derivative 396 419 DO ji = fs_2, fs_jpim1 … … 398 421 END DO 399 422 END DO 423 !$OMP DO schedule(static) private(jj,ji) 400 424 DO jj = 2, jpjm1 ! Second derivative 401 425 DO ji = fs_2, fs_jpim1 … … 403 427 END DO 404 428 END DO 429 !$OMP END PARALLEL 405 430 CALL lbc_lnk( ztv4, 'T', 1. ) 406 431 ! … … 410 435 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 411 436 ! 437 !$OMP PARALLEL DO schedule(static) private(jj,ji) 412 438 DO jj = 1, jpjm1 413 439 DO ji = 1, jpi … … 418 444 ! 419 445 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 446 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv) 420 447 DO jj = 1, jpjm1 421 448 DO ji = 1, jpi … … 429 456 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 430 457 ! 458 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2) 431 459 DO jj = 1, jpjm1 432 460 DO ji = 1, jpi … … 443 471 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 444 472 ! 473 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2) 445 474 DO jj = 1, jpjm1 446 475 DO ji = 1, jpi … … 457 486 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 458 487 ! 488 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2,zdy4) 459 489 DO jj = 1, jpjm1 460 490 DO ji = 1, jpi … … 513 543 514 544 ! clem test 545 !$OMP PARALLEL DO schedule(static) private(jj,ji) 515 546 DO jj = 2, jpjm1 516 547 DO ji = fs_2, fs_jpim1 ! vector opt. … … 522 553 523 554 ! Determine ice masks for before and after tracers 524 WHERE( pbef(:,:) == 0._wp .AND. paft(:,:) == 0._wp .AND. zdiv(:,:) == 0._wp ) ; zmsk(:,:) = 0._wp 525 ELSEWHERE ; zmsk(:,:) = 1._wp * tmask(:,:,1) 526 END WHERE 555 !$OMP PARALLEL DO schedule(static) private(jj,ji) 556 DO jj = 1, jpj 557 DO ji = 1, jpi 558 IF( pbef(ji,jj) == 0._wp .AND. paft(ji,jj) == 0._wp .AND. zdiv(ji,jj) == 0._wp ) THEN 559 zmsk(ji,jj) = 0._wp 560 ELSE 561 zmsk(ji,jj) = 1._wp * tmask(ji,jj,1) 562 END IF 563 END DO 564 END DO 527 565 528 566 ! Search local extrema … … 533 571 ! zbdo(:,:) = MIN( pbef(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) ), & 534 572 ! & paft(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) ) ) 535 zbup(:,:) = MAX( pbef(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) ), &536 & paft(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) ) )537 zbdo(:,:) = MIN( pbef(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) ), &538 & paft(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) ) )539 573 540 574 z1_dt = 1._wp / pdt 575 576 !$OMP PARALLEL 577 !$OMP DO schedule(static) private(jj,ji) 578 DO jj = 1, jpj 579 DO ji = 1, jpi 580 zbup(ji,jj) = MAX( pbef(ji,jj) * zmsk(ji,jj) - zbig * ( 1.e0 - zmsk(ji,jj) ), & 581 & paft(ji,jj) * zmsk(ji,jj) - zbig * ( 1.e0 - zmsk(ji,jj) ) ) 582 zbdo(ji,jj) = MIN( pbef(ji,jj) * zmsk(ji,jj) + zbig * ( 1.e0 - zmsk(ji,jj) ), & 583 & paft(ji,jj) * zmsk(ji,jj) + zbig * ( 1.e0 - zmsk(ji,jj) ) ) 584 END DO 585 END DO 586 587 !$OMP DO schedule(static) private(jj,ji,zup,zdo,zpos,zneg,zbt) 541 588 DO jj = 2, jpjm1 542 589 DO ji = fs_2, fs_jpim1 ! vector opt. … … 557 604 END DO 558 605 END DO 606 !$OMP END PARALLEL 559 607 CALL lbc_lnk_multi( zbetup, 'T', 1., zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) 560 608 561 609 ! monotonic flux in the i & j direction (paa & pbb) 562 610 ! ------------------------------------- 611 !$OMP PARALLEL DO schedule(static) private(jj,ji,zau,zbu,zcu,zav,zbv,zcv) 563 612 DO jj = 2, jpjm1 564 613 DO ji = fs_2, fs_jpim1 ! vector opt. -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r7646 r7698 58 58 INTEGER, INTENT(in) :: kt ! number of iteration 59 59 !! 60 INTEGER :: j l, jk ! dummy loop indices60 INTEGER :: ji, jj, jl, jk ! dummy loop indices 61 61 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 62 62 !!--------------------------------------------------------------------- … … 69 69 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 70 70 71 ! ice velocities before rheology 72 u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 73 v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 71 !$OMP PARALLEL DO schedule(static) private(jj,ji) 72 DO jj = 1, jpj 73 DO ji = 1, jpi 74 ! ice velocities before rheology 75 u_ice_b(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) 76 v_ice_b(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 74 77 75 ! Landfast ice parameterization: define max bottom friction 76 tau_icebfr(:,:) = 0._wp 78 ! Landfast ice parameterization: define max bottom friction 79 tau_icebfr(ji,jj) = 0._wp 80 END DO 81 END DO 77 82 IF( ln_landfast ) THEN 78 83 DO jl = 1, jpl 79 WHERE( ht_i(:,:,jl) > ht_n(:,:) * rn_gamma ) tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 84 !$OMP PARALLEL DO schedule(static) private(jj,ji) 85 DO jj = 1, jpj 86 DO ji = 1, jpi 87 IF( ht_i(ji,jj,jl) > ht_n(ji,jj) * rn_gamma ) tau_icebfr(ji,jj) = tau_icebfr(ji,jj) + a_i(ji,jj,jl) * rn_icebfr 88 END DO 89 END DO 80 90 END DO 81 91 ENDIF -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r7646 r7698 254 254 255 255 CASE( 0 ) 256 ahiu(:,:) = rn_ahi0_ref 257 ahiv(:,:) = rn_ahi0_ref 256 !$OMP PARALLEL DO schedule(static) private(jj,ji) 257 DO jj = 1, jpj 258 DO ji = 1, jpi 259 ahiu(ji,jj) = rn_ahi0_ref 260 ahiv(ji,jj) = rn_ahi0_ref 261 END DO 262 END DO 258 263 259 264 IF(lwp) WRITE(numout,*) '' … … 265 270 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain 266 271 267 ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 272 !$OMP PARALLEL DO schedule(static) private(jj,ji) 273 DO jj = 1, jpj 274 DO ji = 1, jpi 275 ahiu(ji,jj) = rn_ahi0_ref * zd_max * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 268 276 ! (60deg = min latitude for ice cover) 269 ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 277 ahiv(ji,jj) = rn_ahi0_ref * zd_max * 1.e-05_wp 278 END DO 279 END DO 270 280 271 281 IF(lwp) WRITE(numout,*) '' … … 280 290 za00 = rn_ahi0_ref * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 281 291 ! (60deg = min latitude for ice cover) 292 !$OMP PARALLEL DO schedule(static) private(jj,ji) 282 293 DO jj = 1, jpj 283 294 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r7646 r7698 86 86 REAL(wp), POINTER, DIMENSION(:,:) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 87 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini !data by cattegories to fill 88 INTEGER , POINTER, DIMENSION(:) :: itest88 INTEGER , DIMENSION(4) :: itest 89 89 !-------------------------------------------------------------------- 90 90 … … 92 92 CALL wrk_alloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 93 93 CALL wrk_alloc( jpi, jpj, zswitch ) 94 Call wrk_alloc( 4, itest )95 94 96 95 IF(lwp) WRITE(numout,*) … … 106 105 ! init surface temperature 107 106 DO jl = 1, jpl 108 t_su (:,:,jl) = rt0 * tmask(:,:,1) 109 tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 107 !$OMP PARALLEL DO schedule(static) private(jj,ji) 108 DO jj = 1, jpj 109 DO ji = 1, jpi 110 t_su (ji,jj,jl) = rt0 * tmask(ji,jj,1) 111 tn_ice(ji,jj,jl) = rt0 * tmask(ji,jj,1) 112 END DO 113 END DO 110 114 END DO 111 115 112 116 ! init basal temperature (considered at freezing point) 113 117 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 114 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 118 !$OMP PARALLEL DO schedule(static) private(jj,ji) 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 t_bo(ji,jj) = ( t_bo(ji,jj) + rt0 ) * tmask(ji,jj,1) 122 END DO 123 END DO 115 124 116 125 … … 122 131 IF( ln_limini_file )THEN 123 132 ! 124 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 125 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) 126 zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) 127 zts_u_ini(:,:) = si(jp_tsu)%fnow(:,:,1) 128 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 129 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 130 ! 131 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 132 ELSEWHERE ; zswitch(:,:) = 0._wp 133 END WHERE 134 ! 133 !$OMP PARALLEL DO schedule(static) private(jj,ji) 134 DO jj = 1, jpj 135 DO ji = 1, jpi 136 zht_i_ini(ji,jj) = si(jp_hti)%fnow(ji,jj,1) 137 zht_s_ini(ji,jj) = si(jp_hts)%fnow(ji,jj,1) 138 zat_i_ini(ji,jj) = si(jp_ati)%fnow(ji,jj,1) 139 zts_u_ini(ji,jj) = si(jp_tsu)%fnow(ji,jj,1) 140 ztm_i_ini(ji,jj) = si(jp_tmi)%fnow(ji,jj,1) 141 zsm_i_ini(ji,jj) = si(jp_smi)%fnow(ji,jj,1) 142 ! 143 IF ( zat_i_ini(ji,jj) > 0._wp ) THEN ; zswitch(ji,jj) = tmask(ji,jj,1) 144 ELSE ; zswitch(ji,jj) = 0._wp 145 END IF 146 END DO 147 END DO 148 ! 135 149 ELSE ! ln_limini_file = F 136 150 … … 139 153 !-------------------------------------------------------------------- 140 154 ! no ice if sst <= t-freez + ttest 141 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 142 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 143 END WHERE 155 !$OMP PARALLEL 156 !$OMP DO schedule(static) private(jj,ji) 157 DO jj = 1, jpj 158 DO ji = 1, jpi 159 IF ( ( sst_m(ji,jj) - (t_bo(ji,jj) - rt0) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN 160 zswitch(ji,jj) = 0._wp 161 ELSE 162 zswitch(ji,jj) = tmask(ji,jj,1) 163 END IF 164 END DO 165 END DO 144 166 145 167 !----------------------------- … … 147 169 !----------------------------- 148 170 ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 171 !$OMP DO schedule(static) private(jj,ji) 149 172 DO jj = 1, jpj 150 173 DO ji = 1, jpi … … 166 189 END DO 167 190 END DO 191 !$OMP END PARALLEL 168 192 ! 169 193 ENDIF ! ln_limini_file 170 194 171 zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) ! ice volume 195 !$OMP PARALLEL 196 !$OMP DO schedule(static) private(jj,ji) 197 DO jj = 1, jpj 198 DO ji = 1, jpi 199 zvt_i_ini(ji,jj) = zht_i_ini(ji,jj) * zat_i_ini(ji,jj) ! ice volume 200 END DO 201 END DO 172 202 !--------------------------------------------------------------------- 173 203 ! 3.2) Distribute ice concentration and thickness into the categories … … 176 206 ! then we check whether the distribution fullfills 177 207 ! volume and area conservation, positivity and ice categories bounds 178 zh_i_ini(:,:,:) = 0._wp 179 za_i_ini(:,:,:) = 0._wp 208 DO jl = 1, jpl 209 !$OMP DO schedule(static) private(jj,ji) 210 DO jj = 1, jpj 211 DO ji = 1, jpi 212 zh_i_ini(ji,jj,jl) = 0._wp 213 za_i_ini(ji,jj,jl) = 0._wp 214 END DO 215 END DO 216 END DO 180 217 ! 218 !$OMP DO schedule(static) private(jj,ji,jl0,jl,i_fill,zarg,zV,zdv,zconv,itest) 181 219 DO jj = 1, jpj 182 220 DO ji = 1, jpi … … 289 327 END DO 290 328 END DO 329 !$OMP END PARALLEL 291 330 292 331 !--------------------------------------------------------------------- … … 296 335 ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature 297 336 DO jl = 1, jpl ! loop over categories 337 !$OMP PARALLEL DO schedule(static) private(jj,ji) 298 338 DO jj = 1, jpj 299 339 DO ji = 1, jpi … … 333 373 ENDIF 334 374 375 !$OMP PARALLEL 335 376 ! Snow temperature and heat content 336 377 DO jk = 1, nlay_s 337 378 DO jl = 1, jpl ! loop over categories 379 !$OMP DO schedule(static) private(jj,ji) 338 380 DO jj = 1, jpj 339 381 DO ji = 1, jpi … … 352 394 DO jk = 1, nlay_i 353 395 DO jl = 1, jpl ! loop over categories 396 !$OMP DO schedule(static) private(jj,ji) 354 397 DO jj = 1, jpj 355 398 DO ji = 1, jpi … … 370 413 END DO 371 414 372 tn_ice (:,:,:) = t_su (:,:,:) 415 DO jl = 1, jpl 416 !$OMP DO schedule(static) private(jj,ji) 417 DO jj = 1, jpj 418 DO ji = 1, jpi 419 tn_ice (ji,jj,jl) = t_su (ji,jj,jl) 420 END DO 421 END DO 422 END DO 423 !$OMP END PARALLEL 373 424 374 425 ELSE ! if ln_limini=false 375 a_i (:,:,:) = 0._wp 376 v_i (:,:,:) = 0._wp 377 v_s (:,:,:) = 0._wp 378 smv_i(:,:,:) = 0._wp 379 oa_i (:,:,:) = 0._wp 380 ht_i (:,:,:) = 0._wp 381 ht_s (:,:,:) = 0._wp 382 sm_i (:,:,:) = 0._wp 383 o_i (:,:,:) = 0._wp 384 385 e_i(:,:,:,:) = 0._wp 386 e_s(:,:,:,:) = 0._wp 426 !$OMP PARALLEL 427 DO jl = 1, jpl 428 !$OMP DO schedule(static) private(jj,ji) 429 DO jj = 1, jpj 430 DO ji = 1, jpi 431 a_i (ji,jj,jl) = 0._wp 432 v_i (ji,jj,jl) = 0._wp 433 v_s (ji,jj,jl) = 0._wp 434 smv_i(ji,jj,jl) = 0._wp 435 oa_i (ji,jj,jl) = 0._wp 436 ht_i (ji,jj,jl) = 0._wp 437 ht_s (ji,jj,jl) = 0._wp 438 sm_i (ji,jj,jl) = 0._wp 439 o_i (ji,jj,jl) = 0._wp 440 END DO 441 END DO 442 END DO 443 444 DO jk = 1, nlay_i 445 DO jl = 1, jpl 446 !$OMP DO schedule(static) private(jj,ji) 447 DO jj = 1, jpj 448 DO ji = 1, jpi 449 e_i(ji,jj,jl,jk) = 0._wp 450 END DO 451 END DO 452 END DO 453 END DO 454 DO jk = 1, nlay_s 455 DO jl = 1, jpl 456 !$OMP DO schedule(static) private(jj,ji) 457 DO jj = 1, jpj 458 DO ji = 1, jpi 459 e_s(ji,jj,jl,jk) = 0._wp 460 END DO 461 END DO 462 END DO 463 END DO 387 464 388 465 DO jl = 1, jpl 389 466 DO jk = 1, nlay_i 390 t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 467 !$OMP DO schedule(static) private(jj,ji) 468 DO jj = 1, jpj 469 DO ji = 1, jpi 470 t_i(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) 471 END DO 472 END DO 391 473 END DO 392 474 DO jk = 1, nlay_s 393 t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 394 END DO 395 END DO 475 !$OMP DO schedule(static) private(jj,ji) 476 DO jj = 1, jpj 477 DO ji = 1, jpi 478 t_s(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) 479 END DO 480 END DO 481 END DO 482 END DO 483 !$OMP END PARALLEL 396 484 397 485 ENDIF ! ln_limini 398 486 399 at_i (:,:) = 0.0_wp 487 !$OMP PARALLEL 488 !$OMP DO schedule(static) private(jj,ji) 489 DO jj = 1, jpj 490 DO ji = 1, jpi 491 at_i (ji,jj) = 0.0_wp 492 END DO 493 END DO 400 494 DO jl = 1, jpl 401 at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 495 !$OMP DO schedule(static) private(jj,ji) 496 DO jj = 1, jpj 497 DO ji = 1, jpi 498 at_i (ji,jj) = at_i (ji,jj) + a_i (ji,jj,jl) 499 END DO 500 END DO 402 501 END DO 403 502 ! 404 !-------------------------------------------------------------------- 405 ! 4) Global ice variables for output diagnostics | 406 !-------------------------------------------------------------------- 407 u_ice (:,:) = 0._wp 408 v_ice (:,:) = 0._wp 409 stress1_i(:,:) = 0._wp 410 stress2_i(:,:) = 0._wp 411 stress12_i(:,:) = 0._wp 412 413 !-------------------------------------------------------------------- 414 ! 5) Moments for advection 415 !-------------------------------------------------------------------- 416 417 sxopw (:,:) = 0._wp 418 syopw (:,:) = 0._wp 419 sxxopw(:,:) = 0._wp 420 syyopw(:,:) = 0._wp 421 sxyopw(:,:) = 0._wp 422 423 sxice (:,:,:) = 0._wp ; sxsn (:,:,:) = 0._wp ; sxa (:,:,:) = 0._wp 424 syice (:,:,:) = 0._wp ; sysn (:,:,:) = 0._wp ; sya (:,:,:) = 0._wp 425 sxxice(:,:,:) = 0._wp ; sxxsn(:,:,:) = 0._wp ; sxxa (:,:,:) = 0._wp 426 syyice(:,:,:) = 0._wp ; syysn(:,:,:) = 0._wp ; syya (:,:,:) = 0._wp 427 sxyice(:,:,:) = 0._wp ; sxysn(:,:,:) = 0._wp ; sxya (:,:,:) = 0._wp 428 429 sxc0 (:,:,:) = 0._wp ; sxe (:,:,:,:)= 0._wp 430 syc0 (:,:,:) = 0._wp ; sye (:,:,:,:)= 0._wp 431 sxxc0 (:,:,:) = 0._wp ; sxxe (:,:,:,:)= 0._wp 432 syyc0 (:,:,:) = 0._wp ; syye (:,:,:,:)= 0._wp 433 sxyc0 (:,:,:) = 0._wp ; sxye (:,:,:,:)= 0._wp 434 435 sxsal (:,:,:) = 0._wp 436 sysal (:,:,:) = 0._wp 437 sxxsal (:,:,:) = 0._wp 438 syysal (:,:,:) = 0._wp 439 sxysal (:,:,:) = 0._wp 440 441 sxage (:,:,:) = 0._wp 442 syage (:,:,:) = 0._wp 443 sxxage (:,:,:) = 0._wp 444 syyage (:,:,:) = 0._wp 445 sxyage (:,:,:) = 0._wp 503 !$OMP DO schedule(static) private(jj,ji) 504 DO jj = 1, jpj 505 DO ji = 1, jpi 506 !-------------------------------------------------------------------- 507 ! 4) Global ice variables for output diagnostics | 508 !-------------------------------------------------------------------- 509 u_ice (ji,jj) = 0._wp 510 v_ice (ji,jj) = 0._wp 511 stress1_i(ji,jj) = 0._wp 512 stress2_i(ji,jj) = 0._wp 513 stress12_i(ji,jj) = 0._wp 514 515 !-------------------------------------------------------------------- 516 ! 5) Moments for advection 517 !-------------------------------------------------------------------- 518 519 sxopw (ji,jj) = 0._wp 520 syopw (ji,jj) = 0._wp 521 sxxopw(ji,jj) = 0._wp 522 syyopw(ji,jj) = 0._wp 523 sxyopw(ji,jj) = 0._wp 524 END DO 525 END DO 526 527 DO jl = 1, jpl 528 !$OMP DO schedule(static) private(jj,ji) 529 DO jj = 1, jpj 530 DO ji = 1, jpi 531 sxice (ji,jj,jl) = 0._wp ; sxsn (ji,jj,jl) = 0._wp ; sxa (ji,jj,jl) = 0._wp 532 syice (ji,jj,jl) = 0._wp ; sysn (ji,jj,jl) = 0._wp ; sya (ji,jj,jl) = 0._wp 533 sxxice(ji,jj,jl) = 0._wp ; sxxsn(ji,jj,jl) = 0._wp ; sxxa (ji,jj,jl) = 0._wp 534 syyice(ji,jj,jl) = 0._wp ; syysn(ji,jj,jl) = 0._wp ; syya (ji,jj,jl) = 0._wp 535 sxyice(ji,jj,jl) = 0._wp ; sxysn(ji,jj,jl) = 0._wp ; sxya (ji,jj,jl) = 0._wp 536 537 sxc0 (ji,jj,jl) = 0._wp 538 syc0 (ji,jj,jl) = 0._wp 539 sxxc0 (ji,jj,jl) = 0._wp 540 syyc0 (ji,jj,jl) = 0._wp 541 sxyc0 (ji,jj,jl) = 0._wp 542 543 sxsal (ji,jj,jl) = 0._wp 544 sysal (ji,jj,jl) = 0._wp 545 sxxsal (ji,jj,jl) = 0._wp 546 syysal (ji,jj,jl) = 0._wp 547 sxysal (ji,jj,jl) = 0._wp 548 549 sxage (ji,jj,jl) = 0._wp 550 syage (ji,jj,jl) = 0._wp 551 sxxage (ji,jj,jl) = 0._wp 552 syyage (ji,jj,jl) = 0._wp 553 sxyage (ji,jj,jl) = 0._wp 554 END DO 555 END DO 556 END DO 557 558 DO jl = 1, jpl 559 DO jk = 1, nlay_i 560 !$OMP DO schedule(static) private(jj,ji) 561 DO jj = 1, jpj 562 DO ji = 1, jpi 563 sxe (ji,jj,jk,jl)= 0._wp 564 sye (ji,jj,jk,jl)= 0._wp 565 sxxe (ji,jj,jk,jl)= 0._wp 566 syye (ji,jj,jk,jl)= 0._wp 567 sxye (ji,jj,jk,jl)= 0._wp 568 END DO 569 END DO 570 END DO 571 END DO 572 !$OMP END PARALLEL 573 446 574 447 575 !!!clem … … 453 581 CALL wrk_dealloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 454 582 CALL wrk_dealloc( jpi, jpj, zswitch ) 455 Call wrk_dealloc( 4, itest )456 583 457 584 END SUBROUTINE lim_istate -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r7646 r7698 115 115 REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear 116 116 REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges 117 REAL(wp), POINTER, DIMENSION(:,:) :: z_ai 117 118 ! 118 119 INTEGER, PARAMETER :: nitermax = 20 … … 122 123 IF( nn_timing == 1 ) CALL timing_start('limitd_me') 123 124 124 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross )125 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, z_ai ) 125 126 126 127 ! conservation test … … 135 136 ! 136 137 138 !$OMP PARALLEL DO schedule(static) private(jj,ji) 137 139 DO jj = 1, jpj ! Initialize arrays. 138 140 DO ji = 1, jpi … … 192 194 ! closing rate to a gross closing rate. 193 195 ! NOTE: 0 < aksum <= 1 194 closing_gross(:,:) = closing_net(:,:) / aksum(:,:) 196 !$OMP PARALLEL 197 !$OMP DO schedule(static) private(jj,ji) 198 DO jj = 1, jpj 199 DO ji = 1, jpi 200 closing_gross(ji,jj) = closing_net(ji,jj) / aksum(ji,jj) 201 END DO 202 END DO 195 203 196 204 ! correction to closing rate and opening if closing rate is excessive … … 198 206 ! Reduce the closing rate if more than 100% of the open water 199 207 ! would be removed. Reduce the opening rate proportionately. 208 !$OMP DO schedule(static) private(jj,ji,za,zfac) 200 209 DO jj = 1, jpj 201 210 DO ji = 1, jpi … … 216 225 ! would be removed. Reduce the opening rate proportionately. 217 226 DO jl = 1, jpl 227 !$OMP DO schedule(static) private(jj,ji,za,zfac) 218 228 DO jj = 1, jpj 219 229 DO ji = 1, jpi … … 226 236 END DO 227 237 END DO 238 !$OMP END PARALLEL 228 239 229 240 ! 3.3 Redistribute area, volume, and energy. … … 236 247 !-----------------------------------------------------------------------------! 237 248 ! This is in general not equal to one because of divergence during transport 238 asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 249 !$OMP PARALLEL 250 !$OMP DO schedule(static) private(jj,ji) 251 DO jj = 1, jpj 252 DO ji = 1, jpi 253 asum(ji,jj) = 0._wp 254 z_ai(ji,jj) = 0._wp 255 END DO 256 END DO 257 DO jl = 1, jpl 258 !$OMP DO schedule(static) private(jj,ji) 259 DO jj = 1, jpj 260 DO ji = 1, jpi 261 z_ai(ji,jj) = z_ai(ji,jj) + a_i(ji,jj,jl) 262 END DO 263 END DO 264 END DO 265 !$OMP DO schedule(static) private(jj,ji) 266 DO jj = 1, jpj 267 DO ji = 1, jpi 268 asum(ji,jj) = ato_i(ji,jj) + z_ai(ji,jj) 269 END DO 270 END DO 239 271 240 272 ! 3.5 Do we keep on iterating ??? … … 244 276 245 277 iterate_ridging = 0 278 !$OMP DO schedule(static) private(jj,ji) 246 279 DO jj = 1, jpj 247 280 DO ji = 1, jpi … … 258 291 END DO 259 292 END DO 293 !$OMP END PARALLEL 260 294 261 295 IF( lk_mpp ) CALL mpp_max( iterate_ridging ) … … 289 323 IF( ln_ctl ) CALL lim_prt3D( 'limitd_me' ) 290 324 291 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross )325 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, z_ai ) 292 326 ! 293 327 IF( nn_timing == 1 ) CALL timing_stop('limitd_me') … … 306 340 REAL(wp) :: Gstari, astari, hrmean, zdummy ! local scalar 307 341 REAL(wp), POINTER, DIMENSION(:,:,:) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 342 REAL(wp), POINTER, DIMENSION(:,:) :: z_ai 308 343 !------------------------------------------------------------------------------! 309 344 310 345 CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 346 CALL wrk_alloc( jpi,jpj,z_ai ) 311 347 312 348 Gstari = 1.0/rn_gstar 313 349 astari = 1.0/rn_astar 314 aksum(:,:) = 0.0 315 athorn(:,:,:) = 0.0 316 aridge(:,:,:) = 0.0 317 araft (:,:,:) = 0.0 350 !$OMP PARALLEL 351 !$OMP DO schedule(static) private(jj,ji) 352 DO jj = 1, jpj 353 DO ji = 1, jpi 354 aksum(ji,jj) = 0.0 355 END DO 356 END DO 357 !$OMP END DO NOWAIT 358 DO jl = 1, jpl 359 !$OMP DO schedule(static) private(jj,ji) 360 DO jj = 1, jpj 361 DO ji = 1, jpi 362 athorn(ji,jj,jl) = 0.0 363 aridge(ji,jj,jl) = 0.0 364 araft (ji,jj,jl) = 0.0 365 END DO 366 END DO 367 END DO 368 !$OMP END PARALLEL 318 369 319 370 ! Zero out categories with very small areas 320 371 CALL lim_var_zapsmall 321 372 373 !$OMP PARALLEL 322 374 ! Ice thickness needed for rafting 323 375 DO jl = 1, jpl 376 !$OMP DO schedule(static) private(jj,ji,rswitch) 324 377 DO jj = 1, jpj 325 378 DO ji = 1, jpi … … 336 389 ! Compute total area of ice plus open water. 337 390 ! This is in general not equal to one because of divergence during transport 338 asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 339 391 392 !$OMP DO schedule(static) private(jj,ji) 393 DO jj = 1, jpj 394 DO ji = 1, jpi 395 asum(ji,jj) = 0._wp 396 z_ai(ji,jj) = 0._wp 397 END DO 398 END DO 399 DO jl = 1, jpl 400 !$OMP DO schedule(static) private(jj,ji) 401 DO jj = 1, jpj 402 DO ji = 1, jpi 403 z_ai(ji,jj) = z_ai(ji,jj) + a_i(ji,jj,jl) 404 END DO 405 END DO 406 END DO 407 !$OMP DO schedule(static) private(jj,ji) 408 DO jj = 1, jpj 409 DO ji = 1, jpi 410 asum(ji,jj) = ato_i(ji,jj) + z_ai(ji,jj) 411 END DO 412 END DO 340 413 ! Compute cumulative thickness distribution function 341 414 ! Compute the cumulative thickness distribution function Gsum, 342 415 ! where Gsum(n) is the fractional area in categories 0 to n. 343 416 ! initial value (in h = 0) equals open water area 344 Gsum(:,:,-1) = 0._wp 345 Gsum(:,:,0 ) = ato_i(:,:) 417 !$OMP DO schedule(static) private(jj,ji) 418 DO jj = 1, jpj 419 DO ji = 1, jpi 420 Gsum(ji,jj,-1) = 0._wp 421 Gsum(ji,jj,0 ) = ato_i(ji,jj) 422 END DO 423 END DO 346 424 ! for each value of h, you have to add ice concentration then 347 425 DO jl = 1, jpl 348 Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 426 !$OMP DO schedule(static) private(jj,ji) 427 DO jj = 1, jpj 428 DO ji = 1, jpi 429 Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 430 END DO 431 END DO 349 432 END DO 350 433 351 434 ! Normalize the cumulative distribution to 1 352 435 DO jl = 0, jpl 353 Gsum(:,:,jl) = Gsum(:,:,jl) / asum(:,:) 436 !$OMP DO schedule(static) private(jj,ji) 437 DO jj = 1, jpj 438 DO ji = 1, jpi 439 Gsum(ji,jj,jl) = Gsum(ji,jj,jl) / asum(ji,jj) 440 END DO 441 END DO 354 442 END DO 443 !$OMP END PARALLEL 355 444 356 445 ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn) … … 369 458 IF( nn_partfun == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975) 370 459 DO jl = 0, jpl 460 !$OMP PARALLEL DO schedule(static) private(jj,ji) 371 461 DO jj = 1, jpj 372 462 DO ji = 1, jpi … … 387 477 ! 388 478 zdummy = 1._wp / ( 1._wp - EXP(-astari) ) ! precompute exponential terms using Gsum as a work array 479 !$OMP PARALLEL 389 480 DO jl = -1, jpl 390 Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 481 !$OMP DO schedule(static) private(jj,ji) 482 DO jj = 1, jpj 483 DO ji = 1, jpi 484 Gsum(ji,jj,jl) = EXP( -Gsum(ji,jj,jl) * astari ) * zdummy 485 END DO 486 END DO 391 487 END DO 392 488 DO jl = 0, jpl 393 athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 394 END DO 489 !$OMP DO schedule(static) private(jj,ji) 490 DO jj = 1, jpj 491 DO ji = 1, jpi 492 athorn(ji,jj,jl) = Gsum(ji,jj,jl-1) - Gsum(ji,jj,jl) 493 END DO 494 END DO 495 END DO 496 !$OMP END PARALLEL 395 497 ! 396 498 ENDIF … … 400 502 ! 401 503 DO jl = 1, jpl 504 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdummy) 402 505 DO jj = 1, jpj 403 506 DO ji = 1, jpi … … 412 515 ! 413 516 DO jl = 1, jpl 414 aridge(:,:,jl) = athorn(:,:,jl) 517 !$OMP PARALLEL DO schedule(static) private(jj,ji) 518 DO jj = 1, jpj 519 DO ji = 1, jpi 520 aridge(ji,jj,jl) = athorn(ji,jj,jl) 521 END DO 522 END DO 415 523 END DO 416 524 ! … … 418 526 ! 419 527 DO jl = 1, jpl 420 araft(:,:,jl) = athorn(:,:,jl) 528 !$OMP PARALLEL DO schedule(static) private(jj,ji) 529 DO jj = 1, jpj 530 DO ji = 1, jpi 531 araft(ji,jj,jl) = athorn(ji,jj,jl) 532 END DO 533 END DO 421 534 END DO 422 535 ! … … 449 562 !----------------------------------------------------------------- 450 563 451 aksum(:,:) = athorn(:,:,0) 564 !$OMP PARALLEL 565 !$OMP DO schedule(static) private(jj,ji) 566 DO jj = 1, jpj 567 DO ji = 1, jpi 568 aksum(ji,jj) = athorn(ji,jj,0) 569 END DO 570 END DO 452 571 ! Transfer function 453 572 DO jl = 1, jpl !all categories have a specific transfer function 573 !$OMP DO schedule(static) private(jj,ji,hrmean) 454 574 DO jj = 1, jpj 455 575 DO ji = 1, jpi … … 476 596 END DO 477 597 END DO 598 !$OMP END PARALLEL 478 599 ! 479 600 CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 601 CALL wrk_dealloc( jpi,jpj,z_ai ) 480 602 ! 481 603 END SUBROUTINE lim_itd_me_ridgeprep … … 539 661 ! 1) Compute change in open water area due to closing and opening. 540 662 !------------------------------------------------------------------------------- 663 !$OMP PARALLEL DO schedule(static) private(jj,ji) 541 664 DO jj = 1, jpj 542 665 DO ji = 1, jpi … … 568 691 END DO 569 692 693 !$OMP PARALLEL 694 !$OMP DO schedule(static) private(ij,jj,ji) 570 695 DO ij = 1, icells 571 696 ji = indxi(ij) ; jj = indxj(ij) … … 660 785 !-------------------------------------------------------------------- 661 786 DO jk = 1, nlay_i 787 !$OMP DO schedule(static) private(ij,jj,ji) 662 788 DO ij = 1, icells 663 789 ji = indxi(ij) ; jj = indxj(ij) … … 687 813 DO jl2 = 1, jpl 688 814 ! over categories to which ridged/rafted ice is transferred 815 !$OMP DO schedule(static) private(ij,jj,ji,hL,hR,farea) 689 816 DO ij = 1, icells 690 817 ji = indxi(ij) ; jj = indxj(ij) … … 721 848 ! Transfer ice energy to category jl2 by ridging 722 849 DO jk = 1, nlay_i 850 !$OMP DO schedule(static) private(ij,jj,ji) 723 851 DO ij = 1, icells 724 852 ji = indxi(ij) ; jj = indxj(ij) … … 728 856 ! 729 857 END DO ! jl2 858 !$OMP END PARALLEL 730 859 731 860 END DO ! jl1 (deforming categories) 732 733 861 ! 734 862 CALL wrk_dealloc( jpij, indxi, indxj ) … … 769 897 ! 1) Initialize 770 898 !------------------------------------------------------------------------------! 771 strength(:,:) = 0._wp 899 !$OMP PARALLEL DO schedule(static) private(jj,ji) 900 DO jj = 1, jpj 901 DO ji = 1, jpi 902 strength(ji,jj) = 0._wp 903 END DO 904 END DO 772 905 773 906 !------------------------------------------------------------------------------! … … 781 914 IF( kstrngth == 1 ) THEN 782 915 z1_3 = 1._wp / 3._wp 916 !$OMP PARALLEL 783 917 DO jl = 1, jpl 918 !$OMP DO schedule(static) private(jj,ji) 784 919 DO jj= 1, jpj 785 920 DO ji = 1, jpi … … 810 945 END DO 811 946 812 strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) * tmask(:,:,1) 947 !$OMP DO schedule(static) private(jj,ji) 948 DO jj= 1, jpj 949 DO ji = 1, jpi 950 strength(ji,jj) = rn_pe_rdg * Cp * strength(ji,jj) / aksum(ji,jj) * tmask(ji,jj,1) 951 END DO 952 END DO 953 !$OMP END PARALLEL 813 954 ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation 814 955 ksmooth = 1 … … 818 959 !------------------------------------------------------------------------------! 819 960 ELSE ! kstrngth ne 1: Hibler (1979) form 820 ! 821 strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) ) ) * tmask(:,:,1) 961 !$OMP PARALLEL DO schedule(static) private(jj,ji) 962 DO jj= 1, jpj 963 DO ji = 1, jpi 964 ! 965 strength(ji,jj) = rn_pstar * vt_i(ji,jj) * EXP( - rn_crhg * ( 1._wp - at_i(ji,jj) ) ) * tmask(ji,jj,1) 966 END DO 967 END DO 822 968 ! 823 969 ksmooth = 1 … … 830 976 ! CAN BE REMOVED 831 977 IF( ln_icestr_bvf ) THEN 978 !$OMP PARALLEL DO schedule(static) private(jj,ji) 832 979 DO jj = 1, jpj 833 980 DO ji = 1, jpi … … 846 993 IF ( ksmooth == 1 ) THEN 847 994 995 !$OMP PARALLEL 996 !$OMP DO schedule(static) private(jj,ji) 848 997 DO jj = 2, jpjm1 849 998 DO ji = 2, jpim1 … … 859 1008 END DO 860 1009 1010 !$OMP DO schedule(static) private(jj,ji) 861 1011 DO jj = 2, jpjm1 862 1012 DO ji = 2, jpim1 … … 864 1014 END DO 865 1015 END DO 1016 !$OMP END PARALLEL 866 1017 CALL lbc_lnk( strength, 'T', 1. ) 867 1018 … … 874 1025 875 1026 IF ( numit == nit000 + nn_fsbc - 1 ) THEN 876 zstrp1(:,:) = 0._wp 877 zstrp2(:,:) = 0._wp 1027 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1028 DO jj = 1, jpj 1029 DO ji = 1, jpi 1030 zstrp1(ji,jj) = 0._wp 1031 zstrp2(ji,jj) = 0._wp 1032 END DO 1033 END DO 878 1034 ENDIF 879 1035 1036 !$OMP PARALLEL DO schedule(static) private(jj,ji,numts_rm,zp) 880 1037 DO jj = 2, jpjm1 881 1038 DO ji = 2, jpim1 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r7646 r7698 106 106 CALL lim_column_sum (jpl, v_s, vt_s_init) 107 107 CALL lim_column_sum_energy (jpl, nlay_i, e_i, et_i_init) 108 dummy_es(:,:,:) = e_s(:,:,1,:) 108 DO jl = 1, jpl 109 !$OMP PARALLEL DO schedule(static) private(jj,ji) 110 DO jj = 1, jpj 111 DO ji = 1, jpi 112 dummy_es(ji,jj,jl) = e_s(ji,jj,1,jl) 113 END DO 114 END DO 115 END DO 109 116 CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_init) 110 117 ENDIF … … 121 128 ENDIF 122 129 123 zdhice(:,:,:) = 0._wp 130 !$OMP PARALLEL 131 DO jl = 1, jpl 132 !$OMP DO schedule(static) private(jj,ji) 133 DO jj = 1, jpj 134 DO ji = 1, jpi 135 zdhice(ji,jj,jl) = 0._wp 136 END DO 137 END DO 138 END DO 124 139 DO jl = klbnd, kubnd 140 !$OMP DO schedule(static) private(jj,ji,rswitch) 125 141 DO jj = 1, jpj 126 142 DO ji = 1, jpi … … 137 153 ! 2) Compute fractional ice area in each grid cell 138 154 !----------------------------------------------------------------------------------------------- 139 at_i(:,:) = 0._wp 155 !$OMP DO schedule(static) private(jj,ji) 156 DO jj = 1, jpj 157 DO ji = 1, jpi 158 at_i(ji,jj) = 0._wp 159 END DO 160 END DO 140 161 DO jl = klbnd, kubnd 141 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 142 END DO 162 !$OMP DO schedule(static) private(jj,ji) 163 DO jj = 1, jpj 164 DO ji = 1, jpi 165 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 166 END DO 167 END DO 168 END DO 169 !$OMP END PARALLEL 143 170 144 171 !----------------------------------------------------------------------------------------------- … … 163 190 !----------------------------------------------------------------------------------------------- 164 191 !- 4.1 Compute category boundaries 165 zhbnew(:,:,:) = 0._wp 192 !$OMP PARALLEL 193 DO jl = 0, jpl 194 !$OMP DO schedule(static) private(jj,ji) 195 DO jj = 1, jpj 196 DO ji = 1, jpi 197 zhbnew(ji,jj,jl) = 0._wp 198 END DO 199 END DO 200 END DO 166 201 167 202 DO jl = klbnd, kubnd - 1 203 !$OMP DO schedule(static) private(ji,ii,ij,zslope) 168 204 DO ji = 1, nbrem 169 205 ii = nind_i(ji) … … 183 219 184 220 !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 221 !$OMP DO schedule(static) private(ji,ii,ij) 185 222 DO ji = 1, nbrem 186 223 ii = nind_i(ji) … … 205 242 206 243 END DO 244 !$OMP END PARALLEL 207 245 208 246 !----------------------------------------------------------------------------------------------- … … 223 261 ! 6) Fill arrays with lowermost / uppermost boundaries of 'new' categories 224 262 !----------------------------------------------------------------------------------------------- 263 !$OMP PARALLEL DO schedule(static) private(jj,ji) 225 264 DO jj = 1, jpj 226 265 DO ji = 1, jpi … … 254 293 255 294 !- 7.2 Area lost due to melting of thin ice (first category, klbnd) 295 !$OMP PARALLEL DO schedule(static) private(ji,ii,ij,zdh0,zetamax,zx1,zx2,zda0,zdamax) 256 296 DO ji = 1, nbrem 257 297 ii = nind_i(ji) … … 299 339 !----------------------------------------------------------------------------------------------- 300 340 341 !$OMP PARALLEL 301 342 DO jl = klbnd, kubnd - 1 343 !$OMP DO schedule(static) private(jj,ji) 302 344 DO jj = 1, jpj 303 345 DO ji = 1, jpi … … 308 350 END DO 309 351 352 !$OMP DO schedule(static) private(ji,ii,ij,zetamax,zetamin,zx1,zwk1,zwk2,zx2,zx3,nd) 310 353 DO ji = 1, nbrem 311 354 ii = nind_i(ji) … … 342 385 END DO 343 386 END DO 387 !$OMP END PARALLEL 344 388 345 389 !!---------------------------------------------------------------------------------------------- … … 352 396 !!---------------------------------------------------------------------------------------------- 353 397 398 !$OMP PARALLEL DO schedule(static) private(ji,ii,ij) 354 399 DO ji = 1, nbrem 355 400 ii = nind_i(ji) … … 377 422 CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid) 378 423 379 dummy_es(:,:,:) = e_s(:,:,1,:) 424 DO jl = 1, jpl 425 !$OMP PARALLEL DO schedule(static) private(jj,ji) 426 DO jj = 1, jpj 427 DO ji = 1, jpi 428 dummy_es(ji,jj,jl) = e_s(ji,jj,1,jl) 429 END DO 430 END DO 431 END DO 380 432 CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_final) 381 433 fieldid = ' e_s : limitd_th ' … … 421 473 !!------------------------------------------------------------------ 422 474 ! 475 !$OMP PARALLEL DO schedule(static) private(jj,ji,zh13,zh23,zdhr,zwk1,zwk2) 423 476 DO jj = 1, jpj 424 477 DO ji = 1, jpi … … 500 553 501 554 DO jl = klbnd, kubnd 502 zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl) 555 !$OMP PARALLEL DO schedule(static) private(jj,ji) 556 DO jj = 1, jpj 557 DO ji = 1, jpi 558 zaTsfn(ji,jj,jl) = a_i(ji,jj,jl) * t_su(ji,jj,jl) 559 END DO 560 END DO 503 561 END DO 504 562 … … 519 577 END DO 520 578 579 !$OMP PARALLEL DO schedule(static) private(ji,ii,ij,jl1,jl2,rswitch,zdvsnow,zdesnow,zdo_aice,zdsm_vice,zdaTsf) 521 580 DO ji = 1, nbrem 522 581 ii = nind_i(ji) … … 584 643 585 644 DO jk = 1, nlay_i 645 !$OMP PARALLEL DO schedule(static) private(ji,ii,ij,jl1,jl2,zdeice) 586 646 DO ji = 1, nbrem 587 647 ii = nind_i(ji) … … 608 668 609 669 DO jl = klbnd, kubnd 670 !$OMP PARALLEL DO schedule(static) private(jj,ji) 610 671 DO jj = 1, jpj 611 672 DO ji = 1, jpi … … 663 724 ! 1) Compute ice thickness. 664 725 !------------------------------------------------------------------------------ 726 !$OMP PARALLEL 665 727 DO jl = klbnd, kubnd 728 !$OMP DO schedule(static) private(jj,ji,rswitch) 666 729 DO jj = 1, jpj 667 730 DO ji = 1, jpi … … 680 743 !------------------------- 681 744 DO jl = klbnd, kubnd 682 zdonor(:,:,jl) = 0 683 zdaice(:,:,jl) = 0._wp 684 zdvice(:,:,jl) = 0._wp 685 END DO 745 !$OMP DO schedule(static) private(jj,ji) 746 DO jj = 1, jpj 747 DO ji = 1, jpi 748 zdonor(ji,jj,jl) = 0 749 zdaice(ji,jj,jl) = 0._wp 750 zdvice(ji,jj,jl) = 0._wp 751 END DO 752 END DO 753 END DO 754 !$OMP END PARALLEL 686 755 687 756 !------------------------- … … 696 765 zshiftflag = 0 697 766 767 !$OMP PARALLEL DO schedule(static) private(jj,ji) REDUCTION(MAX:zshiftflag) 698 768 DO jj = 1, jpj 699 769 DO ji = 1, jpi … … 716 786 CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 717 787 ! Reset shift parameters 718 zdonor(:,:,jl) = 0 719 zdaice(:,:,jl) = 0._wp 720 zdvice(:,:,jl) = 0._wp 788 !$OMP PARALLEL DO schedule(static) private(jj,ji) 789 DO jj = 1, jpj 790 DO ji = 1, jpi 791 zdonor(ji,jj,jl) = 0 792 zdaice(ji,jj,jl) = 0._wp 793 zdvice(ji,jj,jl) = 0._wp 794 END DO 795 END DO 721 796 ENDIF 722 797 ! … … 734 809 zshiftflag = 0 735 810 811 !$OMP PARALLEL DO schedule(static) private(jj,ji) REDUCTION(MAX:zshiftflag) 736 812 DO jj = 1, jpj 737 813 DO ji = 1, jpi 738 814 IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 739 !740 815 zshiftflag = 1 741 816 zdonor(ji,jj,jl) = jl + 1 … … 751 826 CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 752 827 ! Reset shift parameters 753 zdonor(:,:,jl) = 0 754 zdaice(:,:,jl) = 0._wp 755 zdvice(:,:,jl) = 0._wp 828 !$OMP PARALLEL DO schedule(static) private(jj,ji) 829 DO jj = 1, jpj 830 DO ji = 1, jpi 831 zdonor(ji,jj,jl) = 0 832 zdaice(ji,jj,jl) = 0._wp 833 zdvice(ji,jj,jl) = 0._wp 834 END DO 835 END DO 756 836 ENDIF 757 837 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r7646 r7698 164 164 !------------------------------------------------------------------------------! 165 165 ! ocean/land mask 166 !$OMP PARALLEL DO schedule(static) private(jj, ji) 166 167 DO jj = 1, jpjm1 167 168 DO ji = 1, jpim1 ! NO vector opt. … … 172 173 173 174 ! Lateral boundary conditions on velocity (modify zfmask) 174 zwf(:,:) = zfmask(:,:) 175 !$OMP PARALLEL 176 !$OMP DO schedule(static) private(jj, ji) 177 DO jj = 1, jpj 178 DO ji = 1, jpi 179 zwf(ji,jj) = zfmask(ji,jj) 180 END DO 181 END DO 182 !$OMP DO schedule(static) private(jj, ji) 175 183 DO jj = 2, jpjm1 176 184 DO ji = fs_2, fs_jpim1 ! vector opt. … … 180 188 END DO 181 189 END DO 190 !$OMP DO schedule(static) private(jj) 182 191 DO jj = 2, jpjm1 183 192 IF( zfmask(1,jj) == 0._wp ) THEN … … 188 197 ENDIF 189 198 END DO 199 !$OMP DO schedule(static) private(ji) 190 200 DO ji = 2, jpim1 191 201 IF( zfmask(ji,1) == 0._wp ) THEN … … 196 206 ENDIF 197 207 END DO 208 !$OMP END PARALLEL 198 209 CALL lbc_lnk( zfmask, 'F', 1._wp ) 199 210 … … 225 236 226 237 ! Initialise stress tensor 227 zs1 (:,:) = stress1_i (:,:) 228 zs2 (:,:) = stress2_i (:,:) 229 zs12(:,:) = stress12_i(:,:) 238 !$OMP PARALLEL DO schedule(static) private(jj, ji) 239 DO jj = 1, jpj 240 DO ji = 1, jpi 241 zs1 (ji,jj) = stress1_i (ji,jj) 242 zs2 (ji,jj) = stress2_i (ji,jj) 243 zs12(ji,jj) = stress12_i(ji,jj) 244 END DO 245 END DO 230 246 231 247 ! Ice strength … … 233 249 234 250 ! scale factors 251 !$OMP PARALLEL DO schedule(static) private(jj, ji) 235 252 DO jj = 2, jpjm1 236 253 DO ji = fs_2, fs_jpim1 … … 255 272 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 256 273 ! 257 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 274 !$OMP PARALLEL DO schedule(static) private(jj, ji) 275 DO jj = 1, jpj 276 DO ji = 1, jpi 277 zpice(ji,jj) = ssh_m(ji,jj) + ( zintn * snwice_mass(ji,jj) + zintb * snwice_mass_b(ji,jj) ) * r1_rau0 278 END DO 279 END DO 258 280 ! 259 281 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! 260 zpice(:,:) = ssh_m(:,:) 282 !$OMP PARALLEL DO schedule(static) private(jj, ji) 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 zpice(ji,jj) = ssh_m(ji,jj) 286 END DO 287 END DO 261 288 ENDIF 262 289 290 !$OMP PARALLEL DO schedule(static) private(jj,ji,zm1,zm2,zm3,zmassU,zmassV) 263 291 DO jj = 2, jpjm1 264 292 DO ji = fs_2, fs_jpim1 … … 317 345 ! !----------------------! 318 346 IF(ln_ctl) THEN ! Convergence test 347 !$OMP PARALLEL DO schedule(static) private(jj, ji) 319 348 DO jj = 1, jpjm1 320 zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 321 zv_ice(:,jj) = v_ice(:,jj) 349 DO ji = 1, jpi 350 zu_ice(ji,jj) = u_ice(ji,jj) ! velocity at previous time step 351 zv_ice(ji,jj) = v_ice(ji,jj) 352 END DO 322 353 END DO 323 354 ENDIF 324 355 325 356 ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 357 !$OMP PARALLEL DO schedule(static) private(jj, ji) 326 358 DO jj = 1, jpjm1 ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 327 359 DO ji = 1, jpim1 … … 336 368 CALL lbc_lnk( zds, 'F', 1. ) 337 369 370 !$OMP PARALLEL DO schedule(static) private(jj,ji,zds2,zdiv,zdiv2,zdt,zdt2,zdelta) 338 371 DO jj = 2, jpjm1 339 372 DO ji = 2, jpim1 ! no vector loop … … 370 403 CALL lbc_lnk( zp_delt, 'T', 1. ) 371 404 405 !$OMP PARALLEL DO schedule(static) private(jj,ji,zp_delf) 372 406 DO jj = 1, jpjm1 373 407 DO ji = 1, jpim1 … … 385 419 386 420 ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 421 !$OMP PARALLEL DO schedule(static) private(jj,ji) 387 422 DO jj = 2, jpjm1 388 423 DO ji = fs_2, fs_jpim1 … … 420 455 IF( MOD(jter,2) .EQ. 0 ) THEN ! even iterations 421 456 457 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 422 458 DO jj = 2, jpjm1 423 459 DO ji = fs_2, fs_jpim1 … … 464 500 IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' ) 465 501 502 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 466 503 DO jj = 2, jpjm1 467 504 DO ji = fs_2, fs_jpim1 … … 509 546 ELSE ! odd iterations 510 547 548 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 511 549 DO jj = 2, jpjm1 512 550 DO ji = fs_2, fs_jpim1 … … 552 590 IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' ) 553 591 592 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 554 593 DO jj = 2, jpjm1 555 594 DO ji = fs_2, fs_jpim1 … … 598 637 599 638 IF(ln_ctl) THEN ! Convergence test 639 !$OMP PARALLEL DO schedule(static) private(jj, ji) 600 640 DO jj = 2 , jpjm1 601 zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 641 DO ji = 1, jpi 642 zresr(ji,jj) = MAX( ABS( u_ice(ji,jj) - zu_ice(ji,jj) ), ABS( v_ice(ji,jj) - zv_ice(ji,jj) ) ) 643 END DO 602 644 END DO 603 645 zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) … … 612 654 ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 613 655 !------------------------------------------------------------------------------! 656 !$OMP PARALLEL DO schedule(static) private(jj, ji) 614 657 DO jj = 1, jpjm1 615 658 DO ji = 1, jpim1 … … 624 667 CALL lbc_lnk( zds, 'F', 1. ) 625 668 669 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdt,zdt2,zds2,zdelta,rswitch) 626 670 DO jj = 2, jpjm1 627 671 DO ji = 2, jpim1 ! no vector loop … … 656 700 657 701 ! --- Store the stress tensor for the next time step --- ! 658 stress1_i (:,:) = zs1 (:,:) 659 stress2_i (:,:) = zs2 (:,:) 660 stress12_i(:,:) = zs12(:,:) 702 !$OMP PARALLEL DO schedule(static) private(jj, ji) 703 DO jj = 1, jpj 704 DO ji = 1, jpi 705 stress1_i (ji,jj) = zs1 (ji,jj) 706 stress2_i (ji,jj) = zs2 (ji,jj) 707 stress12_i(ji,jj) = zs12(ji,jj) 708 END DO 709 END DO 661 710 ! 662 711 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r7646 r7698 130 130 WRITE(zchar,'(I2.2)') jl 131 131 znam = 'v_i'//'_htc'//zchar 132 z2d(:,:) = v_i(:,:,jl) 132 !$OMP PARALLEL DO schedule(static) private(jj,ji) 133 DO jj = 1, jpj 134 DO ji = 1, jpi 135 z2d(ji,jj) = v_i(ji,jj,jl) 136 END DO 137 END DO 133 138 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 134 139 znam = 'v_s'//'_htc'//zchar 135 z2d(:,:) = v_s(:,:,jl) 140 !$OMP PARALLEL DO schedule(static) private(jj,ji) 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 z2d(ji,jj) = v_s(ji,jj,jl) 144 END DO 145 END DO 136 146 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 137 147 znam = 'smv_i'//'_htc'//zchar 138 z2d(:,:) = smv_i(:,:,jl) 148 !$OMP PARALLEL DO schedule(static) private(jj,ji) 149 DO jj = 1, jpj 150 DO ji = 1, jpi 151 z2d(ji,jj) = smv_i(ji,jj,jl) 152 END DO 153 END DO 139 154 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 140 155 znam = 'oa_i'//'_htc'//zchar 141 z2d(:,:) = oa_i(:,:,jl) 156 !$OMP PARALLEL DO schedule(static) private(jj,ji) 157 DO jj = 1, jpj 158 DO ji = 1, jpi 159 z2d(ji,jj) = oa_i(ji,jj,jl) 160 END DO 161 END DO 142 162 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 143 163 znam = 'a_i'//'_htc'//zchar 144 z2d(:,:) = a_i(:,:,jl) 164 !$OMP PARALLEL DO schedule(static) private(jj,ji) 165 DO jj = 1, jpj 166 DO ji = 1, jpi 167 z2d(ji,jj) = a_i(ji,jj,jl) 168 END DO 169 END DO 145 170 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 146 171 znam = 't_su'//'_htc'//zchar 147 z2d(:,:) = t_su(:,:,jl) 172 !$OMP PARALLEL DO schedule(static) private(jj,ji) 173 DO jj = 1, jpj 174 DO ji = 1, jpi 175 z2d(ji,jj) = t_su(ji,jj,jl) 176 END DO 177 END DO 148 178 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 149 179 END DO … … 152 182 WRITE(zchar,'(I2.2)') jl 153 183 znam = 'tempt_sl1'//'_htc'//zchar 154 z2d(:,:) = e_s(:,:,1,jl) 184 !$OMP PARALLEL DO schedule(static) private(jj,ji) 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 z2d(ji,jj) = e_s(ji,jj,1,jl) 188 END DO 189 END DO 155 190 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 156 191 END DO … … 161 196 WRITE(zchar1,'(I2.2)') jk 162 197 znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 163 z2d(:,:) = e_i(:,:,jk,jl) 198 !$OMP PARALLEL DO schedule(static) private(jj,ji) 199 DO jj = 1, jpj 200 DO ji = 1, jpi 201 z2d(ji,jj) = e_i(ji,jj,jk,jl) 202 END DO 203 END DO 164 204 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 165 205 END DO … … 181 221 WRITE(zchar,'(I2.2)') jl 182 222 znam = 'sxice'//'_htc'//zchar 183 z2d(:,:) = sxice(:,:,jl) 223 !$OMP PARALLEL DO schedule(static) private(jj,ji) 224 DO jj = 1, jpj 225 DO ji = 1, jpi 226 z2d(ji,jj) = sxice(ji,jj,jl) 227 END DO 228 END DO 184 229 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 185 230 znam = 'syice'//'_htc'//zchar 186 z2d(:,:) = syice(:,:,jl) 231 !$OMP PARALLEL DO schedule(static) private(jj,ji) 232 DO jj = 1, jpj 233 DO ji = 1, jpi 234 z2d(ji,jj) = syice(ji,jj,jl) 235 END DO 236 END DO 187 237 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 188 238 znam = 'sxxice'//'_htc'//zchar 189 z2d(:,:) = sxxice(:,:,jl) 239 !$OMP PARALLEL DO schedule(static) private(jj,ji) 240 DO jj = 1, jpj 241 DO ji = 1, jpi 242 z2d(ji,jj) = sxxice(ji,jj,jl) 243 END DO 244 END DO 190 245 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 191 246 znam = 'syyice'//'_htc'//zchar 192 z2d(:,:) = syyice(:,:,jl) 247 !$OMP PARALLEL DO schedule(static) private(jj,ji) 248 DO jj = 1, jpj 249 DO ji = 1, jpi 250 z2d(ji,jj) = syyice(ji,jj,jl) 251 END DO 252 END DO 193 253 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 194 254 znam = 'sxyice'//'_htc'//zchar 195 z2d(:,:) = sxyice(:,:,jl) 255 !$OMP PARALLEL DO schedule(static) private(jj,ji) 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 z2d(ji,jj) = sxyice(ji,jj,jl) 259 END DO 260 END DO 196 261 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 197 262 znam = 'sxsn'//'_htc'//zchar 198 z2d(:,:) = sxsn(:,:,jl) 263 !$OMP PARALLEL DO schedule(static) private(jj,ji) 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 z2d(ji,jj) = sxsn(ji,jj,jl) 267 END DO 268 END DO 199 269 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 200 270 znam = 'sysn'//'_htc'//zchar 201 z2d(:,:) = sysn(:,:,jl) 271 !$OMP PARALLEL DO schedule(static) private(jj,ji) 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 z2d(ji,jj) = sysn(ji,jj,jl) 275 END DO 276 END DO 202 277 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 203 278 znam = 'sxxsn'//'_htc'//zchar 204 z2d(:,:) = sxxsn(:,:,jl) 279 !$OMP PARALLEL DO schedule(static) private(jj,ji) 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 z2d(ji,jj) = sxxsn(ji,jj,jl) 283 END DO 284 END DO 205 285 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 206 286 znam = 'syysn'//'_htc'//zchar 207 z2d(:,:) = syysn(:,:,jl) 287 !$OMP PARALLEL DO schedule(static) private(jj,ji) 288 DO jj = 1, jpj 289 DO ji = 1, jpi 290 z2d(ji,jj) = syysn(ji,jj,jl) 291 END DO 292 END DO 208 293 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 209 294 znam = 'sxysn'//'_htc'//zchar 210 z2d(:,:) = sxysn(:,:,jl) 295 !$OMP PARALLEL DO schedule(static) private(jj,ji) 296 DO jj = 1, jpj 297 DO ji = 1, jpi 298 z2d(ji,jj) = sxysn(ji,jj,jl) 299 END DO 300 END DO 211 301 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 212 302 znam = 'sxa'//'_htc'//zchar 213 z2d(:,:) = sxa(:,:,jl) 303 !$OMP PARALLEL DO schedule(static) private(jj,ji) 304 DO jj = 1, jpj 305 DO ji = 1, jpi 306 z2d(ji,jj) = sxa(ji,jj,jl) 307 END DO 308 END DO 214 309 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 215 310 znam = 'sya'//'_htc'//zchar 216 z2d(:,:) = sya(:,:,jl) 311 !$OMP PARALLEL DO schedule(static) private(jj,ji) 312 DO jj = 1, jpj 313 DO ji = 1, jpi 314 z2d(ji,jj) = sya(ji,jj,jl) 315 END DO 316 END DO 217 317 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 218 318 znam = 'sxxa'//'_htc'//zchar 219 z2d(:,:) = sxxa(:,:,jl) 319 !$OMP PARALLEL DO schedule(static) private(jj,ji) 320 DO jj = 1, jpj 321 DO ji = 1, jpi 322 z2d(ji,jj) = sxxa(ji,jj,jl) 323 END DO 324 END DO 220 325 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 221 326 znam = 'syya'//'_htc'//zchar 222 z2d(:,:) = syya(:,:,jl) 327 !$OMP PARALLEL DO schedule(static) private(jj,ji) 328 DO jj = 1, jpj 329 DO ji = 1, jpi 330 z2d(ji,jj) = syya(ji,jj,jl) 331 END DO 332 END DO 223 333 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 224 334 znam = 'sxya'//'_htc'//zchar 225 z2d(:,:) = sxya(:,:,jl) 335 !$OMP PARALLEL DO schedule(static) private(jj,ji) 336 DO jj = 1, jpj 337 DO ji = 1, jpi 338 z2d(ji,jj) = sxya(ji,jj,jl) 339 END DO 340 END DO 226 341 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 227 342 znam = 'sxc0'//'_htc'//zchar 228 z2d(:,:) = sxc0(:,:,jl) 343 !$OMP PARALLEL DO schedule(static) private(jj,ji) 344 DO jj = 1, jpj 345 DO ji = 1, jpi 346 z2d(ji,jj) = sxc0(ji,jj,jl) 347 END DO 348 END DO 229 349 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 230 350 znam = 'syc0'//'_htc'//zchar 231 z2d(:,:) = syc0(:,:,jl) 351 !$OMP PARALLEL DO schedule(static) private(jj,ji) 352 DO jj = 1, jpj 353 DO ji = 1, jpi 354 z2d(ji,jj) = syc0(ji,jj,jl) 355 END DO 356 END DO 232 357 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 233 358 znam = 'sxxc0'//'_htc'//zchar 234 z2d(:,:) = sxxc0(:,:,jl) 359 !$OMP PARALLEL DO schedule(static) private(jj,ji) 360 DO jj = 1, jpj 361 DO ji = 1, jpi 362 z2d(ji,jj) = sxxc0(ji,jj,jl) 363 END DO 364 END DO 235 365 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 236 366 znam = 'syyc0'//'_htc'//zchar 237 z2d(:,:) = syyc0(:,:,jl) 367 !$OMP PARALLEL DO schedule(static) private(jj,ji) 368 DO jj = 1, jpj 369 DO ji = 1, jpi 370 z2d(ji,jj) = syyc0(ji,jj,jl) 371 END DO 372 END DO 238 373 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 239 374 znam = 'sxyc0'//'_htc'//zchar 240 z2d(:,:) = sxyc0(:,:,jl) 375 !$OMP PARALLEL DO schedule(static) private(jj,ji) 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 z2d(ji,jj) = sxyc0(ji,jj,jl) 379 END DO 380 END DO 241 381 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 242 382 znam = 'sxsal'//'_htc'//zchar 243 z2d(:,:) = sxsal(:,:,jl) 383 !$OMP PARALLEL DO schedule(static) private(jj,ji) 384 DO jj = 1, jpj 385 DO ji = 1, jpi 386 z2d(ji,jj) = sxsal(ji,jj,jl) 387 END DO 388 END DO 244 389 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 245 390 znam = 'sysal'//'_htc'//zchar 246 z2d(:,:) = sysal(:,:,jl) 391 !$OMP PARALLEL DO schedule(static) private(jj,ji) 392 DO jj = 1, jpj 393 DO ji = 1, jpi 394 z2d(ji,jj) = sysal(ji,jj,jl) 395 END DO 396 END DO 247 397 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 248 398 znam = 'sxxsal'//'_htc'//zchar 249 z2d(:,:) = sxxsal(:,:,jl) 399 !$OMP PARALLEL DO schedule(static) private(jj,ji) 400 DO jj = 1, jpj 401 DO ji = 1, jpi 402 z2d(ji,jj) = sxxsal(ji,jj,jl) 403 END DO 404 END DO 250 405 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 251 406 znam = 'syysal'//'_htc'//zchar 252 z2d(:,:) = syysal(:,:,jl) 407 !$OMP PARALLEL DO schedule(static) private(jj,ji) 408 DO jj = 1, jpj 409 DO ji = 1, jpi 410 z2d(ji,jj) = syysal(ji,jj,jl) 411 END DO 412 END DO 253 413 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 254 414 znam = 'sxysal'//'_htc'//zchar 255 z2d(:,:) = sxysal(:,:,jl) 415 !$OMP PARALLEL DO schedule(static) private(jj,ji) 416 DO jj = 1, jpj 417 DO ji = 1, jpi 418 z2d(ji,jj) = sxysal(ji,jj,jl) 419 END DO 420 END DO 256 421 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 257 422 znam = 'sxage'//'_htc'//zchar 258 z2d(:,:) = sxage(:,:,jl) 423 !$OMP PARALLEL DO schedule(static) private(jj,ji) 424 DO jj = 1, jpj 425 DO ji = 1, jpi 426 z2d(ji,jj) = sxage(ji,jj,jl) 427 END DO 428 END DO 259 429 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 260 430 znam = 'syage'//'_htc'//zchar 261 z2d(:,:) = syage(:,:,jl) 431 !$OMP PARALLEL DO schedule(static) private(jj,ji) 432 DO jj = 1, jpj 433 DO ji = 1, jpi 434 z2d(ji,jj) = syage(ji,jj,jl) 435 END DO 436 END DO 262 437 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 263 438 znam = 'sxxage'//'_htc'//zchar 264 z2d(:,:) = sxxage(:,:,jl) 439 !$OMP PARALLEL DO schedule(static) private(jj,ji) 440 DO jj = 1, jpj 441 DO ji = 1, jpi 442 z2d(ji,jj) = sxxage(ji,jj,jl) 443 END DO 444 END DO 265 445 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 266 446 znam = 'syyage'//'_htc'//zchar 267 z2d(:,:) = syyage(:,:,jl) 447 !$OMP PARALLEL DO schedule(static) private(jj,ji) 448 DO jj = 1, jpj 449 DO ji = 1, jpi 450 z2d(ji,jj) = syyage(ji,jj,jl) 451 END DO 452 END DO 268 453 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 269 454 znam = 'sxyage'//'_htc'//zchar 270 z2d(:,:) = sxyage(:,:,jl) 455 !$OMP PARALLEL DO schedule(static) private(jj,ji) 456 DO jj = 1, jpj 457 DO ji = 1, jpi 458 z2d(ji,jj) = sxyage(ji,jj,jl) 459 END DO 460 END DO 271 461 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 272 462 END DO … … 283 473 WRITE(zchar1,'(I2.2)') jk 284 474 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 285 z2d(:,:) = sxe(:,:,jk,jl) 475 !$OMP PARALLEL DO schedule(static) private(jj,ji) 476 DO jj = 1, jpj 477 DO ji = 1, jpi 478 z2d(ji,jj) = sxe(ji,jj,jk,jl) 479 END DO 480 END DO 286 481 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 287 482 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 288 z2d(:,:) = sye(:,:,jk,jl) 483 !$OMP PARALLEL DO schedule(static) private(jj,ji) 484 DO jj = 1, jpj 485 DO ji = 1, jpi 486 z2d(ji,jj) = sye(ji,jj,jk,jl) 487 END DO 488 END DO 289 489 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 290 490 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 291 z2d(:,:) = sxxe(:,:,jk,jl) 491 !$OMP PARALLEL DO schedule(static) private(jj,ji) 492 DO jj = 1, jpj 493 DO ji = 1, jpi 494 z2d(ji,jj) = sxxe(ji,jj,jk,jl) 495 END DO 496 END DO 292 497 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 293 498 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 294 z2d(:,:) = syye(:,:,jk,jl) 499 !$OMP PARALLEL DO schedule(static) private(jj,ji) 500 DO jj = 1, jpj 501 DO ji = 1, jpi 502 z2d(ji,jj) = syye(ji,jj,jk,jl) 503 END DO 504 END DO 295 505 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 296 506 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 297 z2d(:,:) = sxye(:,:,jk,jl) 507 !$OMP PARALLEL DO schedule(static) private(jj,ji) 508 DO jj = 1, jpj 509 DO ji = 1, jpi 510 z2d(ji,jj) = sxye(ji,jj,jk,jl) 511 END DO 512 END DO 298 513 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 299 514 END DO -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r7646 r7698 112 112 ! --- case we bypass ice thermodynamics --- ! 113 113 IF( .NOT. ln_limthd ) THEN ! we suppose ice is impermeable => ocean is isolated from atmosphere 114 hfx_in (:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 115 hfx_out (:,:) = pfrld(:,:) * qns_oce(:,:) + qemp_oce(:,:) 116 ftr_ice (:,:,:) = 0._wp 117 emp_ice (:,:) = 0._wp 118 qemp_ice (:,:) = 0._wp 119 qevap_ice(:,:,:) = 0._wp 114 !$OMP PARALLEL 115 !$OMP DO schedule(static) private(jj,ji) 116 DO jj = 1, jpj 117 DO ji = 1, jpi 118 hfx_in (ji,jj) = pfrld(ji,jj) * ( qns_oce(ji,jj) + qsr_oce(ji,jj) ) + qemp_oce(ji,jj) 119 hfx_out (ji,jj) = pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) 120 emp_ice (ji,jj) = 0._wp 121 qemp_ice (ji,jj) = 0._wp 122 END DO 123 END DO 124 DO jl = 1, jpl 125 !$OMP DO schedule(static) private(jj,ji) 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 ftr_ice (ji,jj,jl) = 0._wp 129 qevap_ice(ji,jj,jl) = 0._wp 130 END DO 131 END DO 132 END DO 133 !$OMP END PARALLEL 120 134 ENDIF 121 135 … … 123 137 CALL wrk_alloc( jpi,jpj, zalb ) 124 138 125 zalb(:,:) = 0._wp 126 WHERE ( at_i_b <= epsi06 ) ; zalb(:,:) = 0.066_wp 127 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 128 END WHERE 139 !$OMP PARALLEL 140 !$OMP DO schedule(static) private(jj,ji) 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 zalb(ji,jj) = 0._wp 144 END DO 145 END DO 146 !$OMP DO schedule(static) private(jj,ji,jl) 147 DO jj = 1, jpj 148 DO ji = 1, jpi 149 IF ( at_i_b(ji,jj) <= epsi06 ) THEN 150 zalb(ji,jj) = 0.066_wp 151 ELSE 152 DO jl = 1, jpl 153 zalb(ji,jj) = zalb(ji,jj) + ( alb_ice(ji,jj,jl) * a_i_b(ji,jj,jl) ) / at_i_b(ji,jj) 154 END DO 155 END IF 156 END DO 157 END DO 158 !$OMP END PARALLEL 129 159 IF( iom_use('alb_ice' ) ) CALL iom_put( "alb_ice" , zalb(:,:) ) ! ice albedo output 130 160 131 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b ) 161 !$OMP PARALLEL 162 !$OMP DO schedule(static) private(jj,ji) 163 DO jj = 1, jpj 164 DO ji = 1, jpi 165 zalb(ji,jj) = 0._wp 166 END DO 167 END DO 168 DO jl = 1, jpl 169 !$OMP DO schedule(static) private(jj,ji) 170 DO jj = 1, jpj 171 DO ji = 1, jpi 172 zalb(ji,jj) = zalb(ji,jj) + ( alb_ice(ji,jj,jl) * a_i_b(ji,jj,jl) ) + 0.066_wp * ( 1._wp - at_i_b(ji,jj) ) 173 END DO 174 END DO 175 END DO 176 !$OMP END PARALLEL 132 177 IF( iom_use('albedo' ) ) CALL iom_put( "albedo" , zalb(:,:) ) ! ice albedo output 133 178 134 179 CALL wrk_dealloc( jpi,jpj, zalb ) 135 180 181 !$OMP PARALLEL 182 !$OMP DO schedule(static) private(jj,ji,jl,zqsr,zqmass) 136 183 DO jj = 1, jpj 137 184 DO ji = 1, jpi … … 186 233 ! salt flux at the ocean surface ! 187 234 !------------------------------------------! 188 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) & 189 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:) 235 !$OMP DO schedule(static) private(jj,ji) 236 DO jj = 1, jpj 237 DO ji = 1, jpi 238 sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj) & 239 & + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) 240 END DO 241 END DO 242 !$OMP END PARALLEL 190 243 191 244 !-------------------------------------------------------------! … … 193 246 !-------------------------------------------------------------! 194 247 IF( nn_ice_embd /= 0 ) THEN 195 ! save mass from the previous ice time step 196 snwice_mass_b(:,:) = snwice_mass(:,:) 197 ! new mass per unit area 198 snwice_mass (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 199 ! time evolution of snow+ice mass 200 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 248 !$OMP PARALLEL DO schedule(static) private(jj,ji) 249 DO jj = 1, jpj 250 DO ji = 1, jpi 251 ! save mass from the previous ice time step 252 snwice_mass_b(ji,jj) = snwice_mass(ji,jj) 253 ! new mass per unit area 254 snwice_mass (ji,jj) = tmask(ji,jj,1) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj) ) 255 ! time evolution of snow+ice mass 256 snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice 257 END DO 258 END DO 201 259 ENDIF 202 260 … … 204 262 ! Storing the transmitted variables ! 205 263 !-----------------------------------------------! 206 fr_i (:,:) = at_i(:,:) ! Sea-ice fraction 207 tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature 264 !$OMP PARALLEL 265 !$OMP DO schedule(static) private(jj,ji) 266 DO jj = 1, jpj 267 DO ji = 1, jpi 268 fr_i (ji,jj) = at_i(ji,jj) ! Sea-ice fraction 269 END DO 270 END DO 271 DO jl = 1, jpl 272 !$OMP DO schedule(static) private(jj,ji) 273 DO jj = 1, jpj 274 DO ji = 1, jpi 275 tn_ice(ji,jj,jl) = t_su(ji,jj,jl) ! Ice surface temperature 276 END DO 277 END DO 278 END DO 279 !$OMP END PARALLEL 208 280 209 281 !------------------------------------------------------------------------! … … 212 284 CALL wrk_alloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 213 285 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 214 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 286 DO jl = 1, jpl 287 !$OMP PARALLEL DO schedule(static) private(jj,ji) 288 DO jj = 1, jpj 289 DO ji = 1, jpi 290 alb_ice(ji,jj,jl) = ( 1. - cldf_ice ) * zalb_cs(ji,jj,jl) + cldf_ice * zalb_os(ji,jj,jl) 291 END DO 292 END DO 293 END DO 215 294 CALL wrk_dealloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 216 295 … … 260 339 ! 261 340 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 341 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_t,zv_t,zmodt) 262 342 DO jj = 2, jpjm1 !* update the modulus of stress at ocean surface (T-point) 263 343 DO ji = fs_2, fs_jpim1 … … 274 354 CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. ) 275 355 ! 276 utau_oce(:,:) = utau(:,:) !* save the air-ocean stresses at ice time-step 277 vtau_oce(:,:) = vtau(:,:) 356 !$OMP PARALLEL DO schedule(static) private(jj,ji) 357 DO jj = 1, jpj 358 DO ji = 1, jpi 359 utau_oce(ji,jj) = utau(ji,jj) !* save the air-ocean stresses at ice time-step 360 vtau_oce(ji,jj) = vtau(ji,jj) 361 END DO 362 END DO 278 363 ! 279 364 ENDIF … … 281 366 ! !== every ocean time-step ==! 282 367 ! 368 !$OMP PARALLEL DO schedule(static) private(jj,ji,zat_u,zat_v,zutau_ice,zvtau_ice) 283 369 DO jj = 2, jpjm1 !* update the stress WITHOUT a ice-ocean rotation angle 284 370 DO ji = fs_2, fs_jpim1 ! Vect. Opt. … … 319 405 IF( lim_sbc_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' ) 320 406 ! 321 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case 322 sice_0(:,:) = sice 407 !$OMP PARALLEL 408 !$OMP DO schedule(static) private(jj,ji) 409 DO jj = 1, jpj 410 DO ji = 1, jpi 411 soce_0(ji,jj) = soce ! constant SSS and ice salinity used in levitating sea-ice case 412 sice_0(ji,jj) = sice 413 END DO 414 END DO 323 415 ! ! decrease ocean & ice reference salinities in the Baltic Sea area 324 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 325 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 326 soce_0(:,:) = 4._wp 327 sice_0(:,:) = 2._wp 328 END WHERE 416 !$OMP DO schedule(static) private(jj,ji) 417 DO jj = 1, jpj 418 DO ji = 1, jpi 419 IF ( 14._wp <= glamt(ji,jj) .AND. glamt(ji,jj) <= 32._wp .AND. & 420 & 54._wp <= gphit(ji,jj) .AND. gphit(ji,jj) <= 66._wp ) THEN 421 soce_0(ji,jj) = 4._wp 422 sice_0(ji,jj) = 2._wp 423 END IF 424 END DO 425 END DO 426 !$OMP END PARALLEL 329 427 ! 330 428 IF( .NOT. ln_rstart ) THEN 331 429 ! ! embedded sea ice 332 430 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 333 snwice_mass (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 334 snwice_mass_b(:,:) = snwice_mass(:,:) 431 !$OMP PARALLEL DO schedule(static) private(jj,ji) 432 DO jj = 1, jpj 433 DO ji = 1, jpi 434 snwice_mass (ji,jj) = tmask(ji,jj,1) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj) ) 435 snwice_mass_b(ji,jj) = snwice_mass(ji,jj) 436 END DO 437 END DO 335 438 ELSE 336 snwice_mass (:,:) = 0._wp ! no mass exchanges 337 snwice_mass_b(:,:) = 0._wp ! no mass exchanges 439 !$OMP PARALLEL DO schedule(static) private(jj,ji) 440 DO jj = 1, jpj 441 DO ji = 1, jpi 442 snwice_mass (ji,jj) = 0._wp ! no mass exchanges 443 snwice_mass_b(ji,jj) = 0._wp ! no mass exchanges 444 END DO 445 END DO 338 446 ENDIF 339 447 IF( nn_ice_embd == 2 ) THEN ! full embedment (case 2) deplete the initial ssh below sea-ice area 340 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 341 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 448 !$OMP PARALLEL DO schedule(static) private(jj,ji) 449 DO jj = 1, jpj 450 DO ji = 1, jpi 451 sshn(ji,jj) = sshn(ji,jj) - snwice_mass(ji,jj) * r1_rau0 452 sshb(ji,jj) = sshb(ji,jj) - snwice_mass(ji,jj) * r1_rau0 453 END DO 454 END DO 342 455 343 456 !!gm I really don't like this stuff here... Find a way to put that elsewhere or differently 344 457 !!gm 345 458 IF( .NOT.ln_linssh ) THEN 459 !$OMP PARALLEL 460 !$OMP DO schedule(static) private(jj,ji) 346 461 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 347 e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 348 e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 349 END DO 350 e3t_a(:,:,:) = e3t_b(:,:,:) 462 DO jj = 1, jpj 463 DO ji = 1, jpi 464 e3t_n(ji,jj,jk) = e3t_0(ji,jj,jk)*( 1._wp + sshn(ji,jj)*tmask(ji,jj,1)/(ht_0(ji,jj) + 1.0 - tmask(ji,jj,1)) ) 465 e3t_b(ji,jj,jk) = e3t_0(ji,jj,jk)*( 1._wp + sshb(ji,jj)*tmask(ji,jj,1)/(ht_0(ji,jj) + 1.0 - tmask(ji,jj,1)) ) 466 END DO 467 END DO 468 END DO 469 !$OMP DO schedule(static) private(jj,ji) 470 DO jk = 1,jpk 471 DO jj = 1, jpj 472 DO ji = 1, jpi 473 e3t_a(ji,jj,jk) = e3t_b(ji,jj,jk) 474 END DO 475 END DO 476 END DO 477 !$OMP END PARALLEL 351 478 ! Reconstruction of all vertical scale factors at now and before time-steps 352 479 ! ========================================================================= … … 368 495 ! ---------------------- 369 496 !!gm not sure of that.... 370 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 371 gdepw_n(:,:,1) = 0.0_wp 372 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 497 !$OMP PARALLEL 498 !$OMP DO schedule(static) private(jj,ji) 499 DO jj = 1, jpj 500 DO ji = 1, jpi 501 gdept_n(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) 502 gdepw_n(ji,jj,1) = 0.0_wp 503 gde3w_n(ji,jj,1) = gdept_n(ji,jj,1) - sshn(ji,jj) 504 END DO 505 END DO 373 506 DO jk = 2, jpk 374 gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 375 gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 376 gde3w_n(:,:,jk) = gdept_n(:,:,jk ) - sshn (:,:) 377 END DO 507 !$OMP DO schedule(static) private(jj,ji) 508 DO jj = 1, jpj 509 DO ji = 1, jpi 510 gdept_n(ji,jj,jk) = gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk) 511 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 512 gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk ) - sshn (ji,jj) 513 END DO 514 END DO 515 END DO 516 !$OMP END PARALLEL 378 517 ENDIF 379 518 ENDIF -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r7646 r7698 110 110 !---------------------------------------------! 111 111 IF( ln_limdyn ) THEN 112 zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 113 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 112 !$OMP PARALLEL 113 !$OMP DO schedule(static) private(jj,ji) 114 DO jj = 1, jpj 115 DO ji = 1, jpi 116 zu_io(ji,jj) = u_ice(ji,jj) - ssu_m(ji,jj) 117 zv_io(ji,jj) = v_ice(ji,jj) - ssv_m(ji,jj) 118 END DO 119 END DO 120 !$OMP DO schedule(static) private(jj,ji) 114 121 DO jj = 2, jpjm1 115 122 DO ji = fs_2, fs_jpim1 … … 119 126 END DO 120 127 END DO 128 !$OMP END PARALLEL 121 129 ELSE ! if no ice dynamics => transmit directly the atmospheric stress to the ocean 130 !$OMP PARALLEL DO schedule(static) private(jj,ji) 122 131 DO jj = 2, jpjm1 123 132 DO ji = fs_2, fs_jpim1 … … 133 142 ! Initialization and units change 134 143 !----------------------------------! 135 ftr_ice(:,:,:) = 0._wp ! part of solar radiation transmitted through the ice 144 !$OMP PARALLEL 145 DO jl = 1, jpl 146 !$OMP DO schedule(static) private(jj,ji) 147 DO jj = 1, jpj 148 DO ji = 1, jpi 149 ftr_ice(ji,jj,jl) = 0._wp ! part of solar radiation transmitted through the ice 150 END DO 151 END DO 152 END DO 136 153 137 154 ! Change the units of heat content; from J/m2 to J/m3 138 155 DO jl = 1, jpl 139 156 DO jk = 1, nlay_i 157 !$OMP DO schedule(static) private(jj,ji,rswitch) 140 158 DO jj = 1, jpj 141 159 DO ji = 1, jpi … … 147 165 END DO 148 166 DO jk = 1, nlay_s 167 !$OMP DO schedule(static) private(jj,ji,rswitch) 149 168 DO jj = 1, jpj 150 169 DO ji = 1, jpi … … 160 179 ! Partial computation of forcing for the thermodynamic sea ice model 161 180 !--------------------------------------------------------------------! 181 !$OMP DO schedule(static) private(jj,ji,rswitch,zqld,zqfr,zfric_u) 162 182 DO jj = 1, jpj 163 183 DO ji = 1, jpi … … 201 221 END DO 202 222 END DO 223 !$OMP END PARALLEL 203 224 204 225 ! In case we bypass open-water ice formation 205 IF( .NOT. ln_limdO ) qlead(:,:) = 0._wp 226 IF( .NOT. ln_limdO ) THEN 227 !$OMP PARALLEL DO schedule(static) private(jj,ji) 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 qlead(ji,jj) = 0._wp 231 END DO 232 END DO 233 END IF 206 234 ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere 207 IF( .NOT. ln_limdH ) hfx_in(:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 208 IF( .NOT. ln_limdH ) fhtur (:,:) = 0._wp ; fhld (:,:) = 0._wp 235 IF( .NOT. ln_limdH ) THEN 236 !$OMP PARALLEL DO schedule(static) private(jj,ji) 237 DO jj = 1, jpj 238 DO ji = 1, jpi 239 hfx_in(ji,jj) = pfrld(ji,jj) * ( qns_oce(ji,jj) + qsr_oce(ji,jj) ) + qemp_oce(ji,jj) 240 fhtur (ji,jj) = 0._wp 241 END DO 242 END DO 243 END IF 244 !$OMP PARALLEL 245 !$OMP DO schedule(static) private(jj,ji) 246 DO jj = 1, jpj 247 DO ji = 1, jpi 248 fhld (ji,jj) = 0._wp 249 END DO 250 END DO 209 251 210 252 ! --------------------------------------------------------------------- … … 214 256 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 215 257 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 258 !$OMP DO schedule(static) private(jj,ji) 216 259 DO jj = 1, jpj 217 260 DO ji = 1, jpi … … 223 266 END DO 224 267 END DO 268 !$OMP END PARALLEL 225 269 226 270 !------------------------------------------------------------------------------! … … 288 332 289 333 ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 334 !$OMP PARALLEL 290 335 DO jl = 1, jpl 291 336 DO jk = 1, nlay_i 292 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 337 !$OMP DO schedule(static) private(jj,ji) 338 DO jj = 1, jpj 339 DO ji = 1, jpi 340 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i 341 END DO 342 END DO 293 343 END DO 294 344 DO jk = 1, nlay_s 295 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s 296 END DO 297 END DO 298 299 ! Change thickness to volume 300 v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:) 301 v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:) 302 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 345 !$OMP DO schedule(static) private(jj,ji) 346 DO jj = 1, jpj 347 DO ji = 1, jpi 348 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_s(ji,jj,jl) * r1_nlay_s 349 END DO 350 END DO 351 END DO 352 END DO 353 354 ! Change thickness to volume 355 DO jl = 1, jpl 356 !$OMP DO schedule(static) private(jj,ji) 357 DO jj = 1, jpj 358 DO ji = 1, jpi 359 v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 360 v_s(ji,jj,jl) = ht_s(ji,jj,jl) * a_i(ji,jj,jl) 361 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 362 END DO 363 END DO 364 END DO 303 365 304 366 ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat) 305 367 DO jl = 1, jpl 368 !$OMP DO schedule(static) private(jj,ji,rswitch) 306 369 DO jj = 1, jpj 307 370 DO ji = 1, jpi … … 311 374 END DO 312 375 END DO 376 !$OMP END PARALLEL 313 377 314 378 CALL lim_var_zapsmall -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90
r7646 r7698 113 113 zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) ) 114 114 115 !$OMP PARALLEL 116 !$OMP DO schedule(static) private(jj,ji,zdfloe,zperi,zwlat) 115 117 DO jj = 1, jpj 116 118 DO ji = 1, jpi … … 135 137 !---------------------------------------------------------------------------------------------! 136 138 DO jl = jpl, 1, -1 139 !$OMP DO schedule(static) private(jj,ji,rswitch,zda) 137 140 DO jj = 1, jpj 138 141 DO ji = 1, jpi … … 163 166 164 167 ! total concentration 165 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 166 168 !$OMP DO schedule(static) private(jj,ji) 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 at_i(ji,jj) = 0._wp 172 END DO 173 END DO 174 DO jl = 1, jpl 175 !$OMP DO schedule(static) private(jj,ji) 176 DO jj = 1, jpj 177 DO ji = 1, jpi 178 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 179 END DO 180 END DO 181 END DO 167 182 ! --- ensure that ht_i = 0 where a_i = 0 --- 168 WHERE( a_i == 0._wp ) ht_i = 0._wp 183 DO jl = 1, jpl 184 !$OMP DO schedule(static) private(jj,ji) 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 IF(a_i(ji,jj,jl) == 0._wp) ht_i(ji,jj,jl) = 0._wp 188 END DO 189 END DO 190 END DO 191 !$OMP END PARALLEL 192 169 193 ! 170 194 CALL wrk_dealloc( jpi,jpj, zda_tot ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r7646 r7698 125 125 ! 2) Convert units for ice internal energy 126 126 !------------------------------------------------------------------------------| 127 !$OMP PARALLEL 127 128 DO jl = 1, jpl 128 129 DO jk = 1, nlay_i 130 !$OMP DO schedule(static) private(jj,ji,rswitch) 129 131 DO jj = 1, jpj 130 132 DO ji = 1, jpi … … 150 152 ! 151 153 152 zvrel(:,:) = 0._wp 153 154 ! Default new ice thickness 155 WHERE( qlead(:,:) < 0._wp ) ; hicol(:,:) = rn_hnewice 156 ELSEWHERE ; hicol(:,:) = 0._wp 157 END WHERE 154 !$OMP DO schedule(static) private(jj,ji) 155 DO jj = 1, jpj 156 DO ji = 1, jpi 157 zvrel(ji,jj) = 0._wp 158 END DO 159 END DO 160 161 !$OMP DO schedule(static) private(jj,ji) 162 DO jj = 1, jpj 163 DO ji = 1, jpi 164 ! Default new ice thickness 165 IF( qlead(ji,jj) < 0._wp ) THEN ; hicol(ji,jj) = rn_hnewice 166 ELSE ; hicol(ji,jj) = 0._wp 167 END IF 168 END DO 169 END DO 170 !$OMP END PARALLEL 158 171 159 172 IF( ln_frazil ) THEN … … 162 175 ! Physical constants 163 176 !-------------------- 164 hicol(:,:) = 0._wp165 177 166 178 zhicrit = 0.04 ! frazil ice thickness … … 169 181 zgamafr = 0.03 170 182 183 !$OMP PARALLEL 184 !$OMP DO schedule(static) private(jj,ji) 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 hicol(ji,jj) = 0._wp 188 END DO 189 END DO 190 191 !$OMP DO schedule(static) private(jj,ji,ztaux,ztauy,ztenagm,rswitch,zvfrx,zvfry,zvgx,zvgy,zvrel2,iter,zf,zfp) 171 192 DO jj = 2, jpjm1 172 193 DO ji = 2, jpim1 … … 226 247 END DO 227 248 END DO 249 !$OMP END PARALLEL 228 250 ! 229 251 CALL lbc_lnk( zvrel, 'T', 1. ) … … 430 452 431 453 DO jk = 1, nlay_i 454 !$OMP PARALLEL DO schedule(static) private(ji,jl,rswitch) 432 455 DO ji = 1, nbpac 433 456 jl = jcat(ji) … … 448 471 qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp 449 472 DO jk = 1, nlay_i 473 !$OMP PARALLEL DO schedule(static) private(ji) 450 474 DO ji = 1, nbpac 451 475 h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i … … 455 479 456 480 ! new volumes including lateral/bottom accretion + residual 481 !$OMP PARALLEL DO schedule(static) private(ji,rswitch,zv_newfra) 457 482 DO ji = 1, nbpac 458 483 rswitch = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) ) … … 472 497 !----------------- 473 498 DO jl = 1, jpl 499 !$OMP PARALLEL DO schedule(static) private(ji,zdv) 474 500 DO ji = 1, nbpac 475 501 zdv = zv_i_1d(ji,jl) - zv_b(ji,jl) … … 502 528 DO jl = 1, jpl 503 529 DO jk = 1, nlay_i 530 !$OMP PARALLEL DO schedule(static) private(jj,ji) 504 531 DO jj = 1, jpj 505 532 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r7646 r7698 114 114 zviold = v_i 115 115 zvsold = v_s 116 zsmvold(:,:) = SUM( smv_i(:,:,:), dim=3 ) 117 zeiold (:,:) = et_i 118 zesold (:,:) = et_s 119 120 !--- Thickness correction init. --- ! 121 zatold(:,:) = at_i 116 !$OMP PARALLEL 117 !$OMP DO schedule(static) private(jj,ji) 118 DO jj = 1, jpj 119 DO ji = 1, jpi 120 zsmvold(ji,jj) = 0._wp 121 END DO 122 END DO 122 123 DO jl = 1, jpl 124 !$OMP DO schedule(static) private(jj,ji) 125 DO jj = 1, jpj 126 DO ji = 1, jpi 127 zsmvold(ji,jj) = zsmvold(ji,jj) + smv_i(ji,jj,jl) 128 END DO 129 END DO 130 END DO 131 !$OMP DO schedule(static) private(jj,ji) 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 zeiold (ji,jj) = et_i(ji,jj) 135 zesold (ji,jj) = et_s(ji,jj) 136 137 !--- Thickness correction init. --- ! 138 zatold (ji,jj) = at_i(ji,jj) 139 END DO 140 END DO 141 DO jl = 1, jpl 142 !$OMP DO schedule(static) private(jj,ji,rswitch) 123 143 DO jj = 1, jpj 124 144 DO ji = 1, jpi … … 130 150 END DO 131 151 ! --- Record max of the surrounding ice thicknesses for correction in case advection creates ice too thick --- ! 132 zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:)133 152 DO jl = 1, jpl 153 !$OMP DO schedule(static) private(jj,ji) 154 DO jj = 1, jpj 155 DO ji = 1, jpi 156 zhimax(ji,jj,jl) = ht_i(ji,jj,jl) + ht_s(ji,jj,jl) 157 END DO 158 END DO 159 END DO 160 !$OMP END PARALLEL 161 DO jl = 1, jpl 162 !$OMP PARALLEL DO schedule(static) private(jj,ji) 134 163 DO jj = 2, jpjm1 135 164 DO ji = 2, jpim1 … … 173 202 zdt = rdt_ice / REAL(initad) 174 203 204 !$OMP PARALLEL 175 205 ! transport 176 zudy(:,:) = u_ice(:,:) * e2u(:,:) 177 zvdx(:,:) = v_ice(:,:) * e1v(:,:) 206 !$OMP DO schedule(static) private(jj,ji) 207 DO jj = 1, jpj 208 DO ji = 1, jpi 209 zudy(ji,jj) = u_ice(ji,jj) * e2u(ji,jj) 210 zvdx(ji,jj) = v_ice(ji,jj) * e1v(ji,jj) 211 END DO 212 END DO 178 213 179 214 ! define velocity for advection: u*grad(H) 215 !$OMP DO schedule(static) private(jj,ji) 180 216 DO jj = 2, jpjm1 181 217 DO ji = fs_2, fs_jpim1 … … 191 227 END DO 192 228 END DO 229 !$OMP END PARALLEL 193 230 194 231 ! advection … … 208 245 END DO 209 246 ! 210 at_i(:,:) = a_i(:,:,1) ! total ice fraction 247 !$OMP PARALLEL 248 !$OMP DO schedule(static) private(jj,ji) 249 DO jj = 1, jpj 250 DO ji = 1, jpi 251 at_i(ji,jj) = a_i(ji,jj,1) ! total ice fraction 252 END DO 253 END DO 211 254 DO jl = 2, jpl 212 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 213 END DO 255 !$OMP DO schedule(static) private(jj,ji) 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 259 END DO 260 END DO 261 END DO 262 !$OMP END PARALLEL 214 263 ! 215 264 CALL wrk_dealloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box ) … … 230 279 ENDIF 231 280 232 zarea(:,:) = e1e2t(:,:) 233 234 !------------------------- 235 ! transported fields 236 !------------------------- 237 z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:) ! Open water area 281 !$OMP PARALLEL 282 !$OMP DO schedule(static) private(jj,ji) 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 zarea(ji,jj) = e1e2t(ji,jj) 286 287 !------------------------- 288 ! transported fields 289 !------------------------- 290 z0opw(ji,jj,1) = ato_i(ji,jj) * e1e2t(ji,jj) ! Open water area 291 END DO 292 END DO 238 293 DO jl = 1, jpl 239 z0snw (:,:,jl) = v_s (:,:, jl) * e1e2t(:,:) ! Snow volume 240 z0ice(:,:,jl) = v_i (:,:, jl) * e1e2t(:,:) ! Ice volume 241 z0ai (:,:,jl) = a_i (:,:, jl) * e1e2t(:,:) ! Ice area 242 z0smi (:,:,jl) = smv_i(:,:, jl) * e1e2t(:,:) ! Salt content 243 z0oi (:,:,jl) = oa_i (:,:, jl) * e1e2t(:,:) ! Age content 244 z0es (:,:,jl) = e_s (:,:,1,jl) * e1e2t(:,:) ! Snow heat content 294 !$OMP DO schedule(static) private(jj,ji) 295 DO jj = 1, jpj 296 DO ji = 1, jpi 297 z0snw (ji,jj,jl) = v_s (ji,jj, jl) * e1e2t(ji,jj) ! Snow volume 298 z0ice(ji,jj,jl) = v_i (ji,jj, jl) * e1e2t(ji,jj) ! Ice volume 299 z0ai (ji,jj,jl) = a_i (ji,jj, jl) * e1e2t(ji,jj) ! Ice area 300 z0smi (ji,jj,jl) = smv_i(ji,jj, jl) * e1e2t(ji,jj) ! Salt content 301 z0oi (ji,jj,jl) = oa_i (ji,jj, jl) * e1e2t(ji,jj) ! Age content 302 z0es (ji,jj,jl) = e_s (ji,jj,1,jl) * e1e2t(ji,jj) ! Snow heat content 303 END DO 304 END DO 245 305 DO jk = 1, nlay_i 246 z0ei (:,:,jk,jl) = e_i (:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 247 END DO 248 END DO 306 !$OMP DO schedule(static) private(jj,ji) 307 DO jj = 1, jpj 308 DO ji = 1, jpi 309 z0ei (ji,jj,jk,jl) = e_i (ji,jj,jk,jl) * e1e2t(ji,jj) ! Ice heat content 310 END DO 311 END DO 312 END DO 313 END DO 314 !$OMP END PARALLEL 249 315 250 316 … … 336 402 ! Recover the properties from their contents 337 403 !------------------------------------------- 338 ato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) 404 !$OMP PARALLEL 405 !$OMP DO schedule(static) private(jj,ji) 406 DO jj = 1, jpj 407 DO ji = 1, jpi 408 ato_i(ji,jj) = z0opw(ji,jj,1) * r1_e1e2t(ji,jj) 409 END DO 410 END DO 339 411 DO jl = 1, jpl 340 v_i (:,:, jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) 341 v_s (:,:, jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) 342 smv_i(:,:, jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) 343 oa_i (:,:, jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) 344 a_i (:,:, jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) 345 e_s (:,:,1,jl) = z0es (:,:,jl) * r1_e1e2t(:,:) 412 !$OMP DO schedule(static) private(jj,ji) 413 DO jj = 1, jpj 414 DO ji = 1, jpi 415 v_i (ji,jj, jl) = z0ice(ji,jj,jl) * r1_e1e2t(ji,jj) 416 v_s (ji,jj, jl) = z0snw(ji,jj,jl) * r1_e1e2t(ji,jj) 417 smv_i(ji,jj, jl) = z0smi(ji,jj,jl) * r1_e1e2t(ji,jj) 418 oa_i (ji,jj, jl) = z0oi (ji,jj,jl) * r1_e1e2t(ji,jj) 419 a_i (ji,jj, jl) = z0ai (ji,jj,jl) * r1_e1e2t(ji,jj) 420 e_s (ji,jj,1,jl) = z0es (ji,jj,jl) * r1_e1e2t(ji,jj) 421 END DO 422 END DO 346 423 DO jk = 1, nlay_i 347 e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) 348 END DO 349 END DO 350 351 at_i(:,:) = a_i(:,:,1) ! total ice fraction 424 !$OMP DO schedule(static) private(jj,ji) 425 DO jj = 1, jpj 426 DO ji = 1, jpi 427 e_i(ji,jj,jk,jl) = z0ei(ji,jj,jk,jl) * r1_e1e2t(ji,jj) 428 END DO 429 END DO 430 END DO 431 END DO 432 433 !$OMP DO schedule(static) private(jj,ji) 434 DO jj = 1, jpj 435 DO ji = 1, jpi 436 at_i(ji,jj) = a_i(ji,jj,1) ! total ice fraction 437 END DO 438 END DO 352 439 DO jl = 2, jpl 353 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 354 END DO 440 !$OMP DO schedule(static) private(jj,ji) 441 DO jj = 1, jpj 442 DO ji = 1, jpi 443 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 444 END DO 445 END DO 446 END DO 447 !$OMP END PARALLEL 355 448 356 449 CALL wrk_dealloc( jpi,jpj, zarea ) … … 369 462 ! mask eddy diffusivity coefficient at ocean U- and V-points 370 463 jm=1 464 !$OMP PARALLEL 371 465 DO jl = 1, jpl 466 !$OMP DO schedule(static) private(jj,ji) 372 467 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 373 468 DO ji = 1 , fs_jpim1 … … 379 474 END DO 380 475 381 zhdfptab(:,:,jm)= a_i (:,:, jl); jm = jm + 1 382 zhdfptab(:,:,jm)= v_i (:,:, jl); jm = jm + 1 383 zhdfptab(:,:,jm)= v_s (:,:, jl); jm = jm + 1 384 zhdfptab(:,:,jm)= smv_i(:,:, jl); jm = jm + 1 385 zhdfptab(:,:,jm)= oa_i (:,:, jl); jm = jm + 1 386 zhdfptab(:,:,jm)= e_s (:,:,1,jl); jm = jm + 1 476 !$OMP DO schedule(static) private(jj,ji) 477 DO jj = 1, jpj 478 DO ji = 1, jpi 479 zhdfptab(ji,jj,jm)= a_i (ji,jj, jl) 480 END DO 481 END DO 482 jm = jm + 1 483 !$OMP DO schedule(static) private(jj,ji) 484 DO jj = 1, jpj 485 DO ji = 1, jpi 486 zhdfptab(ji,jj,jm)= v_i (ji,jj, jl) 487 END DO 488 END DO 489 jm = jm + 1 490 !$OMP DO schedule(static) private(jj,ji) 491 DO jj = 1, jpj 492 DO ji = 1, jpi 493 zhdfptab(ji,jj,jm)= v_s (ji,jj, jl) 494 END DO 495 END DO 496 jm = jm + 1 497 !$OMP DO schedule(static) private(jj,ji) 498 DO jj = 1, jpj 499 DO ji = 1, jpi 500 zhdfptab(ji,jj,jm)= smv_i(ji,jj, jl) 501 END DO 502 END DO 503 jm = jm + 1 504 !$OMP DO schedule(static) private(jj,ji) 505 DO jj = 1, jpj 506 DO ji = 1, jpi 507 zhdfptab(ji,jj,jm)= oa_i (ji,jj, jl) 508 END DO 509 END DO 510 jm = jm + 1 511 !$OMP DO schedule(static) private(jj,ji) 512 DO jj = 1, jpj 513 DO ji = 1, jpi 514 zhdfptab(ji,jj,jm)= e_s (ji,jj,1,jl) 515 END DO 516 END DO 517 jm = jm + 1 387 518 ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased) 388 519 ! zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1 389 520 ! zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1 390 521 DO jk = 1, nlay_i 391 zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 522 !$OMP DO schedule(static) private(jj,ji) 523 DO jj = 1, jpj 524 DO ji = 1, jpi 525 zhdfptab(ji,jj,jm)=e_i(ji,jj,jk,jl) 526 END DO 527 END DO 528 jm= jm+1 392 529 END DO 393 530 END DO … … 395 532 ! --- Prepare diffusion for open water area --- ! 396 533 ! mask eddy diffusivity coefficient at ocean U- and V-points 534 !$OMP DO schedule(static) private(jj,ji) 397 535 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 398 536 DO ji = 1 , fs_jpim1 … … 404 542 END DO 405 543 ! 406 zhdfptab(:,:,jm)= ato_i (:,:); 544 !$OMP DO schedule(static) private(jj,ji) 545 DO jj = 1, jpj 546 DO ji = 1, jpi 547 zhdfptab(ji,jj,jm)= ato_i (ji,jj); 548 END DO 549 END DO 550 !$OMP END PARALLEL 407 551 408 552 ! --- Apply diffusion --- ! … … 411 555 ! --- Recover properties --- ! 412 556 jm=1 557 !$OMP PARALLEL 413 558 DO jl = 1, jpl 414 a_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 415 v_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 416 v_s (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 417 smv_i(:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 418 oa_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 419 e_s (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 559 !$OMP DO schedule(static) private(jj,ji) 560 DO jj = 1, jpj 561 DO ji = 1, jpi 562 a_i (ji,jj, jl)=zhdfptab(ji,jj,jm) 563 END DO 564 END DO 565 jm = jm + 1 566 !$OMP DO schedule(static) private(jj,ji) 567 DO jj = 1, jpj 568 DO ji = 1, jpi 569 v_i (ji,jj, jl)=zhdfptab(ji,jj,jm) 570 END DO 571 END DO 572 jm = jm + 1 573 !$OMP DO schedule(static) private(jj,ji) 574 DO jj = 1, jpj 575 DO ji = 1, jpi 576 v_s (ji,jj, jl)=zhdfptab(ji,jj,jm) 577 END DO 578 END DO 579 jm = jm + 1 580 !$OMP DO schedule(static) private(jj,ji) 581 DO jj = 1, jpj 582 DO ji = 1, jpi 583 smv_i(ji,jj, jl)=zhdfptab(ji,jj,jm) 584 END DO 585 END DO 586 jm = jm + 1 587 !$OMP DO schedule(static) private(jj,ji) 588 DO jj = 1, jpj 589 DO ji = 1, jpi 590 oa_i (ji,jj, jl)=zhdfptab(ji,jj,jm) 591 END DO 592 END DO 593 jm = jm + 1 594 !$OMP DO schedule(static) private(jj,ji) 595 DO jj = 1, jpj 596 DO ji = 1, jpi 597 e_s (ji,jj,1,jl)=zhdfptab(ji,jj,jm) 598 END DO 599 END DO 600 jm = jm + 1 601 420 602 ! Sample of adding more variables to apply lim_hdf 421 603 ! variable_1 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 422 604 ! variable_2 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 423 605 DO jk = 1, nlay_i 424 e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 425 END DO 426 END DO 427 ato_i (:,:) = zhdfptab(:,:,jm) 606 !$OMP DO schedule(static) private(jj,ji) 607 DO jj = 1, jpj 608 DO ji = 1, jpi 609 e_i(ji,jj,jk,jl) = zhdfptab(ji,jj,jm) 610 END DO 611 END DO 612 jm = jm + 1 613 END DO 614 END DO 615 !$OMP DO schedule(static) private(jj,ji) 616 DO jj = 1, jpj 617 DO ji = 1, jpi 618 ato_i (ji,jj) = zhdfptab(ji,jj,jm) 619 END DO 620 END DO 621 !$OMP END PARALLEL 428 622 429 623 ENDIF 430 624 431 625 ! --- diags --- 626 !$OMP PARALLEL DO schedule(static) private(jj,ji) 432 627 DO jj = 1, jpj 433 628 DO ji = 1, jpi … … 446 641 447 642 !--- Thickness correction in case too high --- ! 643 !$OMP PARALLEL 448 644 DO jl = 1, jpl 645 !$OMP DO schedule(static) private(jj,ji,rswitch,zdv) 449 646 DO jj = 1, jpj 450 647 DO ji = 1, jpi … … 481 678 482 679 ! Force the upper limit of ht_i to always be < hi_max (99 m). 680 !$OMP DO schedule(static) private(jj,ji,rswitch) 483 681 DO jj = 1, jpj 484 682 DO ji = 1, jpi … … 488 686 END DO 489 687 END DO 688 !$OMP END PARALLEL 490 689 491 690 ENDIF … … 495 694 !------------------------------------------------------------ 496 695 ! 497 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 696 !$OMP PARALLEL 697 !$OMP DO schedule(static) private(jj,ji) 698 DO jj = 1, jpj 699 DO ji = 1, jpi 700 at_i(ji,jj) = 0._wp 701 END DO 702 END DO 703 DO jl = 1, jpl 704 !$OMP DO schedule(static) private(jj,ji) 705 DO jj = 1, jpj 706 DO ji = 1, jpi 707 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 708 END DO 709 END DO 710 END DO 711 !$OMP END PARALLEL 712 498 713 IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2 499 714 DO jl = 1, jpl 715 !$OMP PARALLEL DO schedule(static) private(jj,ji,rswitch,zda) 500 716 DO jj = 1, jpj 501 717 DO ji = 1, jpi … … 510 726 511 727 ! --- agglomerate variables ----------------- 512 vt_i(:,:) = SUM( v_i(:,:,:), dim=3 ) 513 vt_s(:,:) = SUM( v_s(:,:,:), dim=3 ) 514 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 728 !$OMP PARALLEL 729 !$OMP DO schedule(static) private(jj,ji) 730 DO jj = 1, jpj 731 DO ji = 1, jpi 732 vt_i(ji,jj) = 0._wp 733 vt_s(ji,jj) = 0._wp 734 at_i(ji,jj) = 0._wp 735 END DO 736 END DO 737 DO jl = 1, jpl 738 !$OMP DO schedule(static) private(jj,ji) 739 DO jj = 1, jpj 740 DO ji = 1, jpi 741 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) 742 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) 743 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 744 END DO 745 END DO 746 END DO 515 747 516 748 ! --- open water = 1 if at_i=0 -------------------------------- 517 WHERE( at_i == 0._wp ) ato_i = 1._wp 749 !$OMP DO schedule(static) private(jj,ji) 750 DO jj = 1, jpj 751 DO ji = 1, jpi 752 IF( at_i(ji,jj) == 0._wp ) ato_i(ji,jj) = 1._wp 753 END DO 754 END DO 755 !$OMP END PARALLEL 518 756 519 757 ! conservation test -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r7646 r7698 70 70 ! ice concentration should not exceed amax 71 71 !----------------------------------------------------- 72 at_i(:,:) = 0._wp 72 !$OMP PARALLEL 73 !$OMP DO schedule(static) private(jj, ji) 74 DO jj = 1, jpj 75 DO ji = 1, jpi 76 at_i(ji,jj) = 0._wp 77 END DO 78 END DO 73 79 DO jl = 1, jpl 74 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 80 !$OMP DO schedule(static) private(jj, ji) 81 DO jj = 1, jpj 82 DO ji = 1, jpi 83 at_i(ji,jj) = a_i(ji,jj,jl) + at_i(ji,jj) 84 END DO 85 END DO 75 86 END DO 76 87 77 88 DO jl = 1, jpl 89 !$OMP DO schedule(static) private(jj, ji) 78 90 DO jj = 1, jpj 79 91 DO ji = 1, jpi … … 85 97 END DO 86 98 END DO 99 !$OMP END PARALLEL 87 100 88 101 !--------------------- … … 91 104 IF ( nn_icesal == 2 ) THEN 92 105 DO jl = 1, jpl 106 !$OMP PARALLEL DO schedule(static) private(jj,ji,zsal,rswitch) 93 107 DO jj = 1, jpj 94 108 DO ji = 1, jpi … … 118 132 ! ------------------------------------------------- 119 133 DO jl = 1, jpl 120 afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 134 !$OMP PARALLEL DO schedule(static) private(jj, ji) 135 DO jj = 1, jpj 136 DO ji = 1, jpi 137 afx_dyn(ji,jj) = afx_dyn(ji,jj) + ( a_i(ji,jj,jl) - a_i_b(ji,jj,jl) ) * r1_rdtice 138 END DO 139 END DO 121 140 END DO 122 141 142 !$OMP PARALLEL DO schedule(static) private(jj, ji) 123 143 DO jj = 1, jpj 124 144 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r7646 r7698 71 71 ! Constrain the thickness of the smallest category above himin 72 72 !---------------------------------------------------------------------- 73 !$OMP PARALLEL 74 !$OMP DO schedule(static) private(jj,ji,rswitch) 73 75 DO jj = 1, jpj 74 76 DO ji = 1, jpi … … 85 87 ! ice concentration should not exceed amax 86 88 !----------------------------------------------------- 87 at_i(:,:) = 0._wp 89 !$OMP DO schedule(static) private(jj, ji) 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 at_i(ji,jj) = 0._wp 93 END DO 94 END DO 88 95 DO jl = 1, jpl 89 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 96 !$OMP DO schedule(static) private(jj, ji) 97 DO jj = 1, jpj 98 DO ji = 1, jpi 99 at_i(ji,jj) = a_i(ji,jj,jl) + at_i(ji,jj) 100 END DO 101 END DO 90 102 END DO 91 103 92 104 DO jl = 1, jpl 105 !$OMP DO schedule(static) private(jj, ji) 93 106 DO jj = 1, jpj 94 107 DO ji = 1, jpi … … 100 113 END DO 101 114 END DO 115 !$OMP END PARALLEL 102 116 103 117 !--------------------- … … 106 120 IF ( nn_icesal == 2 ) THEN 107 121 DO jl = 1, jpl 122 !$OMP PARALLEL DO schedule(static) private(jj,ji,zsal,rswitch) 108 123 DO jj = 1, jpj 109 124 DO ji = 1, jpi … … 134 149 ! Ice drift 135 150 !------------ 151 !$OMP PARALLEL DO schedule(static) private(jj, ji) 136 152 DO jj = 2, jpjm1 137 153 DO ji = 2, jpim1 … … 148 164 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 149 165 !mask velocities 150 u_ice(:,:) = u_ice(:,:) * umask(:,:,1) 151 v_ice(:,:) = v_ice(:,:) * vmask(:,:,1) 166 !$OMP PARALLEL 167 !$OMP DO schedule(static) private(jj, ji) 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 u_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) 171 v_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 172 END DO 173 END DO 152 174 153 175 ! ------------------------------------------------- … … 155 177 ! ------------------------------------------------- 156 178 DO jl = 1, jpl 157 oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday ! ice natural aging 158 afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 179 !$OMP DO schedule(static) private(jj, ji) 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 oa_i(ji,jj,jl) = oa_i(ji,jj,jl) + a_i(ji,jj,jl) * rdt_ice / rday ! ice natural aging 183 afx_thd(ji,jj) = afx_thd(ji,jj) + ( a_i(ji,jj,jl) - a_i_b(ji,jj,jl) ) * r1_rdtice 184 END DO 185 END DO 159 186 END DO 160 187 afx_tot = afx_thd + afx_dyn 161 188 189 !$OMP DO schedule(static) private(jj, ji) 162 190 DO jj = 1, jpj 163 191 DO ji = 1, jpi … … 173 201 END DO 174 202 END DO 203 !$OMP END PARALLEL 175 204 176 205 ! conservation test -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r7646 r7698 80 80 !!------------------------------------------------------------------ 81 81 INTEGER, INTENT( in ) :: kn ! =1 at_i & vt only ; = what is needed 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_s, ze_i 82 83 ! 83 84 INTEGER :: ji, jj, jk, jl ! dummy loop indices 84 85 !!------------------------------------------------------------------ 85 86 87 CALL wrk_alloc( jpi, jpj, nlay_s, ze_s ) 88 CALL wrk_alloc( jpi, jpj, nlay_i, ze_i ) 86 89 ! integrated values 87 vt_i (:,:) = SUM( v_i, dim=3 ) 88 vt_s (:,:) = SUM( v_s, dim=3 ) 89 at_i (:,:) = SUM( a_i, dim=3 ) 90 et_s(:,:) = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 ) 91 et_i(:,:) = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 ) 90 !$OMP PARALLEL 91 !$OMP DO schedule(static) private(jj, ji) 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 vt_i (ji,jj) = 0._wp 95 vt_s (ji,jj) = 0._wp 96 at_i (ji,jj) = 0._wp 97 et_s(ji,jj) = 0._wp 98 et_i(ji,jj) = 0._wp 99 END DO 100 END DO 101 DO jl = 1, jpl 102 !$OMP DO schedule(static) private(jj, ji) 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 vt_i (ji,jj) = vt_i (ji,jj) + v_i (ji,jj,jl) 106 vt_s (ji,jj) = vt_s (ji,jj) + v_s (ji,jj,jl) 107 at_i (ji,jj) = at_i (ji,jj) + a_i (ji,jj,jl) 108 END DO 109 END DO 110 END DO 111 DO jk = 1, nlay_s 112 !$OMP DO schedule(static) private(jj, ji) 113 DO jj = 1, jpj 114 DO ji = 1, jpi 115 ze_s(ji,jj,jk) = 0._wp 116 END DO 117 END DO 118 END DO 119 DO jk = 1, nlay_i 120 !$OMP DO schedule(static) private(jj, ji) 121 DO jj = 1, jpj 122 DO ji = 1, jpi 123 ze_i(ji,jj,jk) = 0._wp 124 END DO 125 END DO 126 END DO 127 DO jl = 1, jpl 128 DO jk = 1, nlay_s 129 !$OMP DO schedule(static) private(jj, ji) 130 DO jj = 1, jpj 131 DO ji = 1, jpi 132 ze_s(ji,jj,jk) = ze_s(ji,jj,jk) + e_s(ji,jj,jk,jl) 133 END DO 134 END DO 135 END DO 136 END DO 137 DO jl = 1, jpl 138 DO jk = 1, nlay_i 139 !$OMP DO schedule(static) private(jj, ji) 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 ze_i(ji,jj,jk) = ze_i(ji,jj,jk) + e_i(ji,jj,jk,jl) 143 END DO 144 END DO 145 END DO 146 END DO 147 DO jk = 1, nlay_s 148 !$OMP DO schedule(static) private(jj, ji) 149 DO jj = 1, jpj 150 DO ji = 1, jpi 151 et_s(ji,jj) = et_s(ji,jj) + ze_s(ji,jj,jk) 152 END DO 153 END DO 154 END DO 155 DO jk = 1, nlay_i 156 !$OMP DO schedule(static) private(jj, ji) 157 DO jj = 1, jpj 158 DO ji = 1, jpi 159 et_i(ji,jj) = et_i(ji,jj) + ze_i(ji,jj,jk) 160 END DO 161 END DO 162 END DO 92 163 93 164 ! open water fraction 165 !$OMP DO schedule(static) private(jj, ji) 94 166 DO jj = 1, jpj 95 167 DO ji = 1, jpi … … 97 169 END DO 98 170 END DO 171 !$OMP END PARALLEL 99 172 100 173 IF( kn > 1 ) THEN 101 174 175 !$OMP PARALLEL 102 176 ! mean ice/snow thickness 177 !$OMP DO schedule(static) private(jj,ji,rswitch) 103 178 DO jj = 1, jpj 104 179 DO ji = 1, jpi … … 110 185 111 186 ! mean temperature (K), salinity and age 112 smt_i(:,:) = 0._wp 113 tm_i(:,:) = 0._wp 114 tm_su(:,:) = 0._wp 115 om_i (:,:) = 0._wp 187 !$OMP DO schedule(static) private(jj,ji) 188 DO jj = 1, jpj 189 DO ji = 1, jpi 190 smt_i(ji,jj) = 0._wp 191 tm_i(ji,jj) = 0._wp 192 tm_su(ji,jj) = 0._wp 193 om_i (ji,jj) = 0._wp 194 ENDDO 195 ENDDO 116 196 DO jl = 1, jpl 117 197 198 !$OMP DO schedule(static) private(jj,ji,rswitch) 118 199 DO jj = 1, jpj 119 200 DO ji = 1, jpi … … 125 206 126 207 DO jk = 1, nlay_i 208 !$OMP DO schedule(static) private(jj,ji,rswitch) 127 209 DO jj = 1, jpj 128 210 DO ji = 1, jpi … … 136 218 END DO 137 219 END DO 220 !$OMP END PARALLEL 138 221 tm_i = tm_i + rt0 139 222 tm_su = tm_su + rt0 140 223 ! 141 224 ENDIF 225 CALL wrk_dealloc( jpi, jpj, nlay_s, ze_s ) 226 CALL wrk_dealloc( jpi, jpj, nlay_i, ze_i ) 142 227 ! 143 228 END SUBROUTINE lim_var_agg … … 159 244 ! Ice thickness, snow thickness, ice salinity, ice age 160 245 !------------------------------------------------------- 161 DO jl = 1, jpl 246 !$OMP PARALLEL 247 DO jl = 1, jpl 248 !$OMP DO schedule(static) private(jj,ji,rswitch) 162 249 DO jj = 1, jpj 163 250 DO ji = 1, jpi … … 168 255 END DO 169 256 ! Force the upper limit of ht_i to always be < hi_max (99 m). 257 !$OMP DO schedule(static) private(jj,ji,rswitch) 170 258 DO jj = 1, jpj 171 259 DO ji = 1, jpi … … 177 265 178 266 DO jl = 1, jpl 267 !$OMP DO schedule(static) private(jj,ji,rswitch) 179 268 DO jj = 1, jpj 180 269 DO ji = 1, jpi … … 188 277 IF( nn_icesal == 2 )THEN 189 278 DO jl = 1, jpl 279 !$OMP DO schedule(static) private(jj,ji,rswitch) 190 280 DO jj = 1, jpj 191 281 DO ji = 1, jpi … … 198 288 END DO 199 289 ENDIF 290 !$OMP END PARALLEL 200 291 201 292 CALL lim_var_salprof ! salinity profile … … 204 295 ! Ice temperatures 205 296 !------------------- 297 !$OMP PARALLEL 206 298 DO jl = 1, jpl 207 299 DO jk = 1, nlay_i 300 !$OMP DO schedule(static) private(jj,ji,rswitch,zq_i,ztmelts,zaaa,zbbb,zccc,zdiscrim) 208 301 DO jj = 1, jpj 209 302 DO ji = 1, jpi … … 231 324 DO jl = 1, jpl 232 325 DO jk = 1, nlay_s 326 !$OMP DO schedule(static) private(jj,ji,rswitch,zq_s) 233 327 DO jj = 1, jpj 234 328 DO ji = 1, jpi … … 245 339 246 340 ! integrated values 247 vt_i (:,:) = SUM( v_i, dim=3 ) 248 vt_s (:,:) = SUM( v_s, dim=3 ) 249 at_i (:,:) = SUM( a_i, dim=3 ) 250 341 !$OMP DO schedule(static) private(jj, ji) 342 DO jj = 1, jpj 343 DO ji = 1, jpi 344 vt_i (ji,jj) = 0._wp 345 vt_s (ji,jj) = 0._wp 346 at_i (ji,jj) = 0._wp 347 END DO 348 END DO 349 DO jl = 1, jpl 350 !$OMP DO schedule(static) private(jj, ji) 351 DO jj = 1, jpj 352 DO ji = 1, jpi 353 vt_i (ji,jj) = vt_i (ji,jj) + v_i (ji,jj,jl) 354 vt_s (ji,jj) = vt_s (ji,jj) + v_s (ji,jj,jl) 355 at_i (ji,jj) = at_i (ji,jj) + a_i (ji,jj,jl) 356 END DO 357 END DO 358 END DO 359 !$OMP END PARALLEL 251 360 ! 252 361 END SUBROUTINE lim_var_glo2eqv … … 300 409 !--------------------------------------- 301 410 IF( nn_icesal == 1 ) THEN 302 s_i (:,:,:,:) = rn_icesal 303 sm_i(:,:,:) = rn_icesal 411 !$OMP PARALLEL 412 DO jl = 1, jpl 413 DO jk = 1, nlay_i 414 !$OMP DO schedule(static) private(jj, ji) 415 DO jj = 1, jpj 416 DO ji = 1, jpi 417 s_i (ji,jj,jk,jl) = rn_icesal 418 END DO 419 END DO 420 END DO 421 END DO 422 DO jl = 1, jpl 423 !$OMP DO schedule(static) private(jj, ji) 424 DO jj = 1, jpj 425 DO ji = 1, jpi 426 sm_i(ji,jj,jl) = rn_icesal 427 END DO 428 END DO 429 END DO 430 !$OMP END PARALLEL 304 431 ENDIF 305 432 … … 309 436 IF( nn_icesal == 2 ) THEN 310 437 ! 311 DO jk = 1, nlay_i 312 s_i(:,:,jk,:) = sm_i(:,:,:) 438 !$OMP PARALLEL 439 DO jl = 1, jpl 440 DO jk = 1, nlay_i 441 !$OMP DO schedule(static) private(jj, ji) 442 DO jj = 1, jpj 443 DO ji = 1, jpi 444 s_i(ji,jj,jk,jl) = sm_i(ji,jj,jl) 445 END DO 446 END DO 447 !$OMP END DO NOWAIT 448 END DO 313 449 END DO 314 450 ! 315 451 DO jl = 1, jpl ! Slope of the linear profile 452 !$OMP DO schedule(static) private(jj,ji,rswitch) 316 453 DO jj = 1, jpj 317 454 DO ji = 1, jpi … … 320 457 END DO 321 458 END DO 459 !$OMP END DO NOWAIT 322 460 END DO 323 461 ! … … 325 463 zfac1 = zsi1 / ( zsi1 - zsi0 ) 326 464 ! 327 zalpha(:,:,:) = 0._wp328 465 DO jl = 1, jpl 466 !$OMP DO schedule(static) private(jj, ji) 467 DO jj = 1, jpj 468 DO ji = 1, jpi 469 zalpha(ji,jj,jl) = 0._wp 470 END DO 471 END DO 472 END DO 473 DO jl = 1, jpl 474 !$OMP DO schedule(static) private(jj,ji,zswi0,zswi01,rswitch) 329 475 DO jj = 1, jpj 330 476 DO ji = 1, jpi … … 345 491 DO jl = 1, jpl 346 492 DO jk = 1, nlay_i 493 !$OMP DO schedule(static) private(jj,ji,zs_zero) 347 494 DO jj = 1, jpj 348 495 DO ji = 1, jpi … … 357 504 END DO 358 505 END DO 506 !$OMP END PARALLEL 359 507 ! 360 508 ENDIF ! nn_icesal … … 366 514 IF( nn_icesal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 367 515 ! 368 sm_i(:,:,:) = 2.30_wp 516 !$OMP PARALLEL 517 DO jl = 1, jpl 518 !$OMP DO schedule(static) private(jj,ji) 519 DO jj = 1, jpj 520 DO ji = 1, jpi 521 sm_i(ji,jj,jl) = 2.30_wp 522 END DO 523 END DO 524 !$OMP END DO NOWAIT 525 END DO 369 526 ! 370 527 DO jl = 1, jpl … … 372 529 zargtemp = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 373 530 zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) ) 374 s_i(:,:,jk,jl) = zsal 375 END DO 376 END DO 531 !$OMP DO schedule(static) private(jj,ji) 532 DO jj = 1, jpj 533 DO ji = 1, jpi 534 s_i(ji,jj,jk,jl) = zsal 535 END DO 536 END DO 537 END DO 538 END DO 539 !$OMP END PARALLEL 377 540 ! 378 541 ENDIF ! nn_icesal … … 396 559 !!------------------------------------------------------------------ 397 560 ! 398 bvm_i(:,:) = 0._wp 399 bv_i (:,:,:) = 0._wp 561 !$OMP PARALLEL 562 !$OMP DO schedule(static) private(jj,ji) 563 DO jj = 1, jpj 564 DO ji = 1, jpi 565 bvm_i(ji,jj) = 0._wp 566 END DO 567 END DO 568 DO jl = 1, jpl 569 !$OMP DO schedule(static) private(jj,ji) 570 DO jj = 1, jpj 571 DO ji = 1, jpi 572 bv_i (ji,jj,jl) = 0._wp 573 END DO 574 END DO 575 END DO 400 576 DO jl = 1, jpl 401 577 DO jk = 1, nlay_i 578 !$OMP DO schedule(static) private(jj,ji,rswitch) 402 579 DO jj = 1, jpj 403 580 DO ji = 1, jpi … … 409 586 END DO 410 587 588 !$OMP DO schedule(static) private(jj,ji,rswitch) 411 589 DO jj = 1, jpj 412 590 DO ji = 1, jpi … … 416 594 END DO 417 595 END DO 596 !$OMP END PARALLEL 418 597 ! 419 598 END SUBROUTINE lim_var_bv … … 518 697 REAL(wp) :: zsal, zvi, zvs, zei, zes 519 698 !!------------------------------------------------------------------- 520 at_i (:,:) = 0._wp 521 DO jl = 1, jpl 522 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 699 !$OMP PARALLEL 700 !$OMP DO schedule(static) private(jj,ji) 701 DO jj = 1, jpj 702 DO ji = 1, jpi 703 at_i (ji,jj) = 0._wp 704 END DO 705 END DO 706 DO jl = 1, jpl 707 !$OMP DO schedule(static) private(jj,ji) 708 DO jj = 1, jpj 709 DO ji = 1, jpi 710 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 711 END DO 712 END DO 523 713 END DO 524 714 … … 529 719 !----------------------------------------------------------------- 530 720 DO jk = 1, nlay_i 721 !$OMP DO schedule(static) private(jj,ji,rswitch,zei) 531 722 DO jj = 1 , jpj 532 723 DO ji = 1 , jpi … … 545 736 END DO 546 737 738 !$OMP DO schedule(static) private(jj,ji,rswitch,zsal,zvi,zvs,zes) 547 739 DO jj = 1 , jpj 548 740 DO ji = 1 , jpi … … 583 775 584 776 ! to be sure that at_i is the sum of a_i(jl) 585 at_i (:,:) = 0._wp 586 DO jl = 1, jpl 587 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 777 !$OMP DO schedule(static) private(jj,ji) 778 DO jj = 1, jpj 779 DO ji = 1, jpi 780 at_i (ji,jj) = 0._wp 781 END DO 782 END DO 783 DO jl = 1, jpl 784 !$OMP DO schedule(static) private(jj,ji) 785 DO jj = 1, jpj 786 DO ji = 1, jpi 787 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 788 END DO 789 END DO 588 790 END DO 589 791 590 792 ! open water = 1 if at_i=0 793 !$OMP DO schedule(static) private(jj,ji,rswitch) 591 794 DO jj = 1, jpj 592 795 DO ji = 1, jpi … … 595 798 END DO 596 799 END DO 800 !$OMP END PARALLEL 597 801 598 802 ! -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r7646 r7698 74 74 75 75 ! tresholds for outputs 76 !$OMP PARALLEL 77 !$OMP DO schedule(static) private(jj,ji) 76 78 DO jj = 1, jpj 77 79 DO ji = 1, jpi … … 80 82 END DO 81 83 DO jl = 1, jpl 84 !$OMP DO schedule(static) private(jj,ji) 82 85 DO jj = 1, jpj 83 86 DO ji = 1, jpi … … 86 89 END DO 87 90 END DO 91 !$OMP END PARALLEL 88 92 ! 89 93 ! fluxes … … 104 108 ! velocity 105 109 IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN 110 !$OMP PARALLEL DO schedule(static) private(jj,ji,z2da,z2db) 106 111 DO jj = 2 , jpjm1 107 112 DO ji = 2 , jpim1 … … 173 178 174 179 IF ( iom_use( "vfxthin" ) ) THEN ! ice production for open water + thin ice (<20cm) => comparable to observations 175 WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog 176 ELSEWHERE ; z2d = 0._wp 177 END WHERE 180 !$OMP PARALLEL DO schedule(static) private(jj,ji) 181 DO jj = 1, jpj 182 DO ji = 1, jpi 183 IF (htm_i(ji,jj) < 0.2 .AND. htm_i(ji,jj) > 0. ) THEN 184 z2d(ji,jj) = wfx_bog(ji,jj) 185 ELSE 186 z2d(ji,jj) = 0._wp 187 END IF 188 END DO 189 END DO 178 190 CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp ) 179 191 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r7646 r7698 156 156 USE lib_mpp, ONLY: ctl_warn, mpp_sum 157 157 ! 158 INTEGER :: ji, jj ! dummy loop indices 158 159 INTEGER :: bdy_oce_alloc 159 160 !!---------------------------------------------------------------------- … … 163 164 ! 164 165 ! Initialize masks 165 bdytmask(:,:) = 1._wp 166 bdyumask(:,:) = 1._wp 167 bdyvmask(:,:) = 1._wp 166 !$OMP PARALLEL DO schedule(static) private(jj,ji) 167 DO jj = 1, jpj 168 DO ji = 1, jpi 169 bdytmask(ji,jj) = 1._wp 170 bdyumask(ji,jj) = 1._wp 171 bdyvmask(ji,jj) = 1._wp 172 END DO 173 END DO 168 174 ! 169 175 IF( lk_mpp ) CALL mpp_sum ( bdy_oce_alloc ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r6140 r7698 62 62 INTEGER :: ios ! Local integer output status for namelist read 63 63 INTEGER :: ierror ! Local integer for memory allocation 64 INTEGER :: ji, jj, jk 64 65 ! 65 66 NAMELIST/nam_dia25h/ ln_dia25h … … 134 135 ! ------------------------- ! 135 136 cnt_25h = 1 ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible) 136 tn_25h(:,:,:) = tsb(:,:,:,jp_tem) 137 sn_25h(:,:,:) = tsb(:,:,:,jp_sal) 138 sshn_25h(:,:) = sshb(:,:) 139 un_25h(:,:,:) = ub(:,:,:) 140 vn_25h(:,:,:) = vb(:,:,:) 141 wn_25h(:,:,:) = wn(:,:,:) 142 avt_25h(:,:,:) = avt(:,:,:) 143 avm_25h(:,:,:) = avm(:,:,:) 137 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 138 DO jk = 1, jpk 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 tn_25h(ji,jj,jk) = tsb(ji,jj,jk,jp_tem) 142 sn_25h(ji,jj,jk) = tsb(ji,jj,jk,jp_sal) 143 sshn_25h(ji,jj) = sshb(ji,jj) 144 un_25h(ji,jj,jk) = ub(ji,jj,jk) 145 vn_25h(ji,jj,jk) = vb(ji,jj,jk) 146 wn_25h(ji,jj,jk) = wn(ji,jj,jk) 147 avt_25h(ji,jj,jk) = avt(ji,jj,jk) 148 avm_25h(ji,jj,jk) = avm(ji,jj,jk) 144 149 # if defined key_zdfgls || defined key_zdftke 145 en_25h(:,:,:) = en(:,:,:)150 en_25h(ji,jj,jk) = en(ji,jj,jk) 146 151 #endif 147 152 # if defined key_zdfgls 148 rmxln_25h(:,:,:) = mxln(:,:,:) 149 #endif 153 rmxln_25h(ji,jj,jk) = mxln(ji,jj,jk) 154 #endif 155 END DO 156 END DO 157 END DO 150 158 #if defined key_lim3 || defined key_lim2 151 159 CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') … … 223 231 ENDIF 224 232 225 tn_25h(:,:,:) = tn_25h(:,:,:) + tsn(:,:,:,jp_tem) 226 sn_25h(:,:,:) = sn_25h(:,:,:) + tsn(:,:,:,jp_sal) 227 sshn_25h(:,:) = sshn_25h(:,:) + sshn (:,:) 228 un_25h(:,:,:) = un_25h(:,:,:) + un(:,:,:) 229 vn_25h(:,:,:) = vn_25h(:,:,:) + vn(:,:,:) 230 wn_25h(:,:,:) = wn_25h(:,:,:) + wn(:,:,:) 231 avt_25h(:,:,:) = avt_25h(:,:,:) + avt(:,:,:) 232 avm_25h(:,:,:) = avm_25h(:,:,:) + avm(:,:,:) 233 !$OMP PARALLEL 234 !$OMP DO schedule(static) private(jj, ji) 235 DO jj = 1, jpj 236 DO ji = 1, jpi 237 sshn_25h(ji,jj) = sshn_25h(ji,jj) + sshn (ji,jj) 238 END DO 239 END DO 240 !$OMP END DO NOWAIT 241 !$OMP DO schedule(static) private(jk, jj, ji) 242 DO jk = 1, jpk 243 DO jj = 1, jpj 244 DO ji = 1, jpi 245 tn_25h(ji,jj,jk) = tn_25h(ji,jj,jk) + tsn(ji,jj,jk,jp_tem) 246 sn_25h(ji,jj,jk) = sn_25h(ji,jj,jk) + tsn(ji,jj,jk,jp_sal) 247 un_25h(ji,jj,jk) = un_25h(ji,jj,jk) + un(ji,jj,jk) 248 vn_25h(ji,jj,jk) = vn_25h(ji,jj,jk) + vn(ji,jj,jk) 249 wn_25h(ji,jj,jk) = wn_25h(ji,jj,jk) + wn(ji,jj,jk) 250 avt_25h(ji,jj,jk) = avt_25h(ji,jj,jk) + avt(ji,jj,jk) 251 avm_25h(ji,jj,jk) = avm_25h(ji,jj,jk) + avm(ji,jj,jk) 233 252 # if defined key_zdfgls || defined key_zdftke 234 en_25h(:,:,:) = en_25h(:,:,:) + en(:,:,:)253 en_25h(ji,jj,jk) = en_25h(ji,jj,jk) + en(ji,jj,jk) 235 254 #endif 236 255 # if defined key_zdfgls 237 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) + mxln(:,:,:) 238 #endif 256 rmxln_25h(ji,jj,jk) = rmxln_25h(ji,jj,jk) + mxln(ji,jj,jk) 257 #endif 258 END DO 259 END DO 260 END DO 261 !$OMP END PARALLEL 239 262 cnt_25h = cnt_25h + 1 240 263 … … 253 276 ENDIF 254 277 255 tn_25h(:,:,:) = tn_25h(:,:,:) / 25.0_wp 256 sn_25h(:,:,:) = sn_25h(:,:,:) / 25.0_wp 257 sshn_25h(:,:) = sshn_25h(:,:) / 25.0_wp 258 un_25h(:,:,:) = un_25h(:,:,:) / 25.0_wp 259 vn_25h(:,:,:) = vn_25h(:,:,:) / 25.0_wp 260 wn_25h(:,:,:) = wn_25h(:,:,:) / 25.0_wp 261 avt_25h(:,:,:) = avt_25h(:,:,:) / 25.0_wp 262 avm_25h(:,:,:) = avm_25h(:,:,:) / 25.0_wp 278 !$OMP PARALLEL 279 !$OMP DO schedule(static) private(jj, ji) 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 sshn_25h(ji,jj) = sshn_25h(ji,jj) / 25.0_wp 283 END DO 284 END DO 285 !$OMP END DO NOWAIT 286 !$OMP DO schedule(static) private(jk, jj, ji) 287 DO jk = 1, jpk 288 DO jj = 1, jpj 289 DO ji = 1, jpi 290 tn_25h(ji,jj,jk) = tn_25h(ji,jj,jk) / 25.0_wp 291 sn_25h(ji,jj,jk) = sn_25h(ji,jj,jk) / 25.0_wp 292 un_25h(ji,jj,jk) = un_25h(ji,jj,jk) / 25.0_wp 293 vn_25h(ji,jj,jk) = vn_25h(ji,jj,jk) / 25.0_wp 294 wn_25h(ji,jj,jk) = wn_25h(ji,jj,jk) / 25.0_wp 295 avt_25h(ji,jj,jk) = avt_25h(ji,jj,jk) / 25.0_wp 296 avm_25h(ji,jj,jk) = avm_25h(ji,jj,jk) / 25.0_wp 263 297 # if defined key_zdfgls || defined key_zdftke 264 en_25h(:,:,:) = en_25h(:,:,:) / 25.0_wp298 en_25h(ji,jj,jk) = en_25h(ji,jj,jk) / 25.0_wp 265 299 #endif 266 300 # if defined key_zdfgls 267 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) / 25.0_wp 268 #endif 301 rmxln_25h(ji,jj,jk) = rmxln_25h(ji,jj,jk) / 25.0_wp 302 #endif 303 END DO 304 END DO 305 END DO 306 !$OMP END PARALLEL 269 307 270 308 IF (lwp) WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output' 271 309 zmdi=1.e+20 !missing data indicator for masking 272 310 ! write tracers (instantaneous) 273 zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 311 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 312 DO jk = 1, jpk 313 DO jj = 1, jpj 314 DO ji = 1, jpi 315 zw3d(ji,jj,jk) = tn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 316 END DO 317 END DO 318 END DO 274 319 CALL iom_put("temper25h", zw3d) ! potential temperature 275 zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 320 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 321 DO jk = 1, jpk 322 DO jj = 1, jpj 323 DO ji = 1, jpi 324 zw3d(ji,jj,jk) = sn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 325 END DO 326 END DO 327 END DO 276 328 CALL iom_put( "salin25h", zw3d ) ! salinity 277 zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 329 !$OMP PARALLEL DO schedule(static) private(jj, ji) 330 DO jj = 1, jpj 331 DO ji = 1, jpi 332 zw2d(ji,jj) = sshn_25h(ji,jj)*tmask(ji,jj,1) + zmdi*(1.0-tmask(ji,jj,1)) 333 END DO 334 END DO 278 335 CALL iom_put( "ssh25h", zw2d ) ! sea surface 279 336 280 337 281 338 ! Write velocities (instantaneous) 282 zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:)) 339 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 340 DO jk = 1, jpk 341 DO jj = 1, jpj 342 DO ji = 1, jpi 343 zw3d(ji,jj,jk) = un_25h(ji,jj,jk)*umask(ji,jj,jk) + zmdi*(1.0-umask(ji,jj,jk)) 344 END DO 345 END DO 346 END DO 283 347 CALL iom_put("vozocrtx25h", zw3d) ! i-current 284 zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:)) 348 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 349 DO jk = 1, jpk 350 DO jj = 1, jpj 351 DO ji = 1, jpi 352 zw3d(ji,jj,jk) = vn_25h(ji,jj,jk)*vmask(ji,jj,jk) + zmdi*(1.0-vmask(ji,jj,jk)) 353 END DO 354 END DO 355 END DO 285 356 CALL iom_put("vomecrty25h", zw3d ) ! j-current 286 287 zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 357 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 358 DO jk = 1, jpk 359 DO jj = 1, jpj 360 DO ji = 1, jpi 361 zw3d(ji,jj,jk) = wn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 362 END DO 363 END DO 364 END DO 288 365 CALL iom_put("vomecrtz25h", zw3d ) ! k-current 289 zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 366 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 367 DO jk = 1, jpk 368 DO jj = 1, jpj 369 DO ji = 1, jpi 370 zw3d(ji,jj,jk) = avt_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 371 END DO 372 END DO 373 END DO 290 374 CALL iom_put("avt25h", zw3d ) ! diffusivity 291 zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 375 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 376 DO jk = 1, jpk 377 DO jj = 1, jpj 378 DO ji = 1, jpi 379 zw3d(ji,jj,jk) = avm_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 380 END DO 381 END DO 382 END DO 292 383 CALL iom_put("avm25h", zw3d) ! viscosity 293 384 #if defined key_zdftke || defined key_zdfgls 294 zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 385 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 386 DO jk = 1, jpk 387 DO jj = 1, jpj 388 DO ji = 1, jpi 389 zw3d(ji,jj,jk) = en_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 390 END DO 391 END DO 392 END DO 295 393 CALL iom_put("tke25h", zw3d) ! tke 296 394 #endif 297 395 #if defined key_zdfgls 298 zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 396 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 397 DO jk = 1, jpk 398 DO jj = 1, jpj 399 DO ji = 1, jpi 400 zw3d(ji,jj,jk) = rmxln_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 401 END DO 402 END DO 403 END DO 299 404 CALL iom_put( "mxln25h",zw3d) 300 405 #endif 301 406 302 407 ! After the write reset the values to cnt=1 and sum values equal current value 303 tn_25h(:,:,:) = tsn(:,:,:,jp_tem) 304 sn_25h(:,:,:) = tsn(:,:,:,jp_sal) 305 sshn_25h(:,:) = sshn (:,:) 306 un_25h(:,:,:) = un(:,:,:) 307 vn_25h(:,:,:) = vn(:,:,:) 308 wn_25h(:,:,:) = wn(:,:,:) 309 avt_25h(:,:,:) = avt(:,:,:) 310 avm_25h(:,:,:) = avm(:,:,:) 408 !$OMP PARALLEL 409 !$OMP DO schedule(static) private(jj, ji) 410 DO jj = 1, jpj 411 DO ji = 1, jpi 412 sshn_25h(ji,jj) = sshn (ji,jj) 413 END DO 414 END DO 415 !$OMP END DO NOWAIT 416 !$OMP DO schedule(static) private(jk, jj, ji) 417 DO jk = 1, jpk 418 DO jj = 1, jpj 419 DO ji = 1, jpi 420 tn_25h(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) 421 sn_25h(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) 422 un_25h(ji,jj,jk) = un(ji,jj,jk) 423 vn_25h(ji,jj,jk) = vn(ji,jj,jk) 424 wn_25h(ji,jj,jk) = wn(ji,jj,jk) 425 avt_25h(ji,jj,jk) = avt(ji,jj,jk) 426 avm_25h(ji,jj,jk) = avm(ji,jj,jk) 311 427 # if defined key_zdfgls || defined key_zdftke 312 en_25h(:,:,:) = en(:,:,:)428 en_25h(ji,jj,jk) = en(ji,jj,jk) 313 429 #endif 314 430 # if defined key_zdfgls 315 rmxln_25h(:,:,:) = mxln(:,:,:) 316 #endif 431 rmxln_25h(ji,jj,jk) = mxln(ji,jj,jk) 432 #endif 433 END DO 434 END DO 435 END DO 436 !$OMP END PARALLEL 317 437 cnt_25h = 1 318 438 IF (lwp) WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r7646 r7698 89 89 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 90 90 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 91 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 91 !$OMP PARALLEL DO schedule(static) private(jj, ji) 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 zarea_ssh(ji,jj) = area(ji,jj) * sshn(ji,jj) 95 END DO 96 END DO 92 97 ENDIF 93 98 ! … … 106 111 IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN 107 112 ! 108 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 109 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 113 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 114 DO jk = 1, jpk 115 DO jj = 1, jpj 116 DO ji = 1, jpi 117 ztsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) ! thermosteric ssh 118 ztsn(ji,jj,jk,jp_sal) = sn0(ji,jj,jk) 119 END DO 120 END DO 121 END DO 110 122 CALL eos( ztsn, zrhd, gdept_n(:,:,:) ) ! now in situ density using initial salinity 111 123 ! 112 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 124 !$OMP PARALLEL 125 !$OMP DO schedule(static) private(jj, ji) 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 zbotpres(ji,jj) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 129 END DO 130 END DO 113 131 DO jk = 1, jpkm1 114 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 115 END DO 132 !$OMP DO schedule(static) private(jj, ji) 133 DO jj = 1, jpj 134 DO ji = 1, jpi 135 zbotpres(ji,jj) = zbotpres(ji,jj) + e3t_n(ji,jj,jk) * zrhd(ji,jj,jk) 136 END DO 137 END DO 138 END DO 139 !$OMP END PARALLEL 116 140 IF( ln_linssh ) THEN 117 141 IF( ln_isfcav ) THEN 142 !$OMP PARALLEL DO schedule(static) private(jj, ji) 118 143 DO ji = 1, jpi 119 144 DO jj = 1, jpj … … 122 147 END DO 123 148 ELSE 124 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 149 !$OMP PARALLEL DO schedule(static) private(jj, ji) 150 DO ji = 1, jpi 151 DO jj = 1, jpj 152 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,1) 153 END DO 154 END DO 125 155 END IF 126 156 !!gm … … 128 158 !!gm 129 159 END IF 160 ! 161 zarho = SUM( area(:,:) * zbotpres(:,:) ) 130 162 ! 131 zarho = SUM( area(:,:) * zbotpres(:,:) )132 163 IF( lk_mpp ) CALL mpp_sum( zarho ) 133 164 zssh_steric = - zarho / area_tot … … 136 167 ! ! steric sea surface height 137 168 CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) ) ! now in situ and potential density 138 zrhop(:,:,jpk) = 0._wp 169 !$OMP PARALLEL DO schedule(static) private(jj, ji) 170 DO jj = 1, jpj 171 DO ji = 1, jpi 172 zrhop(ji,jj,jpk) = 0._wp 173 END DO 174 END DO 139 175 CALL iom_put( 'rhop', zrhop ) 140 176 ! 141 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 177 !$OMP PARALLEL 178 !$OMP DO schedule(static) private(jj, ji) 179 DO jj = 1, jpj 180 DO ji = 1, jpi 181 zbotpres(ji,jj) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 182 END DO 183 END DO 142 184 DO jk = 1, jpkm1 143 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 185 !$OMP DO schedule(static) private(jj, ji) 186 DO jj = 1, jpj 187 DO ji = 1, jpi 188 zbotpres(ji,jj) = zbotpres(ji,jj) + e3t_n(ji,jj,jk) * zrhd(ji,jj,jk) 189 END DO 190 END DO 144 191 END DO 145 192 IF( ln_linssh ) THEN 146 193 IF ( ln_isfcav ) THEN 194 !$OMP DO schedule(static) private(jj, ji) 147 195 DO ji = 1,jpi 148 196 DO jj = 1,jpj … … 151 199 END DO 152 200 ELSE 153 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 201 !$OMP DO schedule(static) private(jj, ji) 202 DO jj = 1, jpj 203 DO ji = 1, jpi 204 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,1) 205 END DO 206 END DO 154 207 END IF 155 208 END IF 209 !$OMP END PARALLEL 156 210 ! 157 zarho = SUM( area(:,:) * zbotpres(:,:) ) 211 zarho = SUM( area(:,:) * zbotpres(:,:) ) 158 212 IF( lk_mpp ) CALL mpp_sum( zarho ) 159 213 zssh_steric = - zarho / area_tot … … 162 216 ! ! ocean bottom pressure 163 217 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 164 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 218 !$OMP PARALLEL DO schedule(static) private(jj, ji) 219 DO jj = 1, jpj 220 DO ji = 1, jpi 221 zbotpres(ji,jj) = zztmp * ( zbotpres(ji,jj) + sshn(ji,jj) + thick0(ji,jj) ) 222 END DO 223 END DO 165 224 CALL iom_put( 'botpres', zbotpres ) 166 225 ! … … 213 272 ! work is not being done against stratification 214 273 CALL wrk_alloc( jpi, jpj, zpe ) 215 zpe(:,:) = 0._wp 274 !$OMP PARALLEL DO schedule(static) private(jj,ji) 275 DO jj = 1, jpj 276 DO ji = 1, jpi 277 zpe(ji,jj) = 0._wp 278 END DO 279 END DO 216 280 IF( lk_zdfddm ) THEN 281 !$OMP PARALLEL DO schedule(static) private(ji,jj,jk,zrw,zaw,zbw) 217 282 DO ji=1,jpi 218 283 DO jj=1,jpj … … 232 297 ENDDO 233 298 ELSE 299 !$OMP PARALLEL DO schedule(static) private(ji,jj,jk) 234 300 DO ji = 1, jpi 235 301 DO jj = 1, jpj … … 323 389 INTEGER :: ik 324 390 INTEGER :: ji, jj, jk ! dummy loop indices 325 REAL(wp) :: zztmp 391 REAL(wp) :: zztmp, zsum 326 392 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 327 393 ! … … 341 407 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 342 408 343 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 409 !$OMP PARALLEL DO schedule(static) private(jj, ji) 410 DO jj = 1, jpj 411 DO ji = 1, jpi 412 area(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj) 413 END DO 414 END DO 344 415 345 416 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot ) 346 417 347 418 vol0 = 0._wp 348 thick0(:,:) = 0._wp 419 !$OMP PARALLEL 420 !$OMP DO schedule(static) private(jj, ji) 421 DO jj = 1, jpj 422 DO ji = 1, jpi 423 thick0(ji,jj) = 0._wp 424 END DO 425 END DO 349 426 DO jk = 1, jpkm1 350 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 351 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 352 END DO 427 !$OMP DO schedule(static) private(jj, ji, zsum) 428 DO jj = 1, jpj 429 DO ji = 1, jpi 430 zsum = area (ji,jj) * tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 431 END DO 432 END DO 433 vol0 = vol0 + zsum 434 !$OMP DO schedule(static) private(jj, ji) 435 DO jj = 1, jpj 436 DO ji = 1, jpi 437 thick0(ji,jj) = thick0(ji,jj) + tmask_i(ji,jj) * tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 438 END DO 439 END DO 440 END DO 441 !$OMP END PARALLEL 353 442 IF( lk_mpp ) CALL mpp_sum( vol0 ) 354 443 … … 358 447 CALL iom_close( inum ) 359 448 360 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 361 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 449 !$OMP PARALLEL 450 !$OMP DO schedule(static) private(jk, jj, ji) 451 DO jk = 1, jpk 452 DO jj = 1, jpj 453 DO ji = 1, jpi 454 sn0(ji,jj,jk) = 0.5_wp * ( zsaldta(ji,jj,jk,1) + zsaldta(ji,jj,jk,2) ) 455 sn0(ji,jj,jk) = sn0(ji,jj,jk) * tmask(ji,jj,jk) 456 END DO 457 END DO 458 END DO 362 459 IF( ln_zps ) THEN ! z-coord. partial steps 460 !$OMP DO schedule(static) private(jj, ji, ik, zztmp) 363 461 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 364 462 DO ji = 1, jpi … … 371 469 END DO 372 470 ENDIF 471 !$OMP END PARALLEL 373 472 ! 374 473 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90
r6140 r7698 71 71 72 72 ! calculate Courant numbers 73 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 73 74 DO jk = 1, jpk 74 75 DO jj = 1, jpj … … 172 173 !!---------------------------------------------------------------------- 173 174 175 INTEGER :: ji, jj, jk ! dummy loop indices 174 176 175 177 IF( nn_diacfl == 1 ) THEN … … 181 183 182 184 ALLOCATE( zcu_cfl(jpi, jpj, jpk), zcv_cfl(jpi, jpj, jpk), zcw_cfl(jpi, jpj, jpk) ) 183 184 zcu_cfl(:,:,:)=0.0 185 zcv_cfl(:,:,:)=0.0 186 zcw_cfl(:,:,:)=0.0 187 185 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 186 DO jk = 1, jpk 187 DO jj = 1, jpj 188 DO ji = 1, jpi 189 zcu_cfl(ji,jj,jk)=0.0 190 zcv_cfl(ji,jj,jk)=0.0 191 zcw_cfl(ji,jj,jk)=0.0 192 END DO 193 END DO 194 END DO 188 195 IF( lwp ) THEN 189 196 WRITE(numout,*) -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r7646 r7698 88 88 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 ) 89 89 ! 90 tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ; 91 tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ; 90 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 91 DO jk = 1, jpk 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 tsn(ji,jj,jk,1) = tsn(ji,jj,jk,1) * tmask(ji,jj,jk) ; tsb(ji,jj,jk,1) = tsb(ji,jj,jk,1) * tmask(ji,jj,jk) 95 tsn(ji,jj,jk,2) = tsn(ji,jj,jk,2) * tmask(ji,jj,jk) ; tsb(ji,jj,jk,2) = tsb(ji,jj,jk,2) * tmask(ji,jj,jk) 96 END DO 97 END DO 98 END DO 92 99 ! ------------------------- ! 93 100 ! 1 - Trends due to forcing ! … … 108 115 IF( ln_linssh ) THEN 109 116 IF( ln_isfcav ) THEN 117 !$OMP PARALLEL DO schedule(static) private(jj,ji) 110 118 DO ji=1,jpi 111 119 DO jj=1,jpj … … 115 123 END DO 116 124 ELSE 117 z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) 118 z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) 125 !$OMP PARALLEL DO schedule(static) private(jj,ji) 126 DO ji=1,jpi 127 DO jj=1,jpj 128 z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,1) * tsb(ji,jj,1,jp_tem) 129 z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,1) * tsb(ji,jj,1,jp_sal) 130 END DO 131 END DO 119 132 END IF 120 133 z_wn_trd_t = - glob_sum( z2d0 ) … … 145 158 IF( ln_linssh ) THEN 146 159 IF( ln_isfcav ) THEN 160 !$OMP PARALLEL DO schedule(static) private(jj,ji) 147 161 DO ji = 1, jpi 148 162 DO jj = 1, jpj … … 152 166 END DO 153 167 ELSE 154 z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) 155 z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 168 !$OMP PARALLEL DO schedule(static) private(jj,ji) 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,1,jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) ) 172 z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,1,jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) ) 173 END DO 174 END DO 156 175 END IF 157 176 z_ssh_hc = glob_sum_full( z2d0 ) … … 275 294 IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 276 295 IF(lwp) WRITE(numout,*) '~~~~~~~' 277 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 278 ssh_ini(:,:) = sshn(:,:) ! initial ssh 296 !$OMP PARALLEL 297 !$OMP DO schedule(static) private(jj,ji) 298 DO jj = 1, jpj 299 DO ji = 1, jpi 300 surf_ini(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj) ! initial ocean surface 301 ssh_ini(ji,jj) = sshn(ji,jj) ! initial ssh 302 END DO 303 END DO 304 !$OMP DO schedule(static) private(jk,jj,ji) 279 305 DO jk = 1, jpk 280 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 281 e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors 282 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content 283 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content 306 DO jj = 1, jpj 307 DO ji = 1, jpi 308 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 309 e3t_ini (ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) ! initial vertical scale factors 310 hc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) ! initial heat content 311 sc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) ! initial salt content 312 END DO 313 END DO 284 314 END DO 315 !$OMP END PARALLEL 285 316 frc_v = 0._wp ! volume trend due to forcing 286 317 frc_t = 0._wp ! heat content - - - - … … 288 319 IF( ln_linssh ) THEN 289 320 IF ( ln_isfcav ) THEN 321 !$OMP PARALLEL DO schedule(static) private(jj,ji) 290 322 DO ji=1,jpi 291 323 DO jj=1,jpj … … 295 327 ENDDO 296 328 ELSE 297 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh 298 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh 329 !$OMP PARALLEL DO schedule(static) private(jj,ji) 330 DO jj = 1, jpj 331 DO ji = 1, jpi 332 ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,1,jp_tem) * sshn(ji,jj) ! initial heat content in ssh 333 ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,1,jp_sal) * sshn(ji,jj) ! initial salt content in ssh 334 ENDDO 335 ENDDO 299 336 END IF 300 337 frc_wn_t = 0._wp ! initial heat content misfit due to free surface … … 345 382 INTEGER :: ierror ! local integer 346 383 INTEGER :: ios 384 INTEGER :: ji, jj, jk ! dummy loop indices 347 385 !! 348 386 NAMELIST/namhsb/ ln_diahsb … … 384 422 ! 2 - Time independant variables and file opening ! 385 423 ! ----------------------------------------------- ! 386 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 424 !$OMP PARALLEL DO schedule(static) private(jj,ji) 425 DO jj = 1, jpj 426 DO ji = 1, jpi 427 surf(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) ! masked surface grid cell area 428 END DO 429 END DO 387 430 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 388 431 -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r7646 r7698 66 66 !!---------------------------------------------------------------------- 67 67 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 68 !! $Id$ 68 !! $Id$ 69 69 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 70 70 !!---------------------------------------------------------------------- … … 384 384 !! ** Purpose : Initialization, namelist read 385 385 !!---------------------------------------------------------------------- 386 INTEGER :: jn 386 INTEGER :: jn, jj, ji ! local integers 387 387 INTEGER :: inum, ierr ! local integers 388 388 INTEGER :: ios ! Local integer output status for namelist read … … 434 434 CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) ) ! Indian basin 435 435 CALL iom_close( inum ) 436 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 437 WHERE( gphit(:,:) < -30._wp) ; btm30(:,:) = 0._wp ! mask out Southern Ocean 438 ELSE WHERE ; btm30(:,:) = ssmask(:,:) 439 END WHERE 436 !$OMP PARALLEL DO schedule(static) private(jj,ji) 437 DO jj = 1, jpj 438 DO ji = 1, jpi 439 btmsk(ji,jj,5) = MAX ( btmsk(ji,jj,3), btmsk(ji,jj,4) ) ! Indo-Pacific basin 440 IF( gphit(ji,jj) < -30._wp) THEN ; btm30(ji,jj) = 0._wp ! mask out Southern Ocean 441 ELSE ; btm30(ji,jj) = ssmask(ji,jj) 442 END IF 443 END DO 444 END DO 440 445 ENDIF 441 446 442 btmsk(:,:,1) = tmask_i(:,:) ! global ocean 447 !$OMP PARALLEL 448 !$OMP DO schedule(static) private(jj,ji) 449 DO jj = 1, jpj 450 DO ji = 1, jpi 451 btmsk(ji,jj,1) = tmask_i(ji,jj) ! global ocean 452 END DO 453 END DO 443 454 444 455 DO jn = 1, nptr 445 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 456 !$OMP DO schedule(static) private(jj,ji) 457 DO jj = 1, jpj 458 DO ji = 1, jpi 459 btmsk(ji,jj,jn) = btmsk(ji,jj,jn) * tmask_i(ji,jj) ! interior domain only 460 END DO 461 END DO 446 462 END DO 447 463 448 464 ! Initialise arrays to zero because diatpr is called before they are first calculated 449 465 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 450 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 451 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 452 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 453 htr_ove(:,:) = 0._wp ; str_ove(:,:) = 0._wp 454 htr_btr(:,:) = 0._wp ; str_btr(:,:) = 0._wp 455 ! 466 !$OMP DO schedule(static) private(jj,ji) 467 DO jj = 1, jpj 468 DO ji = 1, jpi 469 htr_adv(ji,jj) = 0._wp ; str_adv(ji,jj) = 0._wp 470 htr_ldf(ji,jj) = 0._wp ; str_ldf(ji,jj) = 0._wp 471 htr_eiv(ji,jj) = 0._wp ; str_eiv(ji,jj) = 0._wp 472 htr_ove(ji,jj) = 0._wp ; str_ove(ji,jj) = 0._wp 473 htr_btr(ji,jj) = 0._wp ; str_btr(ji,jj) = 0._wp 474 END DO 475 END DO 476 ! 477 !$OMP END PARALLEL 456 478 ENDIF 457 479 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r7646 r7698 161 161 CALL iom_put( "sst", tsn(:,:,1,jp_tem) ) ! surface temperature 162 162 IF ( iom_use("sbt") ) THEN 163 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 163 164 DO jj = 1, jpj 164 165 DO ji = 1, jpi … … 173 174 CALL iom_put( "sss", tsn(:,:,1,jp_sal) ) ! surface salinity 174 175 IF ( iom_use("sbs") ) THEN 176 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 175 177 DO jj = 1, jpj 176 178 DO ji = 1, jpi … … 183 185 184 186 IF ( iom_use("taubot") ) THEN ! bottom stress 185 z2d(:,:) = 0._wp 187 !$OMP PARALLEL 188 !$OMP DO schedule(static) private(jj, ji) 189 DO jj = 1, jpj 190 DO ji = 1, jpi 191 z2d(ji,jj) = 0._wp 192 END DO 193 END DO 194 !$OMP DO schedule(static) private(jj, ji, zztmpx,zztmpy) 186 195 DO jj = 2, jpjm1 187 196 DO ji = fs_2, fs_jpim1 ! vector opt. … … 194 203 ENDDO 195 204 ENDDO 205 !$OMP END PARALLEL 196 206 CALL lbc_lnk( z2d, 'T', 1. ) 197 207 CALL iom_put( "taubot", z2d ) … … 201 211 CALL iom_put( "ssu", un(:,:,1) ) ! surface i-current 202 212 IF ( iom_use("sbu") ) THEN 213 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 203 214 DO jj = 1, jpj 204 215 DO ji = 1, jpi … … 213 224 CALL iom_put( "ssv", vn(:,:,1) ) ! surface j-current 214 225 IF ( iom_use("sbv") ) THEN 226 !$OMP PARALLEL DO schedule(static) private(jj, ji,jkbot) 215 227 DO jj = 1, jpj 216 228 DO ji = 1, jpi … … 225 237 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 226 238 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 227 z2d(:,:) = rau0 * e1e2t(:,:) 239 !$OMP PARALLEL 240 !$OMP DO schedule(static) private(jj, ji) 241 DO jj = 1, jpj 242 DO ji = 1, jpi 243 z2d(ji,jj) = rau0 * e1e2t(ji,jj) 244 END DO 245 END DO 246 !$OMP DO schedule(static) private(jk,jj,ji) 228 247 DO jk = 1, jpk 229 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 230 END DO 248 DO jj = 1, jpj 249 DO ji = 1, jpi 250 z3d(ji,jj,jk) = wn(ji,jj,jk) * z2d(ji,jj) 251 END DO 252 END DO 253 END DO 254 !$OMP END PARALLEL 231 255 CALL iom_put( "w_masstr" , z3d ) 232 256 IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) … … 241 265 242 266 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 267 !$OMP PARALLEL DO schedule(static) private(jj, ji, zztmp, zztmpx, zztmpy) 243 268 DO jj = 2, jpjm1 ! sst gradient 244 269 DO ji = fs_2, fs_jpim1 ! vector opt. … … 252 277 CALL lbc_lnk( z2d, 'T', 1. ) 253 278 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 254 z2d(:,:) = SQRT( z2d(:,:) ) 279 !$OMP PARALLEL DO schedule(static) private(jj, ji) 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 z2d(ji,jj) = SQRT( z2d(ji,jj) ) 283 END DO 284 END DO 255 285 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 256 286 ENDIF … … 258 288 ! clem: heat and salt content 259 289 IF( iom_use("heatc") ) THEN 260 z2d(:,:) = 0._wp 290 !$OMP PARALLEL 291 !$OMP DO schedule(static) private(jj, ji) 292 DO jj = 1, jpj 293 DO ji = 1, jpi 294 z2d(ji,jj) = 0._wp 295 END DO 296 END DO 261 297 DO jk = 1, jpkm1 298 !$OMP DO schedule(static) private(jj, ji) 262 299 DO jj = 1, jpj 263 300 DO ji = 1, jpi … … 266 303 END DO 267 304 END DO 305 !$OMP END PARALLEL 268 306 CALL iom_put( "heatc", (rau0 * rcp) * z2d ) ! vertically integrated heat content (J/m2) 269 307 ENDIF 270 308 271 309 IF( iom_use("saltc") ) THEN 272 z2d(:,:) = 0._wp 310 !$OMP PARALLEL 311 !$OMP DO schedule(static) private(jj, ji) 312 DO jj = 1, jpj 313 DO ji = 1, jpi 314 z2d(ji,jj) = 0._wp 315 END DO 316 END DO 273 317 DO jk = 1, jpkm1 318 !$OMP DO schedule(static) private(jj, ji) 274 319 DO jj = 1, jpj 275 320 DO ji = 1, jpi … … 278 323 END DO 279 324 END DO 325 !$OMP END PARALLEL 280 326 CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 281 327 ENDIF 282 328 ! 283 329 IF ( iom_use("eken") ) THEN 284 rke(:,:,jk) = 0._wp ! kinetic energy 330 !$OMP PARALLEL 331 !$OMP DO schedule(static) private(jj, ji) 332 DO jj = 1, jpj 333 DO ji = 1, jpi 334 rke(ji,jj,jk) = 0._wp ! kinetic energy 335 END DO 336 END DO 337 !$OMP DO schedule(static) private(jk, jj, ji, zztmp, zztmpx, zztmpy) 285 338 DO jk = 1, jpkm1 286 339 DO jj = 2, jpjm1 … … 300 353 ENDDO 301 354 ENDDO 355 !$OMP END PARALLEL 302 356 CALL lbc_lnk( rke, 'T', 1. ) 303 357 CALL iom_put( "eken", rke ) … … 307 361 ! 308 362 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 309 z3d(:,:,jpk) = 0.e0 310 z2d(:,:) = 0.e0 363 !$OMP PARALLEL 364 !$OMP DO schedule(static) private(jj, ji) 365 DO jj = 1, jpj 366 DO ji = 1, jpi 367 z3d(ji,jj,jpk) = 0.e0 368 z2d(ji,jj) = 0.e0 369 END DO 370 END DO 311 371 DO jk = 1, jpkm1 312 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 313 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 314 END DO 372 !$OMP DO schedule(static) private(jj, ji) 373 DO jj = 1, jpj 374 DO ji = 1, jpi 375 z3d(ji,jj,jk) = rau0 * un(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 376 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) 377 END DO 378 END DO 379 END DO 380 !$OMP END PARALLEL 315 381 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 316 382 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum … … 318 384 319 385 IF( iom_use("u_heattr") ) THEN 320 z2d(:,:) = 0.e0 386 !$OMP PARALLEL 387 !$OMP DO schedule(static) private(jj, ji) 388 DO jj = 1, jpj 389 DO ji = 1, jpi 390 z2d(ji,jj) = 0.e0 391 END DO 392 END DO 321 393 DO jk = 1, jpkm1 394 !$OMP DO schedule(static) private(jj, ji) 322 395 DO jj = 2, jpjm1 323 396 DO ji = fs_2, fs_jpim1 ! vector opt. … … 326 399 END DO 327 400 END DO 401 !$OMP END PARALLEL 328 402 CALL lbc_lnk( z2d, 'U', -1. ) 329 403 CALL iom_put( "u_heattr", (0.5 * rcp) * z2d ) ! heat transport in i-direction … … 331 405 332 406 IF( iom_use("u_salttr") ) THEN 333 z2d(:,:) = 0.e0 407 !$OMP PARALLEL 408 !$OMP DO schedule(static) private(jj, ji) 409 DO jj = 1, jpj 410 DO ji = 1, jpi 411 z2d(ji,jj) = 0.e0 412 END DO 413 END DO 334 414 DO jk = 1, jpkm1 415 !$OMP DO schedule(static) private(jj, ji) 335 416 DO jj = 2, jpjm1 336 417 DO ji = fs_2, fs_jpim1 ! vector opt. … … 339 420 END DO 340 421 END DO 422 !$OMP END PARALLEL 341 423 CALL lbc_lnk( z2d, 'U', -1. ) 342 424 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction … … 345 427 346 428 IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 347 z3d(:,:,jpk) = 0.e0 429 !$OMP PARALLEL 430 !$OMP DO schedule(static) private(jj, ji) 431 DO jj = 1, jpj 432 DO ji = 1, jpi 433 z3d(ji,jj,jpk) = 0.e0 434 END DO 435 END DO 436 !$OMP DO schedule(static) private(jk,jj,ji) 348 437 DO jk = 1, jpkm1 349 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 350 END DO 438 DO jj = 1, jpj 439 DO ji = 1, jpi 440 z3d(ji,jj,jk) = rau0 * vn(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 441 END DO 442 END DO 443 END DO 444 !$OMP END PARALLEL 351 445 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 352 446 ENDIF 353 447 354 448 IF( iom_use("v_heattr") ) THEN 355 z2d(:,:) = 0.e0 449 !$OMP PARALLEL 450 !$OMP DO schedule(static) private(jj, ji) 451 DO jj = 1, jpj 452 DO ji = 1, jpi 453 z2d(ji,jj) = 0.e0 454 END DO 455 END DO 356 456 DO jk = 1, jpkm1 457 !$OMP DO schedule(static) private(jj, ji) 357 458 DO jj = 2, jpjm1 358 459 DO ji = fs_2, fs_jpim1 ! vector opt. … … 361 462 END DO 362 463 END DO 464 !$OMP END PARALLEL 363 465 CALL lbc_lnk( z2d, 'V', -1. ) 364 466 CALL iom_put( "v_heattr", (0.5 * rcp) * z2d ) ! heat transport in j-direction … … 366 468 367 469 IF( iom_use("v_salttr") ) THEN 368 z2d(:,:) = 0.e0 470 !$OMP PARALLEL 471 !$OMP DO schedule(static) private(jj, ji) 472 DO jj = 1, jpj 473 DO ji = 1, jpi 474 z2d(ji,jj) = 0.e0 475 END DO 476 END DO 369 477 DO jk = 1, jpkm1 478 !$OMP DO schedule(static) private(jj, ji) 370 479 DO jj = 2, jpjm1 371 480 DO ji = fs_2, fs_jpim1 ! vector opt. … … 374 483 END DO 375 484 END DO 485 !$OMP END PARALLEL 376 486 CALL lbc_lnk( z2d, 'V', -1. ) 377 487 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction … … 380 490 ! Vertical integral of temperature 381 491 IF( iom_use("tosmint") ) THEN 382 z2d(:,:)=0._wp 492 !$OMP PARALLEL 493 !$OMP DO schedule(static) private(jj, ji) 494 DO jj = 1, jpj 495 DO ji = 1, jpi 496 z2d(ji,jj) = 0.e0 497 END DO 498 END DO 383 499 DO jk = 1, jpkm1 500 !$OMP DO schedule(static) private(jj, ji) 384 501 DO jj = 2, jpjm1 385 502 DO ji = fs_2, fs_jpim1 ! vector opt. … … 388 505 END DO 389 506 END DO 507 !$OMP END PARALLEL 390 508 CALL lbc_lnk( z2d, 'T', -1. ) 391 509 CALL iom_put( "tosmint", z2d ) … … 394 512 ! Vertical integral of salinity 395 513 IF( iom_use("somint") ) THEN 396 z2d(:,:)=0._wp 514 !$OMP PARALLEL 515 !$OMP DO schedule(static) private(jj, ji) 516 DO jj = 1, jpj 517 DO ji = 1, jpi 518 z2d(ji,jj) = 0.e0 519 END DO 520 END DO 397 521 DO jk = 1, jpkm1 522 !$OMP DO schedule(static) private(jj, ji) 398 523 DO jj = 2, jpjm1 399 524 DO ji = fs_2, fs_jpim1 ! vector opt. … … 402 527 END DO 403 528 END DO 529 !$OMP END PARALLEL 404 530 CALL lbc_lnk( z2d, 'T', -1. ) 405 531 CALL iom_put( "somint", z2d ) … … 792 918 ENDIF 793 919 IF( .NOT.ln_linssh ) THEN 794 zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 920 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 921 DO jk = 1, jpk 922 DO jj = 1, jpj 923 DO ji = 1, jpi 924 zw3d(ji,jj,jk) = ( ( e3t_n(ji,jj,jk) - e3t_0(ji,jj,jk) ) / e3t_0(ji,jj,jk) * 100 * tmask(ji,jj,jk) ) ** 2 925 END DO 926 END DO 927 END DO 795 928 CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T ) ! level thickness 796 929 CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T ) ! t-point depth … … 804 937 ! in linear free surface case) 805 938 IF( ln_linssh ) THEN 806 zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 939 !$OMP PARALLEL DO schedule(static) private(jj, ji) 940 DO jj = 1, jpj 941 DO ji = 1, jpi 942 zw2d(ji,jj) = emp (ji,jj) * tsn(ji,jj,1,jp_tem) 943 END DO 944 END DO 807 945 CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sst 808 zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 946 !$OMP PARALLEL DO schedule(static) private(jj, ji) 947 DO jj = 1, jpj 948 DO ji = 1, jpi 949 zw2d(ji,jj) = emp (ji,jj) * tsn(ji,jj,1,jp_sal) 950 END DO 951 END DO 809 952 CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sss 810 953 ENDIF … … 842 985 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 843 986 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 844 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 987 IF( ln_ssr ) THEN 988 !$OMP PARALLEL DO schedule(static) private(jj, ji) 989 DO jj = 1, jpj 990 DO ji = 1, jpi 991 zw2d(ji,jj) = erp(ji,jj) * tsn(ji,jj,1,jp_sal) * tmask(ji,jj,1) 992 END DO 993 END DO 994 END IF 845 995 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 846 996 ENDIF … … 848 998 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 849 999 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 850 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 1000 IF( ln_ssr ) THEN 1001 !$OMP PARALLEL DO schedule(static) private(jj, ji) 1002 DO jj = 1, jpj 1003 DO ji = 1, jpi 1004 zw2d(ji,jj) = erp(ji,jj) * tsn(ji,jj,1,jp_sal) * tmask(ji,jj,1) 1005 END DO 1006 END DO 1007 END IF 851 1008 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 852 1009 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/depth_e3.F90
r7646 r7698 150 150 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdept_3d, pdepw_3d ! depth = SUM( e3 ) [m] 151 151 ! 152 INTEGER :: jk ! dummy loop indices152 INTEGER :: jk, jj, ji ! dummy loop indices 153 153 !!---------------------------------------------------------------------- 154 154 ! 155 pdepw_3d(:,:,1) = 0.0_wp 156 pdept_3d(:,:,1) = 0.5_wp * pe3w_3d(:,:,1) 155 !$OMP PARALLEL 156 !$OMP DO schedule(static) private(jj,ji) 157 DO jj = 1, jpj 158 DO ji = 1, jpi 159 pdepw_3d(ji,jj,1) = 0.0_wp 160 pdept_3d(ji,jj,1) = 0.5_wp * pe3w_3d(ji,jj,1) 161 END DO 162 END DO 157 163 DO jk = 2, jpk 158 pdepw_3d(:,:,jk) = pdepw_3d(:,:,jk-1) + pe3t_3d(:,:,jk-1) 159 pdept_3d(:,:,jk) = pdept_3d(:,:,jk-1) + pe3w_3d(:,:,jk ) 164 !$OMP DO schedule(static) private(jj,ji) 165 DO jj = 1, jpj 166 DO ji = 1, jpi 167 pdepw_3d(ji,jj,jk) = pdepw_3d(ji,jj,jk-1) + pe3t_3d(ji,jj,jk-1) 168 pdept_3d(ji,jj,jk) = pdept_3d(ji,jj,jk-1) + pe3w_3d(ji,jj,jk ) 169 END DO 170 END DO 160 171 END DO 172 !$OMP END PARALLEL 161 173 ! 162 174 END SUBROUTINE e3_to_depth_3d -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r7646 r7698 133 133 CALL dom_msk( ik_top, ik_bot ) ! Masks 134 134 ! 135 !$OMP PARALLEL 136 !$OMP DO schedule(static) private(jj,ji,ik) 135 137 DO jj = 1, jpj ! depth of the iceshelves 136 138 DO ji = 1, jpi … … 140 142 END DO 141 143 ! 142 ht_0(:,:) = 0._wp ! Reference ocean thickness 143 hu_0(:,:) = 0._wp 144 hv_0(:,:) = 0._wp 144 !$OMP END DO NOWAIT 145 !$OMP DO schedule(static) private(jj,ji) 146 DO jj = 1, jpj 147 DO ji = 1, jpi 148 ht_0(ji,jj) = 0._wp ! Reference ocean thickness 149 hu_0(ji,jj) = 0._wp 150 hv_0(ji,jj) = 0._wp 151 END DO 152 END DO 145 153 DO jk = 1, jpk 146 ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 147 hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 148 hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk) 154 !$OMP DO schedule(static) private(jj,ji,ik) 155 DO jj = 1, jpj 156 DO ji = 1, jpi 157 ht_0(ji,jj) = ht_0(ji,jj) + e3t_0(ji,jj,jk) * tmask(ji,jj,jk) 158 hu_0(ji,jj) = hu_0(ji,jj) + e3u_0(ji,jj,jk) * umask(ji,jj,jk) 159 hv_0(ji,jj) = hv_0(ji,jj) + e3v_0(ji,jj,jk) * vmask(ji,jj,jk) 160 END DO 161 END DO 149 162 END DO 163 !$OMP END PARALLEL 150 164 ! 151 165 ! !== time varying part of coordinate system ==! … … 166 180 e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- ! 167 181 ! 168 z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF 169 z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 182 !$OMP PARALLEL DO schedule(static) private(jj,ji) 183 DO jj =1, jpj 184 DO ji=1, jpi 185 z1_hu_0(ji,jj) = ssumask(ji,jj) / ( hu_0(ji,jj) + 1._wp - ssumask(ji,jj) ) ! _i mask due to ISF 186 z1_hv_0(ji,jj) = ssvmask(ji,jj) / ( hv_0(ji,jj) + 1._wp - ssvmask(ji,jj) ) 187 END DO 188 END DO 170 189 ! 171 190 ! before ! now ! after ! -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r7646 r7698 40 40 !!---------------------------------------------------------------------- 41 41 !! NEMO/OPA 3.7 , NEMO Consortium (2016) 42 !! $Id$ 42 !! $Id$ 43 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- … … 117 117 IF( iff == 0 ) THEN ! Coriolis parameter has not been defined 118 118 IF(lwp) WRITE(numout,*) ' Coriolis parameter calculated on the sphere from gphif & gphit' 119 ff_f(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) ! compute it on the sphere at f-point 120 ff_t(:,:) = 2. * omega * SIN( rad * gphit(:,:) ) ! - - - at t-point 119 !$OMP PARALLEL DO schedule(static) private(jj, ji) 120 DO jj = 1, jpj 121 DO ji = 1, jpi 122 ff_f(ji,jj) = 2. * omega * SIN( rad * gphif(ji,jj) ) ! compute it on the sphere at f-point 123 ff_t(ji,jj) = 2. * omega * SIN( rad * gphit(ji,jj) ) ! - - - at t-point 124 END DO 125 END DO 121 126 ELSE 122 127 IF( ln_read_cfg ) THEN … … 130 135 ! !== associated horizontal metrics ==! 131 136 ! 132 r1_e1t(:,:) = 1._wp / e1t(:,:) ; r1_e2t (:,:) = 1._wp / e2t(:,:) 133 r1_e1u(:,:) = 1._wp / e1u(:,:) ; r1_e2u (:,:) = 1._wp / e2u(:,:) 134 r1_e1v(:,:) = 1._wp / e1v(:,:) ; r1_e2v (:,:) = 1._wp / e2v(:,:) 135 r1_e1f(:,:) = 1._wp / e1f(:,:) ; r1_e2f (:,:) = 1._wp / e2f(:,:) 136 ! 137 e1e2t (:,:) = e1t(:,:) * e2t(:,:) ; r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 138 e1e2f (:,:) = e1f(:,:) * e2f(:,:) ; r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 137 !$OMP PARALLEL DO schedule(static) private(jj, ji) 138 DO jj = 1, jpj 139 DO ji = 1, jpi 140 r1_e1t(ji,jj) = 1._wp / e1t(ji,jj) ; r1_e2t (ji,jj) = 1._wp / e2t(ji,jj) 141 r1_e1u(ji,jj) = 1._wp / e1u(ji,jj) ; r1_e2u (ji,jj) = 1._wp / e2u(ji,jj) 142 r1_e1v(ji,jj) = 1._wp / e1v(ji,jj) ; r1_e2v (ji,jj) = 1._wp / e2v(ji,jj) 143 r1_e1f(ji,jj) = 1._wp / e1f(ji,jj) ; r1_e2f (ji,jj) = 1._wp / e2f(ji,jj) 144 ! 145 e1e2t (ji,jj) = e1t(ji,jj) * e2t(ji,jj) ; r1_e1e2t(ji,jj) = 1._wp / e1e2t(ji,jj) 146 e1e2f (ji,jj) = e1f(ji,jj) * e2f(ji,jj) ; r1_e1e2f(ji,jj) = 1._wp / e1e2f(ji,jj) 147 END DO 148 END DO 139 149 IF( ie1e2u_v == 0 ) THEN ! u- & v-surfaces have not been defined 140 150 IF(lwp) WRITE(numout,*) ' u- & v-surfaces calculated as e1 e2 product' 141 e1e2u (:,:) = e1u(:,:) * e2u(:,:) ! compute them 142 e1e2v (:,:) = e1v(:,:) * e2v(:,:) 151 !$OMP PARALLEL DO schedule(static) private(jj, ji) 152 DO jj = 1, jpj 153 DO ji = 1, jpi 154 e1e2u (ji,jj) = e1u(ji,jj) * e2u(ji,jj) ! compute them 155 e1e2v (ji,jj) = e1v(ji,jj) * e2v(ji,jj) 156 END DO 157 END DO 143 158 ELSE 144 159 IF(lwp) WRITE(numout,*) ' u- & v-surfaces have been read in "mesh_mask" file:' 145 160 IF(lwp) WRITE(numout,*) ' grid size reduction in strait(s) is used' 146 161 ENDIF 147 r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) ! compute their invert in any cases 148 r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 149 ! 150 e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 151 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 162 !$OMP PARALLEL DO schedule(static) private(jj, ji) 163 DO jj = 1, jpj 164 DO ji = 1, jpi 165 r1_e1e2u(ji,jj) = 1._wp / e1e2u(ji,jj) ! compute their invert in any cases 166 r1_e1e2v(ji,jj) = 1._wp / e1e2v(ji,jj) 167 ! 168 e2_e1u(ji,jj) = e2u(ji,jj) / e1u(ji,jj) 169 e1_e2v(ji,jj) = e1v(ji,jj) / e2v(ji,jj) 170 END DO 171 END DO 152 172 ! 153 173 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r7646 r7698 47 47 !!---------------------------------------------------------------------- 48 48 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 49 !! $Id$ 49 !! $Id$ 50 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 51 !!---------------------------------------------------------------------- … … 137 137 ! ---------------------------- 138 138 ! 139 tmask(:,:,:) = 0._wp 139 !$OMP PARALLEL 140 !$OMP DO schedule(static) private(jk, jj, ji) 141 DO jk = 1, jpk 142 DO jj = 1, jpj 143 DO ji = 1, jpi 144 tmask(ji,jj,jk) = 0._wp 145 END DO 146 END DO 147 END DO 148 !$OMP DO schedule(static) private(jj, ji, iktop, ikbot) 140 149 DO jj = 1, jpj 141 150 DO ji = 1, jpi … … 147 156 END DO 148 157 END DO 158 !$OMP END PARALLEL 149 159 !SF add here lbc_lnk: bug not still understood : cause now domain configuration is read ! 150 160 !!gm I don't understand why... … … 161 171 ! ------------------------ 162 172 IF ( ln_bdy .AND. ln_mask_file ) THEN 173 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 163 174 DO jk = 1, jpkm1 164 175 DO jj = 1, jpj … … 173 184 ! ---------------------------------------- 174 185 ! NB: at this point, fmask is designed for free slip lateral boundary condition 186 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 175 187 DO jk = 1, jpk 176 188 DO jj = 1, jpjm1 … … 192 204 ! Ocean/land mask at wu-, wv- and w points (computed from tmask) 193 205 !----------------------------------------- 194 wmask (:,:,1) = tmask(:,:,1) ! surface 195 wumask(:,:,1) = umask(:,:,1) 196 wvmask(:,:,1) = vmask(:,:,1) 206 !$OMP PARALLEL 207 !$OMP DO schedule(static) private(jj, ji) 208 DO jj = 1, jpj 209 DO ji = 1, jpi 210 wmask (ji,jj,1) = tmask(ji,jj,1) ! surface 211 wumask(ji,jj,1) = umask(ji,jj,1) 212 wvmask(ji,jj,1) = vmask(ji,jj,1) 213 END DO 214 END DO 215 !$OMP DO schedule(static) private(jk,jj,ji) 197 216 DO jk = 2, jpk ! interior values 198 wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 199 wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1) 200 wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 201 END DO 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 wmask (ji,jj,jk) = tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 220 wumask(ji,jj,jk) = umask(ji,jj,jk) * umask(ji,jj,jk-1) 221 wvmask(ji,jj,jk) = vmask(ji,jj,jk) * vmask(ji,jj,jk-1) 222 END DO 223 END DO 224 END DO 225 !$OMP END PARALLEL 202 226 203 227 … … 216 240 ! 217 241 ! ! halo mask : 0 on the halo and 1 elsewhere 218 tmask_h(:,:) = 1._wp 242 !$OMP PARALLEL DO schedule(static) private(jj, ji) 243 DO jj = 1, jpj 244 DO ji = 1, jpi 245 tmask_h(ji,jj) = 1._wp 246 END DO 247 END DO 219 248 tmask_h( 1 :iif, : ) = 0._wp ! first columns 220 249 tmask_h(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns) … … 241 270 ! 242 271 ! ! interior mask : 2D ocean mask x halo mask 243 tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 272 !$OMP PARALLEL DO schedule(static) private(jj, ji) 273 DO jj = 1, jpj 274 DO ji = 1, jpi 275 tmask_i(ji,jj) = ssmask(ji,jj) * tmask_h(ji,jj) 276 END DO 277 END DO 244 278 245 279 … … 250 284 CALL wrk_alloc( jpi,jpj, zwf ) 251 285 ! 286 !$OMP PARALLEL 252 287 DO jk = 1, jpk 253 zwf(:,:) = fmask(:,:,jk) 288 !$OMP DO schedule(static) private(jj, ji) 289 DO jj = 1, jpj 290 DO ji = 1, jpi 291 zwf(ji,jj) = fmask(ji,jj,jk) 292 END DO 293 END DO 294 !$OMP DO schedule(static) private(jj, ji) 254 295 DO jj = 2, jpjm1 255 296 DO ji = fs_2, fs_jpim1 ! vector opt. … … 260 301 END DO 261 302 END DO 303 !$OMP DO schedule(static) private(jj) 262 304 DO jj = 2, jpjm1 263 305 IF( fmask(1,jj,jk) == 0._wp ) THEN … … 268 310 ENDIF 269 311 END DO 312 !$OMP DO schedule(static) private(ji) 270 313 DO ji = 2, jpim1 271 314 IF( fmask(ji,1,jk) == 0._wp ) THEN … … 277 320 END DO 278 321 END DO 322 !$OMP END PARALLEL 279 323 ! 280 324 CALL wrk_dealloc( jpi,jpj, zwf ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r7646 r7698 135 135 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 136 136 CALL dom_vvl_rst( nit000, 'READ' ) 137 e3t_a(:,:,jpk) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all 137 !$OMP PARALLEL DO schedule(static) private(jj, ji) 138 DO jj = 1, jpj 139 DO ji = 1, jpi 140 e3t_a(ji,jj,jpk) = e3t_0(ji,jj,jpk) ! last level always inside the sea floor set one for all 141 END DO 142 END DO 138 143 ! 139 144 ! !== Set of all other vertical scale factors ==! (now and before) … … 153 158 ! 154 159 ! !== depth of t and w-point ==! (set the isf depth as it is in the initial timestep) 155 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) ! reference to the ocean surface (used for MLD and light penetration) 156 gdepw_n(:,:,1) = 0.0_wp 157 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) ! reference to a common level z=0 for hpg 158 gdept_b(:,:,1) = 0.5_wp * e3w_b(:,:,1) 159 gdepw_b(:,:,1) = 0.0_wp 160 !$OMP PARALLEL 161 !$OMP DO schedule(static) private(jj,ji) 162 DO jj = 1, jpj 163 DO ji = 1, jpi 164 gdept_n(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) ! reference to the ocean surface (used for MLD and light penetration) 165 gdepw_n(ji,jj,1) = 0.0_wp 166 gde3w_n(ji,jj,1) = gdept_n(ji,jj,1) - sshn(ji,jj) ! reference to a common level z=0 for hpg 167 gdept_b(ji,jj,1) = 0.5_wp * e3w_b(ji,jj,1) 168 gdepw_b(ji,jj,1) = 0.0_wp 169 END DO 170 END DO 160 171 DO jk = 2, jpk ! vertical sum 172 !$OMP DO schedule(static) private(jj,ji,zcoef) 161 173 DO jj = 1,jpj 162 174 DO ji = 1,jpi … … 178 190 ! 179 191 ! !== thickness of the water column !! (ocean portion only) 180 ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1) !!gm BUG : this should be 1/2 * e3w(k=1) .... 181 hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 182 hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1) 183 hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 184 hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1) 192 !$OMP DO schedule(static) private(jj,ji) 193 DO jj = 1, jpj 194 DO ji = 1, jpi 195 ht_n(ji,jj) = e3t_n(ji,jj,1) * tmask(ji,jj,1) !!gm BUG : this should be 1/2 * e3w(k=1) .... 196 hu_b(ji,jj) = e3u_b(ji,jj,1) * umask(ji,jj,1) 197 hu_n(ji,jj) = e3u_n(ji,jj,1) * umask(ji,jj,1) 198 hv_b(ji,jj) = e3v_b(ji,jj,1) * vmask(ji,jj,1) 199 hv_n(ji,jj) = e3v_n(ji,jj,1) * vmask(ji,jj,1) 200 END DO 201 END DO 185 202 DO jk = 2, jpkm1 186 ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 187 hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 188 hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 189 hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 190 hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 203 !$OMP DO schedule(static) private(jj,ji) 204 DO jj = 1, jpj 205 DO ji = 1, jpi 206 ht_n(ji,jj) = ht_n(ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 207 hu_b(ji,jj) = hu_b(ji,jj) + e3u_b(ji,jj,jk) * umask(ji,jj,jk) 208 hu_n(ji,jj) = hu_n(ji,jj) + e3u_n(ji,jj,jk) * umask(ji,jj,jk) 209 hv_b(ji,jj) = hv_b(ji,jj) + e3v_b(ji,jj,jk) * vmask(ji,jj,jk) 210 hv_n(ji,jj) = hv_n(ji,jj) + e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 211 END DO 212 END DO 191 213 END DO 192 214 ! 193 215 ! !== inverse of water column thickness ==! (u- and v- points) 194 r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF 195 r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) 196 r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 197 r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) 198 216 !$OMP DO schedule(static) private(jj,ji) 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 r1_hu_b(ji,jj) = ssumask(ji,jj) / ( hu_b(ji,jj) + 1._wp - ssumask(ji,jj) ) ! _i mask due to ISF 220 r1_hu_n(ji,jj) = ssumask(ji,jj) / ( hu_n(ji,jj) + 1._wp - ssumask(ji,jj) ) 221 r1_hv_b(ji,jj) = ssvmask(ji,jj) / ( hv_b(ji,jj) + 1._wp - ssvmask(ji,jj) ) 222 r1_hv_n(ji,jj) = ssvmask(ji,jj) / ( hv_n(ji,jj) + 1._wp - ssvmask(ji,jj) ) 223 END DO 224 END DO 225 !$OMP END PARALLEL 199 226 ! !== z_tilde coordinate case ==! (Restoring frequencies) 200 227 IF( ln_vvl_ztilde ) THEN … … 202 229 ! ! Values in days provided via the namelist 203 230 ! ! use rsmall to avoid possible division by zero errors with faulty settings 204 frq_rst_e3t(:,:) = 2._wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.0_wp ) 205 frq_rst_hdv(:,:) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp ) 231 !$OMP PARALLEL DO schedule(static) private(jj,ji) 232 DO jj = 1, jpj 233 DO ji = 1, jpi 234 frq_rst_e3t(ji,jj) = 2._wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.0_wp ) 235 frq_rst_hdv(ji,jj) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp ) 236 END DO 237 END DO 206 238 ! 207 239 IF( ln_vvl_ztilde_as_zstar ) THEN ! z-star emulation using z-tile 208 frq_rst_e3t(:,:) = 0._wp !Ignore namelist settings 209 frq_rst_hdv(:,:) = 1._wp / rdt 240 !$OMP PARALLEL DO schedule(static) private(jj,ji) 241 DO jj = 1, jpj 242 DO ji = 1, jpi 243 frq_rst_e3t(ji,jj) = 0._wp !Ignore namelist settings 244 frq_rst_hdv(ji,jj) = 1._wp / rdt 245 END DO 246 END DO 210 247 ENDIF 211 248 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 249 !$OMP PARALLEL DO schedule(static) private(jj,ji) 212 250 DO jj = 1, jpj 213 251 DO ji = 1, jpi … … 305 343 ! ! --------------------------------------------- ! 306 344 ! 307 z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 345 !$OMP PARALLEL 346 !$OMP DO schedule(static) private(jj,ji) 347 DO jj = 1, jpj 348 DO ji = 1, jpi 349 z_scale(ji,jj) = ( ssha(ji,jj) - sshb(ji,jj) ) * ssmask(ji,jj) / ( ht_0(ji,jj) + sshn(ji,jj) + 1. - ssmask(ji,jj) ) 350 END DO 351 END DO 352 !$OMP DO schedule(static) private(jk,jj,ji) 308 353 DO jk = 1, jpkm1 309 ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0) 310 e3t_a(:,:,jk) = e3t_b(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 311 END DO 354 DO jj = 1, jpj 355 DO ji = 1, jpi 356 ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0) 357 e3t_a(ji,jj,jk) = e3t_b(ji,jj,jk) + e3t_n(ji,jj,jk) * z_scale(ji,jj) * tmask(ji,jj,jk) 358 END DO 359 END DO 360 END DO 361 !$OMP END PARALLEL 312 362 ! 313 363 IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate ! … … 318 368 ! 1 - barotropic divergence 319 369 ! ------------------------- 320 zhdiv(:,:) = 0._wp 321 zht(:,:) = 0._wp 370 !$OMP PARALLEL 371 !$OMP DO schedule(static) private(jj,ji) 372 DO jj = 1, jpj 373 DO ji = 1, jpi 374 zhdiv(ji,jj) = 0._wp 375 zht(ji,jj) = 0._wp 376 END DO 377 END DO 322 378 DO jk = 1, jpkm1 323 zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 324 zht (:,:) = zht (:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 325 END DO 326 zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) ) 379 !$OMP DO schedule(static) private(jj,ji) 380 DO jj = 1, jpj 381 DO ji = 1, jpi 382 zhdiv(ji,jj) = zhdiv(ji,jj) + e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) 383 zht (ji,jj) = zht (ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 384 END DO 385 END DO 386 END DO 387 !$OMP DO schedule(static) private(jj,ji) 388 DO jj = 1, jpj 389 DO ji = 1, jpi 390 zhdiv(ji,jj) = zhdiv(ji,jj) / ( zht(ji,jj) + 1. - tmask_i(ji,jj) ) 391 END DO 392 END DO 393 !$OMP END PARALLEL 327 394 328 395 ! 2 - Low frequency baroclinic horizontal divergence (z-tilde case only) … … 330 397 IF( ln_vvl_ztilde ) THEN 331 398 IF( kt > nit000 ) THEN 399 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 332 400 DO jk = 1, jpkm1 333 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:) & 334 & * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) ) 401 DO jj = 1, jpj 402 DO ji = 1, jpi 403 hdiv_lf(ji,jj,jk) = hdiv_lf(ji,jj,jk) - rdt * frq_rst_hdv(ji,jj) & 404 & * ( hdiv_lf(ji,jj,jk) - e3t_n(ji,jj,jk) * ( hdivn(ji,jj,jk) - zhdiv(ji,jj) ) ) 405 END DO 406 END DO 335 407 END DO 336 408 ENDIF … … 339 411 ! II - after z_tilde increments of vertical scale factors 340 412 ! ======================================================= 341 tilde_e3t_a(:,:,:) = 0._wp ! tilde_e3t_a used to store tendency terms 413 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 414 DO jk = 1, jpk 415 DO jj = 1, jpj 416 DO ji = 1, jpi 417 tilde_e3t_a(ji,jj,jk) = 0._wp ! tilde_e3t_a used to store tendency terms 418 END DO 419 END DO 420 END DO 342 421 343 422 ! 1 - High frequency divergence term 344 423 ! ---------------------------------- 345 424 IF( ln_vvl_ztilde ) THEN ! z_tilde case 425 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 346 426 DO jk = 1, jpkm1 347 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 427 DO jj = 1, jpj 428 DO ji = 1, jpi 429 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) - ( e3t_n(ji,jj,jk) * ( hdivn(ji,jj,jk) - zhdiv(ji,jj) ) - hdiv_lf(ji,jj,jk) ) 430 END DO 431 END DO 348 432 END DO 349 433 ELSE ! layer case 434 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 350 435 DO jk = 1, jpkm1 351 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 436 DO jj = 1, jpj 437 DO ji = 1, jpi 438 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) - e3t_n(ji,jj,jk) * ( hdivn(ji,jj,jk) - zhdiv(ji,jj) ) * tmask(ji,jj,jk) 439 END DO 440 END DO 352 441 END DO 353 442 ENDIF … … 356 445 ! ------------------ 357 446 IF( ln_vvl_ztilde ) THEN 447 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 358 448 DO jk = 1, jpk 359 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk) 449 DO jj = 1, jpj 450 DO ji = 1, jpi 451 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) - frq_rst_e3t(ji,jj) * tilde_e3t_b(ji,jj,jk) 452 END DO 453 END DO 360 454 END DO 361 455 ENDIF … … 363 457 ! 3 - Thickness diffusion term 364 458 ! ---------------------------- 365 zwu(:,:) = 0._wp 366 zwv(:,:) = 0._wp 459 !$OMP PARALLEL 460 !$OMP DO schedule(static) private(jj,ji) 461 DO jj = 1, jpj 462 DO ji = 1, jpi 463 zwu(ji,jj) = 0._wp 464 zwv(ji,jj) = 0._wp 465 END DO 466 END DO 367 467 DO jk = 1, jpkm1 ! a - first derivative: diffusive fluxes 468 !$OMP DO schedule(static) private(jj,ji) 368 469 DO jj = 1, jpjm1 369 470 DO ji = 1, fs_jpim1 ! vector opt. … … 377 478 END DO 378 479 END DO 480 !$OMP DO schedule(static) private(jj,ji) 379 481 DO jj = 1, jpj ! b - correction for last oceanic u-v points 380 482 DO ji = 1, jpi … … 383 485 END DO 384 486 END DO 487 !$OMP DO schedule(static) private(jk,jj,ji) 385 488 DO jk = 1, jpkm1 ! c - second derivative: divergence of diffusive fluxes 386 489 DO jj = 2, jpjm1 … … 392 495 END DO 393 496 END DO 497 !$OMP END PARALLEL 394 498 ! ! d - thickness diffusion transport: boundary conditions 395 499 ! (stored for tracer advction and continuity equation) … … 407 511 ENDIF 408 512 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp ) 409 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 513 !$OMP PARALLEL 514 !$OMP DO schedule(static) private(jk,jj,ji) 515 DO jk = 1, jpk 516 DO jj = 1, jpj 517 DO ji = 1, jpi 518 tilde_e3t_a(ji,jj,jk) = tilde_e3t_b(ji,jj,jk) + z2dt * tmask(ji,jj,jk) * tilde_e3t_a(ji,jj,jk) 519 END DO 520 END DO 521 END DO 410 522 411 523 ! Maximum deformation control 412 524 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 413 ze3t(:,:,jpk) = 0._wp 525 !$OMP DO schedule(static) private(jj,ji) 526 DO jj = 1, jpj 527 DO ji = 1, jpi 528 ze3t(ji,jj,jpk) = 0._wp 529 END DO 530 END DO 531 !$OMP DO schedule(static) private(jk,jj,ji) 414 532 DO jk = 1, jpkm1 415 ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 416 END DO 533 DO jj = 1, jpj 534 DO ji = 1, jpi 535 ze3t(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) / e3t_0(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 536 END DO 537 END DO 538 END DO 539 !$OMP END PARALLEL 417 540 z_tmax = MAXVAL( ze3t(:,:,:) ) 418 541 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain … … 442 565 ! - ML - end test 443 566 ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 444 tilde_e3t_a(:,:,:) = MIN( tilde_e3t_a(:,:,:), rn_zdef_max * e3t_0(:,:,:) ) 445 tilde_e3t_a(:,:,:) = MAX( tilde_e3t_a(:,:,:), - rn_zdef_max * e3t_0(:,:,:) ) 567 !$OMP PARALLEL 568 !$OMP DO schedule(static) private(jk,jj,ji) 569 DO jk = 1, jpk 570 DO jj = 1, jpj 571 DO ji = 1, jpi 572 tilde_e3t_a(ji,jj,jk) = MIN( tilde_e3t_a(ji,jj,jk), rn_zdef_max * e3t_0(ji,jj,jk) ) 573 tilde_e3t_a(ji,jj,jk) = MAX( tilde_e3t_a(ji,jj,jk), - rn_zdef_max * e3t_0(ji,jj,jk) ) 574 END DO 575 END DO 576 END DO 446 577 447 578 ! 448 579 ! "tilda" change in the after scale factor 449 580 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 581 !$OMP DO schedule(static) private(jk,jj,ji) 450 582 DO jk = 1, jpkm1 451 dtilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - tilde_e3t_b(:,:,jk) 583 DO jj = 1, jpj 584 DO ji = 1, jpi 585 dtilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) - tilde_e3t_b(ji,jj,jk) 586 END DO 587 END DO 452 588 END DO 453 589 ! III - Barotropic repartition of the sea surface height over the baroclinic profile … … 457 593 ! i.e. locally and not spread over the water column. 458 594 ! (keep in mind that the idea is to reduce Eulerian velocity as much as possible) 459 zht(:,:) = 0. 595 !$OMP DO schedule(static) private(jj,ji) 596 DO jj = 1, jpj 597 DO ji = 1, jpi 598 zht(ji,jj) = 0. 599 END DO 600 END DO 460 601 DO jk = 1, jpkm1 461 zht(:,:) = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk) 462 END DO 463 z_scale(:,:) = - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 602 !$OMP DO schedule(static) private(jj,ji) 603 DO jj = 1, jpj 604 DO ji = 1, jpi 605 zht(ji,jj) = zht(ji,jj) + tilde_e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 606 END DO 607 END DO 608 END DO 609 !$OMP DO schedule(static) private(jj,ji) 610 DO jj = 1, jpj 611 DO ji = 1, jpi 612 z_scale(ji,jj) = - zht(ji,jj) / ( ht_0(ji,jj) + sshn(ji,jj) + 1. - ssmask(ji,jj) ) 613 END DO 614 END DO 615 !$OMP DO schedule(static) private(jk,jj,ji) 464 616 DO jk = 1, jpkm1 465 dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 466 END DO 467 617 DO jj = 1, jpj 618 DO ji = 1, jpi 619 dtilde_e3t_a(ji,jj,jk) = dtilde_e3t_a(ji,jj,jk) + e3t_n(ji,jj,jk) * z_scale(ji,jj) * tmask(ji,jj,jk) 620 END DO 621 END DO 622 END DO 623 !$OMP END PARALLEL 468 624 ENDIF 469 625 470 626 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde or layer coordinate ! 471 627 ! ! ---baroclinic part--------- ! 628 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 472 629 DO jk = 1, jpkm1 473 e3t_a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 630 DO jj = 1, jpj 631 DO ji = 1, jpi 632 e3t_a(ji,jj,jk) = e3t_a(ji,jj,jk) + dtilde_e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 633 END DO 634 END DO 474 635 END DO 475 636 ENDIF … … 484 645 END IF 485 646 ! 486 zht(:,:) = 0.0_wp 647 !$OMP PARALLEL 648 !$OMP DO schedule(static) private(jj,ji) 649 DO jj = 1, jpj 650 DO ji = 1, jpi 651 zht(ji,jj) = 0.0_wp 652 END DO 653 END DO 487 654 DO jk = 1, jpkm1 488 zht(:,:) = zht(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 489 END DO 655 !$OMP DO schedule(static) private(jj,ji) 656 DO jj = 1, jpj 657 DO ji = 1, jpi 658 zht(ji,jj) = zht(ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 659 END DO 660 END DO 661 END DO 662 !$OMP END PARALLEL 490 663 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 491 664 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 492 665 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 493 666 ! 494 zht(:,:) = 0.0_wp 667 !$OMP PARALLEL 668 !$OMP DO schedule(static) private(jj,ji) 669 DO jj = 1, jpj 670 DO ji = 1, jpi 671 zht(ji,jj) = 0.0_wp 672 END DO 673 END DO 495 674 DO jk = 1, jpkm1 496 zht(:,:) = zht(:,:) + e3t_a(:,:,jk) * tmask(:,:,jk) 497 END DO 675 !$OMP DO schedule(static) private(jj,ji) 676 DO jj = 1, jpj 677 DO ji = 1, jpi 678 zht(ji,jj) = zht(ji,jj) + e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 679 END DO 680 END DO 681 END DO 682 !$OMP END PARALLEL 498 683 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 499 684 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 500 685 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 501 686 ! 502 zht(:,:) = 0.0_wp 687 !$OMP PARALLEL 688 !$OMP DO schedule(static) private(jj,ji) 689 DO jj = 1, jpj 690 DO ji = 1, jpi 691 zht(ji,jj) = 0.0_wp 692 END DO 693 END DO 503 694 DO jk = 1, jpkm1 504 zht(:,:) = zht(:,:) + e3t_b(:,:,jk) * tmask(:,:,jk) 505 END DO 695 !$OMP DO schedule(static) private(jj,ji) 696 DO jj = 1, jpj 697 DO ji = 1, jpi 698 zht(ji,jj) = zht(ji,jj) + e3t_b(ji,jj,jk) * tmask(ji,jj,jk) 699 END DO 700 END DO 701 END DO 702 !$OMP END PARALLEL 506 703 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 507 704 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain … … 532 729 ! *********************************** ! 533 730 534 hu_a(:,:) = e3u_a(:,:,1) * umask(:,:,1) 535 hv_a(:,:) = e3v_a(:,:,1) * vmask(:,:,1) 731 !$OMP PARALLEL 732 !$OMP DO schedule(static) private(jj,ji) 733 DO jj = 1, jpj 734 DO ji = 1, jpi 735 hu_a(ji,jj) = e3u_a(ji,jj,1) * umask(ji,jj,1) 736 hv_a(ji,jj) = e3v_a(ji,jj,1) * vmask(ji,jj,1) 737 END DO 738 END DO 536 739 DO jk = 2, jpkm1 537 hu_a(:,:) = hu_a(:,:) + e3u_a(:,:,jk) * umask(:,:,jk) 538 hv_a(:,:) = hv_a(:,:) + e3v_a(:,:,jk) * vmask(:,:,jk) 740 !$OMP DO schedule(static) private(jj,ji) 741 DO jj = 1, jpj 742 DO ji = 1, jpi 743 hu_a(ji,jj) = hu_a(ji,jj) + e3u_a(ji,jj,jk) * umask(ji,jj,jk) 744 hv_a(ji,jj) = hv_a(ji,jj) + e3v_a(ji,jj,jk) * vmask(ji,jj,jk) 745 END DO 746 END DO 539 747 END DO 540 748 ! ! Inverse of the local depth 541 749 !!gm BUG ? don't understand the use of umask_i here ..... 542 r1_hu_a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) ) 543 r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) 750 !$OMP DO schedule(static) private(jj,ji) 751 DO jj = 1, jpj 752 DO ji = 1, jpi 753 r1_hu_a(ji,jj) = ssumask(ji,jj) / ( hu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 754 r1_hv_a(ji,jj) = ssvmask(ji,jj) / ( hv_a(ji,jj) + 1._wp - ssvmask(ji,jj) ) 755 END DO 756 END DO 757 !$OMP END PARALLEL 544 758 ! 545 759 CALL wrk_dealloc( jpi,jpj, zht, z_scale, zwu, zwv, zhdiv ) … … 596 810 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 597 811 IF( neuler == 0 .AND. kt == nit000 ) THEN 598 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 812 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 813 DO jk = 1, jpk 814 DO jj = 1, jpj 815 DO ji = 1, jpi 816 tilde_e3t_b(ji,jj,jk) = tilde_e3t_n(ji,jj,jk) 817 END DO 818 END DO 819 END DO 599 820 ELSE 600 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 601 & + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 821 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 822 DO jk = 1, jpk 823 DO jj = 1, jpj 824 DO ji = 1, jpi 825 tilde_e3t_b(ji,jj,jk) = tilde_e3t_n(ji,jj,jk) & 826 & + atfp * ( tilde_e3t_b(ji,jj,jk) - 2.0_wp * tilde_e3t_n(ji,jj,jk) + tilde_e3t_a(ji,jj,jk) ) 827 END DO 828 END DO 829 END DO 602 830 ENDIF 603 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 831 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 832 DO jk = 1, jpk 833 DO jj = 1, jpj 834 DO ji = 1, jpi 835 tilde_e3t_n(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) 836 END DO 837 END DO 838 END DO 604 839 ENDIF 605 gdept_b(:,:,:) = gdept_n(:,:,:) 606 gdepw_b(:,:,:) = gdepw_n(:,:,:) 607 608 e3t_n(:,:,:) = e3t_a(:,:,:) 609 e3u_n(:,:,:) = e3u_a(:,:,:) 610 e3v_n(:,:,:) = e3v_a(:,:,:) 840 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 841 DO jk = 1, jpk 842 DO jj = 1, jpj 843 DO ji = 1, jpi 844 gdept_b(ji,jj,jk) = gdept_n(ji,jj,jk) 845 gdepw_b(ji,jj,jk) = gdepw_n(ji,jj,jk) 846 847 e3t_n(ji,jj,jk) = e3t_a(ji,jj,jk) 848 e3u_n(ji,jj,jk) = e3u_a(ji,jj,jk) 849 e3v_n(ji,jj,jk) = e3v_a(ji,jj,jk) 850 END DO 851 END DO 852 END DO 611 853 612 854 ! Compute all missing vertical scale factor and depths … … 628 870 629 871 ! t- and w- points depth (set the isf depth as it is in the initial step) 630 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 631 gdepw_n(:,:,1) = 0.0_wp 632 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 872 ! !$OMP PARALLEL 873 ! !$OMP DO schedule(static) private(jj,ji) 874 DO jj = 1, jpj 875 DO ji = 1, jpi 876 gdept_n(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) 877 gdepw_n(ji,jj,1) = 0.0_wp 878 gde3w_n(ji,jj,1) = gdept_n(ji,jj,1) - sshn(ji,jj) 879 END DO 880 END DO 633 881 DO jk = 2, jpk 882 ! !$OMP DO schedule(static) private(jj,ji,zcoef) 634 883 DO jj = 1,jpj 635 884 DO ji = 1,jpi … … 647 896 ! Local depth and Inverse of the local depth of the water 648 897 ! ------------------------------------------------------- 649 hu_n(:,:) = hu_a(:,:) ; r1_hu_n(:,:) = r1_hu_a(:,:) 650 hv_n(:,:) = hv_a(:,:) ; r1_hv_n(:,:) = r1_hv_a(:,:) 651 ! 652 ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1) 898 !$OMP PARALLEL 899 !$OMP DO schedule(static) private(jj,ji) 900 DO jj = 1, jpj 901 DO ji = 1, jpi 902 hu_n(ji,jj) = hu_a(ji,jj) ; r1_hu_n(ji,jj) = r1_hu_a(ji,jj) 903 hv_n(ji,jj) = hv_a(ji,jj) ; r1_hv_n(ji,jj) = r1_hv_a(ji,jj) 904 ! 905 ht_n(ji,jj) = e3t_n(ji,jj,1) * tmask(ji,jj,1) 906 END DO 907 END DO 653 908 DO jk = 2, jpkm1 654 ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 655 END DO 656 909 !$OMP DO schedule(static) private(jj,ji) 910 DO jj = 1, jpj 911 DO ji = 1, jpi 912 ht_n(ji,jj) = ht_n(ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 913 END DO 914 END DO 915 END DO 916 !$OMP END PARALLEL 657 917 ! write restart file 658 918 ! ================== … … 694 954 ! 695 955 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean 956 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 696 957 DO jk = 1, jpk 697 958 DO jj = 1, jpjm1 … … 704 965 END DO 705 966 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 706 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 967 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 968 DO jk = 1, jpk 969 DO jj = 1, jpj 970 DO ji = 1, jpi 971 pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) + e3u_0(ji,jj,jk) 972 END DO 973 END DO 974 END DO 707 975 ! 708 976 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean 977 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 709 978 DO jk = 1, jpk 710 979 DO jj = 1, jpjm1 … … 717 986 END DO 718 987 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 719 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 988 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 989 DO jk = 1, jpk 990 DO jj = 1, jpj 991 DO ji = 1, jpi 992 pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) + e3v_0(ji,jj,jk) 993 END DO 994 END DO 995 END DO 720 996 ! 721 997 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 998 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 722 999 DO jk = 1, jpk 723 1000 DO jj = 1, jpjm1 … … 731 1008 END DO 732 1009 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 733 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 1010 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 1011 DO jk = 1, jpk 1012 DO jj = 1, jpj 1013 DO ji = 1, jpi 1014 pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) + e3f_0(ji,jj,jk) 1015 END DO 1016 END DO 1017 END DO 734 1018 ! 735 1019 CASE( 'W' ) !* from T- to W-point : vertical simple mean 736 1020 ! 737 pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1) 1021 !$OMP PARALLEL 1022 !$OMP DO schedule(static) private(jj,ji) 1023 DO jj = 1, jpj 1024 DO ji = 1, jpi 1025 pe3_out(ji,jj,1) = e3w_0(ji,jj,1) + pe3_in(ji,jj,1) - e3t_0(ji,jj,1) 1026 END DO 1027 END DO 738 1028 ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing 739 1029 !!gm BUG? use here wmask in case of ISF ? to be checked 1030 !$OMP DO schedule(static) private(jk,jj,ji) 740 1031 DO jk = 2, jpk 741 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) ) & 742 & * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) & 743 & + 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) & 744 & * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) ) 745 END DO 1032 DO jj = 1, jpj 1033 DO ji = 1, jpi 1034 pe3_out(ji,jj,jk) = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * ( tmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) ) & 1035 & * ( pe3_in(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) ) & 1036 & + 0.5_wp * ( tmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) & 1037 & * ( pe3_in(ji,jj,jk ) - e3t_0(ji,jj,jk ) ) 1038 END DO 1039 END DO 1040 END DO 1041 !$OMP END PARALLEL 746 1042 ! 747 1043 CASE( 'UW' ) !* from U- to UW-point : vertical simple mean 748 1044 ! 749 pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1) 1045 !$OMP PARALLEL 1046 !$OMP DO schedule(static) private(jj,ji) 1047 DO jj = 1, jpj 1048 DO ji = 1, jpi 1049 pe3_out(ji,jj,1) = e3uw_0(ji,jj,1) + pe3_in(ji,jj,1) - e3u_0(ji,jj,1) 1050 END DO 1051 END DO 750 1052 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 751 1053 !!gm BUG? use here wumask in case of ISF ? to be checked 1054 !$OMP DO schedule(static) private(jk,jj,ji) 752 1055 DO jk = 2, jpk 753 pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) ) & 754 & * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) ) & 755 & + 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) & 756 & * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) ) 757 END DO 1056 DO jj = 1, jpj 1057 DO ji = 1, jpi 1058 pe3_out(ji,jj,jk) = e3uw_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) ) & 1059 & * ( pe3_in(ji,jj,jk-1) - e3u_0(ji,jj,jk-1) ) & 1060 & + 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) & 1061 & * ( pe3_in(ji,jj,jk ) - e3u_0(ji,jj,jk ) ) 1062 END DO 1063 END DO 1064 END DO 1065 !$OMP END PARALLEL 758 1066 ! 759 1067 CASE( 'VW' ) !* from V- to VW-point : vertical simple mean 760 1068 ! 761 pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1) 1069 !$OMP PARALLEL 1070 !$OMP DO schedule(static) private(jj,ji) 1071 DO jj = 1, jpj 1072 DO ji = 1, jpi 1073 pe3_out(ji,jj,1) = e3vw_0(ji,jj,1) + pe3_in(ji,jj,1) - e3v_0(ji,jj,1) 1074 END DO 1075 END DO 762 1076 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 763 1077 !!gm BUG? use here wvmask in case of ISF ? to be checked 1078 !$OMP DO schedule(static) private(jk,jj,ji) 764 1079 DO jk = 2, jpk 765 pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) ) & 766 & * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) ) & 767 & + 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) & 768 & * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) ) 769 END DO 1080 DO jj = 1, jpj 1081 DO ji = 1, jpi 1082 pe3_out(ji,jj,jk) = e3vw_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) ) & 1083 & * ( pe3_in(ji,jj,jk-1) - e3v_0(ji,jj,jk-1) ) & 1084 & + 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) & 1085 & * ( pe3_in(ji,jj,jk ) - e3v_0(ji,jj,jk ) ) 1086 END DO 1087 END DO 1088 END DO 1089 !$OMP END PARALLEL 770 1090 END SELECT 771 1091 ! … … 905 1225 sshb(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) !!gm I don't understand that ! 906 1226 sshn(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 907 ssha(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 1227 ssha(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 908 1228 ENDIF 909 1229 ENDDO -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r7646 r7698 72 72 INTEGER, DIMENSION(:,:), INTENT(out) :: k_top, k_bot ! ocean first and last level indices 73 73 ! 74 INTEGER :: j k ! dummy loop index74 INTEGER :: ji, jj, jk ! dummy loop index 75 75 INTEGER :: ioptio, ibat, ios ! local integer 76 76 REAL(wp) :: zrefdep ! depth of the reference level (~10m) … … 114 114 !!gm to be remove when removing the OLD definition of e3 scale factors so that gde3w disappears 115 115 ! Compute gde3w_0 (vertical sum of e3w) 116 gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 116 !$OMP PARALLEL 117 !$OMP DO schedule(static) private(jj, ji) 118 DO jj = 1, jpj 119 DO ji = 1, jpi 120 gde3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1) 121 END DO 122 END DO 117 123 DO jk = 2, jpk 118 gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk) 119 END DO 124 !$OMP DO schedule(static) private(jj, ji) 125 DO jj = 1, jpj 126 DO ji = 1, jpi 127 gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 128 END DO 129 END DO 130 END DO 131 !$OMP END PARALLEL 120 132 ! 121 133 IF(lwp) THEN ! Control print … … 190 202 INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top , k_bot ! first & last ocean level 191 203 ! 192 INTEGER :: jk 204 INTEGER :: jk, jj, ji ! dummy loop index 193 205 INTEGER :: inum ! local logical unit 194 206 REAL(WP) :: z_zco, z_zps, z_sco, z_cav … … 254 266 ! !* ocean top and bottom level 255 267 CALL iom_get( inum, jpdom_data, 'top_level' , z2d , lrowattr=ln_use_jattr ) ! 1st wet T-points (ISF) 256 k_top(:,:) = INT( z2d(:,:) ) 268 !$OMP PARALLEL DO schedule(static) private(jj, ji) 269 DO jj = 1, jpj 270 DO ji = 1, jpi 271 k_top(ji,jj) = INT( z2d(ji,jj) ) 272 END DO 273 END DO 257 274 CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d , lrowattr=ln_use_jattr ) ! last wet T-points 258 k_bot(:,:) = INT( z2d(:,:) ) 275 !$OMP PARALLEL DO schedule(static) private(jj, ji) 276 DO jj = 1, jpj 277 DO ji = 1, jpi 278 k_bot(ji,jj) = INT( z2d(ji,jj) ) 279 END DO 280 END DO 259 281 ! 260 282 ! bathymetry with orography (wetting and drying only) … … 295 317 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 296 318 ! 297 mikt(:,:) = MAX( k_top(:,:) , 1 ) ! top ocean k-index of T-level (=1 over land) 298 ! 299 mbkt(:,:) = MAX( k_bot(:,:) , 1 ) ! bottom ocean k-index of T-level (=1 over land) 300 319 !$OMP PARALLEL 320 !$OMP DO schedule(static) private(jj, ji) 321 DO jj = 1, jpj 322 DO ji = 1, jpi 323 mikt(ji,jj) = MAX( k_top(ji,jj) , 1 ) ! top ocean k-index of T-level (=1 over land) 324 ! 325 mbkt(ji,jj) = MAX( k_bot(ji,jj) , 1 ) ! bottom ocean k-index of T-level (=1 over land) 326 END DO 327 END DO 301 328 ! ! N.B. top k-index of W-level = mikt 302 329 ! ! bottom k-index of W-level = mbkt+1 330 !$OMP DO schedule(static) private(jj, ji) 303 331 DO jj = 1, jpjm1 304 332 DO ji = 1, jpim1 … … 312 340 END DO 313 341 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 314 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; miku(:,:) = MAX( INT( zk(:,:) ), 1 ) 315 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mikv(:,:) = MAX( INT( zk(:,:) ), 1 ) 316 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( zk, 'F', 1. ) ; mikf(:,:) = MAX( INT( zk(:,:) ), 1 ) 317 ! 318 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; mbku(:,:) = MAX( INT( zk(:,:) ), 1 ) 319 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mbkv(:,:) = MAX( INT( zk(:,:) ), 1 ) 342 !$OMP DO schedule(static) private(jj, ji) 343 DO jj = 1, jpj 344 DO ji = 1, jpi 345 zk(ji,jj) = REAL( miku(ji,jj), wp ) 346 END DO 347 END DO 348 !$OMP END PARALLEL 349 CALL lbc_lnk( zk, 'U', 1. ) 350 !$OMP PARALLEL 351 !$OMP DO schedule(static) private(jj, ji) 352 DO jj = 1, jpj 353 DO ji = 1, jpi 354 miku(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 355 END DO 356 END DO 357 !$OMP DO schedule(static) private(jj, ji) 358 DO jj = 1, jpj 359 DO ji = 1, jpi 360 zk(ji,jj) = REAL( mikv(ji,jj), wp ) 361 END DO 362 END DO 363 !$OMP END PARALLEL 364 CALL lbc_lnk( zk, 'V', 1. ) 365 !$OMP PARALLEL 366 !$OMP DO schedule(static) private(jj, ji) 367 DO jj = 1, jpj 368 DO ji = 1, jpi 369 mikv(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 370 END DO 371 END DO 372 !$OMP DO schedule(static) private(jj, ji) 373 DO jj = 1, jpj 374 DO ji = 1, jpi 375 zk(ji,jj) = REAL( mikf(ji,jj), wp ) 376 END DO 377 END DO 378 !$OMP END PARALLEL 379 CALL lbc_lnk( zk, 'F', 1. ) 380 !$OMP PARALLEL 381 !$OMP DO schedule(static) private(jj, ji) 382 DO jj = 1, jpj 383 DO ji = 1, jpi 384 mikf(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 385 END DO 386 END DO 387 ! 388 !$OMP DO schedule(static) private(jj, ji) 389 DO jj = 1, jpj 390 DO ji = 1, jpi 391 zk(ji,jj) = REAL( mbku(ji,jj), wp ) 392 END DO 393 END DO 394 !$OMP END PARALLEL 395 CALL lbc_lnk( zk, 'U', 1. ) 396 !$OMP PARALLEL 397 !$OMP DO schedule(static) private(jj, ji) 398 DO jj = 1, jpj 399 DO ji = 1, jpi 400 mbku(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 401 END DO 402 END DO 403 !$OMP DO schedule(static) private(jj, ji) 404 DO jj = 1, jpj 405 DO ji = 1, jpi 406 zk(ji,jj) = REAL( mbkv(ji,jj), wp ) 407 END DO 408 END DO 409 !$OMP END PARALLEL 410 CALL lbc_lnk( zk, 'V', 1. ) 411 !$OMP PARALLEL DO schedule(static) private(jj, ji) 412 DO jj = 1, jpj 413 DO ji = 1, jpi 414 mbkv(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 415 END DO 416 END DO 320 417 ! 321 418 CALL wrk_dealloc( jpi,jpj, zk ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
r7646 r7698 161 161 ij0 = 101 ; ij1 = 109 ! Reduced T & S in the Alboran Sea 162 162 ii0 = 141 ; ii1 = 155 163 !$OMP PARALLEL DO schedule(static) private(jj, ji) 163 164 DO jj = mj0(ij0), mj1(ij1) 164 165 DO ji = mi0(ii0), mi1(ii1) … … 181 182 !!gm end 182 183 ! 183 ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:) ! NO mask 184 ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 184 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 185 DO jk = 1, jpk 186 DO jj = 1, jpj 187 DO ji = 1, jpi 188 ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk) ! NO mask 189 ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk) 190 END DO 191 END DO 192 END DO 185 193 ! 186 194 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 193 201 ENDIF 194 202 ! 203 !$OMP PARALLEL DO schedule(static) private(jj, ji, jk, zl, jkk, zi) 195 204 DO jj = 1, jpj ! vertical interpolation of T & S 196 205 DO ji = 1, jpi … … 226 235 ELSE !== z- or zps- coordinate ==! 227 236 ! 228 ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:) ! Mask 229 ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 237 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 238 DO jk = 1, jpk 239 DO jj = 1, jpj 240 DO ji = 1, jpi 241 ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask 242 ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 243 END DO 244 END DO 245 END DO 230 246 ! 231 247 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 248 !$OMP PARALLEL DO schedule(static) private(jj, ji, ik, zl) 232 249 DO jj = 1, jpj 233 250 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r7646 r7698 59 59 !! ** Purpose : Initialization of the dynamics and tracer fields. 60 60 !!---------------------------------------------------------------------- 61 INTEGER :: ji, jj, jk ! dummy loop indices61 INTEGER :: ji, jj, jk, jn ! dummy loop indices 62 62 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace 63 63 !!---------------------------------------------------------------------- … … 75 75 ! IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data 76 76 !!gm 77 78 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 79 rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk 80 tsa (:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 81 rab_b(:,:,:,:) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 77 !$OMP PARALLEL 78 DO jn = 1, jpts 79 !$OMP DO schedule(static) private(jk, jj, ji) 80 DO jk = 1, jpk 81 DO jj = 1, jpj 82 DO ji = 1, jpi 83 tsa (ji,jj,jk,jn) = 0._wp ! set one for all to 0 at level jpk 84 rab_b(ji,jj,jk,jn) = 0._wp ; rab_n(ji,jj,jk,jn) = 0._wp ! set one for all to 0 at level jpk 85 END DO 86 END DO 87 END DO 88 END DO 89 !$OMP DO schedule(static) private(jk, jj, ji) 90 DO jk = 1, jpk 91 DO jj = 1, jpj 92 DO ji = 1, jpi 93 rhd (ji,jj,jk ) = 0._wp ; rhop (ji,jj,jk ) = 0._wp ! set one for all to 0 at level jpk 94 rn2b (ji,jj,jk ) = 0._wp ; rn2 (ji,jj,jk ) = 0._wp ! set one for all to 0 at levels 1 and jpk 95 END DO 96 END DO 97 END DO 98 !$OMP END PARALLEL 82 99 83 100 IF( ln_rstart ) THEN ! Restart from a file … … 97 114 CALL dta_tsd( nit000, tsb ) ! read 3D T and S data at nit000 98 115 ! 99 sshb(:,:) = 0._wp ! set the ocean at rest 100 ub (:,:,:) = 0._wp 101 vb (:,:,:) = 0._wp 116 !$OMP PARALLEL 117 !$OMP DO schedule(static) private(jj, ji) 118 DO jj = 1, jpj 119 DO ji = 1, jpi 120 sshb (ji,jj) = 0._wp ! set the ocean at rest 121 END DO 122 END DO 123 !$OMP END DO NOWAIT 124 !$OMP DO schedule(static) private(jk, jj, ji) 125 DO jk = 1, jpk 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 ub (ji,jj,jk) = 0._wp 129 vb (ji,jj,jk) = 0._wp 130 END DO 131 END DO 132 END DO 133 !$OMP END PARALLEL 102 134 ! 103 135 ELSE ! user defined initial T and S 104 136 CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb ) 105 137 ENDIF 106 tsn (:,:,:,:) = tsb (:,:,:,:) ! set now values from to before ones 107 sshn (:,:) = sshb(:,:) 108 un (:,:,:) = ub (:,:,:) 109 vn (:,:,:) = vb (:,:,:) 110 hdivn(:,:,jpk) = 0._wp ! bottom divergence set one for 0 to zero at jpk level 138 !$OMP PARALLEL 139 DO jn = 1, jpts 140 !$OMP DO schedule(static) private(jk, jj, ji) 141 DO jk = 1, jpk 142 DO jj = 1, jpj 143 DO ji = 1, jpi 144 tsn (ji,jj,jk,jn) = tsb (ji,jj,jk,jn) ! set now values from to before ones 145 END DO 146 END DO 147 END DO 148 END DO 149 !$OMP DO schedule(static) private(jk, jj, ji) 150 DO jk = 1, jpk 151 DO jj = 1, jpj 152 DO ji = 1, jpi 153 un (ji,jj,jk) = ub (ji,jj,jk) 154 vn (ji,jj,jk) = vb (ji,jj,jk) 155 END DO 156 END DO 157 END DO 158 !$OMP DO schedule(static) private(jj, ji) 159 DO jj = 1, jpj 160 DO ji = 1, jpi 161 sshn (ji,jj) = sshb(ji,jj) 162 hdivn(ji,jj,jpk) = 0._wp ! bottom divergence set one for 0 to zero at jpk level 163 END DO 164 END DO 165 !$OMP END PARALLEL 111 166 CALL div_hor( 0 ) ! compute interior hdivn value 112 167 !!gm hdivn(:,:,:) = 0._wp … … 142 197 ! Do it whatever the free surface method, these arrays being eventually used 143 198 ! 144 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 145 ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 199 !$OMP PARALLEL 200 !$OMP DO schedule(static) private(jj, ji) 201 DO jj = 1, jpj 202 DO ji = 1, jpi 203 un_b(ji,jj) = 0._wp ; vn_b(ji,jj) = 0._wp 204 ub_b(ji,jj) = 0._wp ; vb_b(ji,jj) = 0._wp 205 END DO 206 END DO 146 207 ! 147 208 !!gm the use of umsak & vmask is not necessary below as un, vn, ub, vb are always masked 148 209 DO jk = 1, jpkm1 210 !$OMP DO schedule(static) private(jj, ji) 149 211 DO jj = 1, jpj 150 212 DO ji = 1, jpi … … 158 220 END DO 159 221 ! 160 un_b(:,:) = un_b(:,:) * r1_hu_n(:,:) 161 vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:) 162 ! 163 ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 164 vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 222 !$OMP DO schedule(static) private(jj, ji) 223 DO jj = 1, jpj 224 DO ji = 1, jpi 225 un_b(ji,jj) = un_b(ji,jj) * r1_hu_n(ji,jj) 226 vn_b(ji,jj) = vn_b(ji,jj) * r1_hv_n(ji,jj) 227 ! 228 ub_b(ji,jj) = ub_b(ji,jj) * r1_hu_b(ji,jj) 229 vb_b(ji,jj) = vb_b(ji,jj) * r1_hv_b(ji,jj) 230 END DO 231 END DO 232 !$OMP END PARALLEL 165 233 ! 166 234 IF( nn_timing == 1 ) CALL timing_stop('istate_init') -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
r6140 r7698 72 72 ENDIF 73 73 ! 74 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 74 75 DO jk = 1, jpkm1 !== Horizontal divergence ==! 75 76 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r6140 r7698 47 47 INTEGER, INTENT(in) :: kt ! ocean time-step index 48 48 !! 49 INTEGER :: j i, jj ! dummy loop indexes49 INTEGER :: jk, ji, jj ! dummy loop indexes 50 50 INTEGER :: ikbu, ikbv ! local integers 51 51 REAL(wp) :: zm1_2dt ! local scalar … … 65 65 IF( l_trddyn ) THEN ! trends: store the input trends 66 66 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 67 ztrdu(:,:,:) = ua(:,:,:) 68 ztrdv(:,:,:) = va(:,:,:) 67 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 68 DO jk = 1, jpk 69 DO jj = 1, jpj 70 DO ji = 1, jpi 71 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 72 ztrdv(ji,jj,jk) = va(ji,jj,jk) 73 END DO 74 END DO 75 END DO 69 76 ENDIF 70 77 71 78 79 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 72 80 DO jj = 2, jpjm1 73 81 DO ji = 2, jpim1 … … 82 90 ! 83 91 IF( ln_isfcav ) THEN ! ocean cavities 92 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 84 93 DO jj = 2, jpjm1 85 94 DO ji = 2, jpim1 … … 99 108 ! 100 109 IF( l_trddyn ) THEN ! trends: send trends to trddyn for further diagnostics 101 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 102 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 110 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 111 DO jk = 1, jpk 112 DO jj = 1, jpj 113 DO ji = 1, jpi 114 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 115 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 116 END DO 117 END DO 118 END DO 103 119 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 104 120 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r7646 r7698 84 84 !!---------------------------------------------------------------------- 85 85 INTEGER, INTENT(in) :: kt ! ocean time-step index 86 INTEGER :: jk, jj, ji 86 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 87 88 !!---------------------------------------------------------------------- … … 91 92 IF( l_trddyn ) THEN ! Temporary saving of ua and va trends (l_trddyn) 92 93 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 93 ztrdu(:,:,:) = ua(:,:,:) 94 ztrdv(:,:,:) = va(:,:,:) 94 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 95 DO jk = 1, jpk 96 DO jj = 1, jpj 97 DO ji = 1, jpi 98 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 99 ztrdv(ji,jj,jk) = va(ji,jj,jk) 100 END DO 101 END DO 102 END DO 95 103 ENDIF 96 104 ! … … 105 113 ! 106 114 IF( l_trddyn ) THEN ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 107 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 108 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 115 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 116 DO jk = 1, jpk 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 120 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 121 END DO 122 END DO 123 END DO 109 124 CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 110 125 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) … … 198 213 ! 199 214 ! initialisation of ice shelf load 200 IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0 215 IF ( .NOT. ln_isfcav ) THEN 216 !$OMP PARALLEL DO schedule(static) private(jj, ji) 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 riceload(ji,jj)=0.0 220 END DO 221 END DO 222 END IF 201 223 IF ( ln_isfcav ) THEN 202 224 CALL wrk_alloc( jpi,jpj, 2, ztstop) … … 212 234 213 235 ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 214 ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp 236 !$OMP PARALLEL DO schedule(static) private(jj, ji) 237 DO jj = 1, jpj 238 DO ji = 1, jpi 239 ztstop(ji,jj,1)=-1.9_wp 240 ztstop(ji,jj,2)=34.4_wp 241 END DO 242 END DO 215 243 216 244 ! compute density of the water displaced by the ice shelf … … 226 254 ! divided by 2 later 227 255 ziceload = 0._wp 256 !$OMP PARALLEL 257 !$OMP DO schedule(static) private(jj,ji,ikt,jk) 228 258 DO jj = 1, jpj 229 259 DO ji = 1, jpi … … 238 268 END DO 239 269 END DO 240 riceload(:,:)=ziceload(:,:) ! need to be saved for diaar5 270 !$OMP DO schedule(static) private(jj, ji) 271 DO jj = 1, jpj 272 DO ji = 1, jpi 273 riceload(ji,jj)=ziceload(ji,jj) ! need to be saved for diaar5 274 END DO 275 END DO 276 !$OMP END PARALLEL 241 277 242 278 CALL wrk_dealloc( jpi,jpj, 2, ztstop) … … 282 318 283 319 ! Surface value 320 !$OMP PARALLEL 321 !$OMP DO schedule(static) private(ji,jj, zcoef1) 284 322 DO jj = 2, jpjm1 285 323 DO ji = fs_2, fs_jpim1 ! vector opt. … … 297 335 ! interior value (2=<jk=<jpkm1) 298 336 DO jk = 2, jpkm1 337 !$OMP DO schedule(static) private(ji,jj, zcoef1) 299 338 DO jj = 2, jpjm1 300 339 DO ji = fs_2, fs_jpim1 ! vector opt. … … 313 352 END DO 314 353 END DO 315 END DO 354 !$OMP END DO NOWAIT 355 END DO 356 !$OMP END PARALLEL 316 357 ! 317 358 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) … … 351 392 352 393 ! Surface value (also valid in partial step case) 394 !$OMP PARALLEL 395 !$OMP DO schedule(static) private(ji,jj,zcoef1) 353 396 DO jj = 2, jpjm1 354 397 DO ji = fs_2, fs_jpim1 ! vector opt. … … 365 408 ! interior value (2=<jk=<jpkm1) 366 409 DO jk = 2, jpkm1 410 !$OMP DO schedule(static) private(ji,jj, zcoef1) 367 411 DO jj = 2, jpjm1 368 412 DO ji = fs_2, fs_jpim1 ! vector opt. … … 384 428 385 429 ! partial steps correction at the last level (use gru & grv computed in zpshde.F90) 430 !$OMP DO schedule(static) private(ji,jj,iku,ikv,zcoef2,zcoef3) 386 431 DO jj = 2, jpjm1 387 432 DO ji = 2, jpim1 … … 404 449 END DO 405 450 END DO 451 !$OMP END PARALLEL 406 452 ! 407 453 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r7646 r7698 96 96 IF( l_trddyn ) THEN ! Save ua and va trends 97 97 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 98 ztrdu(:,:,:) = ua(:,:,:) 99 ztrdv(:,:,:) = va(:,:,:) 100 ENDIF 101 102 zhke(:,:,jpk) = 0._wp 98 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 99 DO jk = 1, jpk 100 DO jj = 1, jpj 101 DO ji = 1, jpi 102 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 103 ztrdv(ji,jj,jk) = va(ji,jj,jk) 104 END DO 105 END DO 106 END DO 107 ENDIF 108 !$OMP PARALLEL DO schedule(static) private(jj, ji) 109 DO jj = 1, jpj 110 DO ji = 1, jpi 111 zhke(ji,jj,jpk) = 0._wp 112 END DO 113 END DO 103 114 104 115 IF (ln_bdy) THEN … … 133 144 ! 134 145 CASE ( nkeg_C2 ) !-- Standard scheme --! 146 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv) 135 147 DO jk = 1, jpkm1 136 148 DO jj = 2, jpj … … 146 158 ! 147 159 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! 160 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv) 148 161 DO jk = 1, jpkm1 149 162 DO jj = 2, jpjm1 … … 168 181 IF (ln_bdy) THEN 169 182 ! restore velocity masks at points outside boundary 170 un(:,:,:) = un(:,:,:) * umask(:,:,:) 171 vn(:,:,:) = vn(:,:,:) * vmask(:,:,:) 172 ENDIF 173 174 175 ! 183 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 184 DO jk = 1, jpk 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 un(ji,jj,jk) = un(ji,jj,jk) * umask(ji,jj,jk) 188 vn(ji,jj,jk) = vn(ji,jj,jk) * vmask(ji,jj,jk) 189 END DO 190 END DO 191 END DO 192 ENDIF 193 194 ! 195 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 176 196 DO jk = 1, jpkm1 !== grad( KE ) added to the general momentum trends ==! 177 197 DO jj = 2, jpjm1 … … 184 204 ! 185 205 IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic 186 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 187 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 206 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 207 DO jk = 1, jpk 208 DO jj = 1, jpj 209 DO ji = 1, jpi 210 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 211 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 212 END DO 213 END DO 214 END DO 188 215 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 189 216 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r7646 r7698 61 61 !!---------------------------------------------------------------------- 62 62 INTEGER, INTENT(in) :: kt ! ocean time-step index 63 INTEGER :: jk, jj, ji 63 64 ! 64 65 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 69 70 IF( l_trddyn ) THEN ! temporary save of momentum trends 70 71 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 71 ztrdu(:,:,:) = ua(:,:,:) 72 ztrdv(:,:,:) = va(:,:,:) 72 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 73 DO jk = 1, jpk 74 DO jj = 1, jpj 75 DO ji = 1, jpi 76 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 77 ztrdv(ji,jj,jk) = va(ji,jj,jk) 78 END DO 79 END DO 80 END DO 73 81 ENDIF 74 82 … … 82 90 83 91 IF( l_trddyn ) THEN ! save the horizontal diffusive trends for further diagnostics 84 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 85 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 92 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 93 DO jk = 1, jpk 94 DO jj = 1, jpj 95 DO ji = 1, jpi 96 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 97 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 98 END DO 99 END DO 100 END DO 86 101 CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 87 102 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90
r6140 r7698 75 75 ! 76 76 ! ! =============== 77 !$OMP PARALLEL 77 78 DO jk = 1, jpkm1 ! Horizontal slab 78 79 ! ! =============== 80 !$OMP DO schedule(static) private(jj, ji) 79 81 DO jj = 2, jpj 80 82 DO ji = fs_2, jpi ! vector opt. … … 93 95 END DO 94 96 ! 97 !$OMP DO schedule(static) private(jj, ji) 95 98 DO jj = 2, jpjm1 ! - curl( curl) + grad( div ) 96 99 DO ji = fs_2, fs_jpim1 ! vector opt. … … 106 109 ! ! =============== 107 110 END DO ! End of slab 111 !$OMP END PARALLEL 108 112 ! ! =============== 109 113 CALL wrk_dealloc( jpi, jpj, zcur, zdiv ) … … 128 132 !!---------------------------------------------------------------------- 129 133 INTEGER , INTENT(in ) :: kt ! ocean time-step index 134 INTEGER :: jk, jj, ji 130 135 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pub, pvb ! before velocity fields 131 136 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! momentum trend … … 144 149 ENDIF 145 150 ! 146 zulap(:,:,:) = 0._wp 147 zvlap(:,:,:) = 0._wp 151 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 152 DO jk = 1, jpk 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 zulap(ji,jj,jk) = 0._wp 156 zvlap(ji,jj,jk) = 0._wp 157 END DO 158 END DO 159 END DO 148 160 ! 149 161 CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 ) ! rotated laplacian applied to ptb (output in zlap) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r7646 r7698 115 115 ! Ensure below that barotropic velocities match time splitting estimate 116 116 ! Compute actual transport and replace it with ts estimate at "after" time step 117 zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 118 zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 117 !$OMP PARALLEL 118 !$OMP DO schedule(static) private(jj, ji) 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 zue(ji,jj) = e3u_a(ji,jj,1) * ua(ji,jj,1) * umask(ji,jj,1) 122 zve(ji,jj) = e3v_a(ji,jj,1) * va(ji,jj,1) * vmask(ji,jj,1) 123 END DO 124 END DO 119 125 DO jk = 2, jpkm1 120 zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 121 zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 122 END DO 126 !$OMP DO schedule(static) private(jj,ji) 127 DO jj = 1, jpj 128 DO ji = 1, jpi 129 zue(ji,jj) = zue(ji,jj) + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 130 zve(ji,jj) = zve(ji,jj) + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 131 END DO 132 END DO 133 END DO 134 !$OMP DO schedule(static) private(jk,jj,ji) 123 135 DO jk = 1, jpkm1 124 ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 125 va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 126 END DO 136 DO jj = 1, jpj 137 DO ji = 1, jpi 138 ua(ji,jj,jk) = ( ua(ji,jj,jk) - zue(ji,jj) * r1_hu_a(ji,jj) + ua_b(ji,jj) ) * umask(ji,jj,jk) 139 va(ji,jj,jk) = ( va(ji,jj,jk) - zve(ji,jj) * r1_hv_a(ji,jj) + va_b(ji,jj) ) * vmask(ji,jj,jk) 140 END DO 141 END DO 142 END DO 143 !$OMP END PARALLEL 127 144 ! 128 145 IF( .NOT.ln_bt_fw ) THEN … … 131 148 ! In the forward case, this is done below after asselin filtering 132 149 ! so that asselin contribution is removed at the same time 150 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 133 151 DO jk = 1, jpkm1 134 un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 135 vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 136 END DO 152 DO jj = 1, jpj 153 DO ji = 1, jpi 154 un(ji,jj,jk) = ( un(ji,jj,jk) - un_adv(ji,jj) + un_b(ji,jj) )*umask(ji,jj,jk) 155 vn(ji,jj,jk) = ( vn(ji,jj,jk) - vn_adv(ji,jj) + vn_b(ji,jj) )*vmask(ji,jj,jk) 156 END DO 157 END DO 158 END DO 159 137 160 ENDIF 138 161 ENDIF … … 161 184 ! 162 185 IF( ln_dyn_trd ) THEN ! 3D output: total momentum trends 163 zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 164 zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 186 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 187 DO jk = 1, jpk 188 DO jj = 1, jpj 189 DO ji = 1, jpi 190 zua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_2dt 191 zva(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_2dt 192 END DO 193 END DO 194 END DO 165 195 CALL iom_put( "utrd_tot", zua ) ! total momentum trends, except the asselin time filter 166 196 CALL iom_put( "vtrd_tot", zva ) 167 197 ENDIF 168 198 ! 169 zua(:,:,:) = un(:,:,:) ! save the now velocity before the asselin filter 170 zva(:,:,:) = vn(:,:,:) ! (caution: there will be a shift by 1 timestep in the 171 ! ! computation of the asselin filter trends) 199 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 200 DO jk = 1, jpk 201 DO jj = 1, jpj 202 DO ji = 1, jpi 203 zua(ji,jj,jk) = un(ji,jj,jk) ! save the now velocity before the asselin filter 204 zva(ji,jj,jk) = vn(ji,jj,jk) ! (caution: there will be a shift by 1 timestep in the 205 ! ! computation of the asselin filter trends) 206 END DO 207 END DO 208 END DO 172 209 ENDIF 173 210 … … 175 212 ! ------------------------------------------ 176 213 IF( neuler == 0 .AND. kt == nit000 ) THEN !* Euler at first time-step: only swap 214 !$OMP PARALLEL 215 !$OMP DO schedule(static) private(jk,jj,ji) 177 216 DO jk = 1, jpkm1 178 un(:,:,jk) = ua(:,:,jk) ! un <-- ua 179 vn(:,:,jk) = va(:,:,jk) 180 END DO 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 un(ji,jj,jk) = ua(ji,jj,jk) ! un <-- ua 220 vn(ji,jj,jk) = va(ji,jj,jk) 221 END DO 222 END DO 223 END DO 224 !$OMP END DO NOWAIT 181 225 IF(.NOT.ln_linssh ) THEN 226 !$OMP DO schedule(static) private(jk,jj,ji) 182 227 DO jk = 1, jpkm1 183 e3t_b(:,:,jk) = e3t_n(:,:,jk) 184 e3u_b(:,:,jk) = e3u_n(:,:,jk) 185 e3v_b(:,:,jk) = e3v_n(:,:,jk) 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 e3t_b(ji,jj,jk) = e3t_n(ji,jj,jk) 231 e3u_b(ji,jj,jk) = e3u_n(ji,jj,jk) 232 e3v_b(ji,jj,jk) = e3v_n(ji,jj,jk) 233 END DO 234 END DO 186 235 END DO 187 236 ENDIF 237 !$OMP END PARALLEL 188 238 ELSE !* Leap-Frog : Asselin filter and swap 189 239 ! ! =============! 190 240 IF( ln_linssh ) THEN ! Fixed volume ! 191 241 ! ! =============! 242 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 192 243 DO jk = 1, jpkm1 193 244 DO jj = 1, jpj … … 210 261 ! ---------------------------------------------------- 211 262 IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN ! No asselin filtering on thicknesses if forward time splitting 212 e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 263 !$OMP PARALLEL DO schedule(static) private(jj,ji) 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 e3t_b(ji,jj,1:jpkm1) = e3t_n(ji,jj,1:jpkm1) 267 END DO 268 END DO 213 269 ELSE 270 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 214 271 DO jk = 1, jpkm1 215 e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 e3t_b(ji,jj,jk) = e3t_n(ji,jj,jk) + atfp * ( e3t_b(ji,jj,jk) - 2._wp * e3t_n(ji,jj,jk) + e3t_a(ji,jj,jk) ) 275 END DO 276 END DO 216 277 END DO 217 278 ! Add volume filter correction: compatibility with tracer advection scheme … … 219 280 zcoef = atfp * rdt * r1_rau0 220 281 IF ( .NOT. ln_isf ) THEN ! if no ice shelf melting 221 e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 222 & - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 282 !$OMP PARALLEL DO schedule(static) private(jj,ji) 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 e3t_b(ji,jj,1) = e3t_b(ji,jj,1) - zcoef * ( emp_b(ji,jj) - emp(ji,jj) & 286 & - rnf_b(ji,jj) + rnf(ji,jj) ) * tmask(ji,jj,1) 287 END DO 288 END DO 223 289 ELSE ! if ice shelf melting 290 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt) 224 291 DO jj = 1, jpj 225 292 DO ji = 1, jpi … … 237 304 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 238 305 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 306 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 239 307 DO jk = 1, jpkm1 240 308 DO jj = 1, jpj … … 257 325 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 258 326 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 327 !$OMP PARALLEL 328 !$OMP DO schedule(static) private(jk, jj, ji, zue3a, zve3a, zue3n, zve3n, zue3b, zve3b, zuf, zvf) 259 329 DO jk = 1, jpkm1 260 330 DO jj = 1, jpj … … 277 347 END DO 278 348 END DO 279 e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor 280 e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 349 !$OMP DO schedule(static) private(jj, ji) 350 DO jj = 1, jpj 351 DO ji = 1, jpi 352 e3u_b(ji,jj,1:jpkm1) = ze3u_f(ji,jj,1:jpkm1) ! e3u_b <-- filtered scale factor 353 e3v_b(ji,jj,1:jpkm1) = ze3v_f(ji,jj,1:jpkm1) 354 END DO 355 END DO 356 !$OMP END PARALLEL 281 357 ! 282 358 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) … … 288 364 ! Revert "before" velocities to time split estimate 289 365 ! Doing it here also means that asselin filter contribution is removed 290 zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 291 zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 366 !$OMP PARALLEL 367 !$OMP DO schedule(static) private(jj, ji) 368 DO jj = 1, jpj 369 DO ji = 1, jpi 370 zue(ji,jj) = e3u_b(ji,jj,1) * ub(ji,jj,1) * umask(ji,jj,1) 371 zve(ji,jj) = e3v_b(ji,jj,1) * vb(ji,jj,1) * vmask(ji,jj,1) 372 END DO 373 END DO 292 374 DO jk = 2, jpkm1 293 zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 294 zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 295 END DO 375 !$OMP DO schedule(static) private(jj, ji) 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 zue(ji,jj) = zue(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 379 zve(ji,jj) = zve(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 380 END DO 381 END DO 382 END DO 383 !$OMP DO schedule(static) private(jk,jj,ji) 296 384 DO jk = 1, jpkm1 297 ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk) 298 vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk) 299 END DO 385 DO jj = 1, jpj 386 DO ji = 1, jpi 387 ub(ji,jj,jk) = ub(ji,jj,jk) - (zue(ji,jj) * r1_hu_n(ji,jj) - un_b(ji,jj)) * umask(ji,jj,jk) 388 vb(ji,jj,jk) = vb(ji,jj,jk) - (zve(ji,jj) * r1_hv_n(ji,jj) - vn_b(ji,jj)) * vmask(ji,jj,jk) 389 END DO 390 END DO 391 END DO 392 !$OMP END PARALLEL 300 393 ENDIF 301 394 ! … … 308 401 ! 309 402 IF(.NOT.ln_linssh ) THEN 310 hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 311 hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 403 !$OMP PARALLEL 404 !$OMP DO schedule(static) private(jj, ji) 405 DO jj = 1, jpj 406 DO ji = 1, jpi 407 hu_b(ji,jj) = e3u_b(ji,jj,1) * umask(ji,jj,1) 408 hv_b(ji,jj) = e3v_b(ji,jj,1) * vmask(ji,jj,1) 409 END DO 410 END DO 312 411 DO jk = 2, jpkm1 313 hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 314 hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 315 END DO 316 r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) 317 r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 318 ENDIF 319 ! 320 un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1) 321 ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 322 vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1) 323 vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 412 !$OMP DO schedule(static) private(jj, ji) 413 DO jj = 1, jpj 414 DO ji = 1, jpi 415 hu_b(ji,jj) = hu_b(ji,jj) + e3u_b(ji,jj,jk) * umask(ji,jj,jk) 416 hv_b(ji,jj) = hv_b(ji,jj) + e3v_b(ji,jj,jk) * vmask(ji,jj,jk) 417 END DO 418 END DO 419 END DO 420 !$OMP DO schedule(static) private(jj, ji) 421 DO jj = 1, jpj 422 DO ji = 1, jpi 423 r1_hu_b(ji,jj) = ssumask(ji,jj) / ( hu_b(ji,jj) + 1._wp - ssumask(ji,jj) ) 424 r1_hv_b(ji,jj) = ssvmask(ji,jj) / ( hv_b(ji,jj) + 1._wp - ssvmask(ji,jj) ) 425 END DO 426 END DO 427 !$OMP END PARALLEL 428 ENDIF 429 ! 430 !$OMP PARALLEL 431 !$OMP DO schedule(static) private(jj, ji) 432 DO jj = 1, jpj 433 DO ji = 1, jpi 434 un_b(ji,jj) = e3u_a(ji,jj,1) * un(ji,jj,1) * umask(ji,jj,1) 435 ub_b(ji,jj) = e3u_b(ji,jj,1) * ub(ji,jj,1) * umask(ji,jj,1) 436 vn_b(ji,jj) = e3v_a(ji,jj,1) * vn(ji,jj,1) * vmask(ji,jj,1) 437 vb_b(ji,jj) = e3v_b(ji,jj,1) * vb(ji,jj,1) * vmask(ji,jj,1) 438 END DO 439 END DO 324 440 DO jk = 2, jpkm1 325 un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk) 326 ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 327 vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk) 328 vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 441 !$OMP DO schedule(static) private(jj, ji) 442 DO jj = 1, jpj 443 DO ji = 1, jpi 444 un_b(ji,jj) = un_b(ji,jj) + e3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 445 ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 446 vn_b(ji,jj) = vn_b(ji,jj) + e3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 447 vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 448 END DO 449 END DO 329 450 END DO 330 un_b(:,:) = un_b(:,:) * r1_hu_a(:,:) 331 vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:) 332 ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 333 vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 451 !$OMP DO schedule(static) private(jj, ji) 452 DO jj = 1, jpj 453 DO ji = 1, jpi 454 un_b(ji,jj) = un_b(ji,jj) * r1_hu_a(ji,jj) 455 vn_b(ji,jj) = vn_b(ji,jj) * r1_hv_a(ji,jj) 456 ub_b(ji,jj) = ub_b(ji,jj) * r1_hu_b(ji,jj) 457 vb_b(ji,jj) = vb_b(ji,jj) * r1_hv_b(ji,jj) 458 END DO 459 END DO 460 !$OMP END PARALLEL 334 461 ! 335 462 IF( .NOT.ln_dynspg_ts ) THEN ! output the barotropic currents … … 338 465 ENDIF 339 466 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 340 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 341 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 467 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 468 DO jk = 1, jpkm1 469 DO jj = 1, jpj 470 DO ji = 1, jpi 471 zua(ji,jj,jk) = ( ub(ji,jj,jk) - zua(ji,jj,jk) ) * z1_2dt 472 zva(ji,jj,jk) = ( vb(ji,jj,jk) - zva(ji,jj,jk) ) * z1_2dt 473 END DO 474 END DO 475 END DO 342 476 CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 343 477 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r7646 r7698 83 83 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 84 84 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 85 ztrdu(:,:,:) = ua(:,:,:) 86 ztrdv(:,:,:) = va(:,:,:) 85 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 86 DO jk = 1, jpk 87 DO jj = 1, jpj 88 DO ji = 1, jpi 89 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 90 ztrdv(ji,jj,jk) = va(ji,jj,jk) 91 END DO 92 END DO 93 END DO 87 94 ENDIF 88 95 ! … … 91 98 .OR. nn_ice_embd == 2 ) THEN ! embedded sea-ice 92 99 ! 100 !$OMP PARALLEL DO schedule(static) private(jj, ji) 93 101 DO jj = 2, jpjm1 94 102 DO ji = fs_2, fs_jpim1 ! vector opt. … … 100 108 IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN !== Atmospheric pressure gradient (added later in time-split case) ==! 101 109 zg_2 = grav * 0.5 110 !$OMP PARALLEL DO schedule(static) private(jj, ji) 102 111 DO jj = 2, jpjm1 ! gradient of Patm using inverse barometer ssh 103 112 DO ji = fs_2, fs_jpim1 ! vector opt. … … 115 124 CALL upd_tide( kt ) ! update tide potential 116 125 ! 126 !$OMP PARALLEL DO schedule(static) private(jj, ji) 117 127 DO jj = 2, jpjm1 ! add tide potential forcing 118 128 DO ji = fs_2, fs_jpim1 ! vector opt. … … 128 138 zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 129 139 zgrau0r = - grav * r1_rau0 130 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zgrau0r 140 !$OMP PARALLEL 141 !$OMP DO schedule(static) private(jj, ji) 142 DO jj = 1, jpj 143 DO ji = 1, jpi 144 zpice(ji,jj) = ( zintp * snwice_mass(ji,jj) + ( 1.- zintp ) * snwice_mass_b(ji,jj) ) * zgrau0r 145 END DO 146 END DO 147 !$OMP DO schedule(static) private(jj, ji) 131 148 DO jj = 2, jpjm1 132 149 DO ji = fs_2, fs_jpim1 ! vector opt. … … 135 152 END DO 136 153 END DO 154 !$OMP END PARALLEL 137 155 ! 138 156 CALL wrk_dealloc( jpi,jpj, zpice ) 139 157 ENDIF 140 158 ! 159 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 141 160 DO jk = 1, jpkm1 !== Add all terms to the general trend 142 161 DO jj = 2, jpjm1 … … 158 177 ! 159 178 IF( l_trddyn ) THEN ! save the surface pressure gradient trends for further diagnostics 160 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 161 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 179 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 180 DO jk = 1, jpk 181 DO jj = 1, jpj 182 DO ji = 1, jpi 183 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 184 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 185 END DO 186 END DO 187 END DO 162 188 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 163 189 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7646 r7698 223 223 SELECT CASE( nn_een_e3f ) !* ff_f/e3 at F-point 224 224 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 225 !$OMP PARALLEL DO schedule(static) private(jj, ji) 225 226 DO jj = 1, jpjm1 226 227 DO ji = 1, jpim1 … … 231 232 END DO 232 233 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 234 !$OMP PARALLEL DO schedule(static) private(jj, ji) 233 235 DO jj = 1, jpjm1 234 236 DO ji = 1, jpim1 … … 243 245 CALL lbc_lnk( zwz, 'F', 1._wp ) 244 246 ! 245 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 247 !$OMP PARALLEL 248 !$OMP DO schedule(static) private(jj) 249 DO jj = 1, jpj 250 ftne(1,jj) = 0._wp ; ftnw(1,jj) = 0._wp ; ftse(1,jj) = 0._wp ; ftsw(1,jj) = 0._wp 251 END DO 252 !$OMP DO schedule(static) private(jj, ji) 246 253 DO jj = 2, jpj 247 254 DO ji = 2, jpi … … 252 259 END DO 253 260 END DO 261 !$OMP END PARALLEL 254 262 ! 255 263 ELSE !== all other schemes (ENE, ENS, MIX) 256 zwz(:,:) = 0._wp 257 zhf(:,:) = 0._wp 264 !$OMP PARALLEL DO schedule(static) private(jj, ji) 265 DO jj = 1, jpj 266 DO ji = 1, jpi 267 zwz(ji,jj) = 0._wp 268 zhf(ji,jj) = 0._wp 269 END DO 270 END DO 258 271 259 272 !!gm assume 0 in both cases (xhich is almost surely WRONG ! ) as hvatf has been removed … … 275 288 ELSE 276 289 !zhf(:,:) = hbatf(:,:) 290 !$OMP PARALLEL DO schedule(static) private(ji,jj) 277 291 DO jj = 1, jpjm1 278 292 DO ji = 1, jpim1 … … 289 303 END IF 290 304 305 !$OMP PARALLEL 306 !$OMP DO schedule(static) private(ji,jj) 291 307 DO jj = 1, jpjm1 292 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 308 DO ji = 1, jpim1 309 zhf(ji,jj) = zhf(ji,jj) * (1._wp- umask(ji,jj,1) * umask(ji,jj+1,1)) 310 END DO 293 311 END DO 294 312 !!gm end 295 313 296 314 DO jk = 1, jpkm1 315 !$OMP DO schedule(static) private(ji,jj) 297 316 DO jj = 1, jpjm1 298 zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 299 END DO 300 END DO 317 DO ji = 1, jpi 318 zhf(ji,jj) = zhf(ji,jj) + e3f_n(ji,jj,jk) * umask(ji,jj,jk) * umask(ji,jj+1,jk) 319 END DO 320 END DO 321 END DO 322 !$OMP END PARALLEL 301 323 CALL lbc_lnk( zhf, 'F', 1._wp ) 302 324 ! JC: TBC. hf should be greater than 0 325 !$OMP PARALLEL 326 !$OMP DO schedule(static) private(jj, ji) 303 327 DO jj = 1, jpj 304 328 DO ji = 1, jpi … … 306 330 END DO 307 331 END DO 308 zwz(:,:) = ff_f(:,:) * zwz(:,:) 332 !$OMP DO schedule(static) private(jj, ji) 333 DO jj = 1, jpj 334 DO ji = 1, jpi 335 zwz(ji,jj) = ff_f(ji,jj) * zwz(ji,jj) 336 END DO 337 END DO 338 !$OMP END PARALLEL 309 339 ENDIF 310 340 ENDIF … … 324 354 ! !* e3*d/dt(Ua) (Vertically integrated) 325 355 ! ! -------------------------------------------------- 326 zu_frc(:,:) = 0._wp 327 zv_frc(:,:) = 0._wp 356 !$OMP PARALLEL 357 !$OMP DO schedule(static) private(jj, ji) 358 DO jj = 1, jpj 359 DO ji = 1, jpi 360 zu_frc(ji,jj) = 0._wp 361 zv_frc(ji,jj) = 0._wp 362 END DO 363 END DO 328 364 ! 329 365 DO jk = 1, jpkm1 330 zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 331 zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 366 !$OMP DO schedule(static) private(jj,ji) 367 DO jj=1,jpj 368 DO ji=1,jpi 369 zu_frc(ji,jj) = zu_frc(ji,jj) + e3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 370 zv_frc(ji,jj) = zv_frc(ji,jj) + e3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 371 END DO 372 END DO 332 373 END DO 333 374 ! 334 zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 335 zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 336 ! 375 !$OMP DO schedule(static) private(jj, ji) 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 zu_frc(ji,jj) = zu_frc(ji,jj) * r1_hu_n(ji,jj) 379 zv_frc(ji,jj) = zv_frc(ji,jj) * r1_hv_n(ji,jj) 380 END DO 381 END DO 337 382 ! 338 383 ! !* baroclinic momentum trend (remove the vertical mean trend) 384 !$OMP DO schedule(static) private(jk,jj,ji) 339 385 DO jk = 1, jpkm1 ! ----------------------------------------------------------- 340 386 DO jj = 2, jpjm1 … … 345 391 END DO 346 392 END DO 393 !$OMP END DO NOWAIT 347 394 348 395 !!gm Question here when removing the Vertically integrated trends, we remove the vertically integrated NL trends on momentum.... … … 352 399 ! !* barotropic Coriolis trends (vorticity scheme dependent) 353 400 ! ! -------------------------------------------------------- 354 zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:) ! now fluxes 355 zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 401 !$OMP DO schedule(static) private(jj, ji) 402 DO jj = 1, jpj 403 DO ji = 1, jpi 404 zwx(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) ! now fluxes 405 zwy(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 406 END DO 407 END DO 408 !$OMP END PARALLEL 356 409 ! 357 410 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN ! energy conserving or mixed scheme 411 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2) 358 412 DO jj = 2, jpjm1 359 413 DO ji = fs_2, fs_jpim1 ! vector opt. … … 369 423 ! 370 424 ELSEIF ( ln_dynvor_ens ) THEN ! enstrophy conserving scheme 425 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zx1) 371 426 DO jj = 2, jpjm1 372 427 DO ji = fs_2, fs_jpim1 ! vector opt. … … 381 436 ! 382 437 ELSEIF ( ln_dynvor_een ) THEN ! enstrophy and energy conserving scheme 438 !$OMP PARALLEL DO schedule(static) private(jj,ji) 383 439 DO jj = 2, jpjm1 384 440 DO ji = fs_2, fs_jpim1 ! vector opt. … … 400 456 IF( .NOT.ln_linssh ) THEN ! Variable volume : remove surface pressure gradient 401 457 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 458 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2) 402 459 DO jj = 2, jpjm1 403 460 DO ji = 2, jpim1 … … 440 497 END DO 441 498 499 !$OMP PARALLEL DO schedule(static) private(jj,ji) 442 500 DO jj = 2, jpjm1 443 501 DO ji = 2, jpim1 … … 451 509 ELSE 452 510 511 !$OMP PARALLEL DO schedule(static) private(jj,ji) 453 512 DO jj = 2, jpjm1 454 513 DO ji = fs_2, fs_jpim1 ! vector opt. … … 461 520 ENDIF 462 521 522 !$OMP PARALLEL DO schedule(static) private(jj,ji) 463 523 DO jj = 2, jpjm1 ! Remove coriolis term (and possibly spg) from barotropic trend 464 524 DO ji = fs_2, fs_jpim1 … … 470 530 ! ! Add bottom stress contribution from baroclinic velocities: 471 531 IF (ln_bt_fw) THEN 532 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 472 533 DO jj = 2, jpjm1 473 534 DO ji = fs_2, fs_jpim1 ! vector opt. … … 479 540 END DO 480 541 ELSE 542 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 481 543 DO jj = 2, jpjm1 482 544 DO ji = fs_2, fs_jpim1 ! vector opt. … … 491 553 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 492 554 IF( ln_wd ) THEN 493 zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:) 494 zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:) 555 !$OMP PARALLEL DO schedule(static) private(jj,ji) 556 DO jj = 1, jpj 557 DO ji = 1, jpi ! vector opt. 558 zu_frc(ji,jj) = zu_frc(ji,jj) + MAX(r1_hu_n(ji,jj) * bfrua(ji,jj),-1._wp / rdtbt) * zwx(ji,jj) 559 zv_frc(ji,jj) = zv_frc(ji,jj) + MAX(r1_hv_n(ji,jj) * bfrva(ji,jj),-1._wp / rdtbt) * zwy(ji,jj) 560 END DO 561 END DO 495 562 ELSE 496 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:) 497 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 563 !$OMP PARALLEL DO schedule(static) private(jj,ji) 564 DO jj = 1, jpj 565 DO ji = 1, jpi 566 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * bfrua(ji,jj) * zwx(ji,jj) 567 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * bfrva(ji,jj) * zwy(ji,jj) 568 END DO 569 END DO 498 570 END IF 499 571 ! 500 572 ! ! Add top stress contribution from baroclinic velocities: 501 573 IF( ln_bt_fw ) THEN 574 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv) 502 575 DO jj = 2, jpjm1 503 576 DO ji = fs_2, fs_jpim1 ! vector opt. … … 509 582 END DO 510 583 ELSE 584 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv) 511 585 DO jj = 2, jpjm1 512 586 DO ji = fs_2, fs_jpim1 ! vector opt. … … 520 594 ! 521 595 ! Note that the "unclipped" top friction parameter is used even with explicit drag 522 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:) 523 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:) 596 !$OMP PARALLEL DO schedule(static) private(jj,ji) 597 DO jj = 1, jpj 598 DO ji = 1, jpi 599 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * tfrua(ji,jj) * zwx(ji,jj) 600 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * tfrva(ji,jj) * zwy(ji,jj) 601 END DO 602 END DO 524 603 ! 525 604 IF (ln_bt_fw) THEN ! Add wind forcing 526 zu_frc(:,:) = zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 527 zv_frc(:,:) = zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 605 !$OMP PARALLEL DO schedule(static) private(jj,ji) 606 DO jj = 1, jpj 607 DO ji = 1, jpi 608 zu_frc(ji,jj) = zu_frc(ji,jj) + zraur * utau(ji,jj) * r1_hu_n(ji,jj) 609 zv_frc(ji,jj) = zv_frc(ji,jj) + zraur * vtau(ji,jj) * r1_hv_n(ji,jj) 610 END DO 611 END DO 528 612 ELSE 529 zu_frc(:,:) = zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:) 530 zv_frc(:,:) = zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:) 613 !$OMP PARALLEL DO schedule(static) private(jj,ji) 614 DO jj = 1, jpj 615 DO ji = 1, jpi 616 zu_frc(ji,jj) = zu_frc(ji,jj) + zraur * z1_2 * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 617 zv_frc(ji,jj) = zv_frc(ji,jj) + zraur * z1_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 618 END DO 619 END DO 531 620 ENDIF 532 621 ! 533 622 IF ( ln_apr_dyn ) THEN ! Add atm pressure forcing 534 623 IF (ln_bt_fw) THEN 624 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 535 625 DO jj = 2, jpjm1 536 626 DO ji = fs_2, fs_jpim1 ! vector opt. … … 542 632 END DO 543 633 ELSE 634 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 544 635 DO jj = 2, jpjm1 545 636 DO ji = fs_2, fs_jpim1 ! vector opt. … … 558 649 ! ! Surface net water flux and rivers 559 650 IF (ln_bt_fw) THEN 560 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 651 !$OMP PARALLEL DO schedule(static) private(jj,ji) 652 DO jj = 1, jpj 653 DO ji = 1, jpi 654 zssh_frc(ji,jj) = zraur * ( emp(ji,jj) - rnf(ji,jj) + fwfisf(ji,jj) ) 655 END DO 656 END DO 561 657 ELSE 562 zssh_frc(:,:) = zraur * z1_2 * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 563 & + fwfisf(:,:) + fwfisf_b(:,:) ) 658 !$OMP PARALLEL DO schedule(static) private(jj,ji) 659 DO jj = 1, jpj 660 DO ji = 1, jpi 661 zssh_frc(ji,jj) = zraur * z1_2 * ( emp(ji,jj) + emp_b(ji,jj) - rnf(ji,jj) - rnf_b(ji,jj) & 662 & + fwfisf(ji,jj) + fwfisf_b(ji,jj) ) 663 END DO 664 END DO 564 665 ENDIF 565 666 ! 566 667 IF( ln_sdw ) THEN ! Stokes drift divergence added if necessary 567 zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:) 668 !$OMP PARALLEL DO schedule(static) private(jj,ji) 669 DO jj = 1, jpj 670 DO ji = 1, jpi 671 zssh_frc(ji,jj) = zssh_frc(ji,jj) + div_sd(ji,jj) 672 END DO 673 END DO 568 674 ENDIF 569 675 ! … … 571 677 ! ! Include the IAU weighted SSH increment 572 678 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 573 zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 679 !$OMP PARALLEL DO schedule(static) private(jj,ji) 680 DO jj = 1, jpj 681 DO ji = 1, jpi 682 zssh_frc(ji,jj) = zssh_frc(ji,jj) - ssh_iau(ji,jj) 683 END DO 684 END DO 574 685 ENDIF 575 686 #endif … … 589 700 ! Initialize barotropic variables: 590 701 IF( ll_init )THEN 591 sshbb_e(:,:) = 0._wp 592 ubb_e (:,:) = 0._wp 593 vbb_e (:,:) = 0._wp 594 sshb_e (:,:) = 0._wp 595 ub_e (:,:) = 0._wp 596 vb_e (:,:) = 0._wp 702 !$OMP PARALLEL DO schedule(static) private(jj,ji) 703 DO jj = 1, jpj 704 DO ji = 1, jpi 705 sshbb_e(ji,jj) = 0._wp 706 ubb_e (ji,jj) = 0._wp 707 vbb_e (ji,jj) = 0._wp 708 sshb_e (ji,jj) = 0._wp 709 ub_e (ji,jj) = 0._wp 710 vb_e (ji,jj) = 0._wp 711 END DO 712 END DO 597 713 ENDIF 598 714 599 715 ! 600 716 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 601 sshn_e(:,:) = sshn(:,:) 602 un_e (:,:) = un_b(:,:) 603 vn_e (:,:) = vn_b(:,:) 604 ! 605 hu_e (:,:) = hu_n(:,:) 606 hv_e (:,:) = hv_n(:,:) 607 hur_e (:,:) = r1_hu_n(:,:) 608 hvr_e (:,:) = r1_hv_n(:,:) 717 !$OMP PARALLEL DO schedule(static) private(jj,ji) 718 DO jj = 1, jpj 719 DO ji = 1, jpi 720 sshn_e(ji,jj) = sshn(ji,jj) 721 un_e (ji,jj) = un_b(ji,jj) 722 vn_e (ji,jj) = vn_b(ji,jj) 723 ! 724 hu_e (ji,jj) = hu_n(ji,jj) 725 hv_e (ji,jj) = hv_n(ji,jj) 726 hur_e (ji,jj) = r1_hu_n(ji,jj) 727 hvr_e (ji,jj) = r1_hv_n(ji,jj) 728 END DO 729 END DO 609 730 ELSE ! CENTRED integration: start from BEFORE fields 610 sshn_e(:,:) = sshb(:,:) 611 un_e (:,:) = ub_b(:,:) 612 vn_e (:,:) = vb_b(:,:) 613 ! 614 hu_e (:,:) = hu_b(:,:) 615 hv_e (:,:) = hv_b(:,:) 616 hur_e (:,:) = r1_hu_b(:,:) 617 hvr_e (:,:) = r1_hv_b(:,:) 731 !$OMP PARALLEL DO schedule(static) private(jj,ji) 732 DO jj = 1, jpj 733 DO ji = 1, jpi 734 sshn_e(ji,jj) = sshb(ji,jj) 735 un_e (ji,jj) = ub_b(ji,jj) 736 vn_e (ji,jj) = vb_b(ji,jj) 737 ! 738 hu_e (ji,jj) = hu_b(ji,jj) 739 hv_e (ji,jj) = hv_b(ji,jj) 740 hur_e (ji,jj) = r1_hu_b(ji,jj) 741 hvr_e (ji,jj) = r1_hv_b(ji,jj) 742 END DO 743 END DO 618 744 ENDIF 619 745 ! … … 621 747 ! 622 748 ! Initialize sums: 623 ua_b (:,:) = 0._wp ! After barotropic velocities (or transport if flux form) 624 va_b (:,:) = 0._wp 625 ssha (:,:) = 0._wp ! Sum for after averaged sea level 626 un_adv(:,:) = 0._wp ! Sum for now transport issued from ts loop 627 vn_adv(:,:) = 0._wp 749 !$OMP PARALLEL DO schedule(static) private(jj,ji) 750 DO jj = 1, jpj 751 DO ji = 1, jpi 752 ua_b (ji,jj) = 0._wp ! After barotropic velocities (or transport if flux form) 753 va_b (ji,jj) = 0._wp 754 ssha (ji,jj) = 0._wp ! Sum for after averaged sea level 755 un_adv(ji,jj) = 0._wp ! Sum for now transport issued from ts loop 756 vn_adv(ji,jj) = 0._wp 757 END DO 758 END DO 628 759 ! ! ==================== ! 629 760 DO jn = 1, icycle ! sub-time-step loop ! … … 649 780 650 781 ! Extrapolate barotropic velocities at step jit+0.5: 651 ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 652 va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 782 !$OMP PARALLEL DO schedule(static) private(jj,ji) 783 DO jj = 1, jpj 784 DO ji = 1, jpi 785 ua_e(ji,jj) = za1 * un_e(ji,jj) + za2 * ub_e(ji,jj) + za3 * ubb_e(ji,jj) 786 va_e(ji,jj) = za1 * vn_e(ji,jj) + za2 * vb_e(ji,jj) + za3 * vbb_e(ji,jj) 787 END DO 788 END DO 653 789 654 790 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 655 791 ! ! ------------------ 656 792 ! Extrapolate Sea Level at step jit+0.5: 657 zsshp2_e(:,:) = za1 * sshn_e(:,:) + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 793 !$OMP PARALLEL 794 !$OMP DO schedule(static) private(jj,ji) 795 DO jj = 1, jpj 796 DO ji = 1, jpi 797 zsshp2_e(ji,jj) = za1 * sshn_e(ji,jj) + za2 * sshb_e(ji,jj) + za3 * sshbb_e(ji,jj) 798 END DO 799 END DO 658 800 ! 801 !$OMP DO schedule(static) private(jj,ji) 659 802 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 660 803 DO ji = 2, fs_jpim1 ! Vector opt. … … 667 810 END DO 668 811 END DO 812 !$OMP END PARALLEL 669 813 CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 670 814 ! 671 zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points 672 zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 815 !$OMP PARALLEL DO schedule(static) private(jj,ji) 816 DO jj = 1, jpj 817 DO ji = 1, jpi 818 zhup2_e (ji,jj) = hu_0(ji,jj) + zwx(ji,jj) ! Ocean depth at U- and V-points 819 zhvp2_e (ji,jj) = hv_0(ji,jj) + zwy(ji,jj) 820 END DO 821 END DO 673 822 ELSE 674 zhup2_e (:,:) = hu_n(:,:) 675 zhvp2_e (:,:) = hv_n(:,:) 823 !$OMP PARALLEL DO schedule(static) private(jj,ji) 824 DO jj = 1, jpj 825 DO ji = 1, jpi 826 zhup2_e (ji,jj) = hu_n(ji,jj) 827 zhvp2_e (ji,jj) = hv_n(ji,jj) 828 END DO 829 END DO 676 830 ENDIF 677 831 ! !* after ssh … … 680 834 ! considering fluxes below: 681 835 ! 682 zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:) ! fluxes at jn+0.5 683 zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 836 !$OMP PARALLEL DO schedule(static) private(jj,ji) 837 DO jj = 1, jpj 838 DO ji = 1, jpi 839 zwx(ji,jj) = e2u(ji,jj) * ua_e(ji,jj) * zhup2_e(ji,jj) ! fluxes at jn+0.5 840 zwy(ji,jj) = e1v(ji,jj) * va_e(ji,jj) * zhvp2_e(ji,jj) 841 END DO 842 END DO 843 684 844 ! 685 845 #if defined key_agrif … … 712 872 ! Sum over sub-time-steps to compute advective velocities 713 873 za2 = wgtbtp2(jn) 714 un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 715 vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 874 !$OMP PARALLEL 875 !$OMP DO schedule(static) private(jj,ji) 876 DO jj = 1, jpj 877 DO ji = 1, jpi 878 un_adv(ji,jj) = un_adv(ji,jj) + za2 * zwx(ji,jj) * r1_e2u(ji,jj) 879 vn_adv(ji,jj) = vn_adv(ji,jj) + za2 * zwy(ji,jj) * r1_e1v(ji,jj) 880 END DO 881 END DO 882 !$OMP END DO NOWAIT 716 883 ! 717 884 ! Set next sea level: 885 !$OMP DO schedule(static) private(jj,ji) 718 886 DO jj = 2, jpjm1 719 887 DO ji = fs_2, fs_jpim1 ! vector opt. … … 722 890 END DO 723 891 END DO 724 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 725 892 !$OMP DO schedule(static) private(jj,ji) 893 DO jj = 1, jpj 894 DO ji = 1, jpi 895 ssha_e(ji,jj) = ( sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv(ji,jj) ) ) * ssmask(ji,jj) 896 END DO 897 END DO 898 !$OMP END PARALLEL 726 899 CALL lbc_lnk( ssha_e, 'T', 1._wp ) 727 900 … … 734 907 ! Sea Surface Height at u-,v-points (vvl case only) 735 908 IF( .NOT.ln_linssh ) THEN 909 !$OMP PARALLEL DO schedule(static) private(jj,ji) 736 910 DO jj = 2, jpjm1 737 911 DO ji = 2, jpim1 ! NO Vector Opt. … … 766 940 ENDIF 767 941 ! 768 zsshp2_e(:,:) = za0 * ssha_e(:,:) + za1 * sshn_e (:,:) & 769 & + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 942 !$OMP PARALLEL DO schedule(static) private(jj,ji) 943 DO jj = 1, jpj 944 DO ji = 1, jpi 945 zsshp2_e(ji,jj) = za0 * ssha_e(ji,jj) + za1 * sshn_e (ji,jj) & 946 & + za2 * sshb_e(ji,jj) + za3 * sshbb_e(ji,jj) 947 END DO 948 END DO 770 949 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 950 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2) 771 951 DO jj = 2, jpjm1 772 952 DO ji = 2, jpim1 … … 813 993 IF( .NOT.ln_linssh .AND. .NOT.ln_dynadv_vec ) THEN !* Vector form 814 994 ! 995 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1) 815 996 DO jj = 2, jpjm1 816 997 DO ji = 2, jpim1 … … 826 1007 END DO 827 1008 1009 IF( ln_wd ) THEN 1010 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1011 DO jj = 1, jpj 1012 DO ji = 1, jpi ! vector opt. 1013 zhust_e(ji,jj) = MAX(zhust_e (ji,jj), rn_wdmin1 ) 1014 zhvst_e(ji,jj) = MAX(zhvst_e (ji,jj), rn_wdmin1 ) 1015 END DO 1016 END DO 1017 END IF 828 1018 ENDIF 829 1019 ! … … 836 1026 ! 837 1027 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN !== energy conserving or mixed scheme ==! 1028 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2) 838 1029 DO jj = 2, jpjm1 839 1030 DO ji = fs_2, fs_jpim1 ! vector opt. … … 848 1039 ! 849 1040 ELSEIF ( ln_dynvor_ens ) THEN !== enstrophy conserving scheme ==! 1041 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1) 850 1042 DO jj = 2, jpjm1 851 1043 DO ji = fs_2, fs_jpim1 ! vector opt. … … 860 1052 ! 861 1053 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==! 1054 !$OMP PARALLEL DO schedule(static) private(jj,ji) 862 1055 DO jj = 2, jpjm1 863 1056 DO ji = fs_2, fs_jpim1 ! vector opt. … … 877 1070 ! Add tidal astronomical forcing if defined 878 1071 IF ( ln_tide .AND. ln_tide_pot ) THEN 1072 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 879 1073 DO jj = 2, jpjm1 880 1074 DO ji = fs_2, fs_jpim1 ! vector opt. … … 888 1082 ! 889 1083 ! Add bottom stresses: 890 zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:) 891 zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 892 ! 893 ! Add top stresses: 894 zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:) 895 zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 1084 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1085 DO jj = 1, jpj 1086 DO ji = 1, jpi 1087 zu_trd(ji,jj) = zu_trd(ji,jj) + bfrua(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 1088 zv_trd(ji,jj) = zv_trd(ji,jj) + bfrva(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 1089 ! 1090 ! Add top stresses: 1091 zu_trd(ji,jj) = zu_trd(ji,jj) + tfrua(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 1092 zv_trd(ji,jj) = zv_trd(ji,jj) + tfrva(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 1093 END DO 1094 END DO 1095 896 1096 ! 897 1097 ! Surface pressure trend: 898 1098 899 1099 IF( ln_wd ) THEN 1100 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 900 1101 DO jj = 2, jpjm1 901 1102 DO ji = 2, jpim1 … … 908 1109 END DO 909 1110 ELSE 1111 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 910 1112 DO jj = 2, jpjm1 911 1113 DO ji = fs_2, fs_jpim1 ! vector opt. … … 922 1124 ! Set next velocities: 923 1125 IF( ln_dynadv_vec .OR. ln_linssh ) THEN !* Vector form 1126 !$OMP PARALLEL DO schedule(static) private(jj,ji) 924 1127 DO jj = 2, jpjm1 925 1128 DO ji = fs_2, fs_jpim1 ! vector opt. … … 939 1142 ! 940 1143 ELSE !* Flux form 1144 !$OMP PARALLEL DO schedule(static) private(jj,ji,zhura,zhvra) 941 1145 DO jj = 2, jpjm1 942 1146 DO ji = fs_2, fs_jpim1 ! vector opt. … … 969 1173 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 970 1174 IF( ln_wd ) THEN 971 hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1) 972 hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1) 1175 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1176 DO jj = 1, jpj 1177 DO ji = 1, jpi ! vector opt. 1178 hu_e (ji,jj) = MAX(hu_0(ji,jj) + zsshu_a(ji,jj), rn_wdmin1) 1179 hv_e (ji,jj) = MAX(hv_0(ji,jj) + zsshv_a(ji,jj), rn_wdmin1) 1180 END DO 1181 END DO 973 1182 ELSE 974 hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 975 hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 1183 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1184 DO jj = 1, jpj 1185 DO ji = 1, jpi 1186 hu_e (ji,jj) = hu_0(ji,jj) + zsshu_a(ji,jj) 1187 hv_e (ji,jj) = hv_0(ji,jj) + zsshv_a(ji,jj) 1188 END DO 1189 END DO 976 1190 END IF 977 hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) ) 978 hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) ) 1191 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1192 DO jj = 1, jpj 1193 DO ji = 1, jpi 1194 hur_e(ji,jj) = ssumask(ji,jj) / ( hu_e(ji,jj) + 1._wp - ssumask(ji,jj) ) 1195 hvr_e(ji,jj) = ssvmask(ji,jj) / ( hv_e(ji,jj) + 1._wp - ssvmask(ji,jj) ) 1196 END DO 1197 END DO 979 1198 ! 980 1199 ENDIF … … 989 1208 ! !* Swap 990 1209 ! ! ---- 991 ubb_e (:,:) = ub_e (:,:) 992 ub_e (:,:) = un_e (:,:) 993 un_e (:,:) = ua_e (:,:) 994 ! 995 vbb_e (:,:) = vb_e (:,:) 996 vb_e (:,:) = vn_e (:,:) 997 vn_e (:,:) = va_e (:,:) 998 ! 999 sshbb_e(:,:) = sshb_e(:,:) 1000 sshb_e (:,:) = sshn_e(:,:) 1001 sshn_e (:,:) = ssha_e(:,:) 1210 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1211 DO jj = 1, jpj 1212 DO ji = 1, jpi 1213 ubb_e (ji,jj) = ub_e (ji,jj) 1214 ub_e (ji,jj) = un_e (ji,jj) 1215 un_e (ji,jj) = ua_e (ji,jj) 1216 ! 1217 vbb_e (ji,jj) = vb_e (ji,jj) 1218 vb_e (ji,jj) = vn_e (ji,jj) 1219 vn_e (ji,jj) = va_e (ji,jj) 1220 ! 1221 sshbb_e(ji,jj) = sshb_e(ji,jj) 1222 sshb_e (ji,jj) = sshn_e(ji,jj) 1223 sshn_e (ji,jj) = ssha_e(ji,jj) 1224 END DO 1225 END DO 1002 1226 1003 1227 ! !* Sum over whole bt loop … … 1005 1229 za1 = wgtbtp1(jn) 1006 1230 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! Sum velocities 1007 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) 1008 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) 1231 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1232 DO jj = 1, jpj 1233 DO ji = 1, jpi 1234 ua_b (ji,jj) = ua_b (ji,jj) + za1 * ua_e (ji,jj) 1235 va_b (ji,jj) = va_b (ji,jj) + za1 * va_e (ji,jj) 1236 END DO 1237 END DO 1009 1238 ELSE ! Sum transports 1010 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) * hu_e (:,:) 1011 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) * hv_e (:,:) 1239 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1240 DO jj = 1, jpj 1241 DO ji = 1, jpi 1242 ua_b (ji,jj) = ua_b (ji,jj) + za1 * ua_e (ji,jj) * hu_e (ji,jj) 1243 va_b (ji,jj) = va_b (ji,jj) + za1 * va_e (ji,jj) * hv_e (ji,jj) 1244 END DO 1245 END DO 1012 1246 ENDIF 1013 1247 ! ! Sum sea level 1014 ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:) 1248 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1249 DO jj = 1, jpj 1250 DO ji = 1, jpi 1251 ssha(ji,jj) = ssha(ji,jj) + za1 * ssha_e(ji,jj) 1252 END DO 1253 END DO 1015 1254 ! ! ==================== ! 1016 1255 END DO ! end loop ! … … 1021 1260 ! 1022 1261 ! Set advection velocity correction: 1023 zwx(:,:) = un_adv(:,:) 1024 zwy(:,:) = vn_adv(:,:) 1262 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1263 DO jj = 1, jpj 1264 DO ji = 1, jpi 1265 zwx(ji,jj) = un_adv(ji,jj) 1266 zwy(ji,jj) = vn_adv(ji,jj) 1267 END DO 1268 END DO 1025 1269 IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN 1026 un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 1027 vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 1270 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1271 DO jj = 1, jpj 1272 DO ji = 1, jpi 1273 un_adv(ji,jj) = zwx(ji,jj) * r1_hu_n(ji,jj) 1274 vn_adv(ji,jj) = zwy(ji,jj) * r1_hv_n(ji,jj) 1275 END DO 1276 END DO 1028 1277 ELSE 1029 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 1030 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 1278 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1279 DO jj = 1, jpj 1280 DO ji = 1, jpi 1281 un_adv(ji,jj) = z1_2 * ( ub2_b(ji,jj) + zwx(ji,jj) ) * r1_hu_n(ji,jj) 1282 vn_adv(ji,jj) = z1_2 * ( vb2_b(ji,jj) + zwy(ji,jj) ) * r1_hv_n(ji,jj) 1283 END DO 1284 END DO 1031 1285 END IF 1032 1286 1033 1287 IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 1034 ub2_b(:,:) = zwx(:,:) 1035 vb2_b(:,:) = zwy(:,:) 1288 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1289 DO jj = 1, jpj 1290 DO ji = 1, jpi 1291 ub2_b(ji,jj) = zwx(ji,jj) 1292 vb2_b(ji,jj) = zwy(ji,jj) 1293 END DO 1294 END DO 1036 1295 ENDIF 1037 1296 ! 1038 1297 ! Update barotropic trend: 1039 1298 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 1299 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 1040 1300 DO jk=1,jpkm1 1041 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 1042 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b 1301 DO jj = 1, jpj 1302 DO ji = 1, jpi 1303 ua(ji,jj,jk) = ua(ji,jj,jk) + ( ua_b(ji,jj) - ub_b(ji,jj) ) * z1_2dt_b 1304 va(ji,jj,jk) = va(ji,jj,jk) + ( va_b(ji,jj) - vb_b(ji,jj) ) * z1_2dt_b 1305 END DO 1306 END DO 1043 1307 END DO 1044 1308 ELSE 1045 1309 ! At this stage, ssha has been corrected: compute new depths at velocity points 1310 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1046 1311 DO jj = 1, jpjm1 1047 1312 DO ji = 1, jpim1 ! NO Vector Opt. … … 1056 1321 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 1057 1322 ! 1323 !$OMP PARALLEL 1324 !$OMP DO schedule(static) private(jk,jj,ji) 1058 1325 DO jk=1,jpkm1 1059 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 1060 va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 1061 END DO 1326 DO jj = 1, jpj 1327 DO ji = 1, jpi 1328 ua(ji,jj,jk) = ua(ji,jj,jk) + r1_hu_n(ji,jj) * ( ua_b(ji,jj) - ub_b(ji,jj) * hu_b(ji,jj) ) * z1_2dt_b 1329 va(ji,jj,jk) = va(ji,jj,jk) + r1_hv_n(ji,jj) * ( va_b(ji,jj) - vb_b(ji,jj) * hv_b(ji,jj) ) * z1_2dt_b 1330 END DO 1331 END DO 1332 END DO 1333 !$OMP END DO NOWAIT 1062 1334 ! Save barotropic velocities not transport: 1063 ua_b(:,:) = ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 1064 va_b(:,:) = va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 1065 ENDIF 1066 ! 1335 !$OMP DO schedule(static) private(jj,ji) 1336 DO jj = 1, jpj 1337 DO ji = 1, jpi 1338 ua_b(ji,jj) = ua_b(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 1339 va_b(ji,jj) = va_b(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) ) 1340 END DO 1341 END DO 1342 !$OMP END PARALLEL 1343 ENDIF 1344 ! 1345 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 1067 1346 DO jk = 1, jpkm1 1068 ! Correct velocities: 1069 un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk) 1070 vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk) 1071 ! 1347 DO jj = 1, jpj 1348 DO ji = 1, jpi 1349 ! Correct velocities: 1350 un(ji,jj,jk) = ( un(ji,jj,jk) + un_adv(ji,jj) - un_b(ji,jj) ) * umask(ji,jj,jk) 1351 vn(ji,jj,jk) = ( vn(ji,jj,jk) + vn_adv(ji,jj) - vn_b(ji,jj) ) * vmask(ji,jj,jk) 1352 ! 1353 END DO 1354 END DO 1072 1355 END DO 1073 1356 ! … … 1081 1364 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 1082 1365 IF( Agrif_NbStepint() == 0 ) THEN 1083 ub2_i_b(:,:) = 0._wp 1084 vb2_i_b(:,:) = 0._wp 1366 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1367 DO jj = 1, jpj 1368 DO ji = 1, jpi 1369 ub2_i_b(ji,jj) = 0._wp 1370 vb2_i_b(ji,jj) = 0._wp 1371 END DO 1372 END DO 1085 1373 END IF 1086 1374 ! 1087 1375 za1 = 1._wp / REAL(Agrif_rhot(), wp) 1088 ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:) 1089 vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 1376 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1377 DO jj = 1, jpj 1378 DO ji = 1, jpi 1379 ub2_i_b(ji,jj) = ub2_i_b(ji,jj) + za1 * ub2_b(ji,jj) 1380 vb2_i_b(ji,jj) = vb2_i_b(ji,jj) + za1 * vb2_b(ji,jj) 1381 END DO 1382 END DO 1090 1383 ENDIF 1091 1384 #endif -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r7646 r7698 97 97 !!---------------------------------------------------------------------- 98 98 INTEGER, INTENT( in ) :: kt ! ocean time-step index 99 INTEGER :: jk, jj, ji 99 100 ! 100 101 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 109 110 CASE ( np_ENE ) !* energy conserving scheme 110 111 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 111 ztrdu(:,:,:) = ua(:,:,:) 112 ztrdv(:,:,:) = va(:,:,:) 112 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 113 DO jk = 1, jpk 114 DO jj = 1, jpj 115 DO ji = 1, jpi 116 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 117 ztrdv(ji,jj,jk) = va(ji,jj,jk) 118 END DO 119 END DO 120 END DO 113 121 CALL vor_ene( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 114 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 115 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 122 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 123 DO jk = 1, jpk 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 127 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 128 END DO 129 END DO 130 END DO 116 131 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 117 ztrdu(:,:,:) = ua(:,:,:) 118 ztrdv(:,:,:) = va(:,:,:) 132 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 133 DO jk = 1, jpk 134 DO jj = 1, jpj 135 DO ji = 1, jpi 136 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 137 ztrdv(ji,jj,jk) = va(ji,jj,jk) 138 END DO 139 END DO 140 END DO 119 141 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 120 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 121 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 142 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 143 DO jk = 1, jpk 144 DO jj = 1, jpj 145 DO ji = 1, jpi 146 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 147 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 148 END DO 149 END DO 150 END DO 122 151 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 123 152 ELSE ! total vorticity trend … … 128 157 CASE ( np_ENS ) !* enstrophy conserving scheme 129 158 IF( l_trddyn ) THEN ! trend diagnostics: splitthe trend in two 130 ztrdu(:,:,:) = ua(:,:,:) 131 ztrdv(:,:,:) = va(:,:,:) 159 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 160 DO jk = 1, jpk 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 164 ztrdv(ji,jj,jk) = va(ji,jj,jk) 165 END DO 166 END DO 167 END DO 132 168 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 133 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 134 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 169 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 170 DO jk = 1, jpk 171 DO jj = 1, jpj 172 DO ji = 1, jpi 173 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 174 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 175 END DO 176 END DO 177 END DO 135 178 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 136 ztrdu(:,:,:) = ua(:,:,:) 137 ztrdv(:,:,:) = va(:,:,:) 179 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 180 DO jk = 1, jpk 181 DO jj = 1, jpj 182 DO ji = 1, jpi 183 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 184 ztrdv(ji,jj,jk) = va(ji,jj,jk) 185 END DO 186 END DO 187 END DO 138 188 CALL vor_ens( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 139 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 140 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 189 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 190 DO jk = 1, jpk 191 DO jj = 1, jpj 192 DO ji = 1, jpi 193 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 194 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 195 END DO 196 END DO 197 END DO 141 198 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 142 199 ELSE ! total vorticity trend … … 147 204 CASE ( np_MIX ) !* mixed ene-ens scheme 148 205 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 149 ztrdu(:,:,:) = ua(:,:,:) 150 ztrdv(:,:,:) = va(:,:,:) 206 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 207 DO jk = 1, jpk 208 DO jj = 1, jpj 209 DO ji = 1, jpi 210 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 211 ztrdv(ji,jj,jk) = va(ji,jj,jk) 212 END DO 213 END DO 214 END DO 151 215 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend (ens) 152 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 153 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 216 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 217 DO jk = 1, jpk 218 DO jj = 1, jpj 219 DO ji = 1, jpi 220 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 221 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 222 END DO 223 END DO 224 END DO 154 225 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 155 ztrdu(:,:,:) = ua(:,:,:) 156 ztrdv(:,:,:) = va(:,:,:) 226 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 227 DO jk = 1, jpk 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 231 ztrdv(ji,jj,jk) = va(ji,jj,jk) 232 END DO 233 END DO 234 END DO 157 235 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend (ene) 158 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 159 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 236 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 237 DO jk = 1, jpk 238 DO jj = 1, jpj 239 DO ji = 1, jpi 240 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 241 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 242 END DO 243 END DO 244 END DO 160 245 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 161 246 ELSE ! total vorticity trend … … 167 252 CASE ( np_EEN ) !* energy and enstrophy conserving scheme 168 253 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 169 ztrdu(:,:,:) = ua(:,:,:) 170 ztrdv(:,:,:) = va(:,:,:) 254 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 255 DO jk = 1, jpk 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 259 ztrdv(ji,jj,jk) = va(ji,jj,jk) 260 END DO 261 END DO 262 END DO 171 263 CALL vor_een( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 172 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 173 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 264 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 265 DO jk = 1, jpk 266 DO jj = 1, jpj 267 DO ji = 1, jpi 268 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 269 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 270 END DO 271 END DO 272 END DO 174 273 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 175 ztrdu(:,:,:) = ua(:,:,:) 176 ztrdv(:,:,:) = va(:,:,:) 274 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 275 DO jk = 1, jpk 276 DO jj = 1, jpj 277 DO ji = 1, jpi 278 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 279 ztrdv(ji,jj,jk) = va(ji,jj,jk) 280 END DO 281 END DO 282 END DO 177 283 CALL vor_een( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 178 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 179 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 284 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 285 DO jk = 1, jpk 286 DO jj = 1, jpj 287 DO ji = 1, jpi 288 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 289 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 290 END DO 291 END DO 292 END DO 180 293 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 181 294 ELSE ! total vorticity trend … … 244 357 SELECT CASE( kvor ) !== vorticity considered ==! 245 358 CASE ( np_COR ) !* Coriolis (planetary vorticity) 246 zwz(:,:) = ff_f(:,:) 359 !$OMP PARALLEL DO schedule(static) private(jj,ji) 360 DO jj = 1, jpj 361 DO ji = 1, jpi 362 zwz(ji,jj) = ff_f(ji,jj) 363 END DO 364 END DO 247 365 CASE ( np_RVO ) !* relative vorticity 366 !$OMP PARALLEL DO schedule(static) private(jj,ji) 248 367 DO jj = 1, jpjm1 249 368 DO ji = 1, fs_jpim1 ! vector opt. … … 253 372 END DO 254 373 CASE ( np_MET ) !* metric term 374 !$OMP PARALLEL DO schedule(static) private(jj,ji) 255 375 DO jj = 1, jpjm1 256 376 DO ji = 1, fs_jpim1 ! vector opt. … … 261 381 END DO 262 382 CASE ( np_CRV ) !* Coriolis + relative vorticity 383 !$OMP PARALLEL DO schedule(static) private(jj,ji) 263 384 DO jj = 1, jpjm1 264 385 DO ji = 1, fs_jpim1 ! vector opt. … … 269 390 END DO 270 391 CASE ( np_CME ) !* Coriolis + metric 392 !$OMP PARALLEL DO schedule(static) private(jj,ji) 271 393 DO jj = 1, jpjm1 272 394 DO ji = 1, fs_jpim1 ! vector opt. … … 282 404 ! 283 405 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 406 !$OMP PARALLEL DO schedule(static) private(jj,ji) 284 407 DO jj = 1, jpjm1 285 408 DO ji = 1, fs_jpim1 ! vector opt. … … 290 413 291 414 IF( ln_sco ) THEN 292 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 293 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 294 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 415 !$OMP PARALLEL DO schedule(static) private(jj,ji) 416 DO jj = 1, jpj 417 DO ji = 1, jpi 418 zwz(ji,jj) = zwz(ji,jj) / e3f_n(ji,jj,jk) 419 zwx(ji,jj) = e2u(ji,jj) * e3u_n(ji,jj,jk) * pun(ji,jj,jk) 420 zwy(ji,jj) = e1v(ji,jj) * e3v_n(ji,jj,jk) * pvn(ji,jj,jk) 421 END DO 422 END DO 295 423 ELSE 296 zwx(:,:) = e2u(:,:) * pun(:,:,jk) 297 zwy(:,:) = e1v(:,:) * pvn(:,:,jk) 424 !$OMP PARALLEL DO schedule(static) private(jj,ji) 425 DO jj = 1, jpj 426 DO ji = 1, jpi 427 zwx(ji,jj) = e2u(ji,jj) * pun(ji,jj,jk) 428 zwy(ji,jj) = e1v(ji,jj) * pvn(ji,jj,jk) 429 END DO 430 END DO 298 431 ENDIF 299 432 ! !== compute and add the vorticity term trend =! 433 !$OMP PARALLEL DO schedule(static) private(jj, ji, zy1, zy2, zx1, zx2) 300 434 DO jj = 2, jpjm1 301 435 DO ji = fs_2, fs_jpim1 ! vector opt. … … 487 621 SELECT CASE( nn_een_e3f ) ! == reciprocal of e3 at F-point 488 622 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 623 !$OMP PARALLEL DO schedule(static) private(jj,ji,ze3) 489 624 DO jj = 1, jpjm1 490 625 DO ji = 1, fs_jpim1 ! vector opt. … … 497 632 END DO 498 633 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 634 !$OMP PARALLEL DO schedule(static) private(jj,ji,ze3,zmsk) 499 635 DO jj = 1, jpjm1 500 636 DO ji = 1, fs_jpim1 ! vector opt. … … 512 648 SELECT CASE( kvor ) !== vorticity considered ==! 513 649 CASE ( np_COR ) !* Coriolis (planetary vorticity) 650 !$OMP PARALLEL DO schedule(static) private(jj,ji) 514 651 DO jj = 1, jpjm1 515 652 DO ji = 1, fs_jpim1 ! vector opt. … … 518 655 END DO 519 656 CASE ( np_RVO ) !* relative vorticity 657 !$OMP PARALLEL DO schedule(static) private(jj,ji) 520 658 DO jj = 1, jpjm1 521 659 DO ji = 1, fs_jpim1 ! vector opt. … … 526 664 END DO 527 665 CASE ( np_MET ) !* metric term 666 !$OMP PARALLEL DO schedule(static) private(jj,ji) 528 667 DO jj = 1, jpjm1 529 668 DO ji = 1, fs_jpim1 ! vector opt. … … 534 673 END DO 535 674 CASE ( np_CRV ) !* Coriolis + relative vorticity 675 !$OMP PARALLEL DO schedule(static) private(jj,ji) 536 676 DO jj = 1, jpjm1 537 677 DO ji = 1, fs_jpim1 ! vector opt. … … 542 682 END DO 543 683 CASE ( np_CME ) !* Coriolis + metric 684 !$OMP PARALLEL DO schedule(static) private(jj,ji) 544 685 DO jj = 1, jpjm1 545 686 DO ji = 1, fs_jpim1 ! vector opt. … … 555 696 ! 556 697 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 698 !$OMP PARALLEL DO schedule(static) private(jj,ji) 557 699 DO jj = 1, jpjm1 558 700 DO ji = 1, fs_jpim1 ! vector opt. … … 565 707 ! 566 708 ! !== horizontal fluxes ==! 567 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 568 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 709 !$OMP PARALLEL DO schedule(static) private(jj,ji) 710 DO jj = 1, jpj 711 DO ji = 1, jpi 712 zwx(ji,jj) = e2u(ji,jj) * e3u_n(ji,jj,jk) * pun(ji,jj,jk) 713 zwy(ji,jj) = e1v(ji,jj) * e3v_n(ji,jj,jk) * pvn(ji,jj,jk) 714 END DO 715 END DO 569 716 570 717 ! !== compute and add the vorticity term trend =! 571 718 jj = 2 572 719 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 720 573 721 DO ji = 2, jpi ! split in 2 parts due to vector opt. 574 722 ztne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) … … 577 725 ztsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 578 726 END DO 727 !$OMP PARALLEL 728 !$OMP DO schedule(static) private(jj,ji) 579 729 DO jj = 3, jpj 580 730 DO ji = fs_2, jpi ! vector opt. ok because we start at jj = 3 … … 585 735 END DO 586 736 END DO 737 !$OMP DO schedule(static) private(jj,ji,zua,zva) 587 738 DO jj = 2, jpjm1 588 739 DO ji = fs_2, fs_jpim1 ! vector opt. … … 595 746 END DO 596 747 END DO 748 !$OMP END PARALLEL 597 749 ! ! =============== 598 750 END DO ! End of slab … … 649 801 IF(lwp) WRITE(numout,*) ' change fmask value in the angles (T) ln_vorlat = ', ln_vorlat 650 802 IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN 803 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 651 804 DO jk = 1, jpk 652 805 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r6140 r7698 77 77 IF( l_trddyn ) THEN ! Save ua and va trends 78 78 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 79 ztrdu(:,:,:) = ua(:,:,:) 80 ztrdv(:,:,:) = va(:,:,:) 79 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 80 DO jk = 1, jpk 81 DO jj = 1, jpj 82 DO ji = 1, jpi 83 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 84 ztrdv(ji,jj,jk) = va(ji,jj,jk) 85 END DO 86 END DO 87 END DO 81 88 ENDIF 82 89 90 !$OMP PARALLEL 83 91 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 92 !$OMP DO schedule(static) private(jj, ji) 84 93 DO jj = 2, jpj ! vertical fluxes 85 94 DO ji = fs_2, jpi ! vector opt. … … 87 96 END DO 88 97 END DO 98 !$OMP DO schedule(static) private(jj, ji) 89 99 DO jj = 2, jpjm1 ! vertical momentum advection at w-point 90 100 DO ji = fs_2, fs_jpim1 ! vector opt. … … 94 104 END DO 95 105 END DO 106 !$OMP END PARALLEL 96 107 ! 97 108 ! Surface and bottom advective fluxes set to zero 98 109 IF ( ln_isfcav ) THEN 110 !$OMP PARALLEL DO schedule(static) private(jj, ji) 99 111 DO jj = 2, jpjm1 100 112 DO ji = fs_2, fs_jpim1 ! vector opt. … … 106 118 END DO 107 119 ELSE 120 !$OMP PARALLEL DO schedule(static) private(jj, ji) 108 121 DO jj = 2, jpjm1 109 122 DO ji = fs_2, fs_jpim1 ! vector opt. … … 116 129 END IF 117 130 131 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zua, zva) 118 132 DO jk = 1, jpkm1 ! Vertical momentum advection at u- and v-points 119 133 DO jj = 2, jpjm1 … … 130 144 131 145 IF( l_trddyn ) THEN ! save the vertical advection trends for diagnostic 132 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 133 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 146 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 147 DO jk = 1, jpk 148 DO jj = 1, jpj 149 DO ji = 1, jpi 150 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 151 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 152 END DO 153 END DO 154 END DO 134 155 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 135 156 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r7646 r7698 53 53 !! 54 54 INTEGER, INTENT( in ) :: kt ! ocean time-step index 55 INTEGER :: ji, jj, jk ! dummy loop indices 55 56 ! 56 57 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 66 67 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 67 68 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 68 ztrdu(:,:,:) = ua(:,:,:) 69 ztrdv(:,:,:) = va(:,:,:) 69 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 70 DO jk = 1, jpk 71 DO jj = 1, jpj 72 DO ji = 1, jpi 73 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 74 ztrdv(ji,jj,jk) = va(ji,jj,jk) 75 END DO 76 END DO 77 END DO 70 78 ENDIF 71 79 … … 78 86 79 87 IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics 80 ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:) 81 ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:) 88 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 89 DO jk = 1, jpk 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 ztrdu(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) / r2dt - ztrdu(ji,jj,jk) 93 ztrdv(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) / r2dt - ztrdv(ji,jj,jk) 94 END DO 95 END DO 96 END DO 82 97 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 83 98 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r6752 r7698 92 92 ! 93 93 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity 94 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 94 95 DO jk = 1, jpkm1 95 ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 96 va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 96 DO jj = 1, jpj 97 DO ji = 1, jpi 98 ua(ji,jj,jk) = ( ub(ji,jj,jk) + p2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk) 99 va(ji,jj,jk) = ( vb(ji,jj,jk) + p2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk) 100 END DO 101 END DO 97 102 END DO 98 103 ELSE ! applied on thickness weighted velocity 104 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 99 105 DO jk = 1, jpkm1 100 ua(:,:,jk) = ( e3u_b(:,:,jk) * ub(:,:,jk) & 101 & + p2dt * e3u_n(:,:,jk) * ua(:,:,jk) ) / e3u_a(:,:,jk) * umask(:,:,jk) 102 va(:,:,jk) = ( e3v_b(:,:,jk) * vb(:,:,jk) & 103 & + p2dt * e3v_n(:,:,jk) * va(:,:,jk) ) / e3v_a(:,:,jk) * vmask(:,:,jk) 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 ua(ji,jj,jk) = ( e3u_b(ji,jj,jk) * ub(ji,jj,jk) & 109 & + p2dt * e3u_n(ji,jj,jk) * ua(ji,jj,jk) ) / e3u_a(ji,jj,jk) * umask(ji,jj,jk) 110 va(ji,jj,jk) = ( e3v_b(ji,jj,jk) * vb(ji,jj,jk) & 111 & + p2dt * e3v_n(ji,jj,jk) * va(ji,jj,jk) ) / e3v_a(ji,jj,jk) * vmask(ji,jj,jk) 112 END DO 113 END DO 104 114 END DO 105 115 ENDIF … … 112 122 ! 113 123 IF( ln_bfrimp ) THEN 124 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 114 125 DO jj = 2, jpjm1 115 126 DO ji = 2, jpim1 … … 121 132 END DO 122 133 IF ( ln_isfcav ) THEN 134 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 123 135 DO jj = 2, jpjm1 124 136 DO ji = 2, jpim1 … … 138 150 ! G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a 139 151 IF( ln_bfrimp .AND. ln_dynspg_ts ) THEN 152 !$OMP PARALLEL 153 !$OMP DO schedule(static) private(jk,jj,ji) 140 154 DO jk = 1, jpkm1 ! remove barotropic velocities 141 ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk) 142 va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk) 143 END DO 155 DO jj = 1, jpj 156 DO ji = 1, jpi 157 ua(ji,jj,jk) = ( ua(ji,jj,jk) - ua_b(ji,jj) ) * umask(ji,jj,jk) 158 va(ji,jj,jk) = ( va(ji,jj,jk) - va_b(ji,jj) ) * vmask(ji,jj,jk) 159 END DO 160 END DO 161 END DO 162 !$OMP DO schedule(static) private(jj, ji, ikbu, ikbv, ze3ua, ze3va) 144 163 DO jj = 2, jpjm1 ! Add bottom/top stress due to barotropic component only 145 164 DO ji = fs_2, fs_jpim1 ! vector opt. … … 152 171 END DO 153 172 END DO 173 !$OMP END DO NOWAIT 174 !$OMP END PARALLEL 154 175 IF( ln_isfcav ) THEN ! Ocean cavities (ISF) 176 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv, ze3ua, ze3va) 155 177 DO jj = 2, jpjm1 156 178 DO ji = fs_2, fs_jpim1 ! vector opt. … … 172 194 ! non zero value at the ocean bottom depending on the bottom friction used. 173 195 ! 196 !$OMP PARALLEL 197 !$OMP DO schedule(static) private(jk, jj, ji, ze3ua, zzwi, zzws) 174 198 DO jk = 1, jpkm1 ! Matrix 175 199 DO jj = 2, jpjm1 … … 184 208 END DO 185 209 END DO 210 !$OMP DO schedule(static) private(jj, ji) 186 211 DO jj = 2, jpjm1 ! Surface boundary conditions 187 212 DO ji = fs_2, fs_jpim1 ! vector opt. … … 207 232 ! 208 233 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 234 !$OMP DO schedule(static) private(jj, ji) 209 235 DO jj = 2, jpjm1 210 236 DO ji = fs_2, fs_jpim1 ! vector opt. … … 212 238 END DO 213 239 END DO 214 END DO 215 ! 240 !$OMP END DO NOWAIT 241 END DO 242 ! 243 !$OMP DO schedule(static) private(jj, ji, ze3ua) 216 244 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 217 245 DO ji = fs_2, fs_jpim1 ! vector opt. … … 222 250 END DO 223 251 DO jk = 2, jpkm1 252 !$OMP DO schedule(static) private(jj, ji) 224 253 DO jj = 2, jpjm1 225 254 DO ji = fs_2, fs_jpim1 … … 229 258 END DO 230 259 ! 260 !$OMP DO schedule(static) private(jj, ji) 231 261 DO jj = 2, jpjm1 !== thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk ==! 232 262 DO ji = fs_2, fs_jpim1 ! vector opt. … … 235 265 END DO 236 266 DO jk = jpk-2, 1, -1 267 !$OMP DO schedule(static) private(jj, ji) 237 268 DO jj = 2, jpjm1 238 269 DO ji = fs_2, fs_jpim1 … … 248 279 ! non zero value at the ocean bottom depending on the bottom friction used 249 280 ! 281 !$OMP DO schedule(static) private(jk, jj, ji, ze3va, zzwi, zzws) 250 282 DO jk = 1, jpkm1 ! Matrix 251 283 DO jj = 2, jpjm1 … … 260 292 END DO 261 293 END DO 294 !$OMP DO schedule(static) private(jj, ji) 262 295 DO jj = 2, jpjm1 ! Surface boundary conditions 263 296 DO ji = fs_2, fs_jpim1 ! vector opt. … … 283 316 ! 284 317 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 318 !$OMP DO schedule(static) private(jj, ji) 285 319 DO jj = 2, jpjm1 286 320 DO ji = fs_2, fs_jpim1 ! vector opt. … … 288 322 END DO 289 323 END DO 290 END DO 291 ! 324 !$OMP END DO NOWAIT 325 END DO 326 ! 327 !$OMP DO schedule(static) private(jj, ji, ze3va) 292 328 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 293 329 DO ji = fs_2, fs_jpim1 ! vector opt. … … 298 334 END DO 299 335 DO jk = 2, jpkm1 336 !$OMP DO schedule(static) private(jj, ji) 300 337 DO jj = 2, jpjm1 301 338 DO ji = fs_2, fs_jpim1 ! vector opt. … … 305 342 END DO 306 343 ! 344 !$OMP DO schedule(static) private(jj, ji) 307 345 DO jj = 2, jpjm1 !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk ==! 308 346 DO ji = fs_2, fs_jpim1 ! vector opt. … … 311 349 END DO 312 350 DO jk = jpk-2, 1, -1 351 !$OMP DO schedule(static) private(jj, ji) 313 352 DO jj = 2, jpjm1 314 353 DO ji = fs_2, fs_jpim1 … … 316 355 END DO 317 356 END DO 318 END DO 357 !$OMP END DO NOWAIT 358 END DO 359 !$OMP END PARALLEL 319 360 320 361 ! J. Chanut: Lines below are useless ? … … 322 363 !!gm I almost sure it is !!!! 323 364 IF( ln_bfrimp ) THEN 365 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 324 366 DO jj = 2, jpjm1 325 367 DO ji = 2, jpim1 … … 331 373 END DO 332 374 IF (ln_isfcav) THEN 375 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 333 376 DO jj = 2, jpjm1 334 377 DO ji = 2, jpim1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r7646 r7698 72 72 INTEGER, INTENT(in) :: kt ! time step 73 73 ! 74 INTEGER :: jk ! dummy loop indice74 INTEGER :: jk, jj, ji ! dummy loop indice 75 75 REAL(wp) :: z2dt, zcoef ! local scalars 76 76 REAL(wp), POINTER, DIMENSION(:,: ) :: zhdiv ! 2D workspace … … 95 95 ! !------------------------------! 96 96 IF(ln_wd) THEN 97 CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 98 ENDIF 99 100 CALL div_hor( kt ) ! Horizontal divergence 101 ! 102 zhdiv(:,:) = 0._wp 97 CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 98 END IF 99 100 CALL div_hor( kt ) ! Horizontal divergence 101 ! 102 !$OMP PARALLEL 103 !$OMP DO schedule(static) private(jj, ji) 104 DO jj = 1, jpj 105 DO ji = 1, jpi 106 zhdiv(ji,jj) = 0._wp 107 END DO 108 END DO 103 109 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 104 zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 110 !$OMP DO schedule(static) private(jj, ji) 111 DO jj = 1, jpj 112 DO ji = 1, jpi 113 zhdiv(ji,jj) = zhdiv(ji,jj) + e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) 114 END DO 115 END DO 105 116 END DO 106 117 ! ! Sea surface elevation time stepping … … 108 119 ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 109 120 ! 110 ssha(:,:) = ( sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:) 111 121 !$OMP DO schedule(static) private(jj, ji) 122 DO jj = 1, jpj 123 DO ji = 1, jpi 124 ssha(ji,jj) = ( sshb(ji,jj) - z2dt * ( zcoef * ( emp_b(ji,jj) + emp(ji,jj) ) + zhdiv(ji,jj) ) ) * ssmask(ji,jj) 125 END DO 126 END DO 127 !$OMP END PARALLEL 112 128 IF ( .NOT.ln_dynspg_ts ) THEN 113 129 ! These lines are not necessary with time splitting since … … 125 141 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN ! Include the IAU weighted SSH increment 126 142 CALL ssh_asm_inc( kt ) 127 ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 143 !$OMP PARALLEL DO schedule(static) private(jj, ji) 144 DO jj = 1, jpj 145 DO ji = 1, jpi 146 ssha(ji,jj) = ssha(ji,jj) + z2dt * ssh_iau(ji,jj) 147 END DO 148 END DO 128 149 ENDIF 129 150 #endif … … 171 192 IF(lwp) WRITE(numout,*) '~~~~~ ' 172 193 ! 173 wn(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all) 194 !$OMP PARALLEL DO schedule(static) private(jj, ji) 195 DO jj = 1, jpj 196 DO ji = 1, jpi 197 wn(ji,jj,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all) 198 END DO 199 END DO 174 200 ENDIF 175 201 ! !------------------------------! … … 181 207 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases 182 208 CALL wrk_alloc( jpi, jpj, jpk, zhdiv ) 209 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 183 210 ! 184 211 DO jk = 1, jpkm1 … … 196 223 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 197 224 ! computation of w 198 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk) & 199 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 225 !$OMP PARALLEL DO schedule(static) private(jj, ji) 226 DO jj = 1, jpj 227 DO ji = 1, jpi ! vector opt. 228 wn(ji,jj,jk) = wn(ji,jj,jk+1) - ( e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) + zhdiv(ji,jj,jk) & 229 & + z1_2dt * ( e3t_a(ji,jj,jk) - e3t_b(ji,jj,jk) ) ) * tmask(ji,jj,jk) 230 END DO 231 END DO 200 232 END DO 201 233 ! IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 … … 203 235 ELSE ! z_star and linear free surface cases 204 236 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 205 ! computation of w 206 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) & 207 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 237 !$OMP PARALLEL DO schedule(static) private(jj, ji) 238 DO jj = 1, jpj 239 DO ji = 1, jpi ! vector opt. 240 ! computation of w 241 wn(ji,jj,jk) = wn(ji,jj,jk+1) - ( e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) & 242 & + z1_2dt * ( e3t_a(ji,jj,jk) - e3t_b(ji,jj,jk) ) ) * tmask(ji,jj,jk) 243 END DO 244 END DO 208 245 END DO 209 246 ENDIF 210 247 211 248 IF( ln_bdy ) THEN 249 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 212 250 DO jk = 1, jpkm1 213 wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 251 DO jj = 1, jpj 252 DO ji = 1, jpi 253 wn(ji,jj,jk) = wn(ji,jj,jk) * bdytmask(ji,jj) 254 END DO 255 END DO 214 256 END DO 215 257 ENDIF … … 241 283 INTEGER, INTENT(in) :: kt ! ocean time-step index 242 284 ! 285 INTEGER :: ji, jj, jk ! dummy loop indices 243 286 REAL(wp) :: zcoef ! local scalar 244 287 !!---------------------------------------------------------------------- … … 254 297 IF( ( neuler == 0 .AND. kt == nit000 ) .OR. & 255 298 & ( ln_bt_fw .AND. ln_dynspg_ts ) ) THEN 256 sshb(:,:) = sshn(:,:) ! before <-- now 257 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) 299 !$OMP PARALLEL DO schedule(static) private(jj, ji) 300 DO jj = 1, jpj 301 DO ji = 1, jpi 302 sshb(ji,jj) = sshn(ji,jj) ! before <-- now 303 sshn(ji,jj) = ssha(ji,jj) ! now <-- after (before already = now) 304 END DO 305 END DO 258 306 ! 259 307 ELSE !== Leap-Frog time-stepping: Asselin filter + swap ==! 260 308 ! ! before <-- now filtered 261 sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 309 !$OMP PARALLEL DO schedule(static) private(jj, ji) 310 DO jj = 1, jpj 311 DO ji = 1, jpi 312 sshb(ji,jj) = sshn(ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) 313 END DO 314 END DO 262 315 IF( .NOT.ln_linssh ) THEN ! before <-- with forcing removed 263 316 zcoef = atfp * rdt * r1_rau0 264 sshb(:,:) = sshb(:,:) - zcoef * ( emp_b(:,:) - emp (:,:) & 265 & - rnf_b(:,:) + rnf (:,:) & 266 & + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:) 317 !$OMP PARALLEL DO schedule(static) private(jj, ji) 318 DO jj = 1, jpj 319 DO ji = 1, jpi 320 sshb(ji,jj) = sshb(ji,jj) - zcoef * ( emp_b(ji,jj) - emp (ji,jj) & 321 & - rnf_b(ji,jj) + rnf (ji,jj) & 322 & + fwfisf_b(ji,jj) - fwfisf(ji,jj) ) * ssmask(ji,jj) 323 END DO 324 END DO 267 325 ENDIF 268 sshn(:,:) = ssha(:,:) ! now <-- after 326 !$OMP PARALLEL DO schedule(static) private(jj, ji) 327 DO jj = 1, jpj 328 DO ji = 1, jpi 329 sshn(ji,jj) = ssha(ji,jj) ! now <-- after 330 END DO 331 END DO 269 332 ENDIF 270 333 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
r7646 r7698 85 85 first_width (:) = SQRT( rn_initial_mass(:) / ( rn_LoW_ratio * rn_rho_bergs * rn_initial_thickness(:) ) ) 86 86 first_length(:) = rn_LoW_ratio * first_width(:) 87 88 berg_grid%calving (:,:) = 0._wp 89 berg_grid%calving_hflx (:,:) = 0._wp 90 berg_grid%stored_heat (:,:) = 0._wp 91 berg_grid%floating_melt(:,:) = 0._wp 92 berg_grid%maxclass (:,:) = nclasses 93 berg_grid%stored_ice (:,:,:) = 0._wp 94 berg_grid%tmp (:,:) = 0._wp 95 src_calving (:,:) = 0._wp 96 src_calving_hflx (:,:) = 0._wp 97 87 !$OMP PARALLEL 88 !$OMP DO schedule(static) private(jj, ji) 89 DO jj = 1, jpj 90 DO ji = 1, jpi 91 berg_grid%calving (ji,jj) = 0._wp 92 berg_grid%calving_hflx (ji,jj) = 0._wp 93 berg_grid%stored_heat (ji,jj) = 0._wp 94 berg_grid%floating_melt(ji,jj) = 0._wp 95 berg_grid%maxclass (ji,jj) = nclasses 96 berg_grid%tmp (ji,jj) = 0._wp 97 src_calving (ji,jj) = 0._wp 98 src_calving_hflx (ji,jj) = 0._wp 99 END DO 100 END DO 101 DO jn = 1, nclasses 102 !$OMP DO schedule(static) private(jj, ji) 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 berg_grid%stored_ice (ji,jj,jn) = 0._wp 106 END DO 107 END DO 108 END DO 109 !$OMP END PARALLEL 98 110 ! ! domain for icebergs 99 111 IF( lk_mpp .AND. jpni == 1 ) CALL ctl_stop( 'icbinit: having ONE processor in x currently does not work' ) … … 108 120 nicbfldproc(:) = -1 109 121 122 !$OMP PARALLEL DO schedule(static) private(jj, ji) 110 123 DO jj = 1, jpj 111 124 DO ji = 1, jpi … … 218 231 CALL flush(numicb) 219 232 ENDIF 220 221 src_calving (:,:) = 0._wp 222 src_calving_hflx(:,:) = 0._wp 223 233 !$OMP PARALLEL DO schedule(static) private(jj, ji) 234 DO jj = 1, jpj 235 DO ji = 1, jpi 236 src_calving (ji,jj) = 0._wp 237 src_calving_hflx(ji,jj) = 0._wp 238 END DO 239 END DO 224 240 ! assign each new iceberg with a unique number constructed from the processor number 225 241 ! and incremented by the total number of processors … … 236 252 IF( ivar > 0 ) THEN 237 253 CALL iom_get ( inum, jpdom_data, 'maxclass', src_calving ) ! read the max distribution array 238 berg_grid%maxclass(:,:) = INT( src_calving ) 239 src_calving(:,:) = 0._wp 254 !$OMP PARALLEL 255 !$OMP DO schedule(static) private(jj, ji) 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 berg_grid%maxclass(ji,jj) = INT( src_calving(ji,jj) ) 259 END DO 260 END DO 261 !$OMP DO schedule(static) private(jj, ji) 262 DO jj = 1, jpj 263 DO ji = 1, jpi 264 src_calving(ji,jj) = 0._wp 265 END DO 266 END DO 267 !$OMP END PARALLEL 240 268 ENDIF 241 269 CALL iom_close( inum ) ! close file -
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r7646 r7698 381 381 ! 382 382 ! WARNING ptab is defined only between nld and nle 383 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 383 384 DO jk = 1, jpk 384 385 DO jj = nlcj+1, jpj ! added line(s) (inner only) … … 399 400 ! !* Cyclic east-west 400 401 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 401 ptab( 1 ,:,:) = ptab(jpim1,:,:) 402 ptab(jpi,:,:) = ptab( 2 ,:,:) 402 !$OMP PARALLEL DO schedule(static) private(jk, jj) 403 DO jk = 1, jpk 404 DO jj = 1, jpj 405 ptab( 1 ,jj,jk) = ptab(jpim1,jj,jk) 406 ptab(jpi,jj,jk) = ptab( 2 ,jj,jk) 407 END DO 408 END DO 403 409 ELSE !* closed 404 IF( .NOT. cd_type == 'F' ) ptab( 1 :jpreci,:,:) = zland ! south except F-point 405 ptab(nlci-jpreci+1:jpi ,:,:) = zland ! north 410 IF( .NOT. cd_type == 'F' ) THEN 411 !$OMP PARALLEL DO schedule(static) private(jk, jj) 412 DO jk = 1, jpk 413 DO jj = 1, jpj 414 ptab( 1 :jpreci,jj,jk) = zland ! south except F-point 415 END DO 416 END DO 417 END IF 418 !$OMP PARALLEL DO schedule(static) private(jk, jj) 419 DO jk = 1, jpk 420 DO jj = 1, jpj 421 ptab(nlci-jpreci+1:jpi ,jj,jk) = zland ! north 422 END DO 423 END DO 406 424 ENDIF 407 425 ! North-south cyclic 408 426 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south only with no mpp split in latitude 409 ptab(:,1 , :) = ptab(:, jpjm1,:) 410 ptab(:,jpj,:) = ptab(:, 2,:) 427 !$OMP PARALLEL DO schedule(static) private(jk, ji) 428 DO jk = 1, jpk 429 DO ji = 1, jpi 430 ptab(ji,1 , jk) = ptab(ji, jpjm1,jk) 431 ptab(ji,jpj,jk) = ptab(ji, 2,jk) 432 END DO 433 END DO 411 434 ELSE ! ! North-South boundaries (closed) 412 IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj,:) = zland ! south except F-point 413 ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north 435 IF( .NOT. cd_type == 'F' ) THEN 436 !$OMP PARALLEL DO schedule(static) private(jk, ji) 437 DO jk = 1, jpk 438 DO ji = 1, jpi 439 ptab(ji, 1 :jprecj,jk) = zland ! south except F-point 440 END DO 441 END DO 442 END IF 443 !$OMP PARALLEL DO schedule(static) private(jk, ji) 444 DO jk = 1, jpk 445 DO ji = 1, jpi 446 ptab(ji,nlcj-jprecj+1:jpj ,jk) = zland ! north 447 END DO 448 END DO 414 449 ENDIF 415 450 ! … … 423 458 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 424 459 iihom = nlci-nreci 425 DO jl = 1, jpreci 426 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 427 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 460 !$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 461 DO jk = 1, jpk 462 DO jj = 1, jpj 463 DO jl = 1, jpreci 464 zt3ew(jj,jl,jk,1) = ptab(jpreci+jl,jj,jk) 465 zt3we(jj,jl,jk,1) = ptab(iihom +jl,jj,jk) 466 END DO 467 END DO 428 468 END DO 429 469 END SELECT … … 455 495 SELECT CASE ( nbondi ) 456 496 CASE ( -1 ) 457 DO jl = 1, jpreci 458 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 459 END DO 460 CASE ( 0 ) 461 DO jl = 1, jpreci 462 ptab(jl ,:,:) = zt3we(:,jl,:,2) 463 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 464 END DO 465 CASE ( 1 ) 466 DO jl = 1, jpreci 467 ptab(jl ,:,:) = zt3we(:,jl,:,2) 497 !$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 498 DO jk = 1, jpk 499 DO jl = 1, jpreci 500 DO jj = 1, jpj 501 ptab(iihom+jl,jj,jk) = zt3ew(jj,jl,jk,2) 502 END DO 503 END DO 504 END DO 505 CASE ( 0 ) 506 !$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 507 DO jk = 1, jpk 508 DO jl = 1, jpreci 509 DO jj = 1, jpj 510 ptab(jl ,jj,jk) = zt3we(jj,jl,jk,2) 511 ptab(iihom+jl,jj,jk) = zt3ew(jj,jl,jk,2) 512 END DO 513 END DO 514 END DO 515 CASE ( 1 ) 516 !$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 517 DO jk = 1, jpk 518 DO jl = 1, jpreci 519 DO jj = 1, jpj 520 ptab(jl ,jj,jk) = zt3we(jj,jl,jk,2) 521 END DO 522 END DO 468 523 END DO 469 524 END SELECT … … 475 530 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 476 531 ijhom = nlcj-nrecj 477 DO jl = 1, jprecj 478 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 479 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 532 !$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 533 DO jk = 1, jpk 534 DO jl = 1, jprecj 535 DO ji = 1, jpi 536 zt3sn(ji,jl,jk,1) = ptab(ji,ijhom +jl,jk) 537 zt3ns(ji,jl,jk,1) = ptab(ji,jprecj+jl,jk) 538 END DO 539 END DO 480 540 END DO 481 541 ENDIF … … 507 567 SELECT CASE ( nbondj ) 508 568 CASE ( -1 ) 509 DO jl = 1, jprecj 510 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 511 END DO 512 CASE ( 0 ) 513 DO jl = 1, jprecj 514 ptab(:,jl ,:) = zt3sn(:,jl,:,2) 515 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 516 END DO 517 CASE ( 1 ) 518 DO jl = 1, jprecj 519 ptab(:,jl,:) = zt3sn(:,jl,:,2) 569 !$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 570 DO jk = 1, jpk 571 DO jl = 1, jprecj 572 DO ji = 1, jpi 573 ptab(ji,ijhom+jl,jk) = zt3ns(ji,jl,jk,2) 574 END DO 575 END DO 576 END DO 577 CASE ( 0 ) 578 !$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 579 DO jk = 1, jpk 580 DO jl = 1, jprecj 581 DO ji = 1, jpi 582 ptab(ji,jl ,jk) = zt3sn(ji,jl,jk,2) 583 ptab(ji,ijhom+jl,jk) = zt3ns(ji,jl,jk,2) 584 END DO 585 END DO 586 END DO 587 CASE ( 1 ) 588 !$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 589 DO jk = 1, jpk 590 DO jl = 1, jprecj 591 DO ji = 1, jpi 592 ptab(ji,jl,jk) = zt3sn(ji,jl,jk,2) 593 END DO 594 END DO 520 595 END DO 521 596 END SELECT … … 917 992 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 918 993 iihom = nlci-nreci 919 DO jl = 1, jpreci 920 zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 921 zt2we(:,jl,1) = pt2d(iihom +jl,:) 994 !$OMP PARALLEL DO schedule(static) private(jj,jl) 995 DO jj = 1, jpj 996 DO jl = 1, jpreci 997 zt2ew(jj,jl,1) = pt2d(jpreci+jl,jj) 998 zt2we(jj,jl,1) = pt2d(iihom +jl,jj) 999 END DO 922 1000 END DO 923 1001 END SELECT … … 949 1027 SELECT CASE ( nbondi ) 950 1028 CASE ( -1 ) 1029 !$OMP PARALLEL DO schedule(static) private(jj,jl) 951 1030 DO jl = 1, jpreci 952 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 953 END DO 954 CASE ( 0 ) 1031 DO jj = 1, jpj 1032 pt2d(iihom+jl,jj) = zt2ew(jj,jl,2) 1033 END DO 1034 END DO 1035 CASE ( 0 ) 1036 !$OMP PARALLEL DO schedule(static) private(jj,jl) 955 1037 DO jl = 1, jpreci 956 pt2d(jl ,:) = zt2we(:,jl,2) 957 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 958 END DO 959 CASE ( 1 ) 1038 DO jj = 1, jpj 1039 pt2d(jl ,jj) = zt2we(jj,jl,2) 1040 pt2d(iihom+jl,jj) = zt2ew(jj,jl,2) 1041 END DO 1042 END DO 1043 CASE ( 1 ) 1044 !$OMP PARALLEL DO schedule(static) private(jj,jl) 960 1045 DO jl = 1, jpreci 961 pt2d(jl ,:) = zt2we(:,jl,2) 1046 DO jj = 1, jpj 1047 pt2d(jl ,jj) = zt2we(jj,jl,2) 1048 END DO 962 1049 END DO 963 1050 END SELECT … … 970 1057 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 971 1058 ijhom = nlcj-nrecj 1059 !$OMP PARALLEL DO schedule(static) private(ji,jl) 972 1060 DO jl = 1, jprecj 973 zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 974 zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 1061 DO ji = 1, jpi 1062 zt2sn(ji,jl,1) = pt2d(ji,ijhom +jl) 1063 zt2ns(ji,jl,1) = pt2d(ji,jprecj+jl) 1064 END DO 975 1065 END DO 976 1066 ENDIF … … 1002 1092 SELECT CASE ( nbondj ) 1003 1093 CASE ( -1 ) 1094 !$OMP PARALLEL DO schedule(static) private(ji,jl) 1004 1095 DO jl = 1, jprecj 1005 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1006 END DO 1007 CASE ( 0 ) 1096 DO ji = 1, jpi 1097 pt2d(ji,ijhom+jl) = zt2ns(ji,jl,2) 1098 END DO 1099 END DO 1100 CASE ( 0 ) 1101 !$OMP PARALLEL DO schedule(static) private(ji,jl) 1008 1102 DO jl = 1, jprecj 1009 pt2d(:,jl ) = zt2sn(:,jl,2) 1010 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1011 END DO 1012 CASE ( 1 ) 1103 DO ji = 1, jpi 1104 pt2d(ji,jl ) = zt2sn(ji,jl,2) 1105 pt2d(ji,ijhom+jl) = zt2ns(ji,jl,2) 1106 END DO 1107 END DO 1108 CASE ( 1 ) 1109 !$OMP PARALLEL DO schedule(static) private(ji,jl) 1013 1110 DO jl = 1, jprecj 1014 pt2d(:,jl ) = zt2sn(:,jl,2) 1111 DO ji = 1, jpi 1112 pt2d(ji,jl ) = zt2sn(ji,jl,2) 1113 END DO 1015 1114 END DO 1016 1115 END SELECT -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90
r7646 r7698 148 148 IF(lwp) WRITE(numout,*) ' momentum laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)' 149 149 za00 = pah0 / zd_max 150 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 150 151 DO jj = 1, jpj 151 152 DO ji = 1, jpi … … 159 160 IF(lwp) WRITE(numout,*) ' momentum bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 160 161 za00 = pah0 / ( zd_max * zd_max * zd_max ) 162 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 161 163 DO jj = 1, jpj 162 164 DO ji = 1, jpi … … 171 173 ENDIF 172 174 ! ! deeper values (LAP and BLP cases) 175 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 173 176 DO jk = 2, jpk 174 pah1(:,:,jk) = pah1(:,:,1) * tmask(:,:,jk) 175 pah2(:,:,jk) = pah2(:,:,1) * fmask(:,:,jk) 177 DO jj = 1, jpj 178 DO ji = 1, jpi 179 pah1(ji,jj,jk) = pah1(ji,jj,1) * tmask(ji,jj,jk) 180 pah2(ji,jj,jk) = pah2(ji,jj,1) * fmask(ji,jj,jk) 181 END DO 182 END DO 176 183 END DO 177 184 ! … … 180 187 IF(lwp) WRITE(numout,*) ' tracer laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)' 181 188 za00 = pah0 / zd_max 189 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 182 190 DO jj = 1, jpj 183 191 DO ji = 1, jpi … … 191 199 IF(lwp) WRITE(numout,*) ' tracer bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 192 200 za00 = pah0 / ( zd_max * zd_max * zd_max ) 201 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 193 202 DO jj = 1, jpj 194 203 DO ji = 1, jpi … … 203 212 ENDIF 204 213 ! ! deeper values (LAP and BLP cases) 214 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 205 215 DO jk = 2, jpk 206 pah1(:,:,jk) = pah1(:,:,1) * umask(:,:,jk) 207 pah2(:,:,jk) = pah2(:,:,1) * vmask(:,:,jk) 216 DO jj = 1, jpj 217 DO ji = 1, jpi 218 pah1(ji,jj,jk) = pah1(ji,jj,1) * umask(ji,jj,jk) 219 pah2(ji,jj,jk) = pah2(ji,jj,1) * vmask(ji,jj,jk) 220 END DO 221 END DO 208 222 END DO 209 223 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
r7646 r7698 155 155 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays') 156 156 ! 157 ahmt(:,:,jpk) = 0._wp ! last level always 0 158 ahmf(:,:,jpk) = 0._wp 157 !$OMP PARALLEL DO schedule(static) private(jj, ji) 158 DO jj = 1, jpj 159 DO ji = 1, jpi 160 ahmt(ji,jj,jpk) = 0._wp ! last level always 0 161 ahmf(ji,jj,jpk) = 0._wp 162 END DO 163 END DO 159 164 ! 160 165 ! ! value of eddy mixing coef. … … 173 178 CASE( 0 ) !== constant ==! 174 179 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = constant ' 175 ahmt(:,:,:) = zah0 * tmask(:,:,:) 176 ahmf(:,:,:) = zah0 * fmask(:,:,:) 180 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 181 DO jk = 1, jpk 182 DO jj = 1, jpj 183 DO ji = 1, jpi 184 ahmt(ji,jj,jk) = zah0 * tmask(ji,jj,jk) 185 ahmf(ji,jj,jk) = zah0 * fmask(ji,jj,jk) 186 END DO 187 END DO 188 END DO 177 189 ! 178 190 CASE( 10 ) !== fixed profile ==! 179 191 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( depth )' 180 ahmt(:,:,1) = zah0 * tmask(:,:,1) ! constant surface value 181 ahmf(:,:,1) = zah0 * fmask(:,:,1) 192 !$OMP PARALLEL DO schedule(static) private(jj, ji) 193 DO jj = 1, jpj 194 DO ji = 1, jpi 195 ahmt(ji,jj,1) = zah0 * tmask(ji,jj,1) ! constant surface value 196 ahmf(ji,jj,1) = zah0 * fmask(ji,jj,1) 197 END DO 198 END DO 182 199 CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 183 200 ! … … 191 208 !! do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 192 209 !! better: check that the max is <=1 i.e. it is a shape from 0 to 1, not a coef that has physical dimension 210 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 193 211 DO jk = 2, jpkm1 194 ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk) 195 ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk) 212 DO jj = 1, jpj 213 DO ji = 1, jpi 214 ahmt(ji,jj,jk) = ahmt(ji,jj,1) * tmask(ji,jj,jk) 215 ahmf(ji,jj,jk) = ahmf(ji,jj,1) * fmask(ji,jj,jk) 216 END DO 217 END DO 196 218 END DO 197 219 ! … … 209 231 !!gm Question : info for LAP or BLP case to take into account the SQRT in the bilaplacian case ???? 210 232 !! do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 233 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 211 234 DO jk = 1, jpkm1 212 ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk) 213 ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk) 235 DO jj = 1, jpj 236 DO ji = 1, jpi 237 ahmt(ji,jj,jk) = ahmt(ji,jj,jk) * tmask(ji,jj,jk) 238 ahmf(ji,jj,jk) = ahmf(ji,jj,jk) * fmask(ji,jj,jk) 239 END DO 240 END DO 214 241 END DO 215 242 ! … … 239 266 ! 240 267 ! Set local gridscale values 268 !$OMP PARALLEL DO schedule(static) private(jj,ji) 241 269 DO jj = 2, jpjm1 242 270 DO ji = fs_2, fs_jpim1 … … 251 279 ! 252 280 IF( ln_dynldf_blp .AND. .NOT. l_ldfdyn_time ) THEN ! bilapcian and no time variation: 253 ahmt(:,:,:) = SQRT( ahmt(:,:,:) ) ! take the square root of the coefficient 254 ahmf(:,:,:) = SQRT( ahmf(:,:,:) ) 281 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 282 DO jk = 1, jpk 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 ahmt(ji,jj,jk) = SQRT( ahmt(ji,jj,jk) ) ! take the square root of the coefficient 286 ahmf(ji,jj,jk) = SQRT( ahmf(ji,jj,jk) ) 287 END DO 288 END DO 289 END DO 255 290 ENDIF 256 291 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r6352 r7698 135 135 z1_slpmax = 1._wp / rn_slpmax 136 136 ! 137 zww(:,:,:) = 0._wp 138 zwz(:,:,:) = 0._wp 139 ! 137 !$OMP PARALLEL 138 !$OMP DO schedule(static) private(jk, jj, ji) 139 DO jk = 1, jpk 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 zww(ji,jj,jk) = 0._wp 143 zwz(ji,jj,jk) = 0._wp 144 END DO 145 END DO 146 END DO 147 !$OMP END DO NOWAIT 148 ! 149 !$OMP DO schedule(static) private(jk, jj, ji) 140 150 DO jk = 1, jpk !== i- & j-gradient of density ==! 141 151 DO jj = 1, jpjm1 … … 146 156 END DO 147 157 END DO 158 !$OMP END PARALLEL 148 159 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 160 !$OMP PARALLEL DO schedule(static) private(jj, ji) 149 161 DO jj = 1, jpjm1 150 162 DO ji = 1, jpim1 … … 155 167 ENDIF 156 168 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the bottom ocean level 169 !$OMP PARALLEL DO schedule(static) private(jj, ji) 157 170 DO jj = 1, jpjm1 158 171 DO ji = 1, jpim1 … … 163 176 ENDIF 164 177 ! 165 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 178 !$OMP PARALLEL 179 !$OMP DO schedule(static) private(jj, ji) 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 zdzr(ji,jj,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 183 END DO 184 END DO 185 !$OMP DO schedule(static) private(jk,jj,ji) 166 186 DO jk = 2, jpkm1 167 187 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point … … 170 190 ! ! umask(ik+1) /= 0 => all pn2 /= 0 => zdzr divides by 2 171 191 ! ! NB: 1/(tmask+1) = (1-.5*tmask) substitute a / by a * ==> faster 172 zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp ) & 173 & * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 174 END DO 192 DO jj = 1, jpj 193 DO ji = 1, jpi 194 zdzr(ji,jj,jk) = zm1_g * ( prd(ji,jj,jk) + 1._wp ) & 195 & * ( pn2(ji,jj,jk) + pn2(ji,jj,jk+1) ) * ( 1._wp - 0.5_wp * tmask(ji,jj,jk+1) ) 196 END DO 197 END DO 198 END DO 199 !$OMP END PARALLEL 175 200 ! 176 201 ! !== Slopes just below the mixed layer ==! … … 182 207 ! 183 208 IF ( ln_isfcav ) THEN 209 !$OMP PARALLEL DO schedule(static) private(jj,ji) 184 210 DO jj = 2, jpjm1 185 211 DO ji = fs_2, fs_jpim1 ! vector opt. … … 191 217 END DO 192 218 ELSE 219 !$OMP PARALLEL DO schedule(static) private(jj,ji) 193 220 DO jj = 2, jpjm1 194 221 DO ji = fs_2, fs_jpim1 ! vector opt. … … 199 226 END IF 200 227 228 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zau, zav, zbu, zbv, zfj, zfi, zdepu, zdepv) 201 229 DO jk = 2, jpkm1 !* Slopes at u and v points 202 230 DO jj = 2, jpjm1 … … 239 267 ! 240 268 ! !* horizontal Shapiro filter 269 !$OMP PARALLEL 270 !$OMP DO schedule(static) private(jk, jj, ji) 241 271 DO jk = 2, jpkm1 242 272 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only … … 283 313 ! =========================== | wslpj = mij( d/dj( prd ) / d/dz( prd ) 284 314 ! 315 !$OMP DO schedule(static) private(jk, jj, ji, zbw, zfk, zck, zbi, zbj, zai, zaj, zci, zcj) 285 316 DO jk = 2, jpkm1 286 317 DO jj = 2, jpjm1 … … 318 349 END DO 319 350 END DO 351 !$OMP END PARALLEL 320 352 CALL lbc_lnk( zwz, 'T', -1. ) ; CALL lbc_lnk( zww, 'T', -1. ) ! lateral boundary conditions 321 353 ! 322 354 ! !* horizontal Shapiro filter 355 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcofw, zck) 323 356 DO jk = 2, jpkm1 324 357 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only … … 670 703 z1_slpmax = 1._wp / rn_slpmax 671 704 ! 672 uslpml (1,:) = 0._wp ; uslpml (jpi,:) = 0._wp 673 vslpml (1,:) = 0._wp ; vslpml (jpi,:) = 0._wp 674 wslpiml(1,:) = 0._wp ; wslpiml(jpi,:) = 0._wp 675 wslpjml(1,:) = 0._wp ; wslpjml(jpi,:) = 0._wp 705 !$OMP PARALLEL 706 !$OMP DO schedule(static) private(jj) 707 DO jj = 1, jpj 708 uslpml (1,jj) = 0._wp ; uslpml (jpi,jj) = 0._wp 709 vslpml (1,jj) = 0._wp ; vslpml (jpi,jj) = 0._wp 710 wslpiml(1,jj) = 0._wp ; wslpiml(jpi,jj) = 0._wp 711 wslpjml(1,jj) = 0._wp ; wslpjml(jpi,jj) = 0._wp 712 END DO 676 713 ! 677 714 ! !== surface mixed layer mask ! 715 !$OMP DO schedule(static) private(jk, jj, ji, ik) 678 716 DO jk = 1, jpk ! =1 inside the mixed layer, =0 otherwise 679 717 DO jj = 1, jpj … … 686 724 END DO 687 725 END DO 726 !$OMP END DO NOWAIT 688 727 689 728 … … 698 737 !----------------------------------------------------------------------- 699 738 ! 739 !$OMP DO schedule(static) private(jj, ji, iku, ikv, zbu, zbv, zau, zav, ik, ikm1, zbw, zci, zcj, zai, zaj, zbi, zbj) 700 740 DO jj = 2, jpjm1 701 741 DO ji = 2, jpim1 … … 742 782 END DO 743 783 END DO 784 !$OMP END PARALLEL 744 785 !!gm this lbc_lnk should be useless.... 745 786 CALL lbc_lnk( uslpml , 'U', -1. ) ; CALL lbc_lnk( vslpml , 'V', -1. ) ! lateral boundary cond. (sign change) … … 791 832 ! Direction of lateral diffusion (tracers and/or momentum) 792 833 ! ------------------------------ 793 uslp (:,:,:) = 0._wp ; uslpml (:,:) = 0._wp ! set the slope to zero (even in s-coordinates) 794 vslp (:,:,:) = 0._wp ; vslpml (:,:) = 0._wp 795 wslpi(:,:,:) = 0._wp ; wslpiml(:,:) = 0._wp 796 wslpj(:,:,:) = 0._wp ; wslpjml(:,:) = 0._wp 797 834 835 !$OMP PARALLEL 836 !$OMP DO schedule(static) private(jk, jj, ji) 837 DO jk = 1, jpk 838 DO jj = 1, jpj 839 DO ji = 1, jpi 840 uslp (ji,jj,jk) = 0._wp 841 vslp (ji,jj,jk) = 0._wp 842 wslpi(ji,jj,jk) = 0._wp 843 wslpj(ji,jj,jk) = 0._wp 844 END DO 845 END DO 846 END DO 847 !$OMP END DO NOWAIT 848 !$OMP DO schedule(static) private(jj, ji) 849 DO jj = 1, jpj 850 DO ji = 1, jpi 851 uslpml (ji,jj) = 0._wp 852 vslpml (ji,jj) = 0._wp 853 wslpiml(ji,jj) = 0._wp 854 wslpjml(ji,jj) = 0._wp 855 END DO 856 END DO 857 !$OMP END PARALLEL 798 858 !!gm I no longer understand this..... 799 859 !!gm IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (.NOT.ln_linssh .AND. ln_rstart) ) THEN -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r7646 r7698 116 116 !! aeiu, aeiv initialized once for all or l_ldfeiv_time set to true 117 117 !!---------------------------------------------------------------------- 118 INTEGER :: jk 118 INTEGER :: jk, jj, ji ! dummy loop indices 119 119 INTEGER :: ierr, inum, ios ! local integer 120 120 REAL(wp) :: zah0 ! local scalar … … 184 184 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays') 185 185 ! 186 ahtu(:,:,jpk) = 0._wp ! last level always 0 187 ahtv(:,:,jpk) = 0._wp 186 !$OMP PARALLEL DO schedule(static) private(jj, ji) 187 DO jj = 1, jpj 188 DO ji = 1, jpi 189 ahtu(ji,jj,jpk) = 0._wp ! last level always 0 190 ahtv(ji,jj,jpk) = 0._wp 191 END DO 192 END DO 188 193 ! 189 194 ! ! value of eddy mixing coef. … … 200 205 CASE( 0 ) !== constant ==! 201 206 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = constant = ', rn_aht_0 202 ahtu(:,:,:) = zah0 * umask(:,:,:) 203 ahtv(:,:,:) = zah0 * vmask(:,:,:) 207 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 208 DO jk = 1, jpk 209 DO jj = 1, jpj 210 DO ji = 1, jpi 211 ahtu(ji,jj,jk) = zah0 * umask(ji,jj,jk) 212 ahtv(ji,jj,jk) = zah0 * vmask(ji,jj,jk) 213 END DO 214 END DO 215 END DO 204 216 ! 205 217 CASE( 10 ) !== fixed profile ==! 206 218 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( depth )' 207 ahtu(:,:,1) = zah0 * umask(:,:,1) ! constant surface value 208 ahtv(:,:,1) = zah0 * vmask(:,:,1) 219 !$OMP PARALLEL DO schedule(static) private(jj, ji) 220 DO jj = 1, jpj 221 DO ji = 1, jpi 222 ahtu(ji,jj,1) = zah0 * umask(ji,jj,1) ! constant surface value 223 ahtv(ji,jj,1) = zah0 * vmask(ji,jj,1) 224 END DO 225 END DO 209 226 CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 210 227 ! … … 215 232 CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 216 233 CALL iom_close( inum ) 234 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 217 235 DO jk = 2, jpkm1 218 ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 219 ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 236 DO jj = 1, jpj 237 DO ji = 1, jpi 238 ahtu(ji,jj,jk) = ahtu(ji,jj,1) * umask(ji,jj,jk) 239 ahtv(ji,jj,jk) = ahtv(ji,jj,1) * vmask(ji,jj,jk) 240 END DO 241 END DO 220 242 END DO 221 243 ! … … 244 266 CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 245 267 CALL iom_close( inum ) 268 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 246 269 DO jk = 1, jpkm1 247 ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk) 248 ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk) 270 DO jj = 1, jpj 271 DO ji = 1, jpi 272 ahtu(ji,jj,jk) = ahtu(ji,jj,jk) * umask(ji,jj,jk) 273 ahtv(ji,jj,jk) = ahtv(ji,jj,jk) * vmask(ji,jj,jk) 274 END DO 275 END DO 249 276 END DO 250 277 ! … … 267 294 ! 268 295 IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN 269 ahtu(:,:,:) = SQRT( ahtu(:,:,:) ) 270 ahtv(:,:,:) = SQRT( ahtv(:,:,:) ) 296 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 297 DO jk = 1, jpk 298 DO jj = 1, jpj 299 DO ji = 1, jpi 300 ahtu(ji,jj,jk) = SQRT( ahtu(ji,jj,jk) ) 301 ahtv(ji,jj,jk) = SQRT( ahtv(ji,jj,jk) ) 302 END DO 303 END DO 304 END DO 271 305 ENDIF 272 306 ! … … 313 347 ! ! increase to rn_aht_0 within 20N-20S 314 348 IF( ln_ldfeiv .AND. nn_aei_ijk_t == 21 ) THEN ! use the already computed aei. 315 ahtu(:,:,1) = aeiu(:,:,1) 316 ahtv(:,:,1) = aeiv(:,:,1) 349 !$OMP PARALLEL DO schedule(static) private(jj,ji) 350 DO jj = 1, jpj 351 DO ji = 1, jpi 352 ahtu(ji,jj,1) = aeiu(ji,jj,1) 353 ahtv(ji,jj,1) = aeiv(ji,jj,1) 354 END DO 355 END DO 317 356 ELSE ! compute aht. 318 357 CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv ) … … 321 360 z1_f20 = 1._wp / ( 2._wp * omega * SIN( rad * 20._wp ) ) ! 1 / ff(20 degrees) 322 361 zaht_min = 0.2_wp * rn_aht_0 ! minimum value for aht 362 !$OMP PARALLEL 363 !$OMP DO schedule(static) private(jj,ji,zaht,zahf) 323 364 DO jj = 1, jpj 324 365 DO ji = 1, jpi … … 331 372 END DO 332 373 END DO 374 !$OMP DO schedule(static) private(jk,jj,ji) 333 375 DO jk = 2, jpkm1 ! deeper value = surface value 334 ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 335 ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 336 END DO 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 ahtu(ji,jj,jk) = ahtu(ji,jj,1) * umask(ji,jj,jk) 379 ahtv(ji,jj,jk) = ahtv(ji,jj,1) * vmask(ji,jj,jk) 380 END DO 381 END DO 382 END DO 383 !$OMP END PARALLEL 337 384 ! 338 385 CASE( 31 ) !== time varying 3D field ==! = F( local velocity ) 339 386 IF( ln_traldf_lap ) THEN ! laplacian operator |u| e /12 387 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 340 388 DO jk = 1, jpkm1 341 ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 342 ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 389 DO jj = 1, jpj 390 DO ji = 1, jpi 391 ahtu(ji,jj,jk) = ABS( ub(ji,jj,jk) ) * e1u(ji,jj) * r1_12 392 ahtv(ji,jj,jk) = ABS( vb(ji,jj,jk) ) * e2v(ji,jj) * r1_12 393 END DO 394 END DO 343 395 END DO 344 396 ELSEIF( ln_traldf_blp ) THEN ! bilaplacian operator sqrt( |u| e^3 /12 ) = sqrt( |u| e /12 ) * e 397 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 345 398 DO jk = 1, jpkm1 346 ahtu(:,:,jk) = SQRT( ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 ) * e1u(:,:) 347 ahtv(:,:,jk) = SQRT( ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 ) * e2v(:,:) 399 DO jj = 1, jpj 400 DO ji = 1, jpi 401 ahtu(ji,jj,jk) = SQRT( ABS( ub(ji,jj,jk) ) * e1u(ji,jj) * r1_12 ) * e1u(ji,jj) 402 ahtv(ji,jj,jk) = SQRT( ABS( vb(ji,jj,jk) ) * e2v(ji,jj) * r1_12 ) * e2v(ji,jj) 403 END DO 404 END DO 348 405 END DO 349 406 ENDIF … … 378 435 !! l_ldfeiv_time : =T if EIV coefficients vary with time 379 436 !!---------------------------------------------------------------------- 380 INTEGER :: jk 437 INTEGER :: jk, jj, ji ! dummy loop indices 381 438 INTEGER :: ierr, inum, ios ! local integer 382 439 ! … … 419 476 CASE( 0 ) !== constant ==! 420 477 IF(lwp) WRITE(numout,*) ' eddy induced velocity coef. = constant = ', rn_aeiv_0 421 aeiu(:,:,:) = rn_aeiv_0 422 aeiv(:,:,:) = rn_aeiv_0 478 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 479 DO jk = 1, jpk 480 DO jj = 1, jpj 481 DO ji = 1, jpi 482 aeiu(ji,jj,jk) = rn_aeiv_0 483 aeiv(ji,jj,jk) = rn_aeiv_0 484 END DO 485 END DO 486 END DO 423 487 ! 424 488 CASE( 10 ) !== fixed profile ==! 425 489 IF(lwp) WRITE(numout,*) ' eddy induced velocity coef. = F( depth )' 426 aeiu(:,:,1) = rn_aeiv_0 ! constant surface value 427 aeiv(:,:,1) = rn_aeiv_0 490 !$OMP PARALLEL DO schedule(static) private(jj, ji) 491 DO jj = 1, jpj 492 DO ji = 1, jpi 493 aeiu(ji,jj,1) = rn_aeiv_0 ! constant surface value 494 aeiv(ji,jj,1) = rn_aeiv_0 495 END DO 496 END DO 428 497 CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 429 498 ! … … 434 503 CALL iom_get ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 435 504 CALL iom_close( inum ) 505 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 436 506 DO jk = 2, jpk 437 aeiu(:,:,jk) = aeiu(:,:,1) 438 aeiv(:,:,jk) = aeiv(:,:,1) 507 DO jj = 1, jpj 508 DO ji = 1, jpi 509 aeiu(ji,jj,jk) = aeiu(ji,jj,1) 510 aeiv(ji,jj,jk) = aeiv(ji,jj,1) 511 END DO 512 END DO 439 513 END DO 440 514 ! … … 498 572 CALL wrk_alloc( jpi,jpj, zn, zah, zhw, zross, zaeiw ) 499 573 ! 500 zn (:,:) = 0._wp ! Local initialization 501 zhw (:,:) = 5._wp 502 zah (:,:) = 0._wp 503 zross(:,:) = 0._wp 574 !$OMP PARALLEL DO schedule(static) private(jj,ji) 575 DO jj = 1, jpj 576 DO ji = 1, jpi 577 zn (ji,jj) = 0._wp ! Local initialization 578 zhw (ji,jj) = 5._wp 579 zah (ji,jj) = 0._wp 580 zross(ji,jj) = 0._wp 581 END DO 582 END DO 504 583 ! ! Compute lateral diffusive coefficient at T-point 505 584 IF( ln_traldf_triad ) THEN 506 585 DO jk = 1, jpk 586 !$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w) 507 587 DO jj = 2, jpjm1 508 588 DO ji = 2, jpim1 … … 523 603 ELSE 524 604 DO jk = 1, jpk 605 !$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w) 525 606 DO jj = 2, jpjm1 526 607 DO ji = 2, jpim1 … … 542 623 END IF 543 624 625 !$OMP PARALLEL 626 !$OMP DO schedule(static) private(jj,ji,zfw) 544 627 DO jj = 2, jpjm1 545 628 DO ji = fs_2, fs_jpim1 ! vector opt. … … 554 637 ! !== Bound on eiv coeff. ==! 555 638 z1_f20 = 1._wp / ( 2._wp * omega * sin( rad * 20._wp ) ) 639 !$OMP DO schedule(static) private(jj,ji,zzaei) 556 640 DO jj = 2, jpjm1 557 641 DO ji = fs_2, fs_jpim1 ! vector opt. … … 560 644 END DO 561 645 END DO 646 !$OMP END PARALLEL 562 647 CALL lbc_lnk( zaeiw(:,:), 'W', 1. ) ! lateral boundary condition 563 648 ! 649 !$OMP PARALLEL DO schedule(static) private(jj,ji) 564 650 DO jj = 2, jpjm1 !== aei at u- and v-points ==! 565 651 DO ji = fs_2, fs_jpim1 ! vector opt. … … 570 656 CALL lbc_lnk( paeiu(:,:,1), 'U', 1. ) ; CALL lbc_lnk( paeiv(:,:,1), 'V', 1. ) ! lateral boundary condition 571 657 658 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 572 659 DO jk = 2, jpkm1 !== deeper values equal the surface one ==! 573 paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk) 574 paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk) 660 DO jj = 1, jpj 661 DO ji = 1, jpi 662 paeiu(ji,jj,jk) = paeiu(ji,jj,1) * umask(ji,jj,jk) 663 paeiv(ji,jj,jk) = paeiv(ji,jj,1) * vmask(ji,jj,jk) 664 END DO 665 END DO 575 666 END DO 576 667 ! … … 624 715 625 716 626 zpsi_uw(:,:, 1 ) = 0._wp ; zpsi_vw(:,:, 1 ) = 0._wp 627 zpsi_uw(:,:,jpk) = 0._wp ; zpsi_vw(:,:,jpk) = 0._wp 628 ! 717 !$OMP PARALLEL 718 !$OMP DO schedule(static) private(jj,ji) 719 DO jj = 1, jpj 720 DO ji = 1, jpi 721 zpsi_uw(ji,jj, 1 ) = 0._wp ; zpsi_vw(ji,jj, 1 ) = 0._wp 722 zpsi_uw(ji,jj,jpk) = 0._wp ; zpsi_vw(ji,jj,jpk) = 0._wp 723 END DO 724 END DO 725 !$OMP END DO NOWAIT 726 ! 727 !$OMP DO schedule(static) private(jk,jj,ji) 629 728 DO jk = 2, jpkm1 630 729 DO jj = 1, jpjm1 … … 638 737 END DO 639 738 ! 739 !$OMP DO schedule(static) private(jk,jj,ji) 640 740 DO jk = 1, jpkm1 641 741 DO jj = 1, jpjm1 … … 646 746 END DO 647 747 END DO 748 !$OMP END DO NOWAIT 749 !$OMP DO schedule(static) private(jk,jj,ji) 648 750 DO jk = 1, jpkm1 649 751 DO jj = 2, jpjm1 … … 654 756 END DO 655 757 END DO 758 !$OMP END PARALLEL 656 759 ! 657 760 ! ! diagnose the eddy induced velocity and associated heat transport … … 695 798 CALL wrk_alloc( jpi,jpj,jpk, zw3d ) 696 799 ! 697 zw3d(:,:,jpk) = 0._wp ! bottom value always 0 698 ! 800 !$OMP PARALLEL 801 !$OMP DO schedule(static) private(jj,ji) 802 DO jj = 1, jpj 803 DO ji = 1, jpi 804 zw3d(ji,jj,jpk) = 0._wp ! bottom value always 0 805 END DO 806 END DO 807 !$OMP END DO NOWAIT 808 ! 809 !$OMP DO schedule(static) private(jk,jj,ji) 699 810 DO jk = 1, jpkm1 ! e2u e3u u_eiv = -dk[psi_uw] 700 zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 701 END DO 811 DO jj = 1, jpj 812 DO ji = 1, jpi 813 zw3d(ji,jj,jk) = ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 814 END DO 815 END DO 816 END DO 817 !$OMP END PARALLEL 702 818 CALL iom_put( "uoce_eiv", zw3d ) 703 819 ! 820 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 704 821 DO jk = 1, jpkm1 ! e1v e3v v_eiv = -dk[psi_vw] 705 zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 822 DO jj = 1, jpj 823 DO ji = 1, jpi 824 zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) 825 END DO 826 END DO 706 827 END DO 707 828 CALL iom_put( "voce_eiv", zw3d ) 708 829 ! 830 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 709 831 DO jk = 1, jpkm1 ! e1 e2 w_eiv = dk[psix] + dk[psix] 710 832 DO jj = 2, jpjm1 … … 724 846 zztmp = 0.5_wp * rau0 * rcp 725 847 IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 726 zw2d(:,:) = 0._wp 727 zw3d(:,:,:) = 0._wp 728 DO jk = 1, jpkm1 729 DO jj = 2, jpjm1 730 DO ji = fs_2, fs_jpim1 ! vector opt. 731 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) & 732 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji+1,jj,jk,jp_tem) ) 733 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 734 END DO 735 END DO 736 END DO 737 CALL lbc_lnk( zw2d, 'U', -1. ) 738 CALL lbc_lnk( zw3d, 'U', -1. ) 739 CALL iom_put( "ueiv_heattr" , zztmp * zw2d ) ! heat transport in i-direction 740 CALL iom_put( "ueiv_heattr3d", zztmp * zw3d ) ! heat transport in i-direction 741 ENDIF 742 zw2d(:,:) = 0._wp 743 zw3d(:,:,:) = 0._wp 848 !$OMP PARALLEL 849 !$OMP DO schedule(static) private(jj,ji) 850 DO jj = 1, jpj 851 DO ji = 1, jpi 852 zw2d(ji,jj) = 0._wp 853 END DO 854 END DO 855 !$OMP DO schedule(static) private(jk,jj,ji) 856 DO jk = 1, jpk 857 DO jj = 1, jpj 858 DO ji = 1, jpi 859 zw3d(ji,jj,jk) = 0._wp 860 END DO 861 END DO 862 END DO 863 DO jk = 1, jpkm1 864 !$OMP DO schedule(static) private(jj,ji) 865 DO jj = 2, jpjm1 866 DO ji = fs_2, fs_jpim1 ! vector opt. 867 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) & 868 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji+1,jj,jk,jp_tem) ) 869 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 870 END DO 871 END DO 872 END DO 873 !$OMP END PARALLEL 874 CALL lbc_lnk( zw2d, 'U', -1. ) 875 CALL lbc_lnk( zw3d, 'U', -1. ) 876 CALL iom_put( "ueiv_heattr" , zztmp * zw2d ) ! heat transport in i-direction 877 CALL iom_put( "ueiv_heattr3d", zztmp * zw3d ) ! heat transport in i-direction 878 ENDIF 879 !$OMP PARALLEL 880 !$OMP DO schedule(static) private(jj,ji) 881 DO jj = 1, jpj 882 DO ji = 1, jpi 883 zw2d(ji,jj) = 0._wp 884 END DO 885 END DO 886 !$OMP DO schedule(static) private(jk,jj,ji) 887 DO jk = 1, jpk 888 DO jj = 1, jpj 889 DO ji = 1, jpi 890 zw3d(ji,jj,jk) = 0._wp 891 END DO 892 END DO 893 END DO 744 894 DO jk = 1, jpkm1 895 !$OMP DO schedule(static) private(jj,ji) 745 896 DO jj = 2, jpjm1 746 897 DO ji = fs_2, fs_jpim1 ! vector opt. … … 751 902 END DO 752 903 END DO 904 !$OMP END PARALLEL 753 905 CALL lbc_lnk( zw2d, 'V', -1. ) 754 906 CALL iom_put( "veiv_heattr", zztmp * zw2d ) ! heat transport in j-direction … … 759 911 zztmp = 0.5_wp * 0.5 760 912 IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN 761 zw2d(:,:) = 0._wp 762 zw3d(:,:,:) = 0._wp 763 DO jk = 1, jpkm1 764 DO jj = 2, jpjm1 765 DO ji = fs_2, fs_jpim1 ! vector opt. 766 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) & 767 & * ( tsn (ji,jj,jk,jp_sal) + tsn (ji+1,jj,jk,jp_sal) ) 768 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 769 END DO 770 END DO 771 END DO 772 CALL lbc_lnk( zw2d, 'U', -1. ) 773 CALL lbc_lnk( zw3d, 'U', -1. ) 774 CALL iom_put( "ueiv_salttr", zztmp * zw2d ) ! salt transport in i-direction 775 CALL iom_put( "ueiv_salttr3d", zztmp * zw3d ) ! salt transport in i-direction 776 ENDIF 777 zw2d(:,:) = 0._wp 778 zw3d(:,:,:) = 0._wp 913 !$OMP PARALLEL 914 !$OMP DO schedule(static) private(jj,ji) 915 DO jj = 1, jpj 916 DO ji = 1, jpi 917 zw2d(ji,jj) = 0._wp 918 END DO 919 END DO 920 !$OMP DO schedule(static) private(jk,jj,ji) 921 DO jk = 1, jpk 922 DO jj = 1, jpj 923 DO ji = 1, jpi 924 zw3d(ji,jj,jk) = 0._wp 925 END DO 926 END DO 927 END DO 928 DO jk = 1, jpkm1 929 !$OMP DO schedule(static) private(jj,ji) 930 DO jj = 2, jpjm1 931 DO ji = fs_2, fs_jpim1 ! vector opt. 932 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) & 933 & * ( tsn (ji,jj,jk,jp_sal) + tsn (ji+1,jj,jk,jp_sal) ) 934 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 935 END DO 936 END DO 937 END DO 938 CALL lbc_lnk( zw2d, 'U', -1. ) 939 CALL lbc_lnk( zw3d, 'U', -1. ) 940 CALL iom_put( "ueiv_salttr", zztmp * zw2d ) ! salt transport in i-direction 941 CALL iom_put( "ueiv_salttr3d", zztmp * zw3d ) ! salt transport in i-direction 942 !$OMP END PARALLEL 943 ENDIF 944 !$OMP PARALLEL 945 !$OMP DO schedule(static) private(jj,ji) 946 DO jj = 1, jpj 947 DO ji = 1, jpi 948 zw2d(ji,jj) = 0._wp 949 END DO 950 END DO 951 !$OMP DO schedule(static) private(jk,jj,ji) 952 DO jk = 1, jpk 953 DO jj = 1, jpj 954 DO ji = 1, jpi 955 zw3d(ji,jj,jk) = 0._wp 956 END DO 957 END DO 958 END DO 779 959 DO jk = 1, jpkm1 960 !$OMP DO schedule(static) private(jj,ji) 780 961 DO jj = 2, jpjm1 781 962 DO ji = fs_2, fs_jpim1 ! vector opt. … … 786 967 END DO 787 968 END DO 969 !$OMP END PARALLEL 788 970 CALL lbc_lnk( zw2d, 'V', -1. ) 789 971 CALL iom_put( "veiv_salttr", zztmp * zw2d ) ! salt transport in j-direction -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
r6416 r7698 115 115 116 116 ! Computation of ice albedo (free of snow) 117 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb(:,:,:) = ralb_im 118 ELSE WHERE ; zalb(:,:,:) = ralb_if 119 END WHERE 117 !$OMP PARALLEL DO schedule(static) private(jl,jj,ji) 118 DO jl = 1, ijpl 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 IF ( ph_snw(ji,jj,jl) == 0._wp .AND. pt_ice(ji,jj,jl) >= rt0_ice ) THEN 122 zalb(ji,jj,jl) = ralb_im 123 ELSE 124 zalb(ji,jj,jl) = ralb_if 125 END IF 126 END DO 127 END DO 128 END DO 120 129 121 130 WHERE ( 1.5 < ph_ice ) ; zalb_it = zalb … … 126 135 ELSE WHERE ; zalb_it = 0.1 + 3.6 * ph_ice 127 136 END WHERE 128 137 !$OMP PARALLEL 138 !$OMP DO schedule(static) private(jl, jj, ji,zswitch,zalb_sf,zalb_sm,zalb_st) 129 139 DO jl = 1, ijpl 130 140 DO jj = 1, jpj … … 156 166 END DO 157 167 158 pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rcloud ! Oberhuber correction for overcast sky 168 !$OMP DO schedule(static) private(jl, jj, ji) 169 DO jl = 1, ijpl 170 DO jj = 1, jpj 171 DO ji = 1, jpi 172 pa_ice_os(ji,jj,jl) = pa_ice_cs(ji,jj,jl) + rcloud ! Oberhuber correction for overcast sky 173 END DO 174 END DO 175 END DO 176 !$OMP END PARALLEL 159 177 160 178 !------------------------------------------ … … 193 211 z1_c2 = 1. / 0.03 194 212 ! Computation of the snow/ice albedo 213 !$OMP PARALLEL DO schedule(static) private(jl, jj, ji,zswitch,zalb_sf,zalb_sm,zalb_st) 195 214 DO jl = 1, ijpl 196 215 DO jj = 1, jpj … … 230 249 !! 231 250 REAL(wp) :: zcoef 251 INTEGER :: ji, jj ! dummy loop indices 232 252 !!---------------------------------------------------------------------- 233 253 ! 234 254 zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 ) ! Parameterization of Briegled and Ramanathan, 1982 235 pa_oce_cs(:,:) = zcoef 236 pa_oce_os(:,:) = 0.06 ! Parameterization of Kondratyev, 1969 and Payne, 1972 255 !$OMP PARALLEL DO schedule(static) private(jj, ji) 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 pa_oce_cs(ji,jj) = zcoef 259 pa_oce_os(ji,jj) = 0.06 ! Parameterization of Kondratyev, 1969 and Payne, 1972 260 END DO 261 END DO 237 262 ! 238 263 END SUBROUTINE albedo_oce -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r6140 r7698 66 66 ! ! 'ij->e' = (i,j) components to east 67 67 ! ! 'ij->n' = (i,j) components to north 68 INTEGER :: ji, jj ! dummy loop indices 68 69 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: prot 69 70 !!---------------------------------------------------------------------- … … 82 83 CASE( 'en->i' ) ! east-north to i-component 83 84 SELECT CASE (cd_type) 84 CASE ('T') ; prot(:,:) = pxin(:,:) * gcost(:,:) + pyin(:,:) * gsint(:,:) 85 CASE ('U') ; prot(:,:) = pxin(:,:) * gcosu(:,:) + pyin(:,:) * gsinu(:,:) 86 CASE ('V') ; prot(:,:) = pxin(:,:) * gcosv(:,:) + pyin(:,:) * gsinv(:,:) 87 CASE ('F') ; prot(:,:) = pxin(:,:) * gcosf(:,:) + pyin(:,:) * gsinf(:,:) 85 CASE ('T') 86 !$OMP PARALLEL DO schedule(static) private(jj,ji) 87 DO jj = 1, jpj 88 DO ji = 1, jpi 89 prot(ji,jj) = pxin(ji,jj) * gcost(ji,jj) + pyin(ji,jj) * gsint(ji,jj) 90 END DO 91 END DO 92 CASE ('U') 93 !$OMP PARALLEL DO schedule(static) private(jj,ji) 94 DO jj = 1, jpj 95 DO ji = 1, jpi 96 prot(ji,jj) = pxin(ji,jj) * gcosu(ji,jj) + pyin(ji,jj) * gsinu(ji,jj) 97 END DO 98 END DO 99 CASE ('V') 100 !$OMP PARALLEL DO schedule(static) private(jj,ji) 101 DO jj = 1, jpj 102 DO ji = 1, jpi 103 prot(ji,jj) = pxin(ji,jj) * gcosv(ji,jj) + pyin(ji,jj) * gsinv(ji,jj) 104 END DO 105 END DO 106 CASE ('F') 107 !$OMP PARALLEL DO schedule(static) private(jj,ji) 108 DO jj = 1, jpj 109 DO ji = 1, jpi 110 prot(ji,jj) = pxin(ji,jj) * gcosf(ji,jj) + pyin(ji,jj) * gsinf(ji,jj) 111 END DO 112 END DO 88 113 CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 89 114 END SELECT 90 115 CASE ('en->j') ! east-north to j-component 91 116 SELECT CASE (cd_type) 92 CASE ('T') ; prot(:,:) = pyin(:,:) * gcost(:,:) - pxin(:,:) * gsint(:,:) 93 CASE ('U') ; prot(:,:) = pyin(:,:) * gcosu(:,:) - pxin(:,:) * gsinu(:,:) 94 CASE ('V') ; prot(:,:) = pyin(:,:) * gcosv(:,:) - pxin(:,:) * gsinv(:,:) 95 CASE ('F') ; prot(:,:) = pyin(:,:) * gcosf(:,:) - pxin(:,:) * gsinf(:,:) 117 CASE ('T') 118 !$OMP PARALLEL DO schedule(static) private(jj,ji) 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 prot(ji,jj) = pyin(ji,jj) * gcost(ji,jj) - pxin(ji,jj) * gsint(ji,jj) 122 END DO 123 END DO 124 CASE ('U') 125 !$OMP PARALLEL DO schedule(static) private(jj,ji) 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 prot(ji,jj) = pyin(ji,jj) * gcosu(ji,jj) - pxin(ji,jj) * gsinu(ji,jj) 129 END DO 130 END DO 131 CASE ('V') 132 !$OMP PARALLEL DO schedule(static) private(jj,ji) 133 DO jj = 1, jpj 134 DO ji = 1, jpi 135 prot(ji,jj) = pyin(ji,jj) * gcosv(ji,jj) - pxin(ji,jj) * gsinv(ji,jj) 136 END DO 137 END DO 138 CASE ('F') 139 !$OMP PARALLEL DO schedule(static) private(jj,ji) 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 prot(ji,jj) = pyin(ji,jj) * gcosf(ji,jj) - pxin(ji,jj) * gsinf(ji,jj) 143 END DO 144 END DO 96 145 CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 97 146 END SELECT 98 147 CASE ('ij->e') ! (i,j)-components to east 99 148 SELECT CASE (cd_type) 100 CASE ('T') ; prot(:,:) = pxin(:,:) * gcost(:,:) - pyin(:,:) * gsint(:,:) 101 CASE ('U') ; prot(:,:) = pxin(:,:) * gcosu(:,:) - pyin(:,:) * gsinu(:,:) 102 CASE ('V') ; prot(:,:) = pxin(:,:) * gcosv(:,:) - pyin(:,:) * gsinv(:,:) 103 CASE ('F') ; prot(:,:) = pxin(:,:) * gcosf(:,:) - pyin(:,:) * gsinf(:,:) 149 CASE ('T') 150 !$OMP PARALLEL DO schedule(static) private(jj,ji) 151 DO jj = 1, jpj 152 DO ji = 1, jpi 153 prot(ji,jj) = pxin(ji,jj) * gcost(ji,jj) - pyin(ji,jj) * gsint(ji,jj) 154 END DO 155 END DO 156 CASE ('U') 157 !$OMP PARALLEL DO schedule(static) private(jj,ji) 158 DO jj = 1, jpj 159 DO ji = 1, jpi 160 prot(ji,jj) = pxin(ji,jj) * gcosu(ji,jj) - pyin(ji,jj) * gsinu(ji,jj) 161 END DO 162 END DO 163 CASE ('V') 164 !$OMP PARALLEL DO schedule(static) private(jj,ji) 165 DO jj = 1, jpj 166 DO ji = 1, jpi 167 prot(ji,jj) = pxin(ji,jj) * gcosv(ji,jj) - pyin(ji,jj) * gsinv(ji,jj) 168 END DO 169 END DO 170 CASE ('F') 171 !$OMP PARALLEL DO schedule(static) private(jj,ji) 172 DO jj = 1, jpj 173 DO ji = 1, jpi 174 prot(ji,jj) = pxin(ji,jj) * gcosf(ji,jj) - pyin(ji,jj) * gsinf(ji,jj) 175 END DO 176 END DO 104 177 CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 105 178 END SELECT 106 179 CASE ('ij->n') ! (i,j)-components to north 107 180 SELECT CASE (cd_type) 108 CASE ('T') ; prot(:,:) = pyin(:,:) * gcost(:,:) + pxin(:,:) * gsint(:,:) 109 CASE ('U') ; prot(:,:) = pyin(:,:) * gcosu(:,:) + pxin(:,:) * gsinu(:,:) 110 CASE ('V') ; prot(:,:) = pyin(:,:) * gcosv(:,:) + pxin(:,:) * gsinv(:,:) 111 CASE ('F') ; prot(:,:) = pyin(:,:) * gcosf(:,:) + pxin(:,:) * gsinf(:,:) 181 CASE ('T') 182 !$OMP PARALLEL DO schedule(static) private(jj,ji) 183 DO jj = 1, jpj 184 DO ji = 1, jpi 185 prot(ji,jj) = pyin(ji,jj) * gcost(ji,jj) + pxin(ji,jj) * gsint(ji,jj) 186 END DO 187 END DO 188 CASE ('U') 189 !$OMP PARALLEL DO schedule(static) private(jj,ji) 190 DO jj = 1, jpj 191 DO ji = 1, jpi 192 prot(ji,jj) = pyin(ji,jj) * gcosu(ji,jj) + pxin(ji,jj) * gsinu(ji,jj) 193 END DO 194 END DO 195 CASE ('V') 196 !$OMP PARALLEL DO schedule(static) private(jj,ji) 197 DO jj = 1, jpj 198 DO ji = 1, jpi 199 prot(ji,jj) = pyin(ji,jj) * gcosv(ji,jj) + pxin(ji,jj) * gsinv(ji,jj) 200 END DO 201 END DO 202 CASE ('F') 203 !$OMP PARALLEL DO schedule(static) private(jj,ji) 204 DO jj = 1, jpj 205 DO ji = 1, jpi 206 prot(ji,jj) = pyin(ji,jj) * gcosf(ji,jj) + pxin(ji,jj) * gsinf(ji,jj) 207 END DO 208 END DO 112 209 CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 113 210 END SELECT … … 157 254 ! (computation done on the north stereographic polar plane) 158 255 ! 256 !$OMP PARALLEL 257 !$OMP DO schedule(static) private(jj,ji,zlam,zphi,zxnpt,zynpt,znnpt,zxnpu,zynpu,znnpu,zxnpv,zynpv,znnpv,zxnpf) & 258 !$OMP& private(zynpf,znnpf,zlan,zphh,zxvvt,zyvvt,znvvt,zxffu,zyffu,znffu,zxffv,zyffv,znffv,zxuuf,zyuuf,znuuf) 159 259 DO jj = 2, jpjm1 160 260 DO ji = fs_2, jpi ! vector opt. … … 248 348 ! =============== ! 249 349 350 !$OMP DO schedule(static) private(jj,ji) 250 351 DO jj = 2, jpjm1 251 352 DO ji = fs_2, jpi ! vector opt. … … 268 369 END DO 269 370 END DO 371 !$OMP END DO NOWAIT 372 !$OMP END PARALLEL 270 373 271 374 ! =========================== ! -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90
r7646 r7698 316 316 #if defined key_cice 317 317 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 318 qlw_ice(:,:,1) = sf(jp_qlw )%fnow(:,:,1) 319 IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 320 ELSE ; qsr_ice(:,:,1) = sf(jp_qsr)%fnow(:,:,1) 318 !$OMP PARALLEL DO schedule(static) private(jj, ji) 319 DO jj = 1, jpj 320 DO ji = 1, jpi 321 qlw_ice(ji,jj,1) = sf(jp_qlw)%fnow(ji,jj,1) 322 END DO 323 END DO 324 IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 325 ELSE 326 !$OMP PARALLEL DO schedule(static) private(jj, ji) 327 DO jj = 1, jpj 328 DO ji = 1, jpi 329 qsr_ice(ji,jj,1) = sf(jp_qsr)%fnow(ji,jj,1) 330 END DO 331 END DO 321 332 ENDIF 322 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 323 qatm_ice(:,:) = sf(jp_humi)%fnow(:,:,1) 324 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac 325 sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac 326 wndi_ice(:,:) = sf(jp_wndi)%fnow(:,:,1) 327 wndj_ice(:,:) = sf(jp_wndj)%fnow(:,:,1) 333 !$OMP PARALLEL DO schedule(static) private(jj, ji) 334 DO jj = 1, jpj 335 DO ji = 1, jpi 336 tatm_ice(ji,jj) = sf(jp_tair)%fnow(ji,jj,1) 337 qatm_ice(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) 338 tprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) * rn_pfac 339 sprecip(ji,jj) = sf(jp_snow)%fnow(ji,jj,1) * rn_pfac 340 wndi_ice(ji,jj) = sf(jp_wndi)%fnow(ji,jj,1) 341 wndj_ice(ji,jj) = sf(jp_wndj)%fnow(ji,jj,1) 342 END DO 343 END DO 328 344 ENDIF 329 345 #endif … … 382 398 ! 383 399 384 ! local scalars ( place there for vector optimisation purposes) 385 zst(:,:) = pst(:,:) + rt0 ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 386 400 !$OMP PARALLEL DO schedule(static) private(jj, ji) 401 DO jj = 1, jpj 402 DO ji = 1, jpi 403 ! local scalars ( place there for vector optimisation purposes) 404 zst(ji,jj) = pst(ji,jj) + rt0 ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 405 406 ! ... components ( U10m - U_oce ) at T-point (unmasked) 407 !!gm move zwnd_i (_j) set to zero inside the key_cyclone ??? 408 zwnd_i(ji,jj) = 0._wp 409 zwnd_j(ji,jj) = 0._wp 410 END DO 411 END DO 387 412 ! ----------------------------------------------------------------------------- ! 388 413 ! 0 Wind components and module at T-point relative to the moving ocean ! 389 414 ! ----------------------------------------------------------------------------- ! 390 415 391 ! ... components ( U10m - U_oce ) at T-point (unmasked)392 !!gm move zwnd_i (_j) set to zero inside the key_cyclone ???393 zwnd_i(:,:) = 0._wp394 zwnd_j(:,:) = 0._wp395 416 #if defined key_cyclone 396 417 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add analytical tropical cyclone (Vincent et al. JGR 2012) 418 !$OMP PARALLEL DO schedule(static) private(jj, ji) 397 419 DO jj = 2, jpjm1 398 420 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 402 424 END DO 403 425 #endif 426 !$OMP PARALLEL DO schedule(static) private(jj, ji) 404 427 DO jj = 2, jpjm1 405 428 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 411 434 CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. ) 412 435 ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 413 wndm(:,:) = SQRT( zwnd_i(:,:) * zwnd_i(:,:) & 414 & + zwnd_j(:,:) * zwnd_j(:,:) ) * tmask(:,:,1) 415 436 !$OMP PARALLEL DO schedule(static) private(jj, ji) 437 DO jj = 1, jpj 438 DO ji = 1, jpi 439 wndm(ji,jj) = SQRT( zwnd_i(ji,jj) * zwnd_i(ji,jj) & 440 & + zwnd_j(ji,jj) * zwnd_j(ji,jj) ) * tmask(ji,jj,1) 441 442 END DO 443 END DO 416 444 ! ----------------------------------------------------------------------------- ! 417 445 ! I Radiative FLUXES ! … … 421 449 zztmp = 1. - albo 422 450 IF( ln_dm2dc ) THEN ; qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 423 ELSE ; qsr(:,:) = zztmp * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) 451 ELSE 452 !$OMP PARALLEL DO schedule(static) private(jj, ji) 453 DO jj = 1, jpj 454 DO ji = 1, jpi 455 qsr(ji,jj) = zztmp * sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1) 456 END DO 457 END DO 424 458 ENDIF 425 459 426 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 460 !$OMP PARALLEL DO schedule(static) private(jj, ji) 461 DO jj = 1, jpj 462 DO ji = 1, jpi 463 zqlw(ji,jj) = ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * zst(ji,jj)*zst(ji,jj)*zst(ji,jj)*zst(ji,jj) ) * tmask(ji,jj,1) ! Long Wave 464 END DO 465 END DO 427 466 428 467 … … 461 500 END IF 462 501 463 Cd_oce(:,:) = Cd(:,:) ! record value of pure ocean-atm. drag (clem) 464 502 !$OMP PARALLEL 503 !$OMP DO schedule(static) private(jj, ji) 504 DO jj = 1, jpj 505 DO ji = 1, jpi 506 Cd_oce(ji,jj) = Cd(ji,jj) ! record value of pure ocean-atm. drag (clem) 507 END DO 508 END DO 509 510 !$OMP DO schedule(static) private(jj, ji) 465 511 DO jj = 1, jpj ! tau module, i and j component 466 512 DO ji = 1, jpi … … 471 517 END DO 472 518 END DO 519 !$OMP END PARALLEL 473 520 474 521 ! ! add the HF tau contribution to the wind stress module 475 IF( lhftau ) taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 522 IF( lhftau ) THEN 523 !$OMP PARALLEL DO schedule(static) private(jj, ji) 524 DO jj = 1, jpj 525 DO ji = 1, jpi 526 taum(ji,jj) = taum(ji,jj) + sf(jp_tdif)%fnow(ji,jj,1) 527 END DO 528 END DO 529 END IF 476 530 477 531 CALL iom_put( "taum_oce", taum ) ! output wind stress module … … 480 534 ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 481 535 ! Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 536 !$OMP PARALLEL DO schedule(static) private(jj, ji) 482 537 DO jj = 1, jpjm1 483 538 DO ji = 1, fs_jpim1 … … 496 551 497 552 ! zqla used as temporary array, for rho*U (common term of bulk formulae): 498 zqla(:,:) = zrhoa(:,:) * zU_zu(:,:) 553 !$OMP PARALLEL DO schedule(static) private(jj, ji) 554 DO jj = 1, jpj 555 DO ji = 1, jpi 556 zqla(ji,jj) = zrhoa(ji,jj) * zU_zu(ji,jj) 557 END DO 558 END DO 499 559 500 560 IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN 501 561 !! q_air and t_air are given at 10m (wind reference height) 502 zevap(:,:) = rn_efac*MAX( 0._wp, zqla(:,:)*Ce(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed 503 zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - ztpot(:,:) ) ! Sensible Heat, using bulk wind speed 562 !$OMP PARALLEL DO schedule(static) private(jj, ji) 563 DO jj = 1, jpj 564 DO ji = 1, jpi 565 zevap(ji,jj) = rn_efac*MAX( 0._wp, zqla(ji,jj)*Ce(ji,jj)*(zsq(ji,jj) - sf(jp_humi)%fnow(ji,jj,1)) ) ! Evaporation, using bulk wind speed 566 END DO 567 END DO 568 zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - ztpot(:,:) ) ! Sensible Heat, using bulk wind speed 504 569 ELSE 505 570 !! q_air and t_air are not given at 10m (wind reference height) 506 571 ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 507 zevap(:,:) = rn_efac*MAX( 0._wp, zqla(:,:)*Ce(:,:)*(zsq(:,:) - zq_zu(:,:) ) ) ! Evaporation ! using bulk wind speed 572 !$OMP PARALLEL DO schedule(static) private(jj, ji) 573 DO jj = 1, jpj 574 DO ji = 1, jpi 575 zevap(ji,jj) = rn_efac*MAX( 0._wp, zqla(ji,jj)*Ce(ji,jj)*(zsq(ji,jj) - zq_zu(ji,jj) ) ) ! Evaporation ! using bulk wind speed 576 END DO 577 END DO 508 578 zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - zt_zu(:,:) ) ! Sensible Heat ! using bulk wind speed 509 579 ENDIF … … 527 597 ! ----------------------------------------------------------------------------- ! 528 598 ! 529 emp (:,:) = ( zevap(:,:) & ! mass flux (evap. - precip.) 530 & - sf(jp_prec)%fnow(:,:,1) * rn_pfac ) * tmask(:,:,1) 531 ! 532 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar 533 & - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus & ! remove latent melting heat for solid precip 534 & - zevap(:,:) * pst(:,:) * rcp & ! remove evap heat content at SST 535 & + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac & ! add liquid precip heat content at Tair 536 & * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & 537 & + sf(jp_snow)%fnow(:,:,1) * rn_pfac & ! add solid precip heat content at min(Tair,Tsnow) 538 & * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) 539 ! 599 !$OMP PARALLEL DO schedule(static) private(jj, ji) 600 DO jj = 1, jpj 601 DO ji = 1, jpi 602 emp (ji,jj) = ( zevap(ji,jj) & ! mass flux (evap. - precip.) 603 & - sf(jp_prec)%fnow(ji,jj,1) * rn_pfac ) * tmask(ji,jj,1) 604 ! 605 qns(ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj) & ! Downward Non Solar 606 & - sf(jp_snow)%fnow(ji,jj,1) * rn_pfac * lfus & ! remove latent melting heat for solid precip 607 & - zevap(ji,jj) * pst(ji,jj) * rcp & ! remove evap heat content at SST 608 & + ( sf(jp_prec)%fnow(ji,jj,1) - sf(jp_snow)%fnow(ji,jj,1) ) * rn_pfac & ! add liquid precip heat content at Tair 609 & * ( sf(jp_tair)%fnow(ji,jj,1) - rt0 ) * rcp & 610 & + sf(jp_snow)%fnow(ji,jj,1) * rn_pfac & ! add solid precip heat content at min(Tair,Tsnow) 611 & * ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) 612 ! 540 613 #if defined key_lim3 541 qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) ! non solar without emp (only needed by LIM3)542 qsr_oce(:,:) = qsr(:,:)614 qns_oce(ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj) ! non solar without emp (only needed by LIM3) 615 qsr_oce(ji,jj) = qsr(ji,jj) 543 616 #endif 617 END DO 618 END DO 544 619 ! 545 620 IF ( nn_ice == 0 ) THEN … … 551 626 CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean 552 627 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 553 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! output total precipitation [kg/m2/s] 554 sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! output solid precipitation [kg/m2/s] 628 !$OMP PARALLEL DO schedule(static) private(jj, ji) 629 DO jj = 1, jpj 630 DO ji = 1, jpi 631 tprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) * rn_pfac ! output total precipitation [kg/m2/s] 632 sprecip(ji,jj) = sf(jp_snow)%fnow(ji,jj,1) * rn_pfac ! output solid precipitation [kg/m2/s] 633 END DO 634 END DO 555 635 CALL iom_put( 'snowpre', sprecip * 86400. ) ! Snow 556 636 CALL iom_put( 'precip' , tprecip * 86400. ) ! Total precipitation … … 599 679 CALL wrk_alloc( jpi,jpj, Cd ) 600 680 601 Cd(:,:) = Cd_ice 681 !$OMP PARALLEL DO schedule(static) private(jj, ji) 682 DO jj = 1, jpj 683 DO ji = 1, jpi 684 Cd(ji,jj) = Cd_ice 685 END DO 686 END DO 602 687 603 688 ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) … … 613 698 zrhoa (:,:) = rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 614 699 615 !!gm brutal.... 616 utau_ice (:,:) = 0._wp 617 vtau_ice (:,:) = 0._wp 618 wndm_ice (:,:) = 0._wp 619 !!gm end 700 !$OMP PARALLEL DO schedule(static) private(jj, ji) 701 DO jj = 1, jpj 702 DO ji = 1, jpi 703 !!gm brutal.... 704 utau_ice (ji,jj) = 0._wp 705 vtau_ice (ji,jj) = 0._wp 706 wndm_ice (ji,jj) = 0._wp 707 !!gm end 708 END DO 709 END DO 620 710 621 711 ! ----------------------------------------------------------------------------- ! … … 625 715 CASE( 'I' ) ! B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation) 626 716 ! and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 717 !$OMP PARALLEL DO schedule(static) private(jj,ji,zwndi_f,zwndj_f,zwnorm_f,zwndi_t,zwndj_t) 627 718 DO jj = 2, jpjm1 628 719 DO ji = 2, jpim1 ! B grid : NO vector opt … … 649 740 ! 650 741 CASE( 'C' ) ! C-grid ice dynamics : U & V-points (same as ocean) 742 !$OMP PARALLEL DO schedule(static) private(jj,ji,zwndi_t,zwndj_t) 651 743 DO jj = 2, jpj 652 744 DO ji = fs_2, jpi ! vect. opt. … … 656 748 END DO 657 749 END DO 750 !$OMP PARALLEL DO schedule(static) private(jj,ji) 658 751 DO jj = 2, jpjm1 659 752 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 700 793 REAL(wp) :: zztmp, z1_lsub ! - - 701 794 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw ! long wave heat flux over ice 795 REAL(wp), DIMENSION(:,:,:), POINTER :: zevap_ice3d, zqns_ice3d, zqsr_ice3d 702 796 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qsb ! sensible heat flux over ice 703 797 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqlw ! long wave heat sensitivity over ice 704 798 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqsb ! sensible heat sensitivity over ice 705 799 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw ! evaporation and snw distribution after wind blowing (LIM3) 800 REAL(wp), DIMENSION(:,:) , POINTER :: zevap_ice2d, zqns_ice2d, zqsr_ice2d 706 801 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa 707 802 REAL(wp), DIMENSION(:,:) , POINTER :: Cd ! transfer coefficient for momentum (tau) … … 710 805 IF( nn_timing == 1 ) CALL timing_start('blk_ice_flx') 711 806 ! 712 CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )713 CALL wrk_alloc( jpi,jpj, zrhoa )807 CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb, zevap_ice3d, zqns_ice3d, zqsr_ice3d ) 808 CALL wrk_alloc( jpi,jpj, zrhoa, zevap_ice2d, zqns_ice2d, zqsr_ice2d) 714 809 CALL wrk_alloc( jpi,jpj, Cd ) 715 810 716 Cd(:,:) = Cd_ice 811 !$OMP PARALLEL DO schedule(static) private(jj, ji) 812 DO jj = 1, jpj 813 DO ji = 1, jpi 814 Cd(ji,jj) = Cd_ice 815 END DO 816 END DO 717 817 718 818 ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) … … 731 831 ! 732 832 zztmp = 1. / ( 1. - albo ) 733 ! ! ========================== ! 734 DO jl = 1, jpl ! Loop over ice categories ! 735 ! ! ========================== ! 833 !$OMP PARALLEL 834 !$OMP DO schedule(static) private(jl,jj,ji,zst2,zst3) ! ========================== ! 835 DO jl = 1, jpl ! Loop over ice categories ! 836 ! ! ========================== ! 736 837 DO jj = 1 , jpj 737 838 DO ji = 1, jpi … … 781 882 END DO 782 883 ! 783 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] 784 sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 884 !$OMP DO schedule(static) private(jj, ji) 885 DO jj = 1, jpj 886 DO ji = 1, jpi 887 tprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) * rn_pfac ! total precipitation [kg/m2/s] 888 sprecip(ji,jj) = sf(jp_snow)%fnow(ji,jj,1) * rn_pfac ! solid precipitation [kg/m2/s] 889 END DO 890 END DO 891 !$OMP END PARALLEL 785 892 CALL iom_put( 'snowpre', sprecip * 86400. ) ! Snow precipitation 786 893 CALL iom_put( 'precip' , tprecip * 86400. ) ! Total precipitation … … 791 898 ! --- evaporation --- ! 792 899 z1_lsub = 1._wp / Lsub 793 evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_lsub ! sublimation 794 devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_lsub ! d(sublimation)/dT 795 zevap (:,:) = rn_efac * ( emp(:,:) + tprecip(:,:) ) ! evaporation over ocean 796 797 ! --- evaporation minus precipitation --- ! 798 zsnw(:,:) = 0._wp 900 !$OMP PARALLEL 901 !$OMP DO schedule(static) private(jl,jj,ji) 902 DO jl = 1, jpl 903 DO jj = 1 , jpj 904 DO ji = 1, jpi 905 evap_ice (ji,jj,jl) = rn_efac * qla_ice (ji,jj,jl) * z1_lsub ! sublimation 906 devap_ice(ji,jj,jl) = rn_efac * dqla_ice(ji,jj,jl) * z1_lsub ! d(sublimation)/dT 907 END DO 908 END DO 909 END DO 910 ! 911 !$OMP DO schedule(static) private(jj, ji) 912 DO jj = 1, jpj 913 DO ji = 1, jpi 914 zevap (ji,jj) = rn_efac * ( emp(ji,jj) + tprecip(ji,jj) ) ! evaporation over ocean 915 916 ! --- evaporation minus precipitation --- ! 917 zsnw(ji,jj) = 0._wp 918 END DO 919 END DO 920 !$OMP END PARALLEL 799 921 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow distribution over ice after wind blowing 800 emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 801 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 802 emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 803 804 ! --- heat flux associated with emp --- ! 805 qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap at sst 806 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip at Tair 807 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip at min(Tair,Tsnow) 808 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 809 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 810 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 811 812 ! --- total solar and non solar fluxes --- ! 813 qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 814 qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 815 816 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 817 qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 922 !$OMP PARALLEL 923 !$OMP DO schedule(static) private(jj,ji) 924 DO jj = 1, jpj 925 DO ji = 1, jpi 926 emp_oce(ji,jj) = pfrld(ji,jj) * zevap(ji,jj) - ( tprecip(ji,jj) - sprecip(ji,jj) ) - sprecip(ji,jj) * (1._wp - zsnw(ji,jj)) 927 END DO 928 END DO 929 !$OMP END DO NOWAIT 930 !$OMP DO schedule(static) private(jl,jj,ji) 931 DO jl = 1, jpl 932 DO jj = 1 , jpj 933 DO ji = 1, jpi 934 zevap_ice3d(ji,jj,jl) = a_i_b(ji,jj,jl) * evap_ice(ji,jj,jl) 935 zqns_ice3d(ji,jj,jl) = a_i_b(ji,jj,jl) * qns_ice(ji,jj,jl) 936 zqsr_ice3d(ji,jj,jl) = a_i_b(ji,jj,jl) * qsr_ice(ji,jj,jl) 937 END DO 938 END DO 939 END DO 940 !$OMP END DO NOWAIT 941 !$OMP DO schedule(static) private(jj,ji) 942 DO jj = 1, jpj 943 DO ji = 1, jpi 944 zevap_ice2d(ji,jj) = 0._wp 945 zqns_ice2d(ji,jj) = 0._wp 946 zqsr_ice2d(ji,jj) = 0._wp 947 END DO 948 END DO 949 DO jl = 1, jpl 950 !$OMP DO schedule(static) private(jj,ji) 951 DO jj = 1 , jpj 952 DO ji = 1, jpi 953 zevap_ice2d(ji,jj) = zevap_ice2d(ji,jj) + zevap_ice3d(ji,jj,jl) 954 zqns_ice2d(ji,jj) = zqns_ice2d(ji,jj) + zqns_ice3d(ji,jj,jl) 955 zqsr_ice2d(ji,jj) = zqsr_ice2d(ji,jj) + zqsr_ice3d(ji,jj,jl) 956 END DO 957 END DO 958 END DO 959 !$OMP DO schedule(static) private(jj,ji) 960 DO jj = 1 , jpj 961 DO ji = 1, jpi 962 emp_ice(ji,jj) = zevap_ice2d(ji,jj) - sprecip(ji,jj) * zsnw(ji,jj) 963 emp_tot(ji,jj) = emp_oce(ji,jj) + emp_ice(ji,jj) 964 965 ! --- heat flux associated with emp --- ! 966 qemp_oce(ji,jj) = - pfrld(ji,jj) * zevap(ji,jj) * sst_m(ji,jj) * rcp & ! evap at sst 967 & + ( tprecip(ji,jj) - sprecip(ji,jj) ) * ( sf(jp_tair)%fnow(ji,jj,1) - rt0 ) * rcp & ! liquid precip at Tair 968 & + sprecip(ji,jj) * ( 1._wp - zsnw(ji,jj) ) * & ! solid precip at min(Tair,Tsnow) 969 & ( ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) - lfus ) 970 qemp_ice(ji,jj) = sprecip(ji,jj) * zsnw(ji,jj) * & ! solid precip (only) 971 & ( ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) - lfus ) 972 973 ! --- total solar and non solar fluxes --- ! 974 qns_tot(ji,jj) = pfrld(ji,jj) * qns_oce(ji,jj) + zqns_ice2d(ji,jj) + qemp_ice(ji,jj) + qemp_oce(ji,jj) 975 qsr_tot(ji,jj) = pfrld(ji,jj) * qsr_oce(ji,jj) + zqsr_ice2d(ji,jj) 976 977 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 978 qprec_ice(ji,jj) = rhosn * ( ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) - lfus ) 979 END DO 980 END DO 981 !$OMP END DO NOWAIT 818 982 819 983 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 984 !$OMP DO schedule(static) private(jl,jj,ji) 820 985 DO jl = 1, jpl 821 qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) ) 822 ! But we do not have Tice => consider it at 0degC => evap=0 823 END DO 986 DO jj = 1, jpj 987 DO ji = 1, jpi 988 qevap_ice(ji,jj,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) ) 989 ! But we do not have Tice => consider it at 0degC => evap=0 990 END DO 991 END DO 992 END DO 993 !$OMP END PARALLEL 824 994 825 995 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) … … 831 1001 ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 832 1002 ! 833 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 834 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1003 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1004 DO jj = 1, jpj 1005 DO ji = 1, jpi 1006 fr1_i0(ji,jj) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1007 fr2_i0(ji,jj) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1008 END DO 1009 END DO 835 1010 ! 836 1011 ! … … 844 1019 ENDIF 845 1020 846 CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )1021 CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb, zevap_ice3d, zqns_ice3d, zqsr_ice3d ) 847 1022 CALL wrk_dealloc( jpi,jpj, zrhoa ) 848 CALL wrk_dealloc( jpi,jpj, Cd 1023 CALL wrk_dealloc( jpi,jpj, Cd, zevap_ice2d, zqns_ice2d, zqsr_ice2d) 849 1024 ! 850 1025 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_flx') … … 908 1083 !!---------------------------------------------------------------------------------- 909 1084 ! 1085 !$OMP PARALLEL DO schedule(static) private(jj,ji,ztmp,ze_sat) 910 1086 DO jj = 1, jpj 911 1087 DO ji = 1, jpi … … 944 1120 !!---------------------------------------------------------------------------------- 945 1121 ! 1122 !$OMP PARALLEL DO schedule(static) private(jj,ji,zrv,ziRT) 946 1123 DO jj = 1, jpj 947 1124 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90
r7646 r7698 114 114 ! 115 115 INTEGER :: j_itt 116 INTEGER :: ji, jj ! dummy loop indices 116 117 LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U 117 118 INTEGER , PARAMETER :: nb_itt = 4 ! number of itterations … … 141 142 !! Neutral coefficients at 10m: 142 143 IF( ln_cdgw ) THEN ! wave drag case 143 cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) 144 ztmp0 (:,:) = cdn_wave(:,:) 144 !$OMP PARALLEL DO schedule(static) private(jj, ji) 145 DO jj = 1, jpj 146 DO ji = 1, jpi 147 cdn_wave(ji,jj) = cdn_wave(ji,jj) + rsmall * ( 1._wp - tmask(ji,jj,1) ) 148 ztmp0 (ji,jj) = cdn_wave(ji,jj) 149 END DO 150 END DO 145 151 ELSE 146 152 ztmp0 = cd_neutral_10m( U_blk ) … … 245 251 !!---------------------------------------------------------------------------------- 246 252 ! 253 !$OMP PARALLEL DO schedule(static) private(jj,ji,zw,zw6,zgt33) 247 254 DO jj = 1, jpj 248 255 DO ji = 1, jpi … … 284 291 !!---------------------------------------------------------------------------------- 285 292 ! 293 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx2,zx,zstab) 286 294 DO jj = 1, jpj 287 295 DO ji = 1, jpi … … 318 326 !!---------------------------------------------------------------------------------- 319 327 ! 328 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx2,zstab) 320 329 DO jj = 1, jpj 321 330 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r7646 r7698 109 109 ! 4 = Pure Coupled formulation) 110 110 !! 111 INTEGER :: jl 111 INTEGER :: jl, jj, ji ! dummy loop index 112 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 113 113 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice … … 133 133 134 134 ! mean surface ocean current at ice velocity point (C-grid dynamics : U- & V-points as the ocean) 135 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) 136 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 135 !$OMP PARALLEL DO schedule(static) private(jj, ji) 136 DO jj = 1, jpj 137 DO ji = 1, jpi 138 u_oce(ji,jj) = ssu_m(ji,jj) * umask(ji,jj,1) 139 v_oce(ji,jj) = ssv_m(ji,jj) * vmask(ji,jj,1) 140 END DO 141 END DO 137 142 138 143 ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 139 144 CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) 140 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 145 !$OMP PARALLEL 146 !$OMP DO schedule(static) private(jj, ji) 147 DO jj = 1, jpj 148 DO ji = 1, jpi 149 t_bo(ji,jj) = ( t_bo(ji,jj) + rt0 ) * tmask(ji,jj,1) + rt0 * ( 1._wp - tmask(ji,jj,1) ) 150 END DO 151 END DO 141 152 142 153 ! Mask sea ice surface temperature (set to rt0 over land) 143 154 DO jl = 1, jpl 144 t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 145 END DO 155 !$OMP DO schedule(static) private(jj, ji) 156 DO jj = 1, jpj 157 DO ji = 1, jpi 158 t_su(ji,jj,jl) = t_su(ji,jj,jl) * tmask(ji,jj,1) + rt0 * ( 1._wp - tmask(ji,jj,1) ) 159 END DO 160 END DO 161 END DO 162 !$OMP END PARALLEL 146 163 ! 147 164 !------------------------------------------------! … … 161 178 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 162 179 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 163 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 164 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 180 !$OMP PARALLEL DO schedule(static) private(jj, ji) 181 DO jj = 1, jpj 182 DO ji = 1, jpi 183 utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 184 vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 185 END DO 186 END DO 165 187 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 166 188 ENDIF … … 180 202 CALL lim_dyn( kt ) ! rheology 181 203 ELSE 182 u_ice(:,:) = rn_uice * umask(:,:,1) ! or prescribed velocity 183 v_ice(:,:) = rn_vice * vmask(:,:,1) 204 !$OMP PARALLEL DO schedule(static) private(jj, ji) 205 DO jj = 1, jpj 206 DO ji = 1, jpi 207 u_ice(ji,jj) = rn_uice * umask(ji,jj,1) ! or prescribed velocity 208 v_ice(ji,jj) = rn_vice * vmask(ji,jj,1) 209 END DO 210 END DO 184 211 ENDIF 185 212 CALL lim_trp( kt ) ! -- Ice transport (Advection/diffusion) … … 200 227 CALL lim_var_agg(1) ! at_i for coupling (via pfrld) 201 228 ! 202 pfrld(:,:) = 1._wp - at_i(:,:) 203 phicif(:,:) = vt_i(:,:) 229 !$OMP PARALLEL DO schedule(static) private(jj, ji) 230 DO jj = 1, jpj 231 DO ji = 1, jpi 232 pfrld(ji,jj) = 1._wp - at_i(ji,jj) 233 phicif(ji,jj) = vt_i(ji,jj) 234 END DO 235 END DO 204 236 205 237 !------------------------------------------------------! … … 220 252 CASE( jp_blk ) ! bulk formulation 221 253 ! albedo depends on cloud fraction because of non-linear spectral effects 222 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 254 DO jl = 1, jpl 255 !$OMP PARALLEL DO schedule(static) private(jj, ji) 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 alb_ice(ji,jj,jl) = ( 1. - cldf_ice ) * zalb_cs(ji,jj,jl) + cldf_ice * zalb_os(ji,jj,jl) 259 END DO 260 END DO 261 END DO 223 262 CALL blk_ice_flx( t_su, alb_ice ) 224 263 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) … … 226 265 CASE ( jp_purecpl ) 227 266 ! albedo depends on cloud fraction because of non-linear spectral effects 228 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 267 DO jl = 1, jpl 268 !$OMP PARALLEL DO schedule(static) private(jj, ji) 269 DO jj = 1, jpj 270 DO ji = 1, jpi 271 alb_ice(ji,jj,jl) = ( 1. - cldf_ice ) * zalb_cs(ji,jj,jl) + cldf_ice * zalb_os(ji,jj,jl) 272 END DO 273 END DO 274 END DO 229 275 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 230 276 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) … … 285 331 !! ** purpose : Allocate all the dynamic arrays of the LIM-3 modules 286 332 !!---------------------------------------------------------------------- 287 INTEGER :: j i, jj, ierr333 INTEGER :: jl, ji, jj, ierr 288 334 !!---------------------------------------------------------------------- 289 335 IF(lwp) WRITE(numout,*) … … 334 380 IF( ln_limdiahsb) CALL lim_diahsb_init ! initialization for diags 335 381 ! 336 fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction 337 tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu 338 ! 382 !$OMP PARALLEL 383 !$OMP DO schedule(static) private(jj, ji) 384 DO jj = 1, jpj 385 DO ji = 1, jpi 386 fr_i(ji,jj) = at_i(ji,jj) ! initialisation of sea-ice fraction 387 END DO 388 END DO 389 !$OMP END DO NOWAIT 390 DO jl = 1, jpl 391 !$OMP DO schedule(static) private(jj, ji) 392 DO jj = 1, jpj 393 DO ji = 1, jpi 394 tn_ice(ji,jj,jl) = t_su(ji,jj,jl) ! initialisation of surface temp for coupled simu 395 END DO 396 END DO 397 !$OMP END DO NOWAIT 398 END DO 399 ! 400 !$OMP DO schedule(static) private(jj, ji) 339 401 DO jj = 1, jpj 340 402 DO ji = 1, jpi … … 344 406 END DO 345 407 END DO 408 !$OMP END PARALLEL 346 409 ! 347 410 nstart = numit + nn_fsbc … … 527 590 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdevap_ice ! sublimation sensitivity 528 591 ! 529 INTEGER :: jl ! dummy loop index592 INTEGER :: jl, jj, ji ! dummy loop index 530 593 ! 531 594 REAL(wp), POINTER, DIMENSION(:,:) :: zalb_m ! Mean albedo over all categories … … 550 613 z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 551 614 z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 615 616 !$OMP PARALLEL 552 617 DO jl = 1, jpl 553 pdqn_ice (:,:,jl) = z_dqn_m(:,:) 554 pdevap_ice(:,:,jl) = z_devap_m(:,:) 618 !$OMP DO schedule(static) private(jj, ji) 619 DO jj = 1, jpj 620 DO ji = 1, jpi 621 pdqn_ice (ji,jj,jl) = z_dqn_m(ji,jj) 622 pdevap_ice(ji,jj,jl) = z_devap_m(ji,jj) 623 END DO 624 END DO 625 !$OMP END DO NOWAIT 555 626 END DO 556 627 ! 557 628 DO jl = 1, jpl 558 pqns_ice (:,:,jl) = z_qns_m(:,:) 559 pqsr_ice (:,:,jl) = z_qsr_m(:,:) 560 pevap_ice(:,:,jl) = z_evap_m(:,:) 561 END DO 629 !$OMP DO schedule(static) private(jj, ji) 630 DO jj = 1, jpj 631 DO ji = 1, jpi 632 pqns_ice (ji,jj,jl) = z_qns_m(ji,jj) 633 pqsr_ice (ji,jj,jl) = z_qsr_m(ji,jj) 634 pevap_ice(ji,jj,jl) = z_evap_m(ji,jj) 635 END DO 636 END DO 637 END DO 638 !$OMP END PARALLEL 562 639 ! 563 640 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) … … 571 648 ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) ) 572 649 DO jl = 1, jpl 573 pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 574 pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 575 pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 650 !$OMP PARALLEL DO schedule(static) private(jj, ji) 651 DO jj = 1, jpj 652 DO ji = 1, jpi 653 pqns_ice (ji,jj,jl) = pqns_ice (ji,jj,jl) + pdqn_ice (ji,jj,jl) * ( ptn_ice(ji,jj,jl) - ztem_m(ji,jj) ) 654 pevap_ice(ji,jj,jl) = pevap_ice(ji,jj,jl) + pdevap_ice(ji,jj,jl) * ( ptn_ice(ji,jj,jl) - ztem_m(ji,jj) ) 655 pqsr_ice (ji,jj,jl) = pqsr_ice (ji,jj,jl) * ( 1._wp - palb_ice(ji,jj,jl) ) / ( 1._wp - zalb_m(ji,jj) ) 656 END DO 657 END DO 576 658 END DO 577 659 ! … … 590 672 !! ** purpose : store ice variables at "before" time step 591 673 !!---------------------------------------------------------------------- 592 a_i_b (:,:,:) = a_i (:,:,:) ! ice area 593 e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy 594 v_i_b (:,:,:) = v_i (:,:,:) ! ice volume 595 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 596 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy 597 smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content 598 oa_i_b (:,:,:) = oa_i (:,:,:) ! areal age content 599 u_ice_b(:,:) = u_ice(:,:) 600 v_ice_b(:,:) = v_ice(:,:) 601 ! 602 at_i_b (:,:) = SUM( a_i_b(:,:,:), dim=3 ) 674 INTEGER :: jn, jl, jj, ji ! dummy loop index 675 676 !$OMP PARALLEL 677 DO jl = 1, jpl 678 !$OMP DO schedule(static) private(jj, ji) 679 DO jj = 1, jpj 680 DO ji = 1, jpi 681 a_i_b (ji,jj,jl) = a_i (ji,jj,jl) ! ice area 682 v_i_b (ji,jj,jl) = v_i (ji,jj,jl) ! ice volume 683 v_s_b (ji,jj,jl) = v_s (ji,jj,jl) ! snow volume 684 smv_i_b(ji,jj,jl) = smv_i(ji,jj,jl) ! salt content 685 oa_i_b (ji,jj,jl) = oa_i (ji,jj,jl) ! areal age content 686 END DO 687 END DO 688 !$OMP END DO NOWAIT 689 END DO 690 DO jl = 1, jpl 691 DO jn = 1, nlay_i 692 !$OMP DO schedule(static) private(jj, ji) 693 DO jj = 1, jpj 694 DO ji = 1, jpi 695 e_i_b (ji,jj,jn,jl) = e_i (ji,jj,jn,jl) ! ice thermal energy 696 END DO 697 END DO 698 !$OMP END DO NOWAIT 699 END DO 700 END DO 701 DO jl = 1, jpl 702 DO jn = 1, nlay_s 703 !$OMP DO schedule(static) private(jj, ji) 704 DO jj = 1, jpj 705 DO ji = 1, jpi 706 e_s_b (ji,jj,jn,jl) = e_s (ji,jj,jn,jl) ! snow thermal energy 707 END DO 708 END DO 709 !$OMP END DO NOWAIT 710 END DO 711 END DO 712 !$OMP DO schedule(static) private(jj, ji) 713 DO jj = 1, jpj 714 DO ji = 1, jpi 715 u_ice_b(ji,jj) = u_ice(ji,jj) 716 v_ice_b(ji,jj) = v_ice(ji,jj) 717 at_i_b (ji,jj) = 0._wp 718 END DO 719 END DO 720 DO jl = 1, jpl 721 !$OMP DO schedule(static) private(jj, ji) 722 DO jj = 1, jpj 723 DO ji = 1, jpi 724 ! 725 at_i_b (ji,jj) = at_i_b (ji,jj) + a_i_b(ji,jj,jl) 726 END DO 727 END DO 728 END DO 729 !$OMP END PARALLEL 603 730 604 731 END SUBROUTINE sbc_lim_bef … … 612 739 !! of the time step 613 740 !!---------------------------------------------------------------------- 614 sfx (:,:) = 0._wp ; 615 sfx_bri(:,:) = 0._wp ; sfx_lam(:,:) = 0._wp 616 sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp 617 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp 618 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 619 sfx_res(:,:) = 0._wp ; sfx_sub(:,:) = 0._wp 620 ! 621 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp 622 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp 623 wfx_bog(:,:) = 0._wp ; wfx_dyn(:,:) = 0._wp 624 wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp 625 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 626 wfx_spr(:,:) = 0._wp ; wfx_lam(:,:) = 0._wp 741 INTEGER :: jj, ji ! dummy loop index 742 743 !$OMP PARALLEL DO schedule(static) private(jj, ji) 744 DO jj = 1, jpj 745 DO ji = 1, jpi 746 sfx (ji,jj) = 0._wp ; 747 sfx_bri(ji,jj) = 0._wp ; sfx_lam(ji,jj) = 0._wp 748 sfx_sni(ji,jj) = 0._wp ; sfx_opw(ji,jj) = 0._wp 749 sfx_bog(ji,jj) = 0._wp ; sfx_dyn(ji,jj) = 0._wp 750 sfx_bom(ji,jj) = 0._wp ; sfx_sum(ji,jj) = 0._wp 751 sfx_res(ji,jj) = 0._wp ; sfx_sub(ji,jj) = 0._wp 752 ! 753 wfx_snw(ji,jj) = 0._wp ; wfx_ice(ji,jj) = 0._wp 754 wfx_sni(ji,jj) = 0._wp ; wfx_opw(ji,jj) = 0._wp 755 wfx_bog(ji,jj) = 0._wp ; wfx_dyn(ji,jj) = 0._wp 756 wfx_bom(ji,jj) = 0._wp ; wfx_sum(ji,jj) = 0._wp 757 wfx_res(ji,jj) = 0._wp ; wfx_sub(ji,jj) = 0._wp 758 wfx_spr(ji,jj) = 0._wp ; wfx_lam(ji,jj) = 0._wp 627 759 628 hfx_thd(:,:) = 0._wp ; 629 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp 630 hfx_bog(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp 631 hfx_bom(:,:) = 0._wp ; hfx_sum(:,:) = 0._wp 632 hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp 633 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 634 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 635 hfx_err_dif(:,:) = 0._wp 636 wfx_err_sub(:,:) = 0._wp 637 ! 638 afx_tot(:,:) = 0._wp ; 639 afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp 640 ! 641 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp 642 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp 643 644 tau_icebfr(:,:) = 0._wp; ! landfast ice param only (clem: important to keep the init here) 760 hfx_thd(ji,jj) = 0._wp ; 761 hfx_snw(ji,jj) = 0._wp ; hfx_opw(ji,jj) = 0._wp 762 hfx_bog(ji,jj) = 0._wp ; hfx_dyn(ji,jj) = 0._wp 763 hfx_bom(ji,jj) = 0._wp ; hfx_sum(ji,jj) = 0._wp 764 hfx_res(ji,jj) = 0._wp ; hfx_sub(ji,jj) = 0._wp 765 hfx_spr(ji,jj) = 0._wp ; hfx_dif(ji,jj) = 0._wp 766 hfx_err(ji,jj) = 0._wp ; hfx_err_rem(ji,jj) = 0._wp 767 hfx_err_dif(ji,jj) = 0._wp 768 wfx_err_sub(ji,jj) = 0._wp 769 ! 770 afx_tot(ji,jj) = 0._wp ; 771 afx_dyn(ji,jj) = 0._wp ; afx_thd(ji,jj) = 0._wp 772 ! 773 diag_heat(ji,jj) = 0._wp ; diag_smvi(ji,jj) = 0._wp 774 diag_vice(ji,jj) = 0._wp ; diag_vsnw(ji,jj) = 0._wp 775 776 tau_icebfr(ji,jj) = 0._wp; ! landfast ice param only (clem: important to keep the init here) 777 END DO 778 END DO 645 779 646 780 END SUBROUTINE sbc_lim_diag0 -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r7646 r7698 84 84 !! - nsbc: type of sbc 85 85 !!---------------------------------------------------------------------- 86 INTEGER :: ji, jj, jn ! dummy loop indices 86 87 INTEGER :: ios, icpt ! local integer 87 88 LOGICAL :: ll_purecpl, ll_opa, ll_not_nemo ! local logical … … 240 241 IF( .NOT.ln_isf ) THEN !* No ice-shelf in the domain : allocate and set to zero 241 242 IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 242 fwfisf (:,:) = 0._wp ; risf_tsc (:,:,:) = 0._wp 243 fwfisf_b(:,:) = 0._wp ; risf_tsc_b(:,:,:) = 0._wp 243 !$OMP PARALLEL 244 !$OMP DO schedule(static) private(jj,ji) 245 DO jj = 1, jpj 246 DO ji = 1, jpi 247 fwfisf (ji,jj) = 0.0_wp ; fwfisf_b (ji,jj) = 0.0_wp 248 END DO 249 END DO 250 !$OMP END DO NOWAIT 251 DO jn = 1, jpts 252 !$OMP DO schedule(static) private(jj,ji) 253 DO jj = 1, jpj 254 DO ji = 1, jpi 255 risf_tsc(ji,jj,jn) = 0.0_wp ; risf_tsc_b(ji,jj,jn) = 0.0_wp 256 END DO 257 END DO 258 END DO 259 !$OMP END PARALLEL 244 260 END IF 245 261 IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero 246 IF( nn_components /= jp_iam_opa ) fr_i(:,:) = 0._wp ! except for OPA in SAS-OPA coupled case 247 ENDIF 248 ! 249 sfx (:,:) = 0._wp !* salt flux due to freezing/melting 250 fmmflx(:,:) = 0._wp !* freezing minus melting flux 251 252 taum(:,:) = 0._wp !* wind stress module (needed in GLS in case of reduced restart) 262 IF( nn_components /= jp_iam_opa ) THEN 263 !$OMP PARALLEL DO schedule(static) private(jj,ji) 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 fr_i(ji,jj) = 0._wp ! except for OPA in SAS-OPA coupled case 267 END DO 268 END DO 269 END IF 270 ENDIF 271 ! 272 !$OMP PARALLEL DO schedule(static) private(jj,ji) 273 DO jj = 1, jpj 274 DO ji = 1, jpi 275 sfx (ji,jj) = 0._wp !* salt flux due to freezing/melting 276 fmmflx(ji,jj) = 0._wp !* freezing minus melting flux 277 taum (ji,jj) = 0._wp !* wind stress module (needed in GLS in case of reduced restart) 278 END DO 279 END DO 253 280 254 281 ! ! Choice of the Surface Boudary Condition (set nsbc) … … 356 383 !!---------------------------------------------------------------------- 357 384 INTEGER, INTENT(in) :: kt ! ocean time step 385 INTEGER :: ji, jj, jn ! dummy loop indices 358 386 ! 359 387 LOGICAL :: ll_sas, ll_opa ! local logical … … 365 393 IF( kt /= nit000 ) THEN ! Swap of forcing fields ! 366 394 ! ! ---------------------------------------- ! 367 utau_b(:,:) = utau(:,:) ! Swap the ocean forcing fields 368 vtau_b(:,:) = vtau(:,:) ! (except at nit000 where before fields 369 qns_b (:,:) = qns (:,:) ! are set at the end of the routine) 370 emp_b (:,:) = emp (:,:) 371 sfx_b (:,:) = sfx (:,:) 395 !$OMP PARALLEL DO schedule(static) private(jj,ji) 396 DO jj = 1, jpj 397 DO ji = 1, jpi 398 utau_b(ji,jj) = utau(ji,jj) ! Swap the ocean forcing fields 399 vtau_b(ji,jj) = vtau(ji,jj) ! (except at nit000 where before fields 400 qns_b (ji,jj) = qns (ji,jj) ! are set at the end of the routine) 401 emp_b (ji,jj) = emp (ji,jj) 402 sfx_b (ji,jj) = sfx (ji,jj) 403 END DO 404 END DO 372 405 IF ( ln_rnf ) THEN 373 rnf_b (:,: ) = rnf (:,: ) 374 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 406 !$OMP PARALLEL 407 !$OMP DO schedule(static) private(jj,ji) 408 DO jj = 1, jpj 409 DO ji = 1, jpi 410 rnf_b (ji,jj ) = rnf (ji,jj ) 411 END DO 412 END DO 413 !$OMP END DO NOWAIT 414 DO jn = 1, jpts 415 !$OMP DO schedule(static) private(jj,ji) 416 DO jj = 1, jpj 417 DO ji = 1, jpi 418 rnf_tsc_b(ji,jj,jn) = rnf_tsc(ji,jj,jn) 419 END DO 420 END DO 421 END DO 422 !$OMP END PARALLEL 375 423 ENDIF 376 424 ENDIF … … 401 449 END SELECT 402 450 IF ( ln_wave .AND. ln_tauoc) THEN ! Wave stress subctracted 403 utau(:,:) = utau(:,:)*tauoc_wave(:,:) 404 vtau(:,:) = vtau(:,:)*tauoc_wave(:,:) 405 taum(:,:) = taum(:,:)*tauoc_wave(:,:) 451 !$OMP PARALLEL DO schedule(static) private(jj,ji) 452 DO jj = 1, jpj 453 DO ji = 1, jpi 454 utau(ji,jj) = utau(ji,jj)*tauoc_wave(ji,jj) 455 vtau(ji,jj) = vtau(ji,jj)*tauoc_wave(ji,jj) 456 taum(ji,jj) = taum(ji,jj)*tauoc_wave(ji,jj) 457 END DO 458 END DO 406 459 ! 407 460 SELECT CASE( nsbc ) … … 457 510 CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b ) ! before salt flux (T-point) 458 511 ELSE 459 sfx_b (:,:) = sfx(:,:) 512 !$OMP PARALLEL DO schedule(static) private(jj,ji) 513 DO jj = 1, jpj 514 DO ji = 1, jpi 515 sfx_b (ji,jj) = sfx(ji,jj) 516 END DO 517 END DO 460 518 ENDIF 461 519 ELSE !* no restart: set from nit000 values 462 520 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000' 463 utau_b(:,:) = utau(:,:) 464 vtau_b(:,:) = vtau(:,:) 465 qns_b (:,:) = qns (:,:) 466 emp_b (:,:) = emp (:,:) 467 sfx_b (:,:) = sfx (:,:) 521 !$OMP PARALLEL DO schedule(static) private(jj,ji) 522 DO jj = 1, jpj 523 DO ji = 1, jpi 524 utau_b(ji,jj) = utau(ji,jj) 525 vtau_b(ji,jj) = vtau(ji,jj) 526 qns_b (ji,jj) = qns (ji,jj) 527 emp_b (ji,jj) = emp(ji,jj) 528 sfx_b (ji,jj) = sfx(ji,jj) 529 END DO 530 END DO 468 531 ENDIF 469 532 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r7646 r7698 103 103 INTEGER, INTENT(in) :: kt ! ocean time step 104 104 ! 105 INTEGER :: ji, jj ! dummy loop indices106 INTEGER :: z_err = 0 ! dummy integer for error handling105 INTEGER :: ji, jj, jn ! dummy loop indices 106 INTEGER :: z_err = 0 ! dummy integer for error handling 107 107 !!---------------------------------------------------------------------- 108 108 REAL(wp), DIMENSION(:,:), POINTER :: ztfrz ! freezing point used for temperature correction … … 120 120 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 121 121 ! 122 IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt 122 IF( .NOT. l_rnfcpl ) THEN ! updated runoff value at time step kt 123 !$OMP PARALLEL DO schedule(static) private(jj, ji) 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 rnf(ji,jj) = rn_rfact * ( sf_rnf(1)%fnow(ji,jj,1) ) 127 END DO 128 END DO 129 END IF 123 130 ! 124 131 ! ! set temperature & salinity content of runoffs 125 132 IF( ln_rnf_tem ) THEN ! use runoffs temperature data 126 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 133 !$OMP PARALLEL DO schedule(static) private(jj, ji) 134 DO jj = 1, jpj 135 DO ji = 1, jpi 136 rnf_tsc(ji,jj,jp_tem) = ( sf_t_rnf(1)%fnow(ji,jj,1) ) * rnf(ji,jj) * r1_rau0 137 END DO 138 END DO 127 139 CALL eos_fzp( sss_m(:,:), ztfrz(:,:) ) 128 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp ) ! if missing data value use SST as runoffs temperature 129 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 130 END WHERE 131 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg 132 rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * rlfusisf * r1_rau0_rcp 133 END WHERE 140 !$OMP PARALLEL DO schedule(static) private(jj, ji) 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 IF ( sf_t_rnf(1)%fnow(ji,jj,1) == -999._wp ) THEN ! if missing data value use SST as runoffs temperature 144 rnf_tsc(ji,jj,jp_tem) = sst_m(ji,jj) * rnf(ji,jj) * r1_rau0 145 END IF 146 IF ( sf_t_rnf(1)%fnow(ji,jj,1) == -222._wp ) THEN ! where fwf comes from melting of ice shelves or iceberg 147 rnf_tsc(ji,jj,jp_tem) = ztfrz(ji,jj) * rnf(ji,jj) * r1_rau0 - rnf(ji,jj) * rlfusisf * r1_rau0_rcp 148 END IF 149 END DO 150 END DO 134 151 ELSE ! use SST as runoffs temperature 135 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 136 ENDIF 152 !$OMP PARALLEL DO schedule(static) private(jj, ji) 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 rnf_tsc(ji,jj,jp_tem) = sst_m(ji,jj) * rnf(ji,jj) * r1_rau0 156 END DO 157 END DO 158 END IF 137 159 ! ! use runoffs salinity data 138 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 139 ! ! else use S=0 for runoffs (done one for all in the init) 160 IF( ln_rnf_sal ) THEN 161 !$OMP PARALLEL DO schedule(static) private(jj, ji) 162 DO jj = 1, jpj 163 DO ji = 1, jpi 164 rnf_tsc(ji,jj,jp_sal) = ( sf_s_rnf(1)%fnow(ji,jj,1) ) * rnf(ji,jj) * r1_rau0 165 END DO 166 END DO 167 END IF 168 ! ! else use S=0 for runoffs (done one for all in the init) 140 169 CALL iom_put( "runoffs", rnf ) ! output runoffs arrays 141 170 ENDIF … … 152 181 ELSE !* no restart: set from nit000 values 153 182 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' 154 rnf_b (:,: ) = rnf (:,: ) 155 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 183 !$OMP PARALLEL 184 !$OMP DO schedule(static) private(jj,ji) 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 rnf_b (ji,jj ) = rnf (ji,jj ) 188 END DO 189 END DO 190 !$OMP END DO NOWAIT 191 DO jn = 1, jpts 192 !$OMP DO schedule(static) private(jj,ji) 193 DO jj = 1, jpj 194 DO ji = 1, jpi 195 rnf_tsc_b(ji,jj,jn) = rnf_tsc(ji,jj,jn) 196 END DO 197 END DO 198 END DO 199 !$OMP END PARALLEL 156 200 ENDIF 157 201 ENDIF … … 187 231 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phdivn ! horizontal divergence 188 232 !! 189 INTEGER :: ji, jj, jk ! dummy loop indices233 INTEGER :: ji, jj, jk, jn ! dummy loop indices 190 234 REAL(wp) :: zfact ! local scalar 191 235 !!---------------------------------------------------------------------- … … 195 239 IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==! 196 240 IF( ln_linssh ) THEN !* constant volume case : just apply the runoff input flow 241 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 197 242 DO jj = 1, jpj 198 243 DO ji = 1, jpi … … 203 248 END DO 204 249 ELSE !* variable volume case 250 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 205 251 DO jj = 1, jpj ! update the depth over which runoffs are distributed 206 252 DO ji = 1, jpi … … 217 263 ENDIF 218 264 ELSE !== runoff put only at the surface ==! 219 h_rnf (:,:) = e3t_n (:,:,1) ! update h_rnf to be depth of top box 220 phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1) 265 !$OMP PARALLEL DO schedule(static) private(jj, ji) 266 DO jj = 1, jpj 267 DO ji = 1, jpi 268 h_rnf (ji,jj) = e3t_n (ji,jj,1) ! update h_rnf to be depth of top box 269 phdivn(ji,jj,1) = phdivn(ji,jj,1) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / e3t_n(ji,jj,1) 270 END DO 271 END DO 221 272 ENDIF 222 273 ! … … 235 286 !!---------------------------------------------------------------------- 236 287 CHARACTER(len=32) :: rn_dep_file ! runoff file name 237 INTEGER :: ji, jj, jk, jm ! dummy loop indices288 INTEGER :: ji, jj, jk, jm, jn ! dummy loop indices 238 289 INTEGER :: ierror, inum ! temporary integer 239 290 INTEGER :: ios ! Local integer output status for namelist read … … 256 307 ln_rnf_mouth = .FALSE. ! default definition needed for example by sbc_ssr or by tra_adv_muscl 257 308 nkrnf = 0 258 rnf (:,:) = 0.0_wp 259 rnf_b (:,:) = 0.0_wp 260 rnfmsk (:,:) = 0.0_wp 261 rnfmsk_z(:) = 0.0_wp 309 !$OMP PARALLEL 310 !$OMP DO schedule(static) private(jj, ji) 311 DO jj = 1, jpj 312 DO ji = 1, jpi 313 rnf (ji,jj) = 0.0_wp 314 rnf_b (ji,jj) = 0.0_wp 315 rnfmsk (ji,jj) = 0.0_wp 316 END DO 317 END DO 318 !$OMP END DO NOWAIT 319 !$OMP DO schedule(static) private(jk) 320 DO jk = 1, jpk 321 rnfmsk_z(jk) = 0.0_wp 322 END DO 323 !$OMP END PARALLEL 262 324 RETURN 263 325 ENDIF … … 338 400 CALL iom_close( inum ) ! close file 339 401 ! 340 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 402 !$OMP PARALLEL 403 !$OMP DO schedule(static) private(jj, ji) 404 DO jj = 1, jpj 405 DO ji = 1, jpi 406 nk_rnf(ji,jj) = 0 ! set the number of level over which river runoffs are applied 407 END DO 408 END DO 409 !$OMP DO schedule(static) private(jj, ji, jk) 341 410 DO jj = 1, jpj 342 411 DO ji = 1, jpi … … 354 423 END DO 355 424 END DO 425 !$OMP DO schedule(static) private(jj, ji, jk) 356 426 DO jj = 1, jpj ! set the associated depth 357 427 DO ji = 1, jpi … … 362 432 END DO 363 433 END DO 434 !$OMP END PARALLEL 364 435 ! 365 436 ELSE IF( ln_rnf_depth_ini ) THEN ! runoffs applied at the surface … … 381 452 DEALLOCATE( zrnfcl ) 382 453 ! 383 h_rnf(:,:) = 1.384 !385 454 zacoef = rn_dep_max / rn_rnf_max ! coef of linear relation between runoff and its depth (150m for max of runoff) 386 455 ! 387 WHERE( zrnf(:,:) > 0._wp ) h_rnf(:,:) = zacoef * zrnf(:,:) ! compute depth for all runoffs 388 ! 456 !$OMP PARALLEL 457 IF( zrnf(ji,jj) > 0._wp ) THEN 458 !$OMP DO schedule(static) private(jj, ji) 459 DO jj = 1, jpj 460 DO ji = 1, jpi 461 h_rnf(ji,jj) = zacoef * zrnf(ji,jj) ! compute depth for all runoffs 462 END DO 463 END DO 464 END IF 465 ! 466 !$OMP DO schedule(static) private(jj, ji, jk) 389 467 DO jj = 1, jpj ! take in account min depth of ocean rn_hmin 390 468 DO ji = 1, jpi … … 396 474 END DO 397 475 ! 398 nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed 476 !$OMP DO schedule(static) private(jj, ji) 477 DO jj = 1, jpj 478 DO ji = 1, jpi 479 nk_rnf(ji,jj) = 0 ! number of levels on which runoffs are distributed 480 END DO 481 END DO 482 !$OMP DO schedule(static) private(jj, ji, jk) 399 483 DO jj = 1, jpj 400 484 DO ji = 1, jpi … … 409 493 END DO 410 494 END DO 495 !$OMP END PARALLEL 411 496 ! 412 497 DEALLOCATE( zrnf ) 413 498 ! 499 !$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 414 500 DO jj = 1, jpj ! set the associated depth 415 501 DO ji = 1, jpi … … 428 514 ENDIF 429 515 ELSE ! runoffs applied at the surface 430 nk_rnf(:,:) = 1 431 h_rnf (:,:) = e3t_n(:,:,1) 432 ENDIF 433 ! 434 rnf(:,:) = 0._wp ! runoff initialisation 435 rnf_tsc(:,:,:) = 0._wp ! runoffs temperature & salinty contents initilisation 516 !$OMP PARALLEL DO schedule(static) private(jj, ji) 517 DO jj = 1, jpj 518 DO ji = 1, jpi 519 nk_rnf(ji,jj) = 1 520 h_rnf (ji,jj) = e3t_n(ji,jj,1) 521 END DO 522 END DO 523 ENDIF 524 ! 525 !$OMP PARALLEL 526 !$OMP DO schedule(static) private(jj, ji) 527 DO jj = 1, jpj 528 DO ji = 1, jpi 529 rnf(ji,jj) = 0._wp ! runoff initialisation 530 END DO 531 END DO 532 !$OMP END DO NOWAIT 533 DO jn = 1, jpts 534 !$OMP DO schedule(static) private(jj, ji) 535 DO jj = 1, jpj 536 DO ji = 1, jpi 537 rnf_tsc(ji,jj,jn) = 0._wp ! runoffs temperature & salinty contents initilisation 538 END DO 539 END DO 540 END DO 541 !$OMP END PARALLEL 436 542 ! 437 543 ! ! ======================== … … 466 572 IF(lwp) WRITE(numout,*) 467 573 IF(lwp) WRITE(numout,*) ' No specific treatment at river mouths' 468 rnfmsk (:,:) = 0._wp 469 rnfmsk_z(:) = 0._wp 574 !$OMP PARALLEL 575 !$OMP DO schedule(static) private(jj, ji) 576 DO jj = 1, jpj 577 DO ji = 1, jpi 578 rnfmsk (ji,jj) = 0._wp 579 END DO 580 END DO 581 !$OMP END DO NOWAIT 582 !$OMP DO schedule(static) private(jk) 583 DO jk = 1, jpk 584 rnfmsk_z(jk) = 0._wp 585 END DO 586 !$OMP END PARALLEL 470 587 nkrnf = 0 471 588 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r7646 r7698 59 59 ! 60 60 ! !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 61 !$OMP PARALLEL DO schedule(static) private(jj, ji) 61 62 DO jj = 1, jpj 62 63 DO ji = 1, jpi … … 68 69 IF( nn_fsbc == 1 ) THEN ! Instantaneous surface fields ! 69 70 ! ! ---------------------------------------- ! 70 ssu_m(:,:) = ub(:,:,1) 71 ssv_m(:,:) = vb(:,:,1) 72 IF( l_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 73 ELSE ; sst_m(:,:) = zts(:,:,jp_tem) 74 ENDIF 75 sss_m(:,:) = zts(:,:,jp_sal) 71 !$OMP PARALLEL DO schedule(static) private(jj, ji) 72 DO jj = 1, jpj 73 DO ji = 1, jpi 74 ssu_m(ji,jj) = ub(ji,jj,1) 75 ssv_m(ji,jj) = vb(ji,jj,1) 76 END DO 77 END DO 78 IF( l_useCT ) THEN 79 sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 80 ELSE 81 !$OMP PARALLEL DO schedule(static) private(jj, ji) 82 DO jj = 1, jpj 83 DO ji = 1, jpi 84 sst_m(ji,jj) = zts(ji,jj,jp_tem) 85 END DO 86 END DO 87 ENDIF 88 !$OMP PARALLEL DO schedule(static) private(jj, ji) 89 DO jj = 1, jpj 90 DO ji = 1, jpi 91 sss_m(ji,jj) = zts(ji,jj,jp_sal) 92 END DO 93 END DO 76 94 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 77 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 78 ELSE ; ssh_m(:,:) = sshn(:,:) 79 ENDIF 80 ! 81 e3t_m(:,:) = e3t_n(:,:,1) 82 ! 83 frq_m(:,:) = fraqsr_1lev(:,:) 95 IF( ln_apr_dyn ) THEN 96 !$OMP PARALLEL DO schedule(static) private(jj, ji) 97 DO jj = 1, jpj 98 DO ji = 1, jpi 99 ssh_m(ji,jj) = sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) 100 END DO 101 END DO 102 ELSE 103 !$OMP PARALLEL DO schedule(static) private(jj, ji) 104 DO jj = 1, jpj 105 DO ji = 1, jpi 106 ssh_m(ji,jj) = sshn(ji,jj) 107 END DO 108 END DO 109 ENDIF 110 ! 111 !$OMP PARALLEL DO schedule(static) private(jj, ji) 112 DO jj = 1, jpj 113 DO ji = 1, jpi 114 e3t_m(ji,jj) = e3t_n(ji,jj,1) 115 ! 116 frq_m(ji,jj) = fraqsr_1lev(ji,jj) 117 END DO 118 END DO 84 119 ! 85 120 ELSE … … 91 126 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 92 127 zcoef = REAL( nn_fsbc - 1, wp ) 93 ssu_m(:,:) = zcoef * ub(:,:,1) 94 ssv_m(:,:) = zcoef * vb(:,:,1) 95 IF( l_useCT ) THEN ; sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 96 ELSE ; sst_m(:,:) = zcoef * zts(:,:,jp_tem) 128 !$OMP PARALLEL DO schedule(static) private(jj, ji) 129 DO jj = 1, jpj 130 DO ji = 1, jpi 131 ssu_m(ji,jj) = zcoef * ub(ji,jj,1) 132 ssv_m(ji,jj) = zcoef * vb(ji,jj,1) 133 END DO 134 END DO 135 IF( l_useCT ) THEN 136 sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 137 ELSE 138 !$OMP PARALLEL DO schedule(static) private(jj, ji) 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 sst_m(ji,jj) = zcoef * zts(ji,jj,jp_tem) 142 END DO 143 END DO 97 144 ENDIF 98 sss_m(:,:) = zcoef * zts(:,:,jp_sal) 145 !$OMP PARALLEL DO schedule(static) private(jj, ji) 146 DO jj = 1, jpj 147 DO ji = 1, jpi 148 sss_m(ji,jj) = zcoef * zts(ji,jj,jp_sal) 149 END DO 150 END DO 99 151 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 100 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 101 ELSE ; ssh_m(:,:) = zcoef * sshn(:,:) 152 IF( ln_apr_dyn ) THEN 153 !$OMP PARALLEL DO schedule(static) private(jj, ji) 154 DO jj = 1, jpj 155 DO ji = 1, jpi 156 ssh_m(ji,jj) = zcoef * ( sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) ) 157 END DO 158 END DO 159 ELSE 160 !$OMP PARALLEL DO schedule(static) private(jj, ji) 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 ssh_m(ji,jj) = zcoef * sshn(ji,jj) 164 END DO 165 END DO 102 166 ENDIF 103 167 ! 104 e3t_m(:,:) = zcoef * e3t_n(:,:,1) 105 ! 106 frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 168 !$OMP PARALLEL DO schedule(static) private(jj, ji) 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 e3t_m(ji,jj) = zcoef * e3t_n(ji,jj,1) 172 ! 173 frq_m(ji,jj) = zcoef * fraqsr_1lev(ji,jj) 174 END DO 175 END DO 107 176 ! ! ---------------------------------------- ! 108 177 ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN ! Initialisation: New mean computation ! 109 178 ! ! ---------------------------------------- ! 110 ssu_m(:,:) = 0._wp ! reset to zero ocean mean sbc fields 111 ssv_m(:,:) = 0._wp 112 sst_m(:,:) = 0._wp 113 sss_m(:,:) = 0._wp 114 ssh_m(:,:) = 0._wp 115 e3t_m(:,:) = 0._wp 116 frq_m(:,:) = 0._wp 179 !$OMP PARALLEL DO schedule(static) private(jj, ji) 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 ssu_m(ji,jj) = 0._wp ! reset to zero ocean mean sbc fields 183 ssv_m(ji,jj) = 0._wp 184 sst_m(ji,jj) = 0._wp 185 sss_m(ji,jj) = 0._wp 186 ssh_m(ji,jj) = 0._wp 187 e3t_m(ji,jj) = 0._wp 188 frq_m(ji,jj) = 0._wp 189 END DO 190 END DO 117 191 ENDIF 118 192 ! ! ---------------------------------------- ! 119 193 ! ! Cumulate at each time step ! 120 194 ! ! ---------------------------------------- ! 121 ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 122 ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 123 IF( l_useCT ) THEN ; sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 124 ELSE ; sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 125 ENDIF 126 sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 195 !$OMP PARALLEL DO schedule(static) private(jj, ji) 196 DO jj = 1, jpj 197 DO ji = 1, jpi 198 ssu_m(ji,jj) = ssu_m(ji,jj) + ub(ji,jj,1) 199 ssv_m(ji,jj) = ssv_m(ji,jj) + vb(ji,jj,1) 200 END DO 201 END DO 202 IF( l_useCT ) THEN 203 sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 204 ELSE 205 !$OMP PARALLEL DO schedule(static) private(jj, ji) 206 DO jj = 1, jpj 207 DO ji = 1, jpi 208 sst_m(ji,jj) = sst_m(ji,jj) + zts(ji,jj,jp_tem) 209 END DO 210 END DO 211 ENDIF 212 !$OMP PARALLEL DO schedule(static) private(jj, ji) 213 DO jj = 1, jpj 214 DO ji = 1, jpi 215 sss_m(ji,jj) = sss_m(ji,jj) + zts(ji,jj,jp_sal) 216 END DO 217 END DO 127 218 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 128 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 129 ELSE ; ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 130 ENDIF 131 ! 132 e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 133 ! 134 frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 219 IF( ln_apr_dyn ) THEN 220 !$OMP PARALLEL DO schedule(static) private(jj, ji) 221 DO jj = 1, jpj 222 DO ji = 1, jpi 223 ssh_m(ji,jj) = ssh_m(ji,jj) + sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) 224 END DO 225 END DO 226 ELSE 227 !$OMP PARALLEL DO schedule(static) private(jj, ji) 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 ssh_m(ji,jj) = ssh_m(ji,jj) + sshn(ji,jj) 231 END DO 232 END DO 233 ENDIF 234 ! 235 !$OMP PARALLEL DO schedule(static) private(jj, ji) 236 DO jj = 1, jpj 237 DO ji = 1, jpi 238 e3t_m(ji,jj) = e3t_m(ji,jj) + e3t_n(ji,jj,1) 239 ! 240 frq_m(ji,jj) = frq_m(ji,jj) + fraqsr_1lev(ji,jj) 241 END DO 242 END DO 135 243 136 244 ! ! ---------------------------------------- ! … … 138 246 ! ! ---------------------------------------- ! 139 247 zcoef = 1. / REAL( nn_fsbc, wp ) 140 sst_m(:,:) = sst_m(:,:) * zcoef ! mean SST [Celsius] 141 sss_m(:,:) = sss_m(:,:) * zcoef ! mean SSS [psu] 142 ssu_m(:,:) = ssu_m(:,:) * zcoef ! mean suface current [m/s] 143 ssv_m(:,:) = ssv_m(:,:) * zcoef ! 144 ssh_m(:,:) = ssh_m(:,:) * zcoef ! mean SSH [m] 145 e3t_m(:,:) = e3t_m(:,:) * zcoef ! mean vertical scale factor [m] 146 frq_m(:,:) = frq_m(:,:) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-] 248 !$OMP PARALLEL DO schedule(static) private(jj, ji) 249 DO jj = 1, jpj 250 DO ji = 1, jpi 251 sst_m(ji,jj) = sst_m(ji,jj) * zcoef ! mean SST [Celsius] 252 sss_m(ji,jj) = sss_m(ji,jj) * zcoef ! mean SSS [psu] 253 ssu_m(ji,jj) = ssu_m(ji,jj) * zcoef ! mean suface current [m/s] 254 ssv_m(ji,jj) = ssv_m(ji,jj) * zcoef ! 255 ssh_m(ji,jj) = ssh_m(ji,jj) * zcoef ! mean SSH [m] 256 e3t_m(ji,jj) = e3t_m(ji,jj) * zcoef ! mean vertical scale factor [m] 257 frq_m(ji,jj) = frq_m(ji,jj) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-] 258 END DO 259 END DO 147 260 ! 148 261 ENDIF … … 190 303 !!---------------------------------------------------------------------- 191 304 REAL(wp) :: zcoef, zf_sbc ! local scalar 305 INTEGER :: ji, jj ! loop index 192 306 !!---------------------------------------------------------------------- 193 307 ! … … 217 331 CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m ) 218 332 ELSE 219 frq_m(:,:) = 1._wp ! default definition 333 !$OMP PARALLEL DO schedule(static) private(jj, ji) 334 DO jj = 1, jpj 335 DO ji = 1, jpi 336 frq_m(ji,jj) = 1._wp ! default definition 337 END DO 338 END DO 220 339 ENDIF 221 340 ! … … 223 342 IF(lwp) WRITE(numout,*) ' restart with a change in the frequency of mean from ', zf_sbc, ' to ', nn_fsbc 224 343 zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc 225 ssu_m(:,:) = zcoef * ssu_m(:,:) 226 ssv_m(:,:) = zcoef * ssv_m(:,:) 227 sst_m(:,:) = zcoef * sst_m(:,:) 228 sss_m(:,:) = zcoef * sss_m(:,:) 229 ssh_m(:,:) = zcoef * ssh_m(:,:) 230 e3t_m(:,:) = zcoef * e3t_m(:,:) 231 frq_m(:,:) = zcoef * frq_m(:,:) 344 !$OMP PARALLEL DO schedule(static) private(jj, ji) 345 DO jj = 1, jpj 346 DO ji = 1, jpi 347 ssu_m(ji,jj) = zcoef * ssu_m(ji,jj) 348 ssv_m(ji,jj) = zcoef * ssv_m(ji,jj) 349 sst_m(ji,jj) = zcoef * sst_m(ji,jj) 350 sss_m(ji,jj) = zcoef * sss_m(ji,jj) 351 ssh_m(ji,jj) = zcoef * ssh_m(ji,jj) 352 e3t_m(ji,jj) = zcoef * e3t_m(ji,jj) 353 frq_m(ji,jj) = zcoef * frq_m(ji,jj) 354 END DO 355 END DO 232 356 ELSE 233 357 IF(lwp) WRITE(numout,*) ' mean fields read in the ocean restart file' … … 239 363 ! 240 364 IF(lwp) WRITE(numout,*) ' default initialisation of ss._m arrays' 241 ssu_m(:,:) = ub(:,:,1) 242 ssv_m(:,:) = vb(:,:,1) 365 !$OMP PARALLEL DO schedule(static) private(jj, ji) 366 DO jj = 1, jpj 367 DO ji = 1, jpi 368 ssu_m(ji,jj) = ub(ji,jj,1) 369 ssv_m(ji,jj) = vb(ji,jj,1) 370 END DO 371 END DO 243 372 IF( l_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 244 373 ELSE ; sst_m(:,:) = tsn(:,:,1,jp_tem) 245 374 ENDIF 246 sss_m(:,:) = tsn (:,:,1,jp_sal) 247 ssh_m(:,:) = sshn (:,:) 248 e3t_m(:,:) = e3t_n(:,:,1) 249 frq_m(:,:) = 1._wp 375 !$OMP PARALLEL DO schedule(static) private(jj, ji) 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 sss_m(ji,jj) = tsn (ji,jj,1,jp_sal) 379 ssh_m(ji,jj) = sshn (ji,jj) 380 e3t_m(ji,jj) = e3t_n(ji,jj,1) 381 frq_m(ji,jj) = 1._wp 382 END DO 383 END DO 250 384 ! 251 385 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r7646 r7698 93 93 ! 94 94 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 95 !$OMP PARALLEL DO schedule(static) private(jj,ji,zqrp) 95 96 DO jj = 1, jpj 96 97 DO ji = 1, jpi … … 105 106 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux only (sfx)) 106 107 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 108 !$OMP PARALLEL DO schedule(static) private(jj, ji, zerp) 107 109 DO jj = 1, jpj 108 110 DO ji = 1, jpi … … 118 120 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 119 121 zerp_bnd = rn_sssr_bnd / rday ! - - 122 !$OMP PARALLEL DO schedule(static) private(jj, ji, zerp) 120 123 DO jj = 1, jpj 121 124 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r7646 r7698 237 237 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 238 238 ! 239 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 239 240 DO jk = 1, jpkm1 240 241 DO jj = 1, jpj … … 277 278 CASE( np_seos ) !== simplified EOS ==! 278 279 ! 280 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 279 281 DO jk = 1, jpkm1 280 282 DO jj = 1, jpj … … 345 347 END DO 346 348 ! 349 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, jsmp, jdof, zh, zt, zstemp, zs, ztm, zn3, zn2, zn1) 347 350 DO jk = 1, jpkm1 348 351 DO jj = 1, jpj … … 399 402 ! Non-stochastic equation of state 400 403 ELSE 404 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 401 405 DO jk = 1, jpkm1 402 406 DO jj = 1, jpj … … 441 445 CASE( np_seos ) !== simplified EOS ==! 442 446 ! 447 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 443 448 DO jk = 1, jpkm1 444 449 DO jj = 1, jpj … … 493 498 IF( nn_timing == 1 ) CALL timing_start('eos2d') 494 499 ! 495 prd(:,:) = 0._wp 500 !$OMP PARALLEL DO schedule(static) private(jj, ji) 501 DO jj = 1, jpj 502 DO ji = 1, jpi 503 prd(ji,jj) = 0._wp 504 END DO 505 END DO 496 506 ! 497 507 SELECT CASE( neos ) … … 499 509 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 500 510 ! 511 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn3, zn2, zn1, zn0, zn) 501 512 DO jj = 1, jpjm1 502 513 DO ji = 1, fs_jpim1 ! vector opt. … … 538 549 CASE( np_seos ) !== simplified EOS ==! 539 550 ! 551 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn) 540 552 DO jj = 1, jpjm1 541 553 DO ji = 1, fs_jpim1 ! vector opt. … … 589 601 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 590 602 ! 603 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 591 604 DO jk = 1, jpkm1 592 605 DO jj = 1, jpj … … 646 659 CASE( np_seos ) !== simplified EOS ==! 647 660 ! 661 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 648 662 DO jk = 1, jpkm1 649 663 DO jj = 1, jpj … … 698 712 IF( nn_timing == 1 ) CALL timing_start('rab_2d') 699 713 ! 700 pab(:,:,:) = 0._wp 714 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 715 DO jk = 1, jpts 716 DO jj = 1, jpj 717 DO ji = 1, jpi 718 pab(ji,jj,jk) = 0._wp 719 END DO 720 END DO 721 END DO 701 722 ! 702 723 SELECT CASE ( neos ) … … 704 725 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 705 726 ! 727 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn3, zn2, zn1, zn0, zn) 706 728 DO jj = 1, jpjm1 707 729 DO ji = 1, fs_jpim1 ! vector opt. … … 762 784 CASE( np_seos ) !== simplified EOS ==! 763 785 ! 786 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn) 764 787 DO jj = 1, jpjm1 765 788 DO ji = 1, fs_jpim1 ! vector opt. … … 917 940 IF( nn_timing == 1 ) CALL timing_start('bn2') 918 941 ! 942 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zrw, zaw, zbw) 919 943 DO jk = 2, jpkm1 ! interior points only (2=< jk =< jpkm1 ) 920 944 DO jj = 1, jpj ! surface and bottom value set to zero one for all in istate.F90 … … 952 976 !! Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC) 953 977 !!---------------------------------------------------------------------- 954 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp 955 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity 978 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celsius] 979 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 956 980 ! Leave result array automatic rather than making explicitly allocated 957 981 REAL(wp), DIMENSION(jpi,jpj) :: ptmp ! potential temperature [Celsius] … … 969 993 z1_T0 = 1._wp/40._wp 970 994 ! 995 !$OMP PARALLEL DO schedule(static) private(jj, ji, zt, zs, ztm, zn,zd) 971 996 DO jj = 1, jpj 972 997 DO ji = 1, jpi … … 1024 1049 ! 1025 1050 z1_S0 = 1._wp / 35.16504_wp 1051 !$OMP PARALLEL 1052 !$OMP DO schedule(static) private(jj, ji, zs) 1026 1053 DO jj = 1, jpj 1027 1054 DO ji = 1, jpi … … 1031 1058 END DO 1032 1059 END DO 1033 ptf(:,:) = ptf(:,:) * psal(:,:) 1034 ! 1035 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1060 !$OMP DO schedule(static) private(jj, ji) 1061 DO jj = 1, jpj 1062 DO ji = 1, jpi 1063 ptf(ji,jj) = ptf(ji,jj) * psal(ji,jj) 1064 END DO 1065 END DO 1066 !$OMP END PARALLEL 1067 ! 1068 IF( PRESENT( pdep ) ) THEN 1069 !$OMP PARALLEL DO schedule(static) private(jj, ji) 1070 DO jj = 1, jpj 1071 DO ji = 1, jpi 1072 ptf(ji,jj) = ptf(ji,jj) - 7.53e-4 * pdep(ji,jj) 1073 END DO 1074 END DO 1075 END IF 1036 1076 ! 1037 1077 CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==! 1038 1078 ! 1039 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) & 1040 & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:) 1079 !$OMP PARALLEL DO schedule(static) private(jj, ji) 1080 DO jj = 1, jpj 1081 DO ji = 1, jpi 1082 ptf(ji,jj) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(ji,jj) ) & 1083 & - 2.154996e-4_wp * psal(ji,jj) ) * psal(ji,jj) 1084 END DO 1085 END DO 1041 1086 ! 1042 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1087 IF( PRESENT( pdep ) ) THEN 1088 !$OMP PARALLEL DO schedule(static) private(jj, ji) 1089 DO jj = 1, jpj 1090 DO ji = 1, jpi 1091 ptf(ji,jj) = ptf(ji,jj) - 7.53e-4 * pdep(ji,jj) 1092 END DO 1093 END DO 1094 END IF 1043 1095 ! 1044 1096 CASE DEFAULT … … 1134 1186 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 1135 1187 ! 1188 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn2, zn1, zn0, zn) 1136 1189 DO jk = 1, jpkm1 1137 1190 DO jj = 1, jpj … … 1197 1250 CASE( np_seos ) !== Vallis (2006) simplified EOS ==! 1198 1251 ! 1252 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 1199 1253 DO jk = 1, jpkm1 1200 1254 DO jj = 1, jpj -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r7646 r7698 88 88 INTEGER, INTENT( in ) :: kt ! ocean time-step index 89 89 ! 90 INTEGER :: 90 INTEGER :: ji, jj, jk ! dummy loop index 91 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 92 92 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace … … 98 98 ! 99 99 ! ! set time step 100 zun(:,:,:) = 0.0 101 zvn(:,:,:) = 0.0 102 zwn(:,:,:) = 0.0 100 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 101 DO jk = 1, jpk 102 DO jj = 1, jpj 103 DO ji = 1, jpi 104 zun(ji,jj,jk) = 0.0 105 zvn(ji,jj,jk) = 0.0 106 zwn(ji,jj,jk) = 0.0 107 END DO 108 END DO 109 END DO 103 110 ! 104 111 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 … … 110 117 ! !== effective transport ==! 111 118 IF( ln_wave .AND. ln_sdw ) THEN 119 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 112 120 DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift 113 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) ) 114 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) ) 115 zwn(:,:,jk) = e1e2t(:,:) * ( wn(:,:,jk) + wsd(:,:,jk) ) 121 DO jj = 1, jpj 122 DO ji = 1, jpi 123 zun(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * ( un(ji,jj,jk) + usd(ji,jj,jk) ) 124 zvn(ji,jj,jk) = e1v(ji,jj) * e3v_n(ji,jj,jk) * ( vn(ji,jj,jk) + vsd(ji,jj,jk) ) 125 zwn(ji,jj,jk) = e1e2t(ji,jj) * ( wn(ji,jj,jk) + wsd(ji,jj,jk) ) 126 END DO 127 END DO 116 128 END DO 117 129 ELSE 130 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 118 131 DO jk = 1, jpkm1 119 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport only 120 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 121 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 zun(ji,jj,jk) = e2u (ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) ! eulerian transport only 135 zvn(ji,jj,jk) = e1v (ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 136 zwn(ji,jj,jk) = e1e2t(ji,jj) * wn(ji,jj,jk) 137 END DO 138 END DO 122 139 END DO 123 140 ENDIF 124 141 ! 125 142 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 126 zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 127 zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 128 ENDIF 129 ! 130 zun(:,:,jpk) = 0._wp ! no transport trough the bottom 131 zvn(:,:,jpk) = 0._wp 132 zwn(:,:,jpk) = 0._wp 143 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 144 DO jk = 1, jpk 145 DO jj = 1, jpj 146 DO ji = 1, jpi 147 zun(ji,jj,jk) = zun(ji,jj,jk) + un_td(ji,jj,jk) 148 zvn(ji,jj,jk) = zvn(ji,jj,jk) + vn_td(ji,jj,jk) 149 END DO 150 END DO 151 END DO 152 ENDIF 153 ! 154 !$OMP PARALLEL DO schedule(static) private(jj, ji) 155 DO jj = 1, jpj 156 DO ji = 1, jpi 157 zun(ji,jj,jpk) = 0._wp ! no transport trough the bottom 158 zvn(ji,jj,jpk) = 0._wp 159 zwn(ji,jj,jpk) = 0._wp 160 END DO 161 END DO 133 162 ! 134 163 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & … … 147 176 IF( l_trdtra ) THEN !* Save ta and sa trends 148 177 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 149 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 150 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 178 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 179 DO jk = 1, jpk 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 183 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 184 END DO 185 END DO 186 END DO 151 187 ENDIF 152 188 ! … … 169 205 ! 170 206 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 207 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 171 208 DO jk = 1, jpkm1 172 ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 173 ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 209 DO jj = 1, jpj 210 DO ji = 1, jpi 211 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 212 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 213 END DO 214 END DO 174 215 END DO 175 216 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r7646 r7698 113 113 IF( l_trd .OR. l_hst ) THEN 114 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 115 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 115 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 116 DO jk = 1, jpk 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 ztrdx(ji,jj,jk) = 0._wp 120 ztrdy(ji,jj,jk) = 0._wp 121 ztrdz(ji,jj,jk) = 0._wp 122 END DO 123 END DO 124 END DO 116 125 ENDIF 117 126 ! 118 127 IF( l_ptr ) THEN 119 128 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 120 zptry(:,:,:) = 0._wp 129 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 130 DO jk = 1, jpk 131 DO jj = 1, jpj 132 DO ji = 1, jpi 133 zptry(ji,jj,jk) = 0._wp 134 END DO 135 END DO 136 END DO 121 137 ENDIF 122 138 ! ! surface & bottom value : flux set to zero one for all 123 zwz(:,:, 1 ) = 0._wp 124 zwx(:,:,jpk) = 0._wp ; zwy(:,:,jpk) = 0._wp ; zwz(:,:,jpk) = 0._wp 125 ! 126 zwi(:,:,:) = 0._wp 139 !$OMP PARALLEL 140 !$OMP DO schedule(static) private(jj, ji) 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 zwz(ji,jj, 1 ) = 0._wp 144 zwx(ji,jj,jpk) = 0._wp 145 zwy(ji,jj,jpk) = 0._wp 146 zwz(ji,jj,jpk) = 0._wp 147 END DO 148 END DO 149 !$OMP END DO NOWAIT 150 !$OMP DO schedule(static) private(jk, jj, ji) 151 DO jk = 1, jpk 152 DO jj = 1, jpj 153 DO ji = 1, jpi 154 zwi(ji,jj,jk) = 0._wp 155 END DO 156 END DO 157 END DO 158 !$OMP END PARALLEL 127 159 ! 128 160 DO jn = 1, kjpt !== loop over the tracers ==! … … 130 162 ! !== upstream advection with initial mass fluxes & intermediate update ==! 131 163 ! !* upstream tracer flux in the i and j direction 164 !$OMP PARALLEL 165 !$OMP DO schedule(static) private(jk, jj, ji, zfp_vj, zfm_vj, zfp_ui,zfm_ui) 132 166 DO jk = 1, jpkm1 133 167 DO jj = 1, jpjm1 … … 143 177 END DO 144 178 END DO 179 !$OMP END DO NOWAIT 145 180 ! !* upstream tracer flux in the k direction *! 181 !$OMP DO schedule(static) private(jk, jj, ji, zfp_wk, zfm_wk) 146 182 DO jk = 2, jpkm1 ! Interior value ( multiplied by wmask) 147 183 DO jj = 1, jpj … … 153 189 END DO 154 190 END DO 191 !$OMP END PARALLEL 155 192 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as zwz has been w-masked) 156 193 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 194 !$OMP PARALLEL DO schedule(static) private(jj, ji) 157 195 DO jj = 1, jpj 158 196 DO ji = 1, jpi … … 161 199 END DO 162 200 ELSE ! no cavities: only at the ocean surface 163 zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 201 !$OMP PARALLEL DO schedule(static) private(jj, ji) 202 DO jj = 1, jpj 203 DO ji = 1, jpi 204 zwz(ji,jj,1) = pwn(ji,jj,1) * ptb(ji,jj,1,jn) 205 END DO 206 END DO 164 207 ENDIF 165 208 ENDIF 166 209 ! 210 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztra) 167 211 DO jk = 1, jpkm1 !* trend and after field with monotonic scheme 168 212 DO jj = 2, jpjm1 … … 181 225 ! 182 226 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 183 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 227 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 228 DO jk = 1, jpk 229 DO jj = 1, jpj 230 DO ji = 1, jpi 231 ztrdx(ji,jj,jk) = zwx(ji,jj,jk) 232 ztrdy(ji,jj,jk) = zwy(ji,jj,jk) 233 ztrdz(ji,jj,jk) = zwz(ji,jj,jk) 234 END DO 235 END DO 236 END DO 184 237 END IF 185 238 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 186 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 239 IF( l_ptr ) THEN 240 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 241 DO jk = 1, jpk 242 DO jj = 1, jpj 243 DO ji = 1, jpi 244 zptry(ji,jj,jk) = zwy(ji,jj,jk) 245 END DO 246 END DO 247 END DO 248 END IF 187 249 ! 188 250 ! !== anti-diffusive flux : high order minus low order ==! … … 191 253 ! 192 254 CASE( 2 ) !- 2nd order centered 255 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 193 256 DO jk = 1, jpkm1 194 257 DO jj = 1, jpjm1 … … 201 264 ! 202 265 CASE( 4 ) !- 4th order centered 203 zltu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 204 zltv(:,:,jpk) = 0._wp 266 !$OMP PARALLEL 267 !$OMP DO schedule(static) private(jj, ji) 268 DO jj = 1, jpj 269 DO ji = 1, jpi 270 zltu(ji,jj,jpk) = 0._wp ! Bottom value : flux set to zero 271 zltv(ji,jj,jpk) = 0._wp 272 END DO 273 END DO 274 !$OMP DO schedule(static) private(jk, jj, ji) 205 275 DO jk = 1, jpkm1 ! Laplacian 206 276 DO jj = 1, jpjm1 ! 1st derivative (gradient) … … 217 287 END DO 218 288 END DO 289 !$OMP END PARALLEL 219 290 CALL lbc_lnk( zltu, 'T', 1. ) ; CALL lbc_lnk( zltv, 'T', 1. ) ! Lateral boundary cond. (unchanged sgn) 220 291 ! 292 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v) 221 293 DO jk = 1, jpkm1 ! Horizontal advective fluxes 222 294 DO jj = 1, jpjm1 … … 232 304 ! 233 305 CASE( 41 ) !- 4th order centered ==>> !!gm coding attempt need to be tested 234 ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 235 ztv(:,:,jpk) = 0._wp 306 !$OMP PARALLEL 307 !$OMP DO schedule(static) private(jj, ji) 308 DO jj = 1, jpj 309 DO ji = 1, jpi 310 ztu(ji,jj,jpk) = 0._wp ! Bottom value : flux set to zero 311 ztv(ji,jj,jpk) = 0._wp 312 END DO 313 END DO 314 !$OMP DO schedule(static) private(jk, jj, ji) 236 315 DO jk = 1, jpkm1 ! 1st derivative (gradient) 237 316 DO jj = 1, jpjm1 … … 242 321 END DO 243 322 END DO 323 !$OMP END PARALLEL 244 324 CALL lbc_lnk( ztu, 'U', -1. ) ; CALL lbc_lnk( ztv, 'V', -1. ) ! Lateral boundary cond. (unchanged sgn) 245 325 ! 326 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v, zC4t_u, zC4t_v) 246 327 DO jk = 1, jpkm1 ! Horizontal advective fluxes 247 328 DO jj = 2, jpjm1 … … 264 345 ! 265 346 CASE( 2 ) !- 2nd order centered 347 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 266 348 DO jk = 2, jpkm1 267 349 DO jj = 2, jpjm1 … … 275 357 CASE( 4 ) !- 4th order COMPACT 276 358 CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw ) ! zwt = COMPACT interpolation of T at w-point 359 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 277 360 DO jk = 2, jpkm1 278 361 DO jj = 2, jpjm1 … … 285 368 END SELECT 286 369 IF( ln_linssh ) THEN ! top ocean value: high order = upstream ==>> zwz=0 287 zwz(:,:,1) = 0._wp ! only ocean surface as interior zwz values have been w-masked 370 !$OMP PARALLEL DO schedule(static) private(jj, ji) 371 DO jj = 1, jpj 372 DO ji = 1, jpi 373 zwz(ji,jj,1) = 0._wp ! only ocean surface as interior zwz values have been w-masked 374 END DO 375 END DO 288 376 ENDIF 289 377 ! … … 297 385 ! !== final trend with corrected fluxes ==! 298 386 ! 387 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 299 388 DO jk = 1, jpkm1 300 389 DO jj = 2, jpjm1 … … 309 398 ! 310 399 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 311 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 312 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 313 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 400 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 401 DO jk = 1, jpk 402 DO jj = 1, jpj 403 DO ji = 1, jpi 404 ztrdx(ji,jj,jk) = ztrdx(ji,jj,jk) + zwx(ji,jj,jk) ! <<< Add to previously computed 405 ztrdy(ji,jj,jk) = ztrdy(ji,jj,jk) + zwy(ji,jj,jk) ! <<< Add to previously computed 406 ztrdz(ji,jj,jk) = ztrdz(ji,jj,jk) + zwz(ji,jj,jk) ! <<< Add to previously computed 407 END DO 408 END DO 409 END DO 314 410 ENDIF 315 411 ! … … 325 421 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 326 422 IF( l_ptr ) THEN 327 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 423 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 424 DO jk = 1, jpk 425 DO jj = 1, jpj 426 DO ji = 1, jpi 427 zptry(ji,jj,jk) = zptry(ji,jj,jk) + zwy(ji,jj,jk) ! <<< Add to previously computed 428 END DO 429 END DO 430 END DO 328 431 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 329 432 ENDIF … … 662 765 zbig = 1.e+40_wp 663 766 zrtrn = 1.e-15_wp 664 zbetup(:,:,:) = 0._wp ; zbetdo(:,:,:) = 0._wp665 767 666 768 ! Search local extrema … … 672 774 & paft * tmask + zbig * ( 1._wp - tmask ) ) 673 775 776 !$OMP PARALLEL 777 !$OMP DO schedule(static) private(jk, jj, ji) 778 DO jk = 1, jpk 779 DO jj = 1, jpj 780 DO ji = 1, jpi 781 zbetup(ji,jj,jk) = 0._wp 782 zbetdo(ji,jj,jk) = 0._wp 783 END DO 784 END DO 785 END DO 786 !$OMP DO schedule(static) private(jk, jj, ji, ikm1, zup, zdo, zpos, zneg, zbt) 674 787 DO jk = 1, jpkm1 675 788 ikm1 = MAX(jk-1,1) … … 706 819 END DO 707 820 END DO 821 !$OMP END PARALLEL 708 822 CALL lbc_lnk( zbetup, 'T', 1. ) ; CALL lbc_lnk( zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) 709 823 710 824 ! 3. monotonic flux in the i & j direction (paa & pbb) 711 825 ! ---------------------------------------- 826 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, za, zb, zc, zav, zbv, zcv, zau, zbu, zcu) 712 827 DO jk = 1, jpkm1 713 828 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
r7646 r7698 327 327 IF( ierr /= 0 ) CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' ) 328 328 z1_t2 = 1._wp / ( rn_time * rn_time ) 329 !$OMP PARALLEL DO schedule(static) private(jj, ji, zfu, zfv) 329 330 DO jj = 2, jpj ! "coriolis+ time^-1" at u- & v-points 330 331 DO ji = fs_2, jpi ! vector opt. … … 347 348 ! 348 349 z1_t2 = 1._wp / ( rn_time * rn_time ) 349 r1_ft(:,:) = 1._wp / SQRT( ff_t(:,:) * ff_t(:,:) + z1_t2 ) 350 !$OMP PARALLEL DO schedule(static) private(jj, ji) 351 DO jj = 1, jpj 352 DO ji = 1, jpi 353 r1_ft(ji,jj) = 1._wp / SQRT( ff_t(ji,jj) * ff_t(ji,jj) + z1_t2 ) 354 END DO 355 END DO 350 356 ! 351 357 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
r7646 r7698 108 108 ! 109 109 ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 110 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 110 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 111 DO jk = 1, jpk 112 DO jj = 1, jpj 113 DO ji = 1, jpi 114 xind(ji,jj,jk) = 1._wp ! set equal to 1 where up-stream is not needed 115 END DO 116 END DO 117 END DO 111 118 ! 112 119 IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked) 113 120 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 114 upsmsk(:,:) = 0._wp ! not upstream by default 121 !$OMP PARALLEL 122 !$OMP DO schedule(static) private(jj, ji) 123 DO jj = 1, jpj 124 DO ji = 1, jpi 125 upsmsk(ji,jj) = 0._wp ! not upstream by default 126 END DO 127 END DO 115 128 ! 129 !$OMP DO schedule(static) private(jk,jj,ji) 116 130 DO jk = 1, jpkm1 117 xind(:,:,jk) = 1._wp & ! =>1 where up-stream is not needed 118 & - MAX ( rnfmsk(:,:) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 119 & upsmsk(:,:) ) * tmask(:,:,jk) ! =>0 in some user defined area 120 END DO 131 DO jj = 1, jpj 132 DO ji = 1, jpi 133 xind(ji,jj,jk) = 1._wp & ! =>1 where up-stream is not needed 134 & - MAX ( rnfmsk(ji,jj) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 135 & upsmsk(ji,jj) ) * tmask(ji,jj,jk) ! =>0 in some user defined area 136 END DO 137 END DO 138 END DO 139 !$OMP END DO NOWAIT 140 !$OMP END PARALLEL 121 141 ENDIF 122 142 ! … … 136 156 ! 137 157 ! !-- first guess of the slopes 138 zwx(:,:,jpk) = 0._wp ! bottom values 139 zwy(:,:,jpk) = 0._wp 158 !$OMP PARALLEL 159 !$OMP DO schedule(static) private(jj, ji) 160 DO jj = 1, jpj 161 DO ji = 1, jpi 162 zwx(ji,jj,jpk) = 0._wp ! bottom values 163 zwy(ji,jj,jpk) = 0._wp 164 END DO 165 END DO 166 !$OMP DO schedule(static) private(jk, jj, ji) 140 167 DO jk = 1, jpkm1 ! interior values 141 168 DO jj = 1, jpjm1 … … 146 173 END DO 147 174 END DO 175 !$OMP END DO NOWAIT 176 !$OMP END PARALLEL 148 177 CALL lbc_lnk( zwx, 'U', -1. ) ! lateral boundary conditions (changed sign) 149 178 CALL lbc_lnk( zwy, 'V', -1. ) 150 179 ! !-- Slopes of tracer 151 zslpx(:,:,jpk) = 0._wp ! bottom values 152 zslpy(:,:,jpk) = 0._wp 180 !$OMP PARALLEL 181 !$OMP DO schedule(static) private(jj, ji) 182 DO jj = 1, jpj 183 DO ji = 1, jpi 184 zslpx(ji,jj,jpk) = 0._wp ! bottom values 185 zslpy(ji,jj,jpk) = 0._wp 186 END DO 187 END DO 188 !$OMP DO schedule(static) private(jk, jj, ji) 153 189 DO jk = 1, jpkm1 ! interior values 154 190 DO jj = 2, jpj … … 162 198 END DO 163 199 ! 200 !$OMP DO schedule(static) private(jk, jj, ji) 164 201 DO jk = 1, jpkm1 !-- Slopes limitation 165 202 DO jj = 2, jpj … … 175 212 END DO 176 213 ! 214 !$OMP DO schedule(static) private(jk, jj, ji, z0u, zalpha, zu, zv, zzwx, zzwy, z0v) 177 215 DO jk = 1, jpkm1 !-- MUSCL horizontal advective fluxes 178 216 DO jj = 2, jpjm1 … … 195 233 END DO 196 234 END DO 235 !$OMP END DO NOWAIT 236 !$OMP END PARALLEL 197 237 CALL lbc_lnk( zwx, 'U', -1. ) ; CALL lbc_lnk( zwy, 'V', -1. ) ! lateral boundary conditions (changed sign) 198 238 ! 239 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 199 240 DO jk = 1, jpkm1 !-- Tracer advective trend 200 241 DO jj = 2, jpjm1 … … 219 260 ! 220 261 ! !-- first guess of the slopes 221 zwx(:,:, 1 ) = 0._wp ! surface & bottom boundary conditions 222 zwx(:,:,jpk) = 0._wp 262 !$OMP PARALLEL 263 !$OMP DO schedule(static) private(jj, ji) 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 zwx(ji,jj, 1 ) = 0._wp ! surface & bottom boundary conditions 267 zwx(ji,jj,jpk) = 0._wp 268 END DO 269 END DO 270 !$OMP DO schedule(static) private(jk, jj, ji) 223 271 DO jk = 2, jpkm1 ! interior values 224 zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 275 END DO 276 END DO 225 277 END DO 226 278 ! !-- Slopes of tracer 227 zslpx(:,:,1) = 0._wp ! surface values 279 !$OMP END DO NOWAIT 280 !$OMP DO schedule(static) private(jj, ji) 281 DO jj = 1, jpj 282 DO ji = 1, jpi 283 zslpx(ji,jj,1) = 0._wp ! surface values 284 END DO 285 END DO 286 !$OMP DO schedule(static) private(jk, jj, ji) 228 287 DO jk = 2, jpkm1 ! interior value 229 288 DO jj = 1, jpj … … 234 293 END DO 235 294 END DO 295 !$OMP DO schedule(static) private(jk, jj, ji) 236 296 DO jk = 2, jpkm1 !-- Slopes limitation 237 297 DO jj = 1, jpj ! interior values … … 243 303 END DO 244 304 END DO 305 !$OMP DO schedule(static) private(jk, jj, ji, z0w, zalpha, zw, zzwx, zzwy) 245 306 DO jk = 1, jpk-2 !-- vertical advective flux 246 307 DO jj = 2, jpjm1 … … 255 316 END DO 256 317 END DO 318 !$OMP END DO NOWAIT 319 !$OMP END PARALLEL 257 320 IF( ln_linssh ) THEN ! top values, linear free surface only 258 321 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 322 !$OMP PARALLEL DO schedule(static) private(jj, ji) 259 323 DO jj = 1, jpj 260 324 DO ji = 1, jpi … … 263 327 END DO 264 328 ELSE ! no cavities: only at the ocean surface 265 zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 329 !$OMP PARALLEL DO schedule(static) private(jj, ji) 330 DO jj = 1, jpj 331 DO ji = 1, jpi 332 zwx(ji,jj,1) = pwn(ji,jj,1) * ptb(ji,jj,1,jn) 333 END DO 334 END DO 266 335 ENDIF 267 336 ENDIF 268 337 ! 338 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 269 339 DO jk = 1, jpkm1 !-- vertical advective trend 270 340 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r7646 r7698 76 76 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 77 ! 78 INTEGER :: ji, jj ! dummy loop indices78 INTEGER :: ji, jj, jk ! dummy loop indices 79 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt 80 80 !!---------------------------------------------------------------------- … … 84 84 IF( l_trdtra ) THEN ! Save the input temperature trend 85 85 CALL wrk_alloc( jpi,jpj,jpk, ztrdt ) 86 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 86 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 87 DO jk = 1, jpk 88 DO jj = 1, jpj 89 DO ji = 1, jpi 90 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 91 END DO 92 END DO 93 END DO 87 94 ENDIF 88 95 ! ! Add the geothermal trend on temperature 96 !$OMP PARALLEL DO schedule(static) private(jj, ji) 89 97 DO jj = 2, jpjm1 90 98 DO ji = 2, jpim1 … … 96 104 ! 97 105 IF( l_trdtra ) THEN ! Send the trend for diagnostics 98 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 106 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 107 DO jk = 1, jpk 108 DO jj = 1, jpj 109 DO ji = 1, jpi 110 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 111 END DO 112 END DO 113 END DO 99 114 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 100 115 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt ) … … 162 177 CASE ( 1 ) !* constant flux 163 178 IF(lwp) WRITE(numout,*) ' *** constant heat flux = ', rn_geoflx_cst 164 qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst 179 !$OMP PARALLEL DO schedule(static) private(jj, ji) 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 qgh_trd0(ji,jj) = r1_rau0_rcp * rn_geoflx_cst 183 END DO 184 END DO 165 185 ! 166 186 CASE ( 2 ) !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 … … 179 199 180 200 CALL fld_read( nit000, 1, sf_qgh ) ! Read qgh data 181 qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2 201 !$OMP PARALLEL DO schedule(static) private(jj, ji) 202 DO jj = 1, jpj 203 DO ji = 1, jpi 204 qgh_trd0(ji,jj) = r1_rau0_rcp * sf_qgh(1)%fnow(ji,jj,1) * 1.e-3 ! conversion in W/m2 205 END DO 206 END DO 182 207 ! 183 208 CASE DEFAULT -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r7646 r7698 105 105 !!---------------------------------------------------------------------- 106 106 INTEGER, INTENT( in ) :: kt ! ocean time-step 107 INTEGER :: ji, jj, jk ! dummy loop indices 107 108 ! 108 109 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds … … 113 114 IF( l_trdtra ) THEN !* Save the input trends 114 115 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 115 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 116 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 116 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 117 DO jk = 1, jpk 118 DO jj = 1, jpj 119 DO ji = 1, jpi 120 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 121 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 122 END DO 123 END DO 124 END DO 117 125 ENDIF 118 126 … … 146 154 147 155 IF( l_trdtra ) THEN ! send the trends for further diagnostics 148 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 149 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 156 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 157 DO jk = 1, jpk 158 DO jj = 1, jpj 159 DO ji = 1, jpi 160 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 161 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 162 END DO 163 END DO 164 END DO 150 165 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 151 166 CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) … … 195 210 DO jn = 1, kjpt ! tracer loop 196 211 ! ! =========== 212 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik) 197 213 DO jj = 1, jpj 198 214 DO ji = 1, jpi … … 202 218 END DO 203 219 ! 220 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik) 204 221 DO jj = 2, jpjm1 ! Compute the trend 205 222 DO ji = 2, jpim1 … … 357 374 ENDIF 358 375 ! !* bottom variables (T, S, alpha, beta, depth, velocity) 376 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik) 359 377 DO jj = 1, jpj 360 378 DO ji = 1, jpi … … 374 392 IF( nn_bbl_ldf == 1 ) THEN ! diffusive bbl ! 375 393 ! !-------------------! 394 !$OMP PARALLEL DO schedule(static) private(jj,ji,za,zb,zgdrho,zsign) 376 395 DO jj = 1, jpjm1 ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 377 396 DO ji = 1, fs_jpim1 ! vector opt. … … 406 425 ! 407 426 CASE( 1 ) != use of upper velocity 427 !$OMP PARALLEL DO schedule(static) private(jj,ji,za,zb,zgdrho,zsign,zsigna) 408 428 DO jj = 1, jpjm1 ! criteria: grad(rho).grad(h)<0 and grad(rho).grad(h)<0 409 429 DO ji = 1, fs_jpim1 ! vector opt. … … 437 457 CASE( 2 ) != bbl velocity = F( delta rho ) 438 458 zgbbl = grav * rn_gambbl 459 !$OMP PARALLEL DO schedule(static) private(jj,ji,iid,iis,ikud,ikus,za,zb,zgdrho,ijd,ijs,ikvd,ikvs) 439 460 DO jj = 1, jpjm1 ! criteria: rho_up > rho_down 440 461 DO ji = 1, fs_jpim1 ! vector opt. … … 533 554 534 555 ! !* vertical index of "deep" bottom u- and v-points 556 !$OMP PARALLEL DO schedule(static) private(jj,ji) 535 557 DO jj = 1, jpjm1 ! (the "shelf" bottom k-indices are mbku and mbkv) 536 558 DO ji = 1, jpim1 … … 547 569 ! !* sign of grad(H) at u- and v-points 548 570 mgrhu(jpi,:) = 0 ; mgrhu(:,jpj) = 0 ; mgrhv(jpi,:) = 0 ; mgrhv(:,jpj) = 0 571 !$OMP PARALLEL DO schedule(static) private(jj,ji) 549 572 DO jj = 1, jpjm1 550 573 DO ji = 1, jpim1 … … 554 577 END DO 555 578 ! 579 !$OMP PARALLEL DO schedule(static) private(jj,ji) 556 580 DO jj = 1, jpjm1 !* bbl thickness at u- (v-) point 557 581 DO ji = 1, jpim1 ! minimum of top & bottom e3u_0 (e3v_0) … … 563 587 ! 564 588 ! !* masked diffusive flux coefficients 565 ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 566 ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 589 !$OMP PARALLEL DO schedule(static) private(jj,ji) 590 DO jj = 1, jpj 591 DO ji = 1, jpi 592 ahu_bbl_0(ji,jj) = rn_ahtbbl * e2_e1u(ji,jj) * e3u_bbl_0(ji,jj) * umask(ji,jj,1) 593 ahv_bbl_0(ji,jj) = rn_ahtbbl * e1_e2v(ji,jj) * e3v_bbl_0(ji,jj) * vmask(ji,jj,1) 594 END DO 595 END DO 567 596 568 597 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r7646 r7698 102 102 IF( l_trdtra ) THEN !* Save ta and sa trends 103 103 CALL wrk_alloc( jpi,jpj,jpk,jpts, ztrdts ) 104 ztrdts(:,:,:,:) = tsa(:,:,:,:) 104 DO jn = 1, jpts 105 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 106 DO jk = 1, jpk 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 ztrdts(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) 110 END DO 111 END DO 112 END DO 113 END DO 105 114 ENDIF 106 115 ! !== input T-S data at kt ==! … … 111 120 CASE( 0 ) !* newtonian damping throughout the water column *! 112 121 DO jn = 1, jpts 122 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 113 123 DO jk = 1, jpkm1 114 124 DO jj = 2, jpjm1 … … 121 131 ! 122 132 CASE ( 1 ) !* no damping in the turbocline (avt > 5 cm2/s) *! 133 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 123 134 DO jk = 1, jpkm1 124 135 DO jj = 2, jpjm1 … … 135 146 ! 136 147 CASE ( 2 ) !* no damping in the mixed layer *! 148 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 137 149 DO jk = 1, jpkm1 138 150 DO jj = 2, jpjm1 … … 151 163 ! 152 164 IF( l_trdtra ) THEN ! trend diagnostic 153 ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:) 165 DO jn = 1, jpts 166 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 167 DO jk = 1, jpk 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 ztrdts(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) - ztrdts(ji,jj,jk,jn) 171 END DO 172 END DO 173 END DO 174 END DO 154 175 CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 155 176 CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r7646 r7698 57 57 !!---------------------------------------------------------------------- 58 58 INTEGER, INTENT( in ) :: kt ! ocean time-step index 59 INTEGER :: jk, jj, ji ! dummy loop indices 59 60 !! 60 61 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds … … 65 66 IF( l_trdtra ) THEN !* Save ta and sa trends 66 67 CALL wrk_alloc( jpi,jpj,jpk, ztrdt, ztrds ) 67 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 68 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 68 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 69 DO jk = 1, jpk 70 DO jj = 1, jpj 71 DO ji = 1, jpi 72 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 73 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 74 END DO 75 END DO 76 END DO 69 77 ENDIF 70 78 ! … … 81 89 ! 82 90 IF( l_trdtra ) THEN !* save the horizontal diffusive trends for further diagnostics 83 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 84 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 91 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 92 DO jk = 1, jpk 93 DO jj = 1, jpj 94 DO ji = 1, jpi 95 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 96 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 97 END DO 98 END DO 99 END DO 85 100 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 86 101 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r7646 r7698 125 125 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 126 126 ! 127 akz (:,:,:) = 0._wp 128 ah_wslp2(:,:,:) = 0._wp 127 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 128 DO jk = 1, jpk 129 DO jj = 1, jpj 130 DO ji = 1, jpi 131 akz (ji,jj,jk) = 0._wp 132 ah_wslp2(ji,jj,jk) = 0._wp 133 END DO 134 END DO 135 END DO 129 136 ENDIF 130 137 ! … … 151 158 IF( kpass == 1 ) THEN !== first pass only ==! 152 159 ! 160 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w) 153 161 DO jk = 2, jpkm1 154 162 DO jj = 2, jpjm1 … … 172 180 ! 173 181 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 182 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 174 183 DO jk = 2, jpkm1 175 184 DO jj = 2, jpjm1 … … 185 194 ! 186 195 IF( ln_traldf_blp ) THEN ! bilaplacian operator 196 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 187 197 DO jk = 2, jpkm1 188 198 DO jj = 1, jpjm1 … … 194 204 END DO 195 205 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 206 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ze3w_2, zcoef0) 196 207 DO jk = 2, jpkm1 197 208 DO jj = 1, jpjm1 … … 206 217 ! 207 218 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 208 akz(:,:,:) = ah_wslp2(:,:,:) 219 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 220 DO jk = 1, jpk 221 DO jj = 1, jpj 222 DO ji = 1, jpi 223 akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 224 END DO 225 END DO 226 END DO 209 227 ENDIF 210 228 ENDIF … … 218 236 !!---------------------------------------------------------------------- 219 237 !!gm : bug.... why (x,:,:)? (1,jpj,:) and (jpi,1,:) should be sufficient.... 220 zdit (1,:,:) = 0._wp ; zdit (jpi,:,:) = 0._wp 221 zdjt (1,:,:) = 0._wp ; zdjt (jpi,:,:) = 0._wp 238 !$OMP PARALLEL 239 !$OMP DO schedule(static) private(jk, jj) 240 DO jk = 1, jpk 241 DO jj = 1, jpj 242 zdit (1,jj,jk) = 0._wp ; zdit (jpi,jj,jk) = 0._wp 243 zdjt (1,jj,jk) = 0._wp ; zdjt (jpi,jj,jk) = 0._wp 244 END DO 245 END DO 222 246 !!end 223 247 224 248 ! Horizontal tracer gradient 249 !$OMP DO schedule(static) private(jk, jj, ji) 225 250 DO jk = 1, jpkm1 226 251 DO jj = 1, jpjm1 … … 231 256 END DO 232 257 END DO 258 !$OMP END PARALLEL 233 259 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 260 !$OMP PARALLEL DO schedule(static) private(jj, ji) 234 261 DO jj = 1, jpjm1 ! bottom correction (partial bottom cell) 235 262 DO ji = 1, fs_jpim1 ! vector opt. … … 239 266 END DO 240 267 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 268 !$OMP PARALLEL DO schedule(static) private(jj, ji) 241 269 DO jj = 1, jpjm1 242 270 DO ji = 1, fs_jpim1 ! vector opt. … … 252 280 !!---------------------------------------------------------------------- 253 281 ! 282 !$OMP PARALLEL 254 283 DO jk = 1, jpkm1 ! Horizontal slab 255 284 ! 256 285 ! !== Vertical tracer gradient 257 zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1) ! level jk+1 258 ! 259 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:) ! surface: zdkt(jk=1)=zdkt(jk=2) 260 ELSE ; zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk) 286 !$OMP DO schedule(static) private(jj, ji) 287 DO jj = 1 , jpj 288 DO ji = 1, jpi 289 zdk1t(ji,jj) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) ! level jk+1 290 END DO 291 END DO 292 ! 293 IF( jk == 1 ) THEN 294 !$OMP DO schedule(static) private(jj, ji) 295 DO jj = 1 , jpj 296 DO ji = 1, jpi 297 zdkt(ji,jj) = zdk1t(ji,jj) ! surface: zdkt(jk=1)=zdkt(jk=2) 298 END DO 299 END DO 300 ELSE 301 !$OMP DO schedule(static) private(jj, ji) 302 DO jj = 1 , jpj 303 DO ji = 1, jpi 304 zdkt(ji,jj) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 305 END DO 306 END DO 261 307 ENDIF 308 !$OMP DO schedule(static) private(jj, ji, zmsku, zmskv, zabe1, zabe2, zcof1, zcof2) 262 309 DO jj = 1 , jpjm1 !== Horizontal fluxes 263 310 DO ji = 1, fs_jpim1 ! vector opt. … … 283 330 END DO 284 331 ! 332 !$OMP DO schedule(static) private(jj, ji) 285 333 DO jj = 2 , jpjm1 !== horizontal divergence and add to pta 286 334 DO ji = fs_2, fs_jpim1 ! vector opt. … … 296 344 !!---------------------------------------------------------------------- 297 345 ! 298 ztfw(1,:,:) = 0._wp ; ztfw(jpi,:,:) = 0._wp 346 !$OMP DO schedule(static) private(jk, jj) 347 DO jk = 1, jpk 348 DO jj = 1, jpj 349 ztfw(1,jj,jk) = 0._wp ; ztfw(jpi,jj,jk) = 0._wp 350 END DO 351 END DO 299 352 ! 300 353 ! Vertical fluxes 301 354 ! --------------- 302 355 ! ! Surface and bottom vertical fluxes set to zero 303 ztfw(:,:, 1 ) = 0._wp ; ztfw(:,:,jpk) = 0._wp 356 !$OMP DO schedule(static) private(jj, ji) 357 DO jj = 1, jpj 358 DO ji = 1, jpi 359 ztfw(ji,jj, 1 ) = 0._wp ; ztfw(ji,jj,jpk) = 0._wp 360 END DO 361 END DO 304 362 363 !$OMP DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w, zcoef3, zcoef4) 305 364 DO jk = 2, jpkm1 ! interior (2=<jk=<jpk-1) 306 365 DO jj = 2, jpjm1 … … 327 386 END DO 328 387 END DO 388 !$OMP END PARALLEL 329 389 ! !== add the vertical 33 flux ==! 330 390 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 391 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 331 392 DO jk = 2, jpkm1 332 393 DO jj = 1, jpjm1 … … 342 403 SELECT CASE( kpass ) 343 404 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 405 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 344 406 DO jk = 2, jpkm1 345 407 DO jj = 1, jpjm1 … … 352 414 END DO 353 415 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb and ptbb gradients, resp. 416 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 354 417 DO jk = 2, jpkm1 355 418 DO jj = 1, jpjm1 … … 364 427 ENDIF 365 428 ! 429 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 366 430 DO jk = 1, jpkm1 !== Divergence of vertical fluxes added to pta ==! 367 431 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r7646 r7698 121 121 IF( l_trdtra ) THEN 122 122 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 123 ztrdt(:,:,jk) = 0._wp 124 ztrds(:,:,jk) = 0._wp 123 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 124 DO jk = 1, jpk 125 DO jj = 1, jpj 126 DO ji = 1, jpi 127 ztrdt(ji,jj,jk) = 0._wp 128 ztrds(ji,jj,jk) = 0._wp 129 END DO 130 END DO 131 END DO 125 132 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 126 133 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) … … 129 136 ! total trend for the non-time-filtered variables. 130 137 zfact = 1.0 / rdt 131 DO jk = 1, jpkm1 132 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 133 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact 138 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 139 DO jk = 1, jpkm1 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 ztrdt(ji,jj,jk) = ( tsa(ji,jj,jk,jp_tem) - tsn(ji,jj,jk,jp_tem) ) * zfact 143 ztrds(ji,jj,jk) = ( tsa(ji,jj,jk,jp_sal) - tsn(ji,jj,jk,jp_sal) ) * zfact 144 END DO 145 END DO 134 146 END DO 135 147 CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) … … 137 149 ! Store now fields before applying the Asselin filter 138 150 ! in order to calculate Asselin filter trend later. 139 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 140 ztrds(:,:,:) = tsn(:,:,:,jp_sal) 151 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 152 DO jk = 1, jpkm1 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 ztrdt(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) 156 ztrds(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) 157 END DO 158 END DO 159 END DO 141 160 ENDIF 142 161 143 162 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step (only swap) 144 163 DO jn = 1, jpts 164 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 145 165 DO jk = 1, jpkm1 146 tsn(:,:,jk,jn) = tsa(:,:,jk,jn) 166 DO jj = 1, jpj 167 DO ji = 1, jpi 168 tsn(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) 169 END DO 170 END DO 147 171 END DO 148 172 END DO … … 163 187 ! 164 188 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 165 DO jk = 1, jpkm1 166 zfact = 1._wp / r2dt 167 ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 168 ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 189 !$OMP PARALLEL DO schedule(static) private(jk, zfact) 190 DO jk = 1, jpkm1 191 DO jj = 1, jpj 192 DO ji = 1, jpi 193 zfact = 1._wp / r2dt 194 ztrdt(ji,jj,jk) = ( tsb(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) ) * zfact 195 ztrds(ji,jj,jk) = ( tsb(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) ) * zfact 196 END DO 197 END DO 169 198 END DO 170 199 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) … … 214 243 DO jn = 1, kjpt 215 244 ! 245 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztn,ztd) 216 246 DO jk = 1, jpkm1 217 247 DO jj = 2, jpjm1 … … 280 310 ! 281 311 DO jn = 1, kjpt 312 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact1,zfact2,ze3t_b,ze3t_n,ze3t_a,ze3t_d,ze3t_f,ztc_b,ztc_n,ztc_a,ztc_d,ztc_f) 282 313 DO jk = 1, jpkm1 283 314 zfact1 = atfp * p2dt -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r7646 r7698 128 128 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 129 129 CALL wrk_alloc( jpi,jpj,jpk, ztrdt ) 130 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 130 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 131 DO jk = 1, jpk 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 135 END DO 136 END DO 137 END DO 131 138 ENDIF 132 139 ! … … 142 149 ELSE ! No restart or restart not found: Euler forward time stepping 143 150 z1_2 = 1._wp 144 qsr_hc_b(:,:,:) = 0._wp 151 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 152 DO jk = 1, jpk 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 qsr_hc_b(ji,jj,jk) = 0._wp 156 END DO 157 END DO 158 END DO 145 159 ENDIF 146 160 ELSE !== Swap of qsr heat content ==! 147 161 z1_2 = 0.5_wp 148 qsr_hc_b(:,:,:) = qsr_hc(:,:,:) 162 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 163 DO jk = 1, jpk 164 DO jj = 1, jpj 165 DO ji = 1, jpi 166 qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 167 END DO 168 END DO 169 END DO 149 170 ENDIF 150 171 ! … … 155 176 CASE( np_BIO ) !== bio-model fluxes ==! 156 177 ! 178 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 157 179 DO jk = 1, nksr 158 qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 183 END DO 184 END DO 159 185 END DO 160 186 ! … … 166 192 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll 167 193 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 194 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zchl,zCtot,zze,zpsi,zlogc,zlogc2,zlogc3,zCb,zCmax,zpsimax,zdelpsi,zCze) 168 195 DO jk = 1, nksr + 1 169 196 DO jj = 2, jpjm1 ! Separation in R-G-B depending of the surface Chl … … 190 217 END DO 191 218 ELSE !* constant chrlorophyll 219 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 192 220 DO jk = 1, nksr + 1 193 zchl3d(:,:,jk) = 0.05 221 DO jj = 1, jpj 222 DO ji = 1, jpi 223 zchl3d(ji,jj,jk) = 0.05 224 ENDDO 225 ENDDO 194 226 ENDDO 195 227 ENDIF 196 228 ! 197 229 zcoef = ( 1. - rn_abs ) / 3._wp !* surface equi-partition in R-G-B 230 !$OMP PARALLEL 231 !$OMP DO schedule(static) private(jj,ji) 198 232 DO jj = 2, jpjm1 199 233 DO ji = fs_2, fs_jpim1 … … 205 239 END DO 206 240 END DO 241 !$OMP END DO NOWAIT 207 242 ! 208 243 DO jk = 2, nksr+1 !* interior equi-partition in R-G-B depending of vertical profile of Chl 244 !$OMP DO schedule(static) private(jj,ji,zchl,irgb) 209 245 DO jj = 2, jpjm1 210 246 DO ji = fs_2, fs_jpim1 … … 217 253 END DO 218 254 255 !$OMP DO schedule(static) private(jj,ji,zc0,zc1,zc2,zc3) 219 256 DO jj = 2, jpjm1 220 257 DO ji = fs_2, fs_jpim1 … … 232 269 END DO 233 270 ! 271 !$OMP DO schedule(static) private(jk,jj,ji) 234 272 DO jk = 1, nksr !* now qsr induced heat content 235 273 DO jj = 2, jpjm1 … … 239 277 END DO 240 278 END DO 279 !$OMP END PARALLEL 241 280 ! 242 281 CALL wrk_dealloc( jpi,jpj, zekb, zekg, zekr ) … … 247 286 zz0 = rn_abs * r1_rau0_rcp ! surface equi-partition in 2-bands 248 287 zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 288 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zc0,zc1) 249 289 DO jk = 1, nksr ! solar heat absorbed at T-point in the top 400m 250 290 DO jj = 2, jpjm1 … … 260 300 ! 261 301 ! !-----------------------------! 302 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 262 303 DO jk = 1, nksr ! update to the temp. trend ! 263 304 DO jj = 2, jpjm1 !-----------------------------! … … 270 311 ! 271 312 IF( ln_qsr_ice ) THEN ! sea-ice: store the 1st ocean level attenuation coefficient 313 !$OMP PARALLEL DO schedule(static) private(jj,ji) 272 314 DO jj = 2, jpjm1 273 315 DO ji = fs_2, fs_jpim1 ! vector opt. … … 284 326 CALL wrk_alloc( jpi,jpj,jpk, zetot ) 285 327 ! 286 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 328 !$OMP PARALLEL 329 !$OMP DO schedule(static) private(jj,ji) 330 DO jj = 1, jpj 331 DO ji = 1, jpi ! vector opt. 332 zetot(ji,jj,nksr+1:jpk) = 0._wp ! below ~400m set to zero 333 END DO 334 END DO 287 335 DO jk = nksr, 1, -1 288 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp 336 !$OMP DO schedule(static) private(jj,ji) 337 DO jj = 1, jpj 338 DO ji = 1, jpi ! vector opt. 339 zetot(ji,jj,jk) = zetot(ji,jj,jk+1) + qsr_hc(ji,jj,jk) / r1_rau0_rcp 340 END DO 341 END DO 289 342 END DO 343 !$OMP END PARALLEL 290 344 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 291 345 ! … … 299 353 ! 300 354 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 301 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 355 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 356 DO jk = 1, jpk 357 DO jj = 1, jpj 358 DO ji = 1, jpi 359 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 360 END DO 361 END DO 362 END DO 302 363 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 303 364 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt ) … … 426 487 END SELECT 427 488 ! 428 qsr_hc(:,:,:) = 0._wp ! now qsr heat content set to zero where it will not be computed 489 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 490 DO jk = 1, jpk 491 DO jj = 1, jpj 492 DO ji = 1, jpi 493 qsr_hc(ji,jj,jk) = 0._wp ! now qsr heat content set to zero where it will not be computed 494 END DO 495 END DO 496 END DO 429 497 ! 430 498 ! 1st ocean level attenuation coefficient (used in sbcssm) … … 432 500 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 433 501 ELSE 434 fraqsr_1lev(:,:) = 1._wp ! default : no penetration 502 !$OMP PARALLEL DO schedule(static) private(jj,ji) 503 DO jj = 1, jpj 504 DO ji = 1, jpi 505 fraqsr_1lev(ji,jj) = 1._wp ! default : no penetration 506 END DO 507 END DO 435 508 ENDIF 436 509 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r6701 r7698 88 88 IF( l_trdtra ) THEN !* Save ta and sa trends 89 89 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 90 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 91 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 90 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 91 DO jk = 1, jpk 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 95 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 96 END DO 97 END DO 98 END DO 92 99 ENDIF 93 100 ! 94 101 !!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 95 102 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 96 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 97 qsr(:,:) = 0._wp ! qsr set to zero 103 !$OMP PARALLEL DO schedule(static) private(jj, ji) 104 DO jj = 1, jpj 105 DO ji = 1, jpi 106 qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) ! total heat flux in qns 107 qsr(ji,jj) = 0._wp ! qsr set to zero 108 END DO 109 END DO 98 110 ENDIF 99 111 … … 111 123 ELSE ! No restart or restart not found: Euler forward time stepping 112 124 zfact = 1._wp 113 sbc_tsc(:,:,:) = 0._wp 114 sbc_tsc_b(:,:,:) = 0._wp 125 DO jn = 1, jpts 126 !$OMP PARALLEL DO schedule(static) private(jj, ji) 127 DO jj = 1, jpj 128 DO ji = 1, jpi 129 sbc_tsc(ji,jj,jn) = 0._wp 130 sbc_tsc_b(ji,jj,jn) = 0._wp 131 END DO 132 END DO 133 END DO 115 134 ENDIF 116 135 ELSE !* other time-steps: swap of forcing fields 117 136 zfact = 0.5_wp 118 sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 137 DO jn = 1, jpts 138 !$OMP PARALLEL DO schedule(static) private(jj, ji) 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 sbc_tsc_b(ji,jj,jn) = sbc_tsc(ji,jj,jn) 142 END DO 143 END DO 144 END DO 119 145 ENDIF 120 146 ! !== Now sbc tracer content fields ==! 147 !$OMP PARALLEL DO schedule(static) private(jj, ji) 121 148 DO jj = 2, jpj 122 149 DO ji = fs_2, fs_jpim1 ! vector opt. … … 126 153 END DO 127 154 IF( ln_linssh ) THEN !* linear free surface 155 !$OMP PARALLEL DO schedule(static) private(jj, ji) 128 156 DO jj = 2, jpj !==>> add concentration/dilution effect due to constant volume cell 129 157 DO ji = fs_2, fs_jpim1 ! vector opt. … … 137 165 ! 138 166 DO jn = 1, jpts !== update tracer trend ==! 167 !$OMP PARALLEL DO schedule(static) private(jj, ji) 139 168 DO jj = 2, jpj 140 169 DO ji = fs_2, fs_jpim1 ! vector opt. … … 218 247 ! 219 248 IF( ln_iscpl .AND. ln_hsb) THEN ! input of heat and salt due to river runoff 249 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zdep) 220 250 DO jk = 1,jpk 221 251 DO jj = 2, jpj … … 232 262 233 263 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics 234 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 235 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 264 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 265 DO jk = 1, jpk 266 DO jj = 1, jpj 267 DO ji = 1, jpi 268 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 269 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 270 END DO 271 END DO 272 END DO 236 273 CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 237 274 CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r7646 r7698 58 58 INTEGER, INTENT( in ) :: kt ! ocean time-step index 59 59 ! 60 INTEGER :: jk 60 INTEGER :: jk, jj, ji ! Dummy loop indices 61 61 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 62 62 !!--------------------------------------------------------------------- … … 72 72 IF( l_trdtra ) THEN !* Save ta and sa trends 73 73 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 74 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 75 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 74 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 75 DO jk = 1, jpk 76 DO jj = 1, jpj 77 DO ji = 1, jpi 78 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 79 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 80 END DO 81 END DO 82 END DO 76 83 ENDIF 77 84 ! … … 84 91 ! JMM avoid negative salinities near river outlet ! Ugly fix 85 92 ! JMM : restore negative salinities to small salinities: 86 WHERE( tsa(:,:,:,jp_sal) < 0._wp ) tsa(:,:,:,jp_sal) = 0.1_wp 93 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 94 DO jk = 1, jpk 95 DO jj = 1, jpj 96 DO ji = 1, jpi 97 IF( tsa(ji,jj,jk,jp_sal) < 0._wp ) tsa(ji,jj,jk,jp_sal) = 0.1_wp 98 END DO 99 END DO 100 END DO 87 101 !!gm 88 102 89 103 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 104 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 90 105 DO jk = 1, jpkm1 91 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt ) - ztrdt(:,:,jk) 92 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt ) - ztrds(:,:,jk) 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 ztrdt(ji,jj,jk) = ( ( tsa(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) / r2dt ) - ztrdt(ji,jj,jk) 109 ztrds(ji,jj,jk) = ( ( tsa(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) / r2dt ) - ztrds(ji,jj,jk) 110 END DO 111 END DO 93 112 END DO 94 113 !!gm this should be moved in trdtra.F90 and done on all trends -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r6140 r7698 106 106 ! 107 107 ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers 108 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN ; zwt(:,:,2:jpk) = avt (:,:,2:jpk) 109 ELSE ; zwt(:,:,2:jpk) = fsavs(:,:,2:jpk) 108 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 109 !$OMP PARALLEL DO schedule(static) private(jj, ji) 110 DO jj = 1, jpj 111 DO ji = 1, jpi 112 zwt(ji,jj,2:jpk) = avt (ji,jj,2:jpk) 113 END DO 114 END DO 115 ELSE 116 !$OMP PARALLEL DO schedule(static) private(jj, ji) 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 zwt(ji,jj,2:jpk) = fsavs(ji,jj,2:jpk) 120 END DO 121 END DO 110 122 ENDIF 111 zwt(:,:,1) = 0._wp 123 !$OMP PARALLEL DO schedule(static) private(jj, ji) 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 zwt(ji,jj,1) = 0._wp 127 END DO 128 END DO 112 129 ! 113 130 IF( l_ldfslp ) THEN ! isoneutral diffusion: add the contribution 114 131 IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator 132 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 115 133 DO jk = 2, jpkm1 116 134 DO jj = 2, jpjm1 … … 121 139 END DO 122 140 ELSE ! standard or triad iso-neutral operator 141 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 123 142 DO jk = 2, jpkm1 124 143 DO jj = 2, jpjm1 … … 132 151 ! 133 152 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 153 !$OMP PARALLEL 154 !$OMP DO schedule(static) private(jk, jj, ji) 134 155 DO jk = 1, jpkm1 135 156 DO jj = 2, jpjm1 … … 162 183 ! used as a work space array: its value is modified. 163 184 ! 185 !$OMP DO schedule(static) private(jj, ji) 164 186 DO jj = 2, jpjm1 !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) 165 187 DO ji = fs_2, fs_jpim1 ! done one for all passive tracers (so included in the IF instruction) … … 167 189 END DO 168 190 END DO 191 !$OMP END DO NOWAIT 169 192 DO jk = 2, jpkm1 193 !$OMP DO schedule(static) private(jj, ji) 170 194 DO jj = 2, jpjm1 171 195 DO ji = fs_2, fs_jpim1 … … 174 198 END DO 175 199 END DO 200 !$OMP END PARALLEL 176 201 ! 177 202 ENDIF 178 203 ! 204 !$OMP PARALLEL 205 !$OMP DO schedule(static) private(jj, ji) 179 206 DO jj = 2, jpjm1 !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 180 207 DO ji = fs_2, fs_jpim1 … … 183 210 END DO 184 211 DO jk = 2, jpkm1 212 !$OMP DO schedule(static) private(jj, ji, zrhs) 185 213 DO jj = 2, jpjm1 186 214 DO ji = fs_2, fs_jpim1 … … 191 219 END DO 192 220 ! 221 !$OMP DO schedule(static) private(jj, ji) 193 222 DO jj = 2, jpjm1 !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk (result is the after tracer) 194 223 DO ji = fs_2, fs_jpim1 … … 197 226 END DO 198 227 DO jk = jpk-2, 1, -1 228 !$OMP DO schedule(static) private(jj, ji) 199 229 DO jj = 2, jpjm1 200 230 DO ji = fs_2, fs_jpim1 … … 204 234 END DO 205 235 END DO 236 !$OMP END PARALLEL 206 237 ! ! ================= ! 207 238 END DO ! end tracer loop ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r6140 r7698 101 101 IF( nn_timing == 1 ) CALL timing_start( 'zps_hde') 102 102 ! 103 pgtu(:,:,:)=0._wp ; zti (:,:,:)=0._wp ; zhi (:,: )=0._wp 104 pgtv(:,:,:)=0._wp ; ztj (:,:,:)=0._wp ; zhj (:,: )=0._wp 103 DO jn = 1, kjpt 104 !$OMP PARALLEL DO schedule(static) private(jj,ji) 105 DO jj = 1, jpjm1 106 DO ji = 1, jpim1 107 pgtu(ji,jj,jn)=0._wp ; zti (ji,jj,jn)=0._wp 108 pgtv(ji,jj,jn)=0._wp ; ztj (ji,jj,jn)=0._wp 109 END DO 110 END DO 111 END DO 112 !$OMP PARALLEL DO schedule(static) private(jj,ji) 113 DO jj = 1, jpjm1 114 DO ji = 1, jpim1 115 zhi (ji,jj )=0._wp 116 zhj (ji,jj )=0._wp 117 END DO 118 END DO 105 119 ! 106 120 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 107 121 ! 122 !$OMP PARALLEL DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv,zmaxu,zmaxv) 108 123 DO jj = 1, jpjm1 109 124 DO ji = 1, jpim1 … … 150 165 ! 151 166 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 152 pgru(:,:) = 0._wp 153 pgrv(:,:) = 0._wp ! depth of the partial step level 167 !$OMP PARALLEL 168 !$OMP DO schedule(static) private(jj,ji) 169 DO jj = 1, jpjm1 170 DO ji = 1, jpim1 171 pgru(ji,jj) = 0._wp 172 pgrv(ji,jj) = 0._wp ! depth of the partial step level 173 END DO 174 END DO 175 !$OMP END DO NOWAIT 176 !$OMP DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv) 154 177 DO jj = 1, jpjm1 155 178 DO ji = 1, jpim1 … … 166 189 END DO 167 190 END DO 191 !$OMP END DO NOWAIT 192 !$OMP END PARALLEL 168 193 ! 169 194 CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj 170 195 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 171 196 ! 197 !$OMP PARALLEL DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv) 172 198 DO jj = 1, jpjm1 ! Gradient of density at the last level 173 199 DO ji = 1, jpim1 -
trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_closea.F90
r7427 r7698 388 388 ! 389 389 DO jc = 1, jpncs 390 !$OMP PARALLEL DO schedule(static) private(jj,ji) 390 391 DO jj = ncsj1(jc), ncsj2(jc) 391 392 DO ji = ncsi1(jc), ncsi2(jc) -
trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_hgr.F90
r6960 r7698 103 103 ENDIF 104 104 ! 105 !$OMP PARALLEL 106 !$OMP DO schedule(static) private(jj, ji, zim1, zjm1) 105 107 DO jj = 1, jpj 106 108 DO ji = 1, jpi … … 129 131 END DO 130 132 END DO 133 !$OMP END DO NOWAIT 131 134 ! 132 135 ! !== Horizontal scale factors ==! (in meters) 133 136 ! 134 137 ! ! constant grid spacing 135 pe1t(:,:) = ze1 ; pe2t(:,:) = ze1 136 pe1u(:,:) = ze1 ; pe2u(:,:) = ze1 137 pe1v(:,:) = ze1 ; pe2v(:,:) = ze1 138 pe1f(:,:) = ze1 ; pe2f(:,:) = ze1 139 ! 140 ! ! NO reduction of grid size in some straits 138 !$OMP DO schedule(static) private(jj, ji) 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 pe1t(ji,jj) = ze1 ; pe2t(ji,jj) = ze1 142 pe1u(ji,jj) = ze1 ; pe2u(ji,jj) = ze1 143 pe1v(ji,jj) = ze1 ; pe2v(ji,jj) = ze1 144 pe1f(ji,jj) = ze1 ; pe2f(ji,jj) = ze1 145 ! 146 ! ! NO reduction of grid size in some straits 147 pe1e2u(ji,jj) = 0._wp ! CAUTION: set to zero to avoid error with some compilers that 148 pe1e2v(ji,jj) = 0._wp ! require an initialization of INTENT(out) arguments 149 END DO 150 END DO 151 !$OMP END PARALLEL 141 152 ke1e2u_v = 0 ! ==>> u_ & v_surfaces will be computed in dom_ghr routine 142 pe1e2u(:,:) = 0._wp ! CAUTION: set to zero to avoid error with some compilers that143 pe1e2v(:,:) = 0._wp ! require an initialization of INTENT(out) arguments144 153 ! 145 154 ! … … 153 162 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 154 163 ! 155 pff_f(:,:) = ( zf0 + zbeta * ABS( pphif(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 156 pff_t(:,:) = ( zf0 + zbeta * ABS( pphit(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 164 !$OMP PARALLEL DO schedule(static) private(jj, ji) 165 DO jj = 1, jpj 166 DO ji = 1, jpi 167 pff_f(ji,jj) = ( zf0 + zbeta * ABS( pphif(ji,jj) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 168 pff_t(ji,jj) = ( zf0 + zbeta * ABS( pphit(ji,jj) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 169 END DO 170 END DO 157 171 ! 158 172 IF(lwp) WRITE(numout,*) ' beta-plane used. beta = ', zbeta, ' 1/(s.m)' -
trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_istate.F90
r6923 r7698 55 55 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ Ocean at rest, with an horizontally uniform T and S profiles' 56 56 ! 57 pu (:,:,:) = 0._wp ! ocean at rest 58 pv (:,:,:) = 0._wp 59 pssh(:,:) = 0._wp 57 !$OMP PARALLEL 58 !$OMP DO schedule(static) private(jk,jj,ji) 59 DO jk = 1, jpk 60 DO jj = 1, jpj 61 DO ji = 1, jpi 62 pu (ji,jj,jk) = 0._wp ! ocean at rest 63 pv (ji,jj,jk) = 0._wp 64 END DO 65 END DO 66 END DO 67 !$OMP END DO NOWAIT 68 !$OMP DO schedule(static) private(jj,ji) 69 DO jj = 1, jpj 70 DO ji = 1, jpi 71 pssh(ji,jj) = 0._wp 72 END DO 73 END DO 74 !$OMP END DO NOWAIT 60 75 ! 76 !$OMP DO schedule(static) private(jk,jj,ji) 61 77 DO jk = 1, jpk ! horizontally uniform T & S profiles 62 78 DO jj = 1, jpj … … 79 95 END DO 80 96 END DO 97 !$OMP END PARALLEL 81 98 ! 82 99 END SUBROUTINE usr_def_istate -
trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90
r7426 r7698 109 109 ztrp= - 40.e0 ! retroaction term on heat fluxes (W/m2/K) 110 110 zconv = 3.16e-5 ! convertion factor: 1 m/yr => 3.16e-5 mm/s 111 !$OMP PARALLEL DO schedule(static) private(jj, ji, t_star) 111 112 DO jj = 1, jpj 112 113 DO ji = 1, jpi … … 137 138 138 139 ! freshwater (mass flux) and update of qns with heat content of emp 139 emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1) ! freshwater flux (=0 in domain average) 140 sfx (:,:) = 0.0_wp ! no salt flux 141 qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! evap and precip are at SST 140 !$OMP PARALLEL DO schedule(static) private(jj, ji) 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 emp (ji,jj) = emp(ji,jj) - zsumemp * tmask(ji,jj,1) ! freshwater flux (=0 in domain average) 144 sfx (ji,jj) = 0.0_wp ! no salt flux 145 qns (ji,jj) = qns(ji,jj) - emp(ji,jj) * sst_m(ji,jj) * rcp ! evap and precip are at SST 146 END DO 147 END DO 142 148 143 149 … … 166 172 ztau_sais = 0.015 167 173 ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi ) 174 !$OMP PARALLEL 175 !$OMP DO schedule(static) private(jj, ji) 168 176 DO jj = 1, jpj 169 177 DO ji = 1, jpi … … 177 185 ! module of wind stress and wind speed at T-point 178 186 zcoef = 1. / ( zrhoa * zcdrag ) 187 !$OMP DO schedule(static) private(jj, ji, ztx, zty, zmod) 179 188 DO jj = 2, jpjm1 180 189 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 186 195 END DO 187 196 END DO 197 !$OMP END PARALLEL 188 198 CALL lbc_lnk( taum(:,:), 'T', 1. ) ; CALL lbc_lnk( wndm(:,:), 'T', 1. ) 189 199 -
trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_zgr.F90
r7200 r7698 199 199 ! 200 200 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D local workspace 201 202 INTEGER :: ji, jj 201 203 !!---------------------------------------------------------------------- 202 204 ! … … 206 208 IF(lwp) WRITE(numout,*) ' GYRE case : closed flat box ocean without ocean cavities' 207 209 ! 208 z2d(:,:) = REAL( jpkm1 , wp ) ! flat bottom 210 !$OMP PARALLEL DO schedule(static) private(jj, ji) 211 DO jj = 1, jpj 212 DO ji = 1, jpi 213 z2d(ji,jj) = REAL( jpkm1 , wp ) ! flat bottom 214 END DO 215 END DO 209 216 ! 210 217 CALL lbc_lnk( z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) 211 218 ! 212 k_bot(:,:) = INT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere 213 ! 214 k_top(:,:) = MIN( 1 , k_bot(:,:) ) ! = 1 over the ocean point, =0 elsewhere 219 !$OMP PARALLEL DO schedule(static) private(jj, ji) 220 DO jj = 1, jpj 221 DO ji = 1, jpi 222 k_bot(ji,jj) = INT( z2d(ji,jj) ) ! =jpkm1 over the ocean point, =0 elsewhere 223 ! 224 k_top(ji,jj) = MIN( 1 , k_bot(ji,jj) ) ! = 1 over the ocean point, =0 elsewhere 225 END DO 226 END DO 215 227 ! 216 228 END SUBROUTINE zgr_msk_top_bot … … 234 246 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! - - - 235 247 ! 236 INTEGER :: j k248 INTEGER :: ji, jj, jk 237 249 !!---------------------------------------------------------------------- 238 250 ! 239 251 IF( nn_timing == 1 ) CALL timing_start('zgr_zco') 240 252 ! 253 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 241 254 DO jk = 1, jpk 242 pdept(:,:,jk) = pdept_1d(jk) 243 pdepw(:,:,jk) = pdepw_1d(jk) 244 pe3t (:,:,jk) = pe3t_1d (jk) 245 pe3u (:,:,jk) = pe3t_1d (jk) 246 pe3v (:,:,jk) = pe3t_1d (jk) 247 pe3f (:,:,jk) = pe3t_1d (jk) 248 pe3w (:,:,jk) = pe3w_1d (jk) 249 pe3uw(:,:,jk) = pe3w_1d (jk) 250 pe3vw(:,:,jk) = pe3w_1d (jk) 255 DO jj = 1, jpj 256 DO ji = 1, jpi 257 pdept(ji,jj,jk) = pdept_1d(jk) 258 pdepw(ji,jj,jk) = pdepw_1d(jk) 259 pe3t (ji,jj,jk) = pe3t_1d (jk) 260 pe3u (ji,jj,jk) = pe3t_1d (jk) 261 pe3v (ji,jj,jk) = pe3t_1d (jk) 262 pe3f (ji,jj,jk) = pe3t_1d (jk) 263 pe3w (ji,jj,jk) = pe3w_1d (jk) 264 pe3uw(ji,jj,jk) = pe3w_1d (jk) 265 pe3vw(ji,jj,jk) = pe3w_1d (jk) 266 END DO 267 END DO 251 268 END DO 252 269 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r7646 r7698 106 106 IF ( ln_loglayer.AND. .NOT.ln_linssh ) THEN ! "log layer" bottom friction coefficient 107 107 108 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 108 109 DO jj = 1, jpj 109 110 DO ji = 1, jpi … … 117 118 ! (ISF) 118 119 IF ( ln_isfcav ) THEN 120 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 119 121 DO jj = 1, jpj 120 122 DO ji = 1, jpi … … 129 131 ! 130 132 ELSE 131 zbfrt(:,:) = bfrcoef2d(:,:) 132 ztfrt(:,:) = tfrcoef2d(:,:) 133 ENDIF 134 133 !$OMP PARALLEL DO schedule(static) private(jj,ji) 134 DO jj = 1, jpj 135 DO ji = 1, jpi 136 zbfrt(ji,jj) = bfrcoef2d(ji,jj) 137 ztfrt(ji,jj) = tfrcoef2d(ji,jj) 138 END DO 139 END DO 140 ENDIF 141 142 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv,zvu,zuv,zecu,zecv) 135 143 DO jj = 2, jpjm1 136 144 DO ji = 2, jpim1 … … 167 175 168 176 IF( ln_isfcav ) THEN 177 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv,zvu,zuv,zecu,zecv) 169 178 DO jj = 2, jpjm1 170 179 DO ji = 2, jpim1 … … 260 269 CASE( 0 ) 261 270 IF(lwp) WRITE(numout,*) ' free-slip ' 262 bfrua(:,:) = 0._wp 263 bfrva(:,:) = 0._wp 264 tfrua(:,:) = 0._wp 265 tfrva(:,:) = 0._wp 271 !$OMP PARALLEL DO schedule(static) private(jj,ji) 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 bfrua(ji,jj) = 0.e0 275 bfrva(ji,jj) = 0.e0 276 tfrua(ji,jj) = 0.e0 277 tfrva(ji,jj) = 0.e0 278 END DO 279 END DO 266 280 ! 267 281 CASE( 1 ) … … 285 299 CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array 286 300 CALL iom_close(inum) 287 bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 301 !$OMP PARALLEL DO schedule(static) private(jj,ji) 302 DO jj = 1, jpj 303 DO ji = 1, jpi 304 bfrcoef2d(ji,jj) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(ji,jj) ) 305 END DO 306 END DO 288 307 ELSE 289 bfrcoef2d(:,:) = rn_bfri1 ! initialize bfrcoef2d to the namelist variable 290 ENDIF 291 ! 292 bfrua(:,:) = - bfrcoef2d(:,:) 293 bfrva(:,:) = - bfrcoef2d(:,:) 308 !$OMP PARALLEL DO schedule(static) private(jj,ji) 309 DO jj = 1, jpj 310 DO ji = 1, jpi 311 bfrcoef2d(ji,jj) = rn_bfri1 ! initialize bfrcoef2d to the namelist variable 312 END DO 313 END DO 314 ENDIF 315 ! 316 !$OMP PARALLEL DO schedule(static) private(jj,ji) 317 DO jj = 1, jpj 318 DO ji = 1, jpi 319 bfrua(ji,jj) = - bfrcoef2d(ji,jj) 320 bfrva(ji,jj) = - bfrcoef2d(ji,jj) 321 END DO 322 END DO 294 323 ! 295 324 IF ( ln_isfcav ) THEN … … 299 328 CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 300 329 CALL iom_close(inum) 301 tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 330 !$OMP PARALLEL DO schedule(static) private(jj,ji) 331 DO jj = 1, jpj 332 DO ji = 1, jpi 333 tfrcoef2d(ji,jj) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(ji,jj) ) 334 END DO 335 END DO 302 336 ELSE 303 tfrcoef2d(:,:) = rn_tfri1 ! initialize tfrcoef2d to the namelist variable 337 !$OMP PARALLEL DO schedule(static) private(jj,ji) 338 DO jj = 1, jpj 339 DO ji = 1, jpi 340 tfrcoef2d(ji,jj) = rn_tfri1 ! initialize tfrcoef2d to the namelist variable 341 END DO 342 END DO 304 343 ENDIF 305 344 ! 306 tfrua(:,:) = - tfrcoef2d(:,:) 307 tfrva(:,:) = - tfrcoef2d(:,:) 345 !$OMP PARALLEL DO schedule(static) private(jj,ji) 346 DO jj = 1, jpj 347 DO ji = 1, jpi 348 tfrua(ji,jj) = - tfrcoef2d(ji,jj) 349 tfrva(ji,jj) = - tfrcoef2d(ji,jj) 350 END DO 351 END DO 308 352 END IF 309 353 ! … … 346 390 CALL iom_close(inum) 347 391 ! 348 bfrcoef2d(:,:) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 392 !$OMP PARALLEL DO schedule(static) private(jj,ji) 393 DO jj = 1, jpj 394 DO ji = 1, jpi 395 bfrcoef2d(ji,jj) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(ji,jj) ) 396 END DO 397 END DO 349 398 ELSE 350 bfrcoef2d(:,:) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable 399 !$OMP PARALLEL DO schedule(static) private(jj,ji) 400 DO jj = 1, jpj 401 DO ji = 1, jpi 402 bfrcoef2d(ji,jj) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable 403 END DO 404 END DO 351 405 ENDIF 352 406 … … 358 412 CALL iom_close(inum) 359 413 ! 360 tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 414 !$OMP PARALLEL DO schedule(static) private(jj,ji) 415 DO jj = 1, jpj 416 DO ji = 1, jpi 417 tfrcoef2d(ji,jj) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(ji,jj) ) 418 END DO 419 END DO 361 420 ELSE 362 tfrcoef2d(:,:) = rn_tfri2 ! initialize tfrcoef2d to the namelist variable 421 !$OMP PARALLEL DO schedule(static) private(jj,ji) 422 DO jj = 1, jpj 423 DO ji = 1, jpi 424 tfrcoef2d(ji,jj) = rn_tfri2 ! initialize tfrcoef2d to the namelist variable 425 END DO 426 END DO 363 427 ENDIF 364 428 END IF 365 429 ! 366 430 IF( ln_loglayer.AND. ln_linssh ) THEN ! set "log layer" bottom friction once for all 431 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 367 432 DO jj = 1, jpj 368 433 DO ji = 1, jpi … … 374 439 END DO 375 440 IF ( ln_isfcav ) THEN 441 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 376 442 DO jj = 1, jpj 377 443 DO ji = 1, jpi … … 413 479 zmaxtfr = -1.e10_wp ! initialise tracker for maximum of bottom friction coefficient 414 480 ! 481 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv,zfru,zfrv,ictu,ictv,zminbfr,zmaxbfr,zmintfr,zmaxtfr) 415 482 DO jj = 2, jpjm1 416 483 DO ji = 2, jpim1 -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r6497 r7698 112 112 ! Define the mask 113 113 ! --------------- 114 !$OMP PARALLEL 115 !$OMP DO schedule(static) private(jj,ji,zrw,zaw,zbw,zdt,zds) 114 116 DO jj = 1, jpj ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 115 117 DO ji = 1, jpi … … 128 130 END DO 129 131 END DO 130 132 !$OMP END DO NOWAIT 133 134 !$OMP DO schedule(static) private(jj,ji) 131 135 DO jj = 1, jpj ! indicators: 132 136 DO ji = 1, jpi … … 155 159 END DO 156 160 ! mask zmsk in order to have avt and avs masked 157 zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk) 158 161 162 !$OMP DO schedule(static) private(jj,ji) 163 DO jj = 1, jpj 164 DO ji = 1, jpi 165 zmsks(ji,jj) = zmsks(ji,jj) * wmask(ji,jj,jk) 166 END DO 167 END DO 159 168 160 169 ! Update avt and avs 161 170 ! ------------------ 162 171 ! Constant eddy coefficient: reset to the background value 172 !$OMP DO schedule(static) private(jj,ji,zinr,zrr,zavfs,zavft,zavdt,zavds) 163 173 DO jj = 1, jpj 164 174 DO ji = 1, jpi … … 189 199 ! -------------------------------- 190 200 !!gm to be changed following the definition of avm. 201 !$OMP DO schedule(static) private(jj,ji) 191 202 DO jj = 1, jpjm1 192 203 DO ji = 1, fs_jpim1 ! vector opt. … … 199 210 END DO 200 211 END DO 212 !$OMP END DO NOWAIT 213 !$OMP END PARALLEL 201 214 ! ! =============== 202 215 END DO ! End of slab … … 232 245 !!---------------------------------------------------------------------- 233 246 INTEGER :: ios ! local integer 247 INTEGER :: ji, jj , jk ! dummy loop indices 234 248 !! 235 249 NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr … … 257 271 IF( zdf_ddm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' ) 258 272 ! ! initialization to masked Kz 259 avs(:,:,:) = rn_avt0 * wmask(:,:,:) 273 !$OMP DO schedule(static) private(jk,jj,ji) 274 DO jk = 1, jpk 275 DO jj = 1, jpj 276 DO ji = 1, jpi 277 avs(ji,jj,jk) = rn_avt0 * wmask(ji,jj,jk) 278 END DO 279 END DO 280 END DO 260 281 ! 261 282 END SUBROUTINE zdf_ddm_init -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r7646 r7698 70 70 CALL wrk_alloc( jpi,jpj,jpk, zavt_evd, zavm_evd ) 71 71 ! 72 zavt_evd(:,:,:) = avt(:,:,:) ! set avt prior to evd application 72 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 73 DO jk = 1, jpk 74 DO jj = 1, jpj 75 DO ji = 1, jpi 76 zavt_evd(ji,jj,jk) = avt(ji,jj,jk) ! set avt prior to evd application 77 END DO 78 END DO 79 END DO 73 80 ! 74 81 SELECT CASE ( nn_evdm ) … … 76 83 CASE ( 1 ) ! enhance vertical eddy viscosity and diffusivity (if rn2<-1.e-12) 77 84 ! 78 zavm_evd(:,:,:) = avm(:,:,:) ! set avm prior to evd application 85 !$OMP PARALLEL 86 !$OMP DO schedule(static) private(jk, jj, ji) 87 DO jk = 1, jpk 88 DO jj = 1, jpj 89 DO ji = 1, jpi 90 zavm_evd(ji,jj,jk) = avm(ji,jj,jk) ! set avm prior to evd application 91 END DO 92 END DO 93 END DO 79 94 ! 95 !$OMP DO schedule(static) private(jk, jj, ji) 80 96 DO jk = 1, jpkm1 81 97 DO jj = 2, jpj ! no vector opt. … … 92 108 END DO 93 109 END DO 110 !$OMP END PARALLEL 94 111 CALL lbc_lnk( avt , 'W', 1. ) ; CALL lbc_lnk( avm , 'W', 1. ) ! Lateral boundary conditions 95 112 CALL lbc_lnk( avmu, 'U', 1. ) ; CALL lbc_lnk( avmv, 'V', 1. ) 96 113 ! 97 zavm_evd(:,:,:) = avm(:,:,:) - zavm_evd(:,:,:) ! change in avm due to evd 114 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 115 DO jk = 1, jpk 116 DO jj = 1, jpj 117 DO ji = 1, jpi 118 zavm_evd(ji,jj,jk) = avm(ji,jj,jk) - zavm_evd(ji,jj,jk) ! change in avm due to evd 119 END DO 120 END DO 121 END DO 98 122 CALL iom_put( "avm_evd", zavm_evd ) ! output this change 99 123 ! 100 124 CASE DEFAULT ! enhance vertical eddy diffusivity only (if rn2<-1.e-12) 125 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 101 126 DO jk = 1, jpkm1 102 127 !!! WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd ! agissant sur T SEUL! … … 111 136 END SELECT 112 137 113 zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:) ! change in avt due to evd 138 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 139 DO jk = 1, jpk 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 zavt_evd(ji,jj,jk) = avt(ji,jj,jk) - zavt_evd(ji,jj,jk) ! change in avt due to evd 143 END DO 144 END DO 145 END DO 114 146 CALL iom_put( "avt_evd", zavt_evd ) ! output this change 115 147 IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r7646 r7698 96 96 97 97 ! w-level of the mixing and mixed layers 98 nmln(:,:) = nlb10 ! Initialization to the number of w ocean point 99 hmlp(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 100 zN2_c = grav * rho_c * r1_rau0 ! convert density criteria into N^2 criteria 98 zN2_c = grav * rho_c * r1_rau0 ! convert density criteria into N^2 criteria 99 !$OMP PARALLEL 100 !$OMP DO schedule(static) private(jj, ji) 101 DO jj = 1, jpj 102 DO ji = 1, jpi 103 nmln(ji,jj) = nlb10 ! Initialization to the number of w ocean point 104 hmlp(ji,jj) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 105 END DO 106 END DO 101 107 DO jk = nlb10, jpkm1 108 !$OMP DO schedule(static) private(jj, ji, ikt) 102 109 DO jj = 1, jpj ! Mixed layer level: w-level 103 110 DO ji = 1, jpi … … 110 117 ! 111 118 ! w-level of the turbocline and mixing layer (iom_use) 112 imld(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point 119 !$OMP DO schedule(static) private(jj, ji) 120 DO jj = 1, jpj 121 DO ji = 1, jpi 122 imld(ji,jj) = mbkt(ji,jj) + 1 ! Initialization to the number of w ocean point 123 END DO 124 END DO 113 125 DO jk = jpkm1, nlb10, -1 ! from the bottom to nlb10 126 !$OMP DO schedule(static) private(jj, ji) 114 127 DO jj = 1, jpj 115 128 DO ji = 1, jpi … … 119 132 END DO 120 133 ! depth of the mixing and mixed layers 134 !$OMP DO schedule(static) private(jj, ji, iiki, iikn) 121 135 DO jj = 1, jpj 122 136 DO ji = 1, jpi … … 128 142 END DO 129 143 END DO 144 !$OMP END PARALLEL 130 145 ! 131 146 IF( .NOT.l_offline ) THEN -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r6497 r7698 171 171 !!---------------------------------------------------------------------- 172 172 INTEGER, INTENT(in) :: kt ! ocean time step 173 INTEGER :: jk, jj, ji 173 174 !!---------------------------------------------------------------------- 174 175 ! … … 179 180 ! 180 181 IF( kt /= nit000 ) THEN ! restore before value to compute tke 181 avt (:,:,:) = avt_k (:,:,:) 182 avm (:,:,:) = avm_k (:,:,:) 183 avmu(:,:,:) = avmu_k(:,:,:) 184 avmv(:,:,:) = avmv_k(:,:,:) 182 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 183 DO jk = 1, jpk 184 DO jj = 1, jpj 185 DO ji = 1, jpi 186 avt (ji,jj,jk) = avt_k (ji,jj,jk) 187 avm (ji,jj,jk) = avm_k (ji,jj,jk) 188 avmu(ji,jj,jk) = avmu_k(ji,jj,jk) 189 avmv(ji,jj,jk) = avmv_k(ji,jj,jk) 190 END DO 191 END DO 192 END DO 185 193 ENDIF 186 194 ! … … 189 197 CALL tke_avn ! now avt, avm, avmu, avmv 190 198 ! 191 avt_k (:,:,:) = avt (:,:,:) 192 avm_k (:,:,:) = avm (:,:,:) 193 avmu_k(:,:,:) = avmu(:,:,:) 194 avmv_k(:,:,:) = avmv(:,:,:) 199 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 200 DO jk = 1, jpk 201 DO jj = 1, jpj 202 DO ji = 1, jpi 203 avt_k (ji,jj,jk) = avt (ji,jj,jk) 204 avm_k (ji,jj,jk) = avm (ji,jj,jk) 205 avmu_k(ji,jj,jk) = avmu(ji,jj,jk) 206 avmv_k(ji,jj,jk) = avmv(ji,jj,jk) 207 END DO 208 END DO 209 END DO 195 210 ! 196 211 #if defined key_agrif … … 253 268 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 254 269 IF ( ln_isfcav ) THEN 270 !$OMP PARALLEL DO schedule(static) private(jj, ji) 255 271 DO jj = 2, jpjm1 ! en(mikt(ji,jj)) = rn_emin 256 272 DO ji = fs_2, fs_jpim1 ! vector opt. … … 259 275 END DO 260 276 END IF 277 !$OMP PARALLEL DO schedule(static) private(jj, ji) 261 278 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 262 279 DO ji = fs_2, fs_jpim1 ! vector opt. … … 293 310 ! 294 311 ! !* total energy produce by LC : cumulative sum over jk 295 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * gdepw_n(:,:,1) * e3w_n(:,:,1) 312 !$OMP PARALLEL 313 !$OMP DO schedule(static) private(jj, ji) 314 DO jj =1, jpj 315 DO ji=1, jpi 316 zpelc(ji,jj,1) = MAX( rn2b(ji,jj,1), 0._wp ) * gdepw_n(ji,jj,1) * e3w_n(ji,jj,1) 317 END DO 318 END DO 296 319 DO jk = 2, jpk 297 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw_n(:,:,jk) * e3w_n(:,:,jk) 320 !$OMP DO schedule(static) private(jj, ji) 321 DO jj =1, jpj 322 DO ji=1, jpi 323 zpelc(ji,jj,jk) = zpelc(ji,jj,jk-1) + MAX( rn2b(ji,jj,jk), 0._wp ) * gdepw_n(ji,jj,jk) * e3w_n(ji,jj,jk) 324 END DO 325 END DO 298 326 END DO 299 327 ! !* finite Langmuir Circulation depth 300 328 zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 301 imlc(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point (=2 over land) 329 !$OMP DO schedule(static) private(jj,ji) 330 DO jj = 1, jpj 331 DO ji = 1, jpi 332 imlc(ji,jj) = mbkt(ji,jj) + 1 ! Initialization to the number of w ocean point (=2 over land) 333 END DO 334 END DO 302 335 DO jk = jpkm1, 2, -1 336 !$OMP DO schedule(static) private(jj, ji, zus) 303 337 DO jj = 1, jpj ! Last w-level at which zpelc>=0.5*us*us 304 338 DO ji = 1, jpi ! with us=0.016*wind(starting from jpk-1) … … 309 343 END DO 310 344 ! ! finite LC depth 345 !$OMP DO schedule(static) private(jj, ji) 311 346 DO jj = 1, jpj 312 347 DO ji = 1, jpi … … 315 350 END DO 316 351 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 352 !$OMP DO schedule(static) private(jk, jj, ji, zus, zind, zwlc) 317 353 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 318 354 DO jj = 2, jpjm1 … … 328 364 END DO 329 365 END DO 366 !$OMP END PARALLEL 330 367 ! 331 368 ENDIF … … 338 375 ! ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal 339 376 ! 377 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 340 378 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 341 379 DO jj = 1, jpjm1 … … 356 394 ! Note that zesh2 is also computed in the next loop. 357 395 ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops 396 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zesh2, zri) 358 397 DO jk = 2, jpkm1 359 398 DO jj = 2, jpjm1 … … 372 411 ENDIF 373 412 ! 413 !$OMP PARALLEL 414 !$OMP DO schedule(static) private(jk, jj, ji, zcof, zzd_up, zzd_lw, zesh2) 374 415 DO jk = 2, jpkm1 !* Matrix and right hand side in en 375 416 DO jj = 2, jpjm1 … … 405 446 ! !* Matrix inversion from level 2 (tke prescribed at level 1) 406 447 DO jk = 3, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 448 !$OMP DO schedule(static) private(jj, ji) 407 449 DO jj = 2, jpjm1 408 450 DO ji = fs_2, fs_jpim1 ! vector opt. … … 411 453 END DO 412 454 END DO 455 !$OMP DO schedule(static) private(jj, ji) 413 456 DO jj = 2, jpjm1 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 414 457 DO ji = fs_2, fs_jpim1 ! vector opt. … … 417 460 END DO 418 461 DO jk = 3, jpkm1 462 !$OMP DO schedule(static) private(jj, ji) 419 463 DO jj = 2, jpjm1 420 464 DO ji = fs_2, fs_jpim1 ! vector opt. … … 423 467 END DO 424 468 END DO 469 !$OMP DO schedule(static) private(jj, ji) 425 470 DO jj = 2, jpjm1 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 426 471 DO ji = fs_2, fs_jpim1 ! vector opt. … … 429 474 END DO 430 475 DO jk = jpk-2, 2, -1 476 !$OMP DO schedule(static) private(jj, ji) 431 477 DO jj = 2, jpjm1 432 478 DO ji = fs_2, fs_jpim1 ! vector opt. … … 435 481 END DO 436 482 END DO 483 !$OMP DO schedule(static) private(jk,jj, ji) 437 484 DO jk = 2, jpkm1 ! set the minimum value of tke 438 485 DO jj = 2, jpjm1 … … 442 489 END DO 443 490 END DO 491 !$OMP END PARALLEL 444 492 445 493 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 450 498 451 499 IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction) 500 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 452 501 DO jk = 2, jpkm1 453 502 DO jj = 2, jpjm1 … … 459 508 END DO 460 509 ELSEIF( nn_etau == 2 ) THEN !* act only at the base of the mixed layer (jk=nmln) (rn_efr fraction) 510 !$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 461 511 DO jj = 2, jpjm1 462 512 DO ji = fs_2, fs_jpim1 ! vector opt. … … 467 517 END DO 468 518 ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) 519 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztx2, zty2, ztau, zdif) 469 520 DO jk = 2, jpkm1 470 521 DO jj = 2, jpjm1 … … 545 596 ! 546 597 ! initialisation of interior minimum value (avoid a 2d loop with mikt) 547 zmxlm(:,:,:) = rmxl_min 548 zmxld(:,:,:) = rmxl_min 598 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 599 DO jk = 1, jpk 600 DO jj = 1, jpj 601 DO ji = 1, jpi 602 zmxlm(ji,jj,jk) = rmxl_min 603 zmxld(ji,jj,jk) = rmxl_min 604 END DO 605 END DO 606 END DO 549 607 ! 550 608 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 609 !$OMP PARALLEL DO schedule(static) private(jj, ji, zraug) 551 610 DO jj = 2, jpjm1 552 611 DO ji = fs_2, fs_jpim1 … … 556 615 END DO 557 616 ELSE 558 zmxlm(:,:,1) = rn_mxl0 617 !$OMP PARALLEL DO schedule(static) private(jj,ji) 618 DO jj = 1, jpj 619 DO ji = 1, jpi 620 zmxlm(ji,jj,1) = rn_mxl0 621 END DO 622 END DO 559 623 ENDIF 560 624 ! 625 !$OMP PARALLEL 626 !$OMP DO schedule(static) private(jk, jj, ji, zrn2) 561 627 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 562 628 DO jj = 2, jpjm1 … … 570 636 ! !* Physical limits for the mixing length 571 637 ! 572 zmxld(:,:, 1 ) = zmxlm(:,:,1) ! surface set to the minimum value 573 zmxld(:,:,jpk) = rmxl_min ! last level set to the minimum value 638 !$OMP DO schedule(static) private(jj,ji) 639 DO jj = 1, jpj 640 DO ji = 1, jpi 641 zmxld(ji,jj, 1 ) = zmxlm(ji,jj,1) ! surface set to the minimum value 642 zmxld(ji,jj,jpk) = rmxl_min ! last level set to the minimum value 643 END DO 644 END DO 645 !$OMP END PARALLEL 574 646 ! 575 647 SELECT CASE ( nn_mxl ) … … 578 650 ! where wmask = 0 set zmxlm == e3w_n 579 651 CASE ( 0 ) ! bounded by the distance to surface and bottom 652 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl) 580 653 DO jk = 2, jpkm1 581 654 DO jj = 2, jpjm1 … … 591 664 ! 592 665 CASE ( 1 ) ! bounded by the vertical scale factor 666 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl) 593 667 DO jk = 2, jpkm1 594 668 DO jj = 2, jpjm1 … … 602 676 ! 603 677 CASE ( 2 ) ! |dk[xml]| bounded by e3t : 678 !$OMP PARALLEL 604 679 DO jk = 2, jpkm1 ! from the surface to the bottom : 680 !$OMP DO schedule(static) private(jj, ji) 605 681 DO jj = 2, jpjm1 606 682 DO ji = fs_2, fs_jpim1 ! vector opt. … … 610 686 END DO 611 687 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : 688 !$OMP DO schedule(static) private(jj, ji, zemxl) 612 689 DO jj = 2, jpjm1 613 690 DO ji = fs_2, fs_jpim1 ! vector opt. … … 618 695 END DO 619 696 END DO 697 !$OMP END PARALLEL 620 698 ! 621 699 CASE ( 3 ) ! lup and ldown, |dk[xml]| bounded by e3t : 700 !$OMP PARALLEL 622 701 DO jk = 2, jpkm1 ! from the surface to the bottom : lup 702 !$OMP DO schedule(static) private(jj, ji) 623 703 DO jj = 2, jpjm1 624 704 DO ji = fs_2, fs_jpim1 ! vector opt. … … 628 708 END DO 629 709 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : ldown 710 !$OMP DO schedule(static) private(jj, ji) 630 711 DO jj = 2, jpjm1 631 712 DO ji = fs_2, fs_jpim1 ! vector opt. … … 634 715 END DO 635 716 END DO 717 !$OMP DO schedule(static) private(jk, jj, ji, zemlm, zemlp) 636 718 DO jk = 2, jpkm1 637 719 DO jj = 2, jpjm1 … … 644 726 END DO 645 727 END DO 728 !$OMP END PARALLEL 646 729 ! 647 730 END SELECT 648 731 ! 649 732 # if defined key_c1d 650 e_dis(:,:,:) = zmxld(:,:,:) ! c1d configuration : save mixing and dissipation turbulent length scales 651 e_mix(:,:,:) = zmxlm(:,:,:) 733 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 734 DO jk = 1, jpk 735 DO jj = 1, jpj 736 DO ji = 1, jpi 737 e_dis(ji,jj,jk) = zmxld(ji,jj,jk) ! c1d configuration : save mixing and dissipation turbulent length scales 738 e_mix(ji,jj,jk) = zmxlm(ji,jj,jk) 739 END DO 740 END DO 741 END DO 652 742 # endif 653 743 … … 655 745 ! ! Vertical eddy viscosity and diffusivity (avmu, avmv, avt) 656 746 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 747 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zsqen, zav) 657 748 DO jk = 1, jpkm1 !* vertical eddy viscosity & diffivity at w-points 658 749 DO jj = 2, jpjm1 … … 668 759 CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 669 760 ! 761 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 670 762 DO jk = 2, jpkm1 !* vertical eddy viscosity at wu- and wv-points 671 763 DO jj = 2, jpjm1 … … 679 771 ! 680 772 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt 773 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 681 774 DO jk = 2, jpkm1 682 775 DO jj = 2, jpjm1 … … 798 891 SELECT CASE( nn_htau ) ! Choice of the depth of penetration 799 892 CASE( 0 ) ! constant depth penetration (here 10 meters) 800 htau(:,:) = 10._wp 893 !$OMP PARALLEL DO schedule(static) private(jj,ji) 894 DO jj = 1, jpj 895 DO ji = 1, jpi 896 htau(ji,jj) = 10._wp 897 END DO 898 END DO 801 899 CASE( 1 ) ! F(latitude) : 0.5m to 30m poleward of 40 degrees 802 htau(:,:) = MAX( 0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(:,:) ) ) ) ) 900 !$OMP PARALLEL DO schedule(static) private(jj,ji) 901 DO jj = 1, jpj 902 DO ji = 1, jpi 903 htau(ji,jj) = MAX( 0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(ji,jj) ) ) ) ) 904 END DO 905 END DO 803 906 END SELECT 804 907 ENDIF 805 908 ! !* set vertical eddy coef. to the background value 909 !$OMP PARALLEL 910 !$OMP DO schedule(static) private(jk,jj,ji) 806 911 DO jk = 1, jpk 807 avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 808 avm (:,:,jk) = avmb(jk) * wmask (:,:,jk) 809 avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk) 810 avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk) 811 END DO 812 dissl(:,:,:) = 1.e-12_wp 912 DO jj = 1, jpj 913 DO ji = 1, jpi 914 avt (ji,jj,jk) = avtb(jk) * wmask (ji,jj,jk) 915 avm (ji,jj,jk) = avmb(jk) * wmask (ji,jj,jk) 916 avmu(ji,jj,jk) = avmb(jk) * wumask(ji,jj,jk) 917 avmv(ji,jj,jk) = avmb(jk) * wvmask(ji,jj,jk) 918 END DO 919 END DO 920 END DO 921 !$OMP END DO NOWAIT 922 !$OMP DO schedule(static) private(jk,jj,ji) 923 DO jk = 1, jpk 924 DO jj = 1, jpj 925 DO ji = 1, jpi 926 dissl(ji,jj,jk) = 1.e-12_wp 927 END DO 928 END DO 929 END DO 930 !$OMP END PARALLEL 813 931 ! 814 932 CALL tke_rst( nit000, 'READ' ) !* read or initialize all required files … … 830 948 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 831 949 ! 832 INTEGER :: jit, jk ! dummy loop indices950 INTEGER :: jit, jk, jj, ji ! dummy loop indices 833 951 INTEGER :: id1, id2, id3, id4, id5, id6 ! local integers 834 952 !!---------------------------------------------------------------------- … … 857 975 ELSE ! No TKE array found: initialisation 858 976 IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without tke scheme, en computed by iterative loop' 859 en (:,:,:) = rn_emin * tmask(:,:,:) 977 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 978 DO jk = 1, jpk 979 DO jj = 1, jpj 980 DO ji = 1, jpi 981 en (ji,jj,jk) = rn_emin * tmask(ji,jj,jk) 982 END DO 983 END DO 984 END DO 860 985 CALL tke_avn ! recompute avt, avm, avmu, avmv and dissl (approximation) 861 986 ! 862 avt_k (:,:,:) = avt (:,:,:) 863 avm_k (:,:,:) = avm (:,:,:) 864 avmu_k(:,:,:) = avmu(:,:,:) 865 avmv_k(:,:,:) = avmv(:,:,:) 987 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 988 DO jk = 1, jpk 989 DO jj = 1, jpj 990 DO ji = 1, jpi 991 avt_k (ji,jj,jk) = avt (ji,jj,jk) 992 avm_k (ji,jj,jk) = avm (ji,jj,jk) 993 avmu_k(ji,jj,jk) = avmu(ji,jj,jk) 994 avmv_k(ji,jj,jk) = avmv(ji,jj,jk) 995 END DO 996 END DO 997 END DO 866 998 ! 867 999 DO jit = nit000 + 1, nit000 + 10 ; CALL zdf_tke( jit ) ; END DO 868 1000 ENDIF 869 1001 ELSE !* Start from rest 870 en(:,:,:) = rn_emin * tmask(:,:,:) 1002 !$OMP PARALLEL 1003 !$OMP DO schedule(static) private(jk,jj,ji) 1004 DO jk = 1, jpk 1005 DO jj = 1, jpj 1006 DO ji = 1, jpi 1007 en(ji,jj,jk) = rn_emin * tmask(ji,jj,jk) 1008 END DO 1009 END DO 1010 END DO 1011 !$OMP END DO NOWAIT 1012 !$OMP DO schedule(static) private(jk) 871 1013 DO jk = 1, jpk ! set the Kz to the background value 872 avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 873 avm (:,:,jk) = avmb(jk) * wmask (:,:,jk) 874 avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk) 875 avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk) 1014 DO jj = 1, jpj 1015 DO ji = 1, jpi 1016 avt (ji,jj,jk) = avtb(jk) * wmask (ji,jj,jk) 1017 avm (ji,jj,jk) = avmb(jk) * wmask (ji,jj,jk) 1018 avmu(ji,jj,jk) = avmb(jk) * wumask(ji,jj,jk) 1019 avmv(ji,jj,jk) = avmb(jk) * wvmask(ji,jj,jk) 1020 END DO 1021 END DO 876 1022 END DO 1023 !$OMP END PARALLEL 877 1024 ENDIF 878 1025 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r6497 r7698 121 121 ! ! ----------------------- ! 122 122 ! !* First estimation (with n2 bound by rn_n2min) bounded by 60 cm2/s 123 zav_tide(:,:,:) = MIN( 60.e-4, az_tmx(:,:,:) / MAX( rn_n2min, rn2(:,:,:) ) ) 124 125 zkz(:,:) = 0.e0 !* Associated potential energy consummed over the whole water column 123 !$OMP PARALLEL 124 !$OMP DO schedule(static) private(jk,jj,ji) 125 DO jk = 1, jpk 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 zav_tide(ji,jj,jk) = MIN( 60.e-4, az_tmx(ji,jj,jk) / MAX( rn_n2min, rn2(ji,jj,jk) ) ) 129 END DO 130 END DO 131 END DO 132 !$OMP END DO NOWAIT 133 134 !$OMP DO schedule(static) private(jj, ji) 135 DO jj = 1, jpj 136 DO ji = 1, jpi 137 zkz(ji,jj) = 0.e0 !* Associated potential energy consummed over the whole water column 138 END DO 139 END DO 126 140 DO jk = 2, jpkm1 127 zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 128 END DO 129 141 !$OMP DO schedule(static) private(jj, ji) 142 DO jj = 1, jpj 143 DO ji = 1, jpi 144 zkz(ji,jj) = zkz(ji,jj) + e3w_n(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 145 END DO 146 END DO 147 END DO 148 149 !$OMP DO schedule(static) private(jj, ji) 130 150 DO jj = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 131 151 DO ji = 1, jpi … … 135 155 136 156 DO jk = 2, jpkm1 !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s 137 zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk) !kz max = 300 cm2/s 138 END DO 157 !$OMP DO schedule(static) private(jj, ji) 158 DO jj = 1, jpj 159 DO ji = 1, jpi 160 zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk) !kz max = 300 cm2/s 161 END DO 162 END DO 163 END DO 164 !$OMP END PARALLEL 139 165 140 166 IF( kt == nit000 ) THEN !* check at first time-step: diagnose the energy consumed by zav_tide 141 167 ztpc = 0._wp 168 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc) 142 169 DO jk= 1, jpk 143 170 DO jj= 1, jpj … … 162 189 ! ! Update mixing coefs ! 163 190 ! ! ----------------------- ! 191 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 164 192 DO jk = 2, jpkm1 !* update momentum & tracer diffusivity with tidal mixing 165 avt(:,:,jk) = avt(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 166 avm(:,:,jk) = avm(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 193 DO jj = 1, jpj 194 DO ji = 1, jpi ! vector opt. 195 avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 196 avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 197 END DO 198 END DO 167 199 DO jj = 2, jpjm1 168 200 DO ji = fs_2, fs_jpim1 ! vector opt. … … 225 257 226 258 ! ! compute the form function using N2 at each time step 227 zempba_3d_1(:,:,jpk) = 0.e0 228 zempba_3d_2(:,:,jpk) = 0.e0 259 !$OMP PARALLEL 260 !$OMP DO schedule(static) private(jj, ji) 261 DO jj = 1, jpj 262 DO ji = 1, jpi 263 zempba_3d_1(ji,jj,jpk) = 0.e0 264 zempba_3d_2(ji,jj,jpk) = 0.e0 265 END DO 266 END DO 267 !$OMP DO schedule(static) private(jk,jj,ji) 229 268 DO jk = 1, jpkm1 230 zdn2dz (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1) ! Vertical profile of dN2/dz 231 zempba_3d_1(:,:,jk) = SQRT( MAX( 0.e0, rn2(:,:,jk) ) ) ! - - of N 232 zempba_3d_2(:,:,jk) = MAX( 0.e0, rn2(:,:,jk) ) ! - - of N^2 233 END DO 234 ! 235 zsum (:,:) = 0.e0 236 zsum1(:,:) = 0.e0 237 zsum2(:,:) = 0.e0 269 DO jj = 1, jpj 270 DO ji = 1, jpi 271 zdn2dz (ji,jj,jk) = rn2(ji,jj,jk) - rn2(ji,jj,jk+1) ! Vertical profile of dN2/dz 272 zempba_3d_1(ji,jj,jk) = SQRT( MAX( 0.e0, rn2(ji,jj,jk) ) ) ! - - of N 273 zempba_3d_2(ji,jj,jk) = MAX( 0.e0, rn2(ji,jj,jk) ) ! - - of N^2 274 END DO 275 END DO 276 END DO 277 !$OMP END DO NOWAIT 278 ! 279 !$OMP DO schedule(static) private(jj, ji) 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 zsum (ji,jj) = 0.e0 283 zsum1(ji,jj) = 0.e0 284 zsum2(ji,jj) = 0.e0 285 END DO 286 END DO 238 287 DO jk= 2, jpk 239 zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk) 240 zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk) 241 END DO 288 !$OMP DO schedule(static) private(jj,ji) 289 DO jj= 1, jpj 290 DO ji= 1, jpi 291 zsum1(ji,jj) = zsum1(ji,jj) + zempba_3d_1(ji,jj,jk) * e3w_n(ji,jj,jk) * wmask(ji,jj,jk) 292 zsum2(ji,jj) = zsum2(ji,jj) + zempba_3d_2(ji,jj,jk) * e3w_n(ji,jj,jk) * wmask(ji,jj,jk) 293 END DO 294 END DO 295 END DO 296 !$OMP DO schedule(static) private(jj,ji) 242 297 DO jj = 1, jpj 243 298 DO ji = 1, jpi … … 248 303 249 304 DO jk= 1, jpk 305 !$OMP DO schedule(static) private(jj,ji,zcoef,ztpc) 250 306 DO jj = 1, jpj 251 307 DO ji = 1, jpi … … 259 315 END DO 260 316 END DO 317 !$OMP DO schedule(static) private(jj,ji) 261 318 DO jj = 1, jpj 262 319 DO ji = 1, jpi … … 267 324 ! ! first estimation bounded by 10 cm2/s (with n2 bounded by rn_n2min) 268 325 zcoef = rn_tfe_itf / ( rn_tfe * rau0 ) 326 !$OMP DO schedule(static) private(jk,jj,ji) 269 327 DO jk = 1, jpk 270 zavt_itf(:,:,jk) = MIN( 10.e-4, zcoef * en_tmx(:,:) * zsum(:,:) * zempba_3d(:,:,jk) & 271 & / MAX( rn_n2min, rn2(:,:,jk) ) * tmask(:,:,jk) ) 272 END DO 273 274 zkz(:,:) = 0.e0 ! Associated potential energy consummed over the whole water column 328 DO jj = 1, jpj 329 DO ji = 1, jpi 330 zavt_itf(ji,jj,jk) = MIN( 10.e-4, zcoef * en_tmx(ji,jj) * zsum(ji,jj) * zempba_3d(ji,jj,jk) & 331 & / MAX( rn_n2min, rn2(ji,jj,jk) ) * tmask(ji,jj,jk) ) 332 END DO 333 END DO 334 END DO 335 336 !$OMP DO schedule(static) private(jj, ji) 337 DO jj = 1, jpj 338 DO ji = 1, jpi 339 zkz(ji,jj) = 0.e0 ! Associated potential energy consummed over the whole water column 340 END DO 341 END DO 275 342 DO jk = 2, jpkm1 276 zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk) 277 END DO 278 343 !$OMP DO schedule(static) private(jj,ji) 344 DO jj = 1, jpj 345 DO ji = 1, jpi 346 zkz(ji,jj) = zkz(ji,jj) + e3w_n(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zavt_itf(ji,jj,jk) * wmask(ji,jj,jk) 347 END DO 348 END DO 349 END DO 350 351 !$OMP DO schedule(static) private(jj,ji) 279 352 DO jj = 1, jpj ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 280 353 DO ji = 1, jpi … … 283 356 END DO 284 357 358 !$OMP DO schedule(static) private(jk,jj,ji) 285 359 DO jk = 2, jpkm1 ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s 286 zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * wmask(:,:,jk) ! kz max = 120 cm2/s 287 END DO 360 DO jj = 1, jpj 361 DO ji = 1, jpi 362 zavt_itf(ji,jj,jk) = zavt_itf(ji,jj,jk) * MIN( zkz(ji,jj), 120./10. ) * wmask(ji,jj,jk) ! kz max = 120 cm2/s 363 END DO 364 END DO 365 END DO 366 !$OMP END PARALLEL 288 367 289 368 IF( kt == nit000 ) THEN ! diagnose the nergy consumed by zavt_itf 290 369 ztpc = 0.e0 370 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc) 291 371 DO jk= 1, jpk 292 372 DO jj= 1, jpj … … 303 383 304 384 ! ! Update pav with the ITF mixing coefficient 385 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 305 386 DO jk = 2, jpkm1 306 pav(:,:,jk) = pav (:,:,jk) * ( 1.e0 - mask_itf(:,:) ) & 307 & + zavt_itf(:,:,jk) * mask_itf(:,:) 387 DO jj= 1, jpj 388 DO ji= 1, jpi 389 pav(ji,jj,jk) = pav (ji,jj,jk) * ( 1.e0 - mask_itf(ji,jj) ) & 390 & + zavt_itf(ji,jj,jk) * mask_itf(ji,jj) 391 END DO 392 END DO 308 393 END DO 309 394 ! … … 409 494 ! ! only the energy available for mixing is taken into account, 410 495 ! ! (mixing efficiency tidal dissipation efficiency) 411 en_tmx(:,:) = - rn_tfe * rn_me * ( zem2(:,:) * 1.25 + zek1(:,:) ) * ssmask(:,:) 496 !$OMP PARALLEL 497 498 !$OMP DO schedule(static) private(jj, ji) 499 DO jj = 1, jpj 500 DO ji = 1, jpi 501 en_tmx(ji,jj) = - rn_tfe * rn_me * ( zem2(ji,jj) * 1.25 + zek1(ji,jj) ) * ssmask(ji,jj) 502 END DO 503 END DO 412 504 413 505 !============ … … 416 508 !! the error is thus ~1% which I feel comfortable with, compared to uncertainties in tidal energy dissipation. 417 509 ! ! Vertical structure (az_tmx) 510 !$OMP DO schedule(static) private(jj, ji) 418 511 DO jj = 1, jpj ! part independent of the level 419 512 DO ji = 1, jpi … … 423 516 END DO 424 517 END DO 518 !$OMP DO schedule(static) private(jk, jj, ji) 425 519 DO jk= 1, jpk ! complete with the level-dependent part 426 520 DO jj = 1, jpj … … 430 524 END DO 431 525 END DO 526 !$OMP END PARALLEL 432 527 !=========== 433 528 ! … … 436 531 ! Total power consumption due to vertical mixing 437 532 ! zpc = rau0 * 1/rn_me * rn2 * zav_tide 438 zav_tide(:,:,:) = 0.e0 533 ztpc = 0._wp 534 !$OMP PARALLEL 535 !$OMP DO schedule(static) private(jk, jj, ji) 536 DO jk = 1, jpk 537 DO jj = 1, jpj 538 DO ji = 1, jpi 539 zav_tide(ji,jj,jk) = 0.e0 540 END DO 541 END DO 542 END DO 543 !$OMP DO schedule(static) private(jk,jj,ji) 439 544 DO jk = 2, jpkm1 440 zav_tide(:,:,jk) = az_tmx(:,:,jk) / MAX( rn_n2min, rn2(:,:,jk) ) 545 DO jj = 1, jpj 546 DO ji = 1, jpi 547 zav_tide(ji,jj,jk) = az_tmx(ji,jj,jk) / MAX( rn_n2min, rn2(ji,jj,jk) ) 548 END DO 549 END DO 441 550 END DO 442 551 ! 443 ztpc = 0._wp 444 zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:) 552 !$OMP DO schedule(static) private(jk, jj, ji) 553 DO jk= 1, jpk 554 DO jj = 1, jpj 555 DO ji = 1, jpi 556 zpc(ji,jj,jk) = MAX(rn_n2min,rn2(ji,jj,jk)) * zav_tide(ji,jj,jk) 557 END DO 558 END DO 559 END DO 560 !$OMP DO schedule(static) private(jk, jj, ji, ztpc) 445 561 DO jk= 2, jpkm1 446 562 DO jj = 1, jpj … … 450 566 END DO 451 567 END DO 568 !$OMP END PARALLEL 452 569 IF( lk_mpp ) CALL mpp_sum( ztpc ) 453 570 ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc … … 457 574 ! 458 575 ! control print 2 459 zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 ) 460 zkz(:,:) = 0._wp 576 !$OMP PARALLEL 577 !$OMP DO schedule(static) private(jk, jj, ji) 578 DO jk= 1, jpk 579 DO jj = 1, jpj 580 DO ji = 1, jpi 581 zav_tide(ji,jj,jk) = MIN( zav_tide(ji,jj,jk), 60.e-4 ) 582 zkz(ji,jj) = 0._wp 583 END DO 584 END DO 585 END DO 586 461 587 DO jk = 2, jpkm1 462 zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 588 !$OMP DO schedule(static) private(jj, ji) 589 DO jj = 1, jpj 590 DO ji = 1, jpi 591 zkz(ji,jj) = zkz(ji,jj) + e3w_n(ji,jj,jk) * MAX(0.e0, rn2(ji,jj,jk)) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 592 END DO 593 END DO 463 594 END DO 464 595 ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz 596 !$OMP DO schedule(static) private(jj, ji) 465 597 DO jj = 1, jpj 466 598 DO ji = 1, jpi … … 471 603 END DO 472 604 ztpc = 1.e50 605 !$OMP DO schedule(static) private(jj, ji, ztpc) 473 606 DO jj = 1, jpj 474 607 DO ji = 1, jpi … … 478 611 END DO 479 612 END DO 613 !$OMP END PARALLEL 480 614 WRITE(numout,*) ' Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) ) 615 !$OMP PARALLEL 481 616 ! 617 !$OMP DO schedule(static) private(jk,jj,ji) 482 618 DO jk = 2, jpkm1 483 zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk) !kz max = 300 cm2/s 619 DO jj = 1, jpj 620 DO ji = 1, jpi 621 zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk) !kz max = 300 cm2/s 622 END DO 623 END DO 484 624 END DO 485 625 ztpc = 0._wp 486 zpc(:,:,:) = Max(0.e0,rn2(:,:,:)) * zav_tide(:,:,:)626 !$OMP DO schedule(static) private(jk, jj, ji) 487 627 DO jk= 1, jpk 488 628 DO jj = 1, jpj 489 629 DO ji = 1, jpi 630 zpc(ji,jj,jk) = Max(0.e0,rn2(ji,jj,jk)) * zav_tide(ji,jj,jk) 631 END DO 632 END DO 633 END DO 634 !$OMP DO schedule(static) private(jk, jj, ji, ztpc) 635 DO jk= 1, jpk 636 DO jj = 1, jpj 637 DO ji = 1, jpi 490 638 ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 491 639 END DO 492 640 END DO 493 641 END DO 642 !$OMP END PARALLEL 494 643 IF( lk_mpp ) CALL mpp_sum( ztpc ) 495 644 ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc … … 500 649 & / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) ) 501 650 ztpc = 1.e50 651 !$OMP PARALLEL DO schedule(static) private(ztpc, jj, ji) 502 652 DO jj = 1, jpj 503 653 DO ji = 1, jpi … … 513 663 WRITE(numout,*) ' Initial profile of tidal vertical mixing' 514 664 DO jk = 1, jpk 665 !$OMP PARALLEL DO schedule(static) private(jj, ji) 515 666 DO jj = 1,jpj 516 667 DO ji = 1,jpi … … 523 674 END DO 524 675 DO jk = 1, jpk 525 zkz(:,:) = az_tmx(:,:,jk) /rn_n2min 676 !$OMP PARALLEL DO schedule(static) private(jj, ji) 677 DO jj = 1,jpj 678 DO ji = 1,jpi 679 zkz(ji,jj) = az_tmx(ji,jj,jk) /rn_n2min 680 END DO 681 END DO 526 682 ze_z = SUM( e1e2t(:,:) * zkz (:,:) * tmask_i(:,:) ) & 527 683 & / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) ) … … 689 845 ! !* Critical slope mixing: distribute energy over the time-varying ocean depth, 690 846 ! using an exponential decay from the seafloor. 847 !$OMP PARALLEL 848 !$OMP DO schedule(static) private(jj,ji) 691 849 DO jj = 1, jpj ! part independent of the level 692 850 DO ji = 1, jpi … … 697 855 END DO 698 856 857 !$OMP DO schedule(static) private(jk,jj,ji) 699 858 DO jk = 2, jpkm1 ! complete with the level-dependent part 700 emix_tmx(:,:,jk) = zfact(:,:) * ( EXP( ( gde3w_n(:,:,jk ) - zhdep(:,:) ) / hcri_tmx(:,:) ) & 701 & - EXP( ( gde3w_n(:,:,jk-1) - zhdep(:,:) ) / hcri_tmx(:,:) ) ) * wmask(:,:,jk) & 702 & / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 703 END DO 859 DO jj = 1, jpj 860 DO ji = 1, jpi 861 emix_tmx(ji,jj,jk) = zfact(ji,jj) * ( EXP( ( gde3w_n(ji,jj,jk ) - zhdep(ji,jj) ) / hcri_tmx(:,:) ) & 862 & - EXP( ( gde3w_n(ji,jj,jk-1) - zhdep(ji,jj) ) / hcri_tmx(ji,jj) ) ) * wmask(ji,jj,jk) & 863 & / ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) ) 864 END DO 865 END DO 866 END DO 867 !$OMP END PARALLEL 704 868 705 869 ! !* Pycnocline-intensified mixing: distribute energy over the time-varying … … 710 874 CASE ( 1 ) ! Dissipation scales as N (recommended) 711 875 712 zfact(:,:) = 0._wp 876 !$OMP PARALLEL 877 !$OMP DO schedule(static) private(jj, ji) 878 DO jj = 1, jpj 879 DO ji = 1, jpi 880 zfact(ji,jj) = 0._wp 881 END DO 882 END DO 713 883 DO jk = 2, jpkm1 ! part independent of the level 714 zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 715 END DO 716 884 !$OMP DO schedule(static) private(jj,ji) 885 DO jj = 1, jpj ! part independent of the level 886 DO ji = 1, jpi 887 zfact(ji,jj) = zfact(ji,jj) + e3w_n(ji,jj,jk) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 888 END DO 889 END DO 890 END DO 891 892 !$OMP DO schedule(static) private(jj,ji) 717 893 DO jj = 1, jpj 718 894 DO ji = 1, jpi … … 721 897 END DO 722 898 899 !$OMP DO schedule(static) private(jk,jj,ji) 723 900 DO jk = 2, jpkm1 ! complete with the level-dependent part 724 emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 725 END DO 901 DO jj = 1, jpj 902 DO ji = 1, jpi 903 emix_tmx(ji,jj,jk) = emix_tmx(ji,jj,jk) + zfact(ji,jj) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,ji,jk) 904 END DO 905 END DO 906 END DO 907 !$OMP END PARALLEL 726 908 727 909 CASE ( 2 ) ! Dissipation scales as N^2 728 910 729 zfact(:,:) = 0._wp 730 DO jk = 2, jpkm1 ! part independent of the level 731 zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 732 END DO 733 911 !$OMP PARALLEL 912 !$OMP DO schedule(static) private(jj, ji) 913 DO jj = 1, jpj 914 DO ji = 1, jpi 915 zfact(ji,jj) = 0._wp 916 END DO 917 END DO 918 919 DO jk = 2, jpkm1 920 !$OMP DO schedule(static) private(jj,ji) 921 DO jj = 1, jpj 922 DO ji = 1, jpi 923 zfact(ji,jj) = zfact(ji,jj) + e3w_n(ji,jj,jk) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 924 END DO 925 END DO 926 END DO 927 928 !$OMP DO schedule(static) private(jj,ji) 734 929 DO jj= 1, jpj 735 930 DO ji = 1, jpi … … 738 933 END DO 739 934 935 !$OMP DO schedule(static) private(jk,jj,ji) 740 936 DO jk = 2, jpkm1 ! complete with the level-dependent part 741 emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 742 END DO 937 DO jj = 1, jpj 938 DO ji = 1, jpi 939 emix_tmx(ji,jj,jk) = emix_tmx(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,ji,jk) 940 END DO 941 END DO 942 END DO 943 !$OMP END PARALLEL 743 944 744 945 END SELECT … … 747 948 ! !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 748 949 749 zwkb(:,:,:) = 0._wp 750 zfact(:,:) = 0._wp 950 !$OMP PARALLEL 951 !$OMP DO schedule(static) private(jk,jj,ji) 952 DO jk = 1, jpk 953 DO jj = 1, jpj 954 DO ji = 1, jpi 955 zwkb(ji,jj,jk) = 0._wp 956 END DO 957 END DO 958 END DO 959 !$OMP DO schedule(static) private(jj,ji) 960 DO jj = 1, jpj 961 DO ji = 1, jpi 962 zfact(ji,jj) = 0._wp 963 END DO 964 END DO 751 965 DO jk = 2, jpkm1 752 zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 753 zwkb(:,:,jk) = zfact(:,:) 754 END DO 755 966 !$OMP DO schedule(static) private(jj,ji) 967 DO jj = 1, jpj 968 DO ji = 1, jpi 969 zfact(ji,jj) = zfact(ji,jj) + e3w_n(ji,jj,jk) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 970 zwkb(ji,jj,jk) = zfact(ji,jj) 971 END DO 972 END DO 973 END DO 974 975 !$OMP DO schedule(static) private(jk,jj,ji) 756 976 DO jk = 2, jpkm1 757 977 DO jj = 1, jpj … … 762 982 END DO 763 983 END DO 764 zwkb(:,:,1) = zhdep(:,:) * tmask(:,:,1) 765 766 zweight(:,:,:) = 0._wp 984 985 !$OMP DO schedule(static) private(jj, ji) 986 DO jj = 1, jpj 987 DO ji = 1, jpi 988 zwkb(ji,jj,1) = zhdep(ji,jj) * tmask(ji,jj,1) 989 END DO 990 END DO 991 !$OMP END DO NOWAIT 992 !$OMP DO schedule(static) private(jk,jj,ji) 993 DO jk = 1, jpk 994 DO jj = 1, jpj 995 DO ji = 1, jpi 996 zweight(ji,jj,jk) = 0._wp 997 END DO 998 END DO 999 END DO 1000 1001 !$OMP DO schedule(static) private(jk,jj,ji) 767 1002 DO jk = 2, jpkm1 768 zweight(:,:,jk) = MAX( 0._wp, rn2(:,:,jk) ) * hbot_tmx(:,:) * wmask(:,:,jk) & 769 & * ( EXP( -zwkb(:,:,jk) / hbot_tmx(:,:) ) - EXP( -zwkb(:,:,jk-1) / hbot_tmx(:,:) ) ) 770 END DO 771 772 zfact(:,:) = 0._wp 1003 DO jj = 1, jpj 1004 DO ji = 1, jpi 1005 zweight(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * hbot_tmx(ji,jj) * wmask(ji,jj,jk) & 1006 & * ( EXP( -zwkb(ji,jj,jk) / hbot_tmx(ji,jj) ) - EXP( -zwkb(ji,jj,jk-1) / hbot_tmx(ji,jj) ) ) 1007 END DO 1008 END DO 1009 END DO 1010 1011 !$OMP DO schedule(static) private(jj, ji) 1012 DO jj = 1, jpj 1013 DO ji = 1, jpi 1014 zfact(ji,jj) = 0._wp 1015 END DO 1016 END DO 1017 773 1018 DO jk = 2, jpkm1 ! part independent of the level 774 zfact(:,:) = zfact(:,:) + zweight(:,:,jk) 775 END DO 776 1019 !$OMP DO schedule(static) private(jj,ji) 1020 DO jj = 1, jpj 1021 DO ji = 1, jpi 1022 zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 1023 END DO 1024 END DO 1025 END DO 1026 1027 !$OMP DO schedule(static) private(jj,ji) 777 1028 DO jj = 1, jpj 778 1029 DO ji = 1, jpi … … 781 1032 END DO 782 1033 1034 !$OMP DO schedule(static) private(jk,jj,ji) 783 1035 DO jk = 2, jpkm1 ! complete with the level-dependent part 784 emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk) & 785 & / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 786 END DO 1036 DO jj = 1, jpj 1037 DO ji = 1, jpi 1038 emix_tmx(ji,jj,jk) = emix_tmx(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,ji,jk) 1039 & / ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) ) 1040 END DO 1041 END DO 1042 END DO 1043 !$OMP END DO NOWAIT 787 1044 788 1045 789 1046 ! Calculate molecular kinematic viscosity 790 znu_t(:,:,:) = 1.e-4_wp * ( 17.91_wp - 0.53810_wp * tsn(:,:,:,jp_tem) + 0.00694_wp * tsn(:,:,:,jp_tem) * tsn(:,:,:,jp_tem) & 791 & + 0.02305_wp * tsn(:,:,:,jp_sal) ) * tmask(:,:,:) * r1_rau0 1047 !$OMP DO schedule(static) private(jj, ji) 1048 DO jj = 1, jpj 1049 DO ji = 1, jpi 1050 znu_t(ji,jj,jk) = 1.e-4_wp * ( 17.91_wp - 0.53810_wp * tsn(ji,jj,jk,jp_tem) & 1051 & + 0.00694_wp * tsn(ji,jj,jk,jp_tem) * tsn(ji,jj,jk,jp_tem) & 1052 & + 0.02305_wp * tsn(ji,jj,jk,jp_sal) ) * tmask(ji,jj,jk) * r1_rau0 1053 END DO 1054 END DO 1055 !$OMP DO schedule(static) private(jk,jj,ji) 792 1056 DO jk = 2, jpkm1 793 znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) 1057 DO jj = 1, jpj 1058 DO ji = 1, jpi 1059 znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 1060 END DO 1061 END DO 794 1062 END DO 795 1063 796 1064 ! Calculate turbulence intensity parameter Reb 1065 !$OMP DO schedule(static) private(jk,jj,ji) 797 1066 DO jk = 2, jpkm1 798 zReb(:,:,jk) = emix_tmx(:,:,jk) / MAX( 1.e-20_wp, znu_w(:,:,jk) * rn2(:,:,jk) ) 1067 DO jj = 1, jpj 1068 DO ji = 1, jpi 1069 zReb(ji,jj,jk) = emix_tmx(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 1070 END DO 1071 END DO 799 1072 END DO 800 1073 801 1074 ! Define internal wave-induced diffusivity 1075 !$OMP DO schedule(static) private(jk,jj,ji) 802 1076 DO jk = 2, jpkm1 803 zav_wave(:,:,jk) = znu_w(:,:,jk) * zReb(:,:,jk) * r1_6 ! This corresponds to a constant mixing efficiency of 1/6 804 END DO 1077 DO jj = 1, jpj 1078 DO ji = 1, jpi 1079 zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6 ! This corresponds to a constant mixing efficiency of 1/6 1080 END DO 1081 END DO 1082 END DO 1083 !$OMP END PARALLEL 805 1084 806 1085 IF( ln_mevar ) THEN ! Variable mixing efficiency case : modify zav_wave in the 1086 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 807 1087 DO jk = 2, jpkm1 ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 808 1088 DO jj = 1, jpj … … 818 1098 ENDIF 819 1099 1100 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 820 1101 DO jk = 2, jpkm1 ! Bound diffusivity by molecular value and 100 cm2/s 821 zav_wave(:,:,jk) = MIN( MAX( 1.4e-7_wp, zav_wave(:,:,jk) ), 1.e-2_wp ) * wmask(:,:,jk) 1102 DO jj = 1, jpj 1103 DO ji = 1, jpi 1104 zav_wave(ji,jj,jk) = MIN( MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp ) * wmask(ji,jj,jk) 1105 END DO 1106 END DO 822 1107 END DO 823 1108 824 1109 IF( kt == nit000 ) THEN !* Control print at first time-step: diagnose the energy consumed by zav_wave 825 1110 ztpc = 0._wp 1111 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc) 826 1112 DO jk = 2, jpkm1 827 1113 DO jj = 1, jpj … … 849 1135 ! 850 1136 IF( ln_tsdiff ) THEN !* Option for differential mixing of salinity and temperature 1137 !$OMP PARALLEL 1138 !$OMP DO schedule(static) private(jk,jj,ji) 851 1139 DO jk = 2, jpkm1 ! Calculate S/T diffusivity ratio as a function of Reb 852 1140 DO jj = 1, jpj … … 858 1146 END DO 859 1147 END DO 1148 !$OMP DO schedule(static) private(jk,jj,ji) 1149 DO jk = 2, jpkm1 !* update momentum & tracer diffusivity with wave-driven mixing 1150 DO jj = 1, jpj 1151 DO ji = 1, jpi 1152 fsavs(ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 1153 avt (ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) 1154 avm (ji,jj,jk) = avm(ji,jj,jk) + zav_wave(ji,jj,jk) 1155 END DO 1156 END DO 1157 END DO 1158 !$OMP END PARALLEL 860 1159 CALL iom_put( "av_ratio", zav_ratio ) 861 DO jk = 2, jpkm1 !* update momentum & tracer diffusivity with wave-driven mixing862 fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) * zav_ratio(:,:,jk)863 avt (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk)864 avm (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk)865 END DO866 1160 ! 867 1161 ELSE !* update momentum & tracer diffusivity with wave-driven mixing 1162 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 868 1163 DO jk = 2, jpkm1 869 fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 870 avt (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 871 avm (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk) 1164 DO jj = 1, jpj 1165 DO ji = 1, jpi 1166 fsavs(ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) 1167 avt (ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) 1168 avm (ji,jj,jk) = avm(ji,jj,jk) + zav_wave(ji,jj,jk) 1169 END DO 1170 END DO 872 1171 END DO 873 1172 ENDIF 874 1173 1174 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 875 1175 DO jk = 2, jpkm1 !* update momentum diffusivity at wu and wv points 876 1176 DO jj = 2, jpjm1 … … 888 1188 ! vertical integral of rau0 * Kz * N^2 (pcmap_tmx), energy density (emix_tmx) 889 1189 IF( iom_use("bflx_tmx") .OR. iom_use("pcmap_tmx") ) THEN 890 bflx_tmx(:,:,:) = MAX( 0._wp, rn2(:,:,:) ) * zav_wave(:,:,:) 891 pcmap_tmx(:,:) = 0._wp 892 DO jk = 2, jpkm1 893 pcmap_tmx(:,:) = pcmap_tmx(:,:) + e3w_n(:,:,jk) * bflx_tmx(:,:,jk) * wmask(:,:,jk) 894 END DO 895 pcmap_tmx(:,:) = rau0 * pcmap_tmx(:,:) 1190 !$OMP PARALLEL 1191 !$OMP DO schedule(static) private(jk,jj,ji) 1192 DO jk = 1, jpk 1193 DO jj = 1, jpj 1194 DO ji = 1, jpi 1195 bflx_tmx(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) 1196 END DO 1197 END DO 1198 END DO 1199 !$OMP END DO NOWAIT 1200 !$OMP DO schedule(static) private(jj, ji) 1201 DO jj = 1, jpj 1202 DO ji = 1, jpi 1203 pcmap_tmx(ji,jj) = 0._wp 1204 END DO 1205 END DO 1206 DO jk = 2, jpkm1 1207 !$OMP DO schedule(static) private(jj, ji) 1208 DO jj = 1, jpj 1209 DO ji = 1, jpi 1210 pcmap_tmx(ji,jj) = pcmap_tmx(ji,jj) + e3w_n(ji,jj,jk) * bflx_tmx(ji,jj,jk) * wmask(ji,jj,jk) 1211 END DO 1212 END DO 1213 END DO 1214 !$OMP DO schedule(static) private(jj, ji) 1215 DO jj = 1, jpj 1216 DO ji = 1, jpi 1217 pcmap_tmx(ji,jj) = rau0 * pcmap_tmx(ji,jj) 1218 END DO 1219 END DO 1220 !$OMP END PARALLEL 896 1221 CALL iom_put( "bflx_tmx", bflx_tmx ) 897 1222 CALL iom_put( "pcmap_tmx", pcmap_tmx ) … … 970 1295 avmb(:) = 1.4e-6_wp ! viscous molecular value 971 1296 avtb(:) = 1.e-10_wp ! very small diffusive minimum (background avt is specified in zdf_tmx) 972 avtb_2d(:,:) = 1.e0_wp ! uniform 1297 !$OMP PARALLEL DO schedule(static) private(jj, ji) 1298 DO jj = 1, jpj 1299 DO ji = 1, jpi 1300 avtb_2d(ji,jj) = 1.e0_wp ! uniform 1301 END DO 1302 END DO 973 1303 IF(lwp) THEN ! Control print 974 1304 WRITE(numout,*) … … 1003 1333 CALL iom_close(inum) 1004 1334 1005 ebot_tmx(:,:) = ebot_tmx(:,:) * ssmask(:,:) 1006 epyc_tmx(:,:) = epyc_tmx(:,:) * ssmask(:,:) 1007 ecri_tmx(:,:) = ecri_tmx(:,:) * ssmask(:,:) 1008 1009 ! Set once for all to zero the first and last vertical levels of appropriate variables 1010 emix_tmx (:,:, 1 ) = 0._wp 1011 emix_tmx (:,:,jpk) = 0._wp 1012 zav_ratio(:,:, 1 ) = 0._wp 1013 zav_ratio(:,:,jpk) = 0._wp 1014 zav_wave (:,:, 1 ) = 0._wp 1015 zav_wave (:,:,jpk) = 0._wp 1335 !$OMP PARALLEL DO schedule(static) private(jj, ji) 1336 DO jj = 1, jpj 1337 DO ji = 1, jpi 1338 ebot_tmx(ji,jj) = ebot_tmx(ji,jj) * ssmask(ji,jj) 1339 epyc_tmx(ji,jj) = epyc_tmx(ji,jj) * ssmask(ji,jj) 1340 ecri_tmx(ji,jj) = ecri_tmx(ji,jj) * ssmask(ji,jj) 1341 1342 ! Set once for all to zero the first and last vertical levels of appropriate variables 1343 emix_tmx (ji,jj, 1 ) = 0._wp 1344 emix_tmx (ji,jj,jpk) = 0._wp 1345 zav_ratio(ji,jj, 1 ) = 0._wp 1346 zav_ratio(ji,jj,jpk) = 0._wp 1347 zav_wave (ji,jj, 1 ) = 0._wp 1348 zav_wave (ji,jj,jpk) = 0._wp 1349 END DO 1350 END DO 1016 1351 1017 1352 zbot = glob_sum( e1e2t(:,:) * ebot_tmx(:,:) ) -
trunk/NEMOGCM/NEMO/OPA_SRC/step.F90
r7646 r7698 74 74 !! -8- Outputs and diagnostics 75 75 !!---------------------------------------------------------------------- 76 INTEGER :: ji,jj,jk ! dummy loop indice76 INTEGER :: ji,jj,jk,jn ! dummy loop indice 77 77 INTEGER :: indic ! error indicator if < 0 78 78 INTEGER :: kcall ! optional integer argument (dom_vvl_sf_nxt) … … 135 135 ! 136 136 IF( lk_zdfcst ) THEN ! Constant Kz (reset avt, avm[uv] to the background value) 137 avt (:,:,:) = rn_avt0 * wmask (:,:,:) 138 avmu(:,:,:) = rn_avm0 * wumask(:,:,:) 139 avmv(:,:,:) = rn_avm0 * wvmask(:,:,:) 137 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 138 DO jk = 1, jpk 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 avt (ji,jj,jk) = rn_avt0 * wmask (ji,jj,jk) 142 avmu(ji,jj,jk) = rn_avm0 * wumask(ji,jj,jk) 143 avmv(ji,jj,jk) = rn_avm0 * wvmask(ji,jj,jk) 144 END DO 145 END DO 146 END DO 140 147 ENDIF 141 148 142 149 IF( ln_rnf_mouth ) THEN ! increase diffusivity at rivers mouths 143 DO jk = 2, nkrnf ; avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk) ; END DO 150 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 151 DO jk = 2, nkrnf 152 DO jj = 1, jpj 153 DO ji = 1, jpi 154 avt(ji,jj,jk) = avt(ji,jj,jk) + 2._wp * rn_avt_rnf * rnfmsk(ji,jj) * tmask(ji,jj,jk) 155 END DO 156 END DO 157 END DO 144 158 ENDIF 145 159 IF( ln_zdfevd ) CALL zdf_evd( kstp ) ! enhanced vertical eddy diffusivity … … 197 211 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the first ocean level 198 212 !!jc: fs simplification 199 200 ua(:,:,:) = 0._wp ! set dynamics trends to zero 201 va(:,:,:) = 0._wp 213 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 214 DO jk = 1, jpk 215 DO jj = 1, jpj 216 DO ji = 1, jpi 217 ua(ji,jj,jk) = 0._wp ! set dynamics trends to zero 218 va(ji,jj,jk) = 0._wp 219 END DO 220 END DO 221 END DO 202 222 203 223 IF( lk_asminc .AND. ln_asmiau .AND. ln_dyninc ) & … … 252 272 ! Active tracers 253 273 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 254 tsa(:,:,:,:) = 0._wp ! set tracer trends to zero 274 DO jn = 1, jpts 275 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 276 DO jk = 1, jpk 277 DO jj = 1, jpj 278 DO ji = 1, jpi 279 tsa(ji,jj,jk,jn) = 0._wp ! set tracer trends to zero 280 END DO 281 END DO 282 END DO 283 END DO 255 284 256 285 IF( lk_asminc .AND. ln_asmiau .AND. & -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zagg.F90
r7646 r7698 56 56 IF( ln_p4z ) THEN 57 57 ! 58 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact,zagg1,zagg2,zagg3,zagg4,zagg,zaggfe,zaggdoc,zaggdoc2,zaggdoc3) 58 59 DO jk = 1, jpkm1 59 60 DO jj = 1, jpj … … 102 103 ELSE ! ln_p5z 103 104 ! 105 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact,zaggtmp,zaggfe,zaggpoc,zaggpoc1,zaggpoc2,zaggpoc3,zaggpoc4) & 106 !$OMP& private(zaggpon,zaggpop,zaggdoc,zaggdon,zaggdop,zaggdoc2,zaggdon2,zaggdop2,zaggdoc3,zaggdon3,zaggdop3) 104 107 DO jk = 1, jpkm1 105 108 DO jj = 1, jpj -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r7646 r7698 66 66 ! OF PHYTOPLANKTON AND DETRITUS 67 67 68 xdiss(:,:,:) = 1. 68 !$OMP PARALLEL 69 !$OMP DO schedule(static) private(jk,jj,ji) 70 DO jk = 1, jpk 71 DO jj = 1, jpj 72 DO ji = 1, jpi 73 xdiss(ji,jj,jk) = 1. 74 END DO 75 END DO 76 END DO 69 77 !!gm the use of nmld should be better here? 78 !$OMP DO schedule(static) private(jk,jj,ji) 70 79 DO jk = 2, jpkm1 71 80 DO jj = 1, jpj … … 76 85 END DO 77 86 END DO 87 !$OMP END PARALLEL 78 88 79 89 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r7646 r7698 132 132 !!---------------------------------------------------------------------- 133 133 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 134 !! $Id$ 134 !! $Id$ 135 135 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 136 136 !!---------------------------------------------------------------------- … … 165 165 ! ------------------------------------------------------------- 166 166 IF (neos == -1) THEN 167 salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 167 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 168 DO jk = 1, jpk 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 salinprac(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) * 35.0 / 35.16504 172 END DO 173 END DO 174 END DO 168 175 ELSE 169 salinprac(:,:,:) = tsn(:,:,:,jp_sal) 176 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 177 DO jk = 1, jpk 178 DO jj = 1, jpj 179 DO ji = 1, jpi 180 salinprac(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) 181 END DO 182 END DO 183 END DO 170 184 ENDIF 171 185 … … 176 190 ! 0.04°C relative to an exact computation 177 191 ! --------------------------------------------------------------------- 192 !$OMP PARALLEL 193 !$OMP DO schedule(static) private(jk,jj,ji,zpres,za1,za2) 178 194 DO jk = 1, jpk 179 195 DO jj = 1, jpj … … 190 206 ! ---------------------------------- 191 207 !CDIR NOVERRCHK 208 !$OMP DO schedule(static) private(jj,ji,ztkel,zt,zsal,zcek1) 192 209 DO jj = 1, jpj 193 210 !CDIR NOVERRCHK … … 211 228 ! ------------------------------- 212 229 !CDIR NOVERRCHK 230 !$OMP DO schedule(static) private(jk,jj,ji,ztkel,zsal,zsal2,ztgg,ztgg2,ztgg3,ztgg4,ztgg5,zoxy) 213 231 DO jk = 1, jpk 214 232 !CDIR NOVERRCHK … … 239 257 ! ------------------------------- 240 258 !CDIR NOVERRCHK 259 !$OMP DO schedule(static) private(jk,jj,ji,zplat,zc1,zpres,ztkel,zsal,zsqrt,zsal15,zlogt,ztr,zis,zis2,zisqrt,ztc,zcl,zst) & 260 !$OMP& private(zft,zcks,zckf,zckb,zck1,zck2,zckw,zck1p,zck2p,zck3p,zcksi,zaksp0,total2free,free2SWS,total2SWS,SWS2total,zak1,zak2,zakb,zakw,zaksp1,zak1p,zak2p,zak3p,zaksi,zcpexp,zcpexp2,zbuf1,zbuf2,ztkel1) 241 261 DO jk = 1, jpk 242 262 !CDIR NOVERRCHK … … 446 466 END DO 447 467 END DO 468 !$OMP END PARALLEL 448 469 ! 449 470 IF( nn_timing == 1 ) CALL timing_stop('p4z_che') … … 473 494 IF( nn_timing == 1 ) CALL timing_start('ahini_for_at') 474 495 ! 496 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,p_alkcb,p_dictot,p_bortot,zca1,zba1,za2,za1,za0,zd,zsqrtd,zhmin) 475 497 DO jk = 1, jpk 476 498 DO jj = 1, jpj … … 515 537 ! 516 538 END SUBROUTINE ahini_for_at 517 518 539 !=============================================================================== 519 540 SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) … … 526 547 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 527 548 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 528 529 p_alknw_inf(:,:,:) = -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:) & 530 & - fluorid(:,:,:) 531 p_alknw_sup(:,:,:) = (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) ) & 532 & * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:) 549 INTEGER :: ji, jj, jk 550 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 551 DO jk = 1, jpk 552 DO jj = 1, jpj 553 DO ji = 1, jpi 554 p_alknw_inf(ji,jj,jk) = -trb(ji,jj,jk,jppo4) * 1000. / (rhop(ji,jj,jk) + rtrn) - sulfat(ji,jj,jk) & 555 & - fluorid(ji,jj,jk) 556 p_alknw_sup(ji,jj,jk) = (2. * trb(ji,jj,jk,jpdic) + 2. * trb(ji,jj,jk,jppo4) + trb(ji,jj,jk,jpsil) ) & 557 & * 1000. / (rhop(ji,jj,jk) + rtrn) + borat(ji,jj,jk) 558 END DO 559 END DO 560 END DO 533 561 534 562 END SUBROUTINE anw_infsup … … 571 599 CALL anw_infsup( zalknw_inf, zalknw_sup ) 572 600 573 rmask(:,:,:) = tmask(:,:,:) 574 zhi(:,:,:) = 0. 601 !$OMP PARALLEL 602 !$OMP DO schedule(static) private(jk,jj,ji) 603 DO jk = 1, jpk 604 DO jj = 1, jpj 605 DO ji = 1, jpi 606 rmask(ji,jj,jk) = tmask(ji,jj,jk) 607 zhi(ji,jj,jk) = 0. 608 END DO 609 END DO 610 END DO 575 611 576 612 ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 613 !$OMP DO schedule(static) private(jk,jj,ji,p_alktot,aphscale,zh_ini,zdelta) 577 614 DO jk = 1, jpk 578 615 DO jj = 1, jpj … … 605 642 END DO 606 643 607 zeqn_absmin(:,:,:) = HUGE(1._wp) 644 !$OMP DO schedule(static) private(jk,jj,ji) 645 DO jk = 1, jpk 646 DO jj = 1, jpj 647 DO ji = 1, jpi 648 zeqn_absmin(ji,jj,jk) = HUGE(1._wp) 649 END DO 650 END DO 651 END DO 608 652 609 653 DO jn = 1, jp_maxniter_atgen 654 !$OMP DO schedule(static) private(jk,jj,ji,zfact,p_alktot,zdic,zbot,zpt,zsit,zst,zft,zh,zh_prev,znumer_dic) & 655 !$OMP& private(zdenom_dic,zalk_dic,zdnumer_dic,zdalk_dic,znumer_bor,zdenom_bor,zalk_bor,zdnumer_bor,zdalk_bor) & 656 !$OMP& private(znumer_po4,zdenom_po4,zalk_po4,zdnumer_po4,zdalk_po4,znumer_sil,zdenom_sil,zalk_sil,zdnumer_sil) & 657 !$OMP& private(zdalk_sil,aphscale,znumer_so4,zdenom_so4,zalk_so4,zdnumer_so4,zdalk_so4,znumer_flu,zdenom_flu) & 658 !$OMP& private(zalk_flu,zdnumer_flu,zdalk_flu,zalk_wat,zdalk_wat,zeqn,zalka,zdeqndh,zh_lnfactor,zh_delta,l_exitnow) 610 659 DO jk = 1, jpk 611 660 DO jj = 1, jpj … … 796 845 END DO 797 846 END DO 847 !$OMP END PARALLEL 798 848 ! 799 849 CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r7646 r7698 83 83 ! Allocate temporary workspace 84 84 CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 85 zFe3 (:,:,:) = 0. 86 zFeL1(:,:,:) = 0. 87 zTL1 (:,:,:) = 0. 88 IF( ln_fechem ) THEN 89 CALL wrk_alloc( jpi, jpj, zstrn, zstrn2 ) 90 CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 91 zFe2 (:,:,:) = 0. 92 zFeL2(:,:,:) = 0. 93 zTL2 (:,:,:) = 0. 94 zFeP (:,:,:) = 0. 95 ENDIF 85 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 86 DO jk = 1, jpk 87 DO jj = 1, jpj 88 DO ji = 1, jpi 89 zFe3 (ji,jj,jk) = 0. 90 zFeL1(ji,jj,jk) = 0. 91 zTL1 (ji,jj,jk) = 0. 92 END DO 93 END DO 94 END DO 96 95 97 96 ! Total ligand concentration : Ligands can be chosen to be constant or variable … … 99 98 ! ------------------------------------------------- 100 99 IF( ln_ligvar ) THEN 101 ztotlig(:,:,:) = 0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9 102 ztotlig(:,:,:) = MIN( ztotlig(:,:,:), 10. ) 100 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 101 DO jk = 1, jpk 102 DO jj = 1, jpj 103 DO ji = 1, jpi 104 ztotlig(ji,jj,jk) = 0.09 * trb(ji,jj,jk,jpdoc) * 1E6 + ligand * 1E9 105 ztotlig(ji,jj,jk) = MIN( ztotlig(ji,jj,jk), 10. ) 106 END DO 107 END DO 108 END DO 103 109 ELSE 104 IF( ln_ligand ) THEN ; ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9 105 ELSE ; ztotlig(:,:,:) = ligand * 1E9 110 IF( ln_ligand ) THEN 111 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 112 DO jk = 1, jpk 113 DO jj = 1, jpj 114 DO ji = 1, jpi 115 ztotlig(ji,jj,jk) = trb(ji,jj,jk,jplgw) * 1E9 116 END DO 117 END DO 118 END DO 119 ELSE 120 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 121 DO jk = 1, jpk 122 DO jj = 1, jpj 123 DO ji = 1, jpi 124 ztotlig(ji,jj,jk) = ligand * 1E9 125 END DO 126 END DO 127 END DO 106 128 ENDIF 107 129 ENDIF 108 130 109 131 IF( ln_fechem ) THEN 132 CALL wrk_alloc( jpi, jpj, zstrn, zstrn2 ) 133 CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 110 134 ! compute the day length depending on latitude and the day 111 135 zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 112 136 zcodel = ASIN( SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp ) ) 113 137 138 !$OMP PARALLEL 139 !$OMP DO schedule(static) private(jk,jj,ji) 140 DO jk = 1, jpk 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 zFe2 (ji,jj,jk) = 0. 144 zFeL2(ji,jj,jk) = 0. 145 zTL2 (ji,jj,jk) = 0. 146 zFeP (ji,jj,jk) = 0. 147 END DO 148 END DO 149 END DO 114 150 ! day length in hours 115 zstrn(:,:) = 0. 151 !$OMP DO schedule(static) private(jj,ji) 152 DO jj = 1, jpj 153 DO ji = 1, jpi 154 zstrn(ji,jj) = 0. 155 END DO 156 END DO 157 !$OMP DO schedule(static) private(jj,ji,zargu) 116 158 DO jj = 1, jpj 117 159 DO ji = 1, jpi … … 123 165 124 166 ! Maximum light intensity 125 zstrn2(:,:) = zstrn(:,:) / 24. 126 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 127 zstrn(:,:) = 24. / zstrn(:,:) 167 !$OMP DO schedule(static) private(jj,ji) 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 zstrn2(ji,jj) = zstrn(ji,jj) / 24. 171 IF( zstrn(ji,jj) < 1.e0 ) zstrn(ji,jj) = 24. 172 zstrn(ji,jj) = 24. / zstrn(ji,jj) 173 END DO 174 END DO 128 175 129 176 ! ------------------------------------------------------------ … … 133 180 ! ------------------------------------------------------------ 134 181 DO jn = 1, 2 182 !$OMP DO schedule(static) private(jk,jj,ji,zzstrn2,ztligand,zph,zoxy,zkox,zkph2,zkph1,ztfe,za) & 183 !$OMP& private(zb,zc,zkappa1,zkappa2,za2,za1,za0,zp,zq,zp3,zq2,zd,zr,zphi,zxs,zfff,jic,zfunc) & 184 !$OMP& private(zlight,zzFe3,zzFep,zzFeL2,zzFeL1,zzFe2) 135 185 DO jk = 1, jpkm1 136 186 DO jj = 1, jpj … … 213 263 END DO 214 264 END DO 265 !$OMP END PARALLEL 215 266 ELSE 216 267 ! ------------------------------------------------------------ … … 219 270 ! Chemistry is supposed to be fast enough to be at equilibrium 220 271 ! ------------------------------------------------------------ 272 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zkeq,zfesatur,ztfe) 221 273 DO jk = 1, jpkm1 222 274 DO jj = 1, jpj … … 239 291 240 292 zdust = 0. ! if no dust available 293 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfeequi,zfecoll,zhplus,fe3sol,ztrc,zdust) & 294 !$OMP& private(zlam1b,zscave,zdenom1,zdenom2,zlamfac,zdep,zcoag,zlam1a,zaggdfea,zaggdfeb) 241 295 DO jk = 1, jpkm1 242 296 DO jj = 1, jpj … … 308 362 ! Define the bioavailable fraction of iron 309 363 ! ---------------------------------------- 310 IF( ln_fechem ) THEN ; biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 311 ELSE ; biron(:,:,:) = trb(:,:,:,jpfer) 364 IF( ln_fechem ) THEN 365 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 366 DO jk = 1, jpk 367 DO jj = 1, jpj 368 DO ji = 1, jpi 369 biron(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) - zFeP(ji,jj,jk) * 1E-9 ) 370 END DO 371 END DO 372 END DO 373 ELSE 374 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 375 DO jk = 1, jpk 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 biron(ji,jj,jk) = trb(ji,jj,jk,jpfer) 379 END DO 380 END DO 381 END DO 312 382 ENDIF 313 383 ! 314 384 IF( ln_ligand ) THEN 315 385 ! 386 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zlam1a,zlam1b,zligco,zaggliga,zaggligb) 316 387 DO jk = 1, jpkm1 317 388 DO jj = 1, jpj … … 331 402 ! 332 403 IF( .NOT.ln_fechem) THEN 333 plig(:,:,:) = MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 334 plig(:,:,:) = MAX( 0. , plig(:,:,:) ) 404 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 405 DO jk = 1, jpk 406 DO jj = 1, jpj 407 DO ji = 1, jpi 408 plig(ji,jj,jk) = MAX( 0., ( ( zFeL1(ji,jj,jk) * 1E-9 ) / ( trb(ji,jj,jk,jpfer) +rtrn ) ) ) 409 plig(ji,jj,jk) = MAX( 0. , plig(ji,jj,jk) ) 410 END DO 411 END DO 412 END DO 335 413 ENDIF 336 414 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r7646 r7698 54 54 !!---------------------------------------------------------------------- 55 55 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 56 !! $Id$ 56 !! $Id$ 57 57 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 58 58 !!---------------------------------------------------------------------- … … 105 105 zdco2dt = ( atcco2h(iind) - atcco2h(iindm1) ) / ( years(iind) - years(iindm1) + rtrn ) 106 106 atcco2 = zdco2dt * ( zyr_dec - years(iindm1) ) + atcco2h(iindm1) 107 satmco2(:,:) = atcco2 108 ENDIF 109 110 IF( l_co2cpl ) satmco2(:,:) = atm_co2(:,:) 111 107 !$OMP PARALLEL DO schedule(static) private(jj,ji) 108 DO jj = 1, jpj 109 DO ji = 1, jpi 110 satmco2(ji,jj) = atcco2 111 END DO 112 END DO 113 ENDIF 114 115 IF( l_co2cpl ) THEN 116 !$OMP PARALLEL DO schedule(static) private(jj,ji) 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 satmco2(ji,jj) = atm_co2(ji,jj) 120 END DO 121 END DO 122 END IF 123 124 !$OMP PARALLEL 125 !$OMP DO schedule(static) private(jj,ji,zfact,zdic,zph) 112 126 DO jj = 1, jpj 113 127 DO ji = 1, jpi … … 128 142 ! ------------------------------------------- 129 143 144 !$OMP DO schedule(static) private(jj,ji,ztc,ztc2,ztc3,ztc4,zsch_co2,zsch_o2,zws,zkgwan) 130 145 DO jj = 1, jpj 131 146 DO ji = 1, jpi … … 149 164 150 165 166 !$OMP DO schedule(static) private(jj,ji,ztkel,zsal,zvapsw,zxc2,zfugcoeff,zfco2,zfld,zflu,zflu16) 151 167 DO jj = 1, jpj 152 168 DO ji = 1, jpi … … 174 190 END DO 175 191 END DO 192 !$OMP END PARALLEL 176 193 177 194 t_oce_co2_flx = glob_sum( oce_co2(:,:) ) ! Total Flux of Carbon … … 189 206 CALL wrk_alloc( jpi, jpj, zw2d ) 190 207 IF( iom_use( "Cflx" ) ) THEN 191 zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r 208 !$OMP PARALLEL DO schedule(static) private(jj,ji) 209 DO jj = 1, jpj 210 DO ji = 1, jpi 211 zw2d(ji,jj) = oce_co2(ji,jj) / e1e2t(ji,jj) * rfact2r 212 END DO 213 END DO 192 214 CALL iom_put( "Cflx" , zw2d ) 193 215 ENDIF 194 216 IF( iom_use( "Oflx" ) ) THEN 195 zw2d(:,:) = zoflx(:,:) * 1000 * tmask(:,:,1) 217 !$OMP PARALLEL DO schedule(static) private(jj,ji) 218 DO jj = 1, jpj 219 DO ji = 1, jpi 220 zw2d(ji,jj) = zoflx(ji,jj) * 1000 * tmask(ji,jj,1) 221 END DO 222 END DO 196 223 CALL iom_put( "Oflx" , zw2d ) 197 224 ENDIF 198 225 IF( iom_use( "Kg" ) ) THEN 199 zw2d(:,:) = zkgco2(:,:) * tmask(:,:,1) 226 !$OMP PARALLEL DO schedule(static) private(jj,ji) 227 DO jj = 1, jpj 228 DO ji = 1, jpi 229 zw2d(ji,jj) = zkgco2(ji,jj) * tmask(ji,jj,1) 230 END DO 231 END DO 200 232 CALL iom_put( "Kg" , zw2d ) 201 233 ENDIF 202 234 IF( iom_use( "Dpco2" ) ) THEN 203 zw2d(:,:) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 235 !$OMP PARALLEL DO schedule(static) private(jj,ji) 236 DO jj = 1, jpj 237 DO ji = 1, jpi 238 zw2d(ji,jj) = ( zpco2atm(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 239 END DO 240 END DO 204 241 CALL iom_put( "Dpco2" , zw2d ) 205 242 ENDIF 206 243 IF( iom_use( "Dpo2" ) ) THEN 207 zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 244 !$OMP PARALLEL DO schedule(static) private(jj,ji) 245 DO jj = 1, jpj 246 DO ji = 1, jpi 247 zw2d(ji,jj) = ( atcox * patm(ji,jj) - atcox * trb(ji,jj,1,jpoxy) / ( chemo2(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 248 END DO 249 END DO 208 250 CALL iom_put( "Dpo2" , zw2d ) 209 251 ENDIF … … 232 274 !!---------------------------------------------------------------------- 233 275 NAMELIST/nampisext/ln_co2int, atcco2, clname, nn_offset 234 INTEGER :: jm 276 INTEGER :: jm, jj, ji 235 277 INTEGER :: ios ! Local integer output status for namelist read 236 278 !!---------------------------------------------------------------------- … … 258 300 WRITE(numout,*) ' ' 259 301 ENDIF 260 satmco2(:,:) = atcco2 ! Initialisation of atmospheric pco2 302 !$OMP PARALLEL DO schedule(static) private(jj,ji) 303 DO jj = 1, jpj 304 DO ji = 1, jpi 305 satmco2(ji,jj) = atcco2 ! Initialisation of atmospheric pco2 306 END DO 307 END DO 261 308 ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 262 309 IF(lwp) THEN … … 294 341 295 342 ! 296 oce_co2(:,:) = 0._wp ! Initialization of Flux of Carbon 343 !$OMP PARALLEL DO schedule(static) private(jj,ji) 344 DO jj = 1, jpj 345 DO ji = 1, jpi 346 oce_co2(ji,jj) = 0._wp ! Initialization of Flux of Carbon 347 END DO 348 END DO 297 349 t_oce_co2_flx = 0._wp 298 350 t_atm_co2_flx = 0._wp … … 313 365 !! * arguments 314 366 INTEGER, INTENT( in ) :: kt ! ocean time step 367 INTEGER :: jj, ji 315 368 ! 316 369 INTEGER :: ierr … … 361 414 ENDIF 362 415 ! 363 IF( .NOT.ln_presatm ) patm(:,:) = 1.e0 ! Initialize patm if no reading from a file 416 IF( .NOT.ln_presatm ) THEN 417 !$OMP PARALLEL DO schedule(static) private(jj,ji) 418 DO jj = 1, jpj 419 DO ji = 1, jpi 420 patm(ji,jj) = 1.e0 ! Initialize patm if no reading from a file 421 END DO 422 END DO 423 ENDIF 364 424 ! 365 425 ENDIF … … 367 427 IF( ln_presatm ) THEN 368 428 CALL fld_read( kt, 1, sf_patm ) !* input Patm provided at kt + 1/2 369 patm(:,:) = sf_patm(1)%fnow(:,:,1) ! atmospheric pressure 429 !$OMP PARALLEL DO schedule(static) private(jj,ji) 430 DO jj = 1, jpj 431 DO ji = 1, jpi 432 patm(ji,jj) = sf_patm(1)%fnow(ji,jj,1) ! atmospheric pressure 433 END DO 434 END DO 370 435 ENDIF 371 436 ! 372 437 IF( ln_presatmco2 ) THEN 373 438 CALL fld_read( kt, 1, sf_atmco2 ) !* input atmco2 provided at kt + 1/2 374 satmco2(:,:) = sf_atmco2(1)%fnow(:,:,1) ! atmospheric pressure 439 !$OMP PARALLEL DO schedule(static) private(jj,ji) 440 DO jj = 1, jpj 441 DO ji = 1, jpi 442 satmco2(ji,jj) = sf_atmco2(1)%fnow(ji,jj,1) ! atmospheric pressure 443 END DO 444 END DO 375 445 ELSE 376 satmco2(:,:) = atcco2 ! Initialize atmco2 if no reading from a file 446 !$OMP PARALLEL DO schedule(static) private(jj,ji) 447 DO jj = 1, jpj 448 DO ji = 1, jpi 449 satmco2(ji,jj) = atcco2 ! Initialize atmco2 if no reading from a file 450 END DO 451 END DO 377 452 ENDIF 378 453 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
r7646 r7698 21 21 !!---------------------------------------------------------------------- 22 22 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 23 !! $Id$ 23 !! $Id$ 24 24 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 25 25 !!---------------------------------------------------------------------- … … 36 36 INTEGER, INTENT( in ) :: kt ! ocean time-step index 37 37 ! 38 INTEGER :: ji, jj 38 INTEGER :: ji, jj, jk ! dummy loop indices 39 39 REAL(wp) :: zvar ! local variable 40 40 !!--------------------------------------------------------------------- … … 44 44 ! Computation of phyto and zoo metabolic rate 45 45 ! ------------------------------------------- 46 tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 47 tgfunc2(:,:,:) = EXP( 0.07608 * tsn(:,:,:,jp_tem) ) 46 !$OMP PARALLEL 47 !$OMP DO schedule(static) private(jk,jj,ji) 48 DO jk = 1, jpk 49 DO jj = 1, jpj 50 DO ji = 1, jpi 51 tgfunc (ji,jj,jk) = EXP( 0.063913 * tsn(ji,jj,jk,jp_tem) ) 52 tgfunc2(ji,jj,jk) = EXP( 0.07608 * tsn(ji,jj,jk,jp_tem) ) 53 END DO 54 END DO 55 END DO 48 56 49 57 ! Computation of the silicon dependant half saturation constant for silica uptake 50 58 ! --------------------------------------------------- 59 !$OMP DO schedule(static) private(jj,ji,zvar) 51 60 DO ji = 1, jpi 52 61 DO jj = 1, jpj … … 57 66 ! 58 67 IF( nday_year == nyear_len(1) ) THEN 59 xksi (:,:) = xksimax(:,:) 60 xksimax(:,:) = 0._wp 68 !$OMP DO schedule(static) private(jj,ji) 69 DO jj = 1, jpj 70 DO ji = 1, jpi 71 xksi (ji,jj) = xksimax(ji,jj) 72 xksimax(ji,jj) = 0._wp 73 END DO 74 END DO 61 75 ENDIF 76 !$OMP END PARALLEL 62 77 ! 63 78 IF( nn_timing == 1 ) CALL timing_stop('p4z_int') -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r7646 r7698 97 97 IF( nn_timing == 1 ) CALL timing_start('p4z_lim') 98 98 ! 99 !$OMP PARALLEL 100 !$OMP DO schedule(static) private(jk,jj,ji,zno3,zferlim,zconcd,zconcd2,zconcn,zconcn2,z1_trbphy,z1_trbdia) & 101 !$OMP& private(zconc1d,zconc1dnh4,zconc0n,zconc0nnh4,zdenom,zlim1,zlim2,zlim3,zlim4,zratio,zironmin) 99 102 DO jk = 1, jpkm1 100 103 DO jj = 1, jpj … … 173 176 END DO 174 177 END DO 178 !$OMP END DO NOWAIT 175 179 176 180 ! Compute the fraction of nanophytoplankton that is made of calcifiers 177 181 ! -------------------------------------------------------------------- 182 !$OMP DO schedule(static) private(jk,jj,ji,zlim1,zlim2,zlim3,ztem1,ztem2,zetot1,zetot2) 178 183 DO jk = 1, jpkm1 179 184 DO jj = 1, jpj … … 199 204 END DO 200 205 END DO 201 ! 206 !$OMP END DO NOWAIT 207 ! 208 !$OMP DO schedule(static) private(jk,jj,ji) 202 209 DO jk = 1, jpkm1 203 210 DO jj = 1, jpj … … 210 217 END DO 211 218 END DO 219 !$OMP END PARALLEL 212 220 ! 213 221 IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics … … 241 249 & xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r, oxymin 242 250 INTEGER :: ios ! Local integer output status for namelist read 251 INTEGER :: ji, jj, jk 243 252 244 253 REWIND( numnatp_ref ) ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters … … 277 286 ENDIF 278 287 ! 279 nitrfac (:,:,:) = 0._wp 288 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 289 DO jk = 1, jpkm1 290 DO jj = 1, jpj 291 DO ji = 1, jpi 292 nitrfac (ji,jj,jk) = 0._wp 293 END DO 294 END DO 295 END DO 280 296 ! 281 297 END SUBROUTINE p4z_lim_init -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r7646 r7698 69 69 CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 70 70 ! 71 zco3 (:,:,:) = 0. 72 zcaldiss(:,:,:) = 0. 73 zhinit(:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 71 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 72 DO jk = 1, jpk 73 DO jj = 1, jpj 74 DO ji = 1, jpi 75 zco3 (ji,jj,jk) = 0. 76 zcaldiss(ji,jj,jk) = 0. 77 zhinit(ji,jj,jk) = hi(ji,jj,jk) * 1000. / ( rhop(ji,jj,jk) + rtrn ) 78 END DO 79 END DO 80 END DO 74 81 ! ------------------------------------------- 75 82 ! COMPUTE [CO3--] and [H+] CONCENTRATIONS … … 78 85 CALL solve_at_general(zhinit, zhi) 79 86 87 !$OMP PARALLEL 88 !$OMP DO schedule(static) private(jk, jj, ji) 80 89 DO jk = 1, jpkm1 81 90 DO jj = 1, jpj … … 94 103 ! --------------------------------------------------------- 95 104 105 !$OMP DO schedule(static) private(jk,jj,ji,zcalcon,zfact,zomegaca,zexcess0,zexcess,zdispot) 96 106 DO jk = 1, jpkm1 97 107 DO jj = 1, jpj … … 124 134 END DO 125 135 END DO 136 !$OMP END PARALLEL 126 137 ! 127 138 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r7646 r7698 79 79 ! 80 80 CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 81 zgrazing(:,:,:) = 0._wp 82 81 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 82 DO jk = 1, jpk 83 DO jj = 1, jpj 84 DO ji = 1, jpi 85 zgrazing(ji,jj,jk) = 0._wp 86 END DO 87 END DO 88 END DO 89 90 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zcompam,zfact,zrespz2,ztortz2,zcompadi,zcompaz,zcompaph,zfracal) & 91 !$OMP& private(zcompapoc,zfood,zfoodlim,zdenom,zdenom2,zgraze2,zgrazd,zgrazz,zgrazn,zgrazpoc,zgraznf,zgrazf,zgrazpof) & 92 !$OMP& private(zgrazffeg,zgrazfffg,zgrazffep,zgrazfffp,zgraztot,zproport,zratio,zratio2,zfrac,zfracfe,zgraztotf,zgrasrat) & 93 !$OMP& private(zgraztotn,zgrasratn,zepshert,zepsherv,zgrarem2,zgrafer2,zgrapoc2,zgrarsig,zmortz2,zmortzgoc,zprcaca,zgrazcal) 83 94 DO jk = 1, jpkm1 84 95 DO jj = 1, jpj … … 220 231 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 221 232 IF( iom_use( "GRAZ2" ) ) THEN 222 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 233 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 234 DO jk = 1, jpk 235 DO jj = 1, jpj 236 DO ji = 1, jpi 237 zw3d(ji,jj,jk) = zgrazing(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! Total grazing of phyto by zooplankton 238 END DO 239 END DO 240 END DO 223 241 CALL iom_put( "GRAZ2", zw3d ) 224 242 ENDIF 225 243 IF( iom_use( "PCAL" ) ) THEN 226 zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Calcite production 244 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 245 DO jk = 1, jpk 246 DO jj = 1, jpj 247 DO ji = 1, jpi 248 zw3d(ji,jj,jk) = prodcal(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! Calcite production 249 END DO 250 END DO 251 END DO 227 252 CALL iom_put( "PCAL", zw3d ) 228 253 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r7646 r7698 79 79 CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 80 80 ! 81 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zcompaz,zfact,zrespz,ztortz,zcompadi,zcompaph,zcompapoc,zfood) & 82 !$OMP& private(zfoodlim,zdenom,zdenom2,zgraze,zgrazp,zgrazm,zgrazsd,zgrazpf,zgrazmf,zgrazsf,zgraztot,zgraztotf) & 83 !$OMP& private(zgraztotn,zgrasrat,zgrasratn,zepshert,zepsherv,zgrafer,zgrarem,zgrapoc,zgrarsig,zmortz,zprcaca) 81 84 DO jk = 1, jpkm1 82 85 DO jj = 1, jpj … … 181 184 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 182 185 IF( iom_use( "GRAZ1" ) ) THEN 183 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 186 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 187 DO jk = 1, jpk 188 DO jj = 1, jpj 189 DO ji = 1, jpi 190 zw3d(ji,jj,jk) = zgrazing(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! Total grazing of phyto by zooplankton 191 END DO 192 END DO 193 END DO 184 194 CALL iom_put( "GRAZ1", zw3d ) 185 195 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
r7646 r7698 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 34 !! $Id$ 34 !! $Id$ 35 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- … … 74 74 IF( nn_timing == 1 ) CALL timing_start('p4z_nano') 75 75 ! 76 prodcal(:,:,:) = 0. !: calcite production variable set to zero 76 !$OMP PARALLEL 77 !$OMP DO schedule(static) private(jk,jj,ji) 78 DO jk = 1, jpk 79 DO jj = 1, jpj 80 DO ji = 1, jpi 81 prodcal(ji,jj,jk) = 0. !: calcite production variable set to zero 82 END DO 83 END DO 84 END DO 85 !$OMP DO schedule(static) private(jk,jj,ji,zcompaph,zsizerat,zrespp,ztortp,zmortp,zfactfe,zfactch,zprcaca,zfracal) 77 86 DO jk = 1, jpkm1 78 87 DO jj = 1, jpj … … 119 128 END DO 120 129 END DO 130 !$OMP END PARALLEL 121 131 ! 122 132 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 153 163 ! ------------------------------------------------------------ 154 164 165 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zcompadi,zlim2,zlim1,zrespp2,ztortp2,zmortp2,zfactfe,zfactch,zfactsi) 155 166 DO jk = 1, jpkm1 156 167 DO jj = 1, jpj -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r7646 r7698 84 84 ! Initialisation of variables used to compute PAR 85 85 ! ----------------------------------------------- 86 ze1(:,:,:) = 0._wp 87 ze2(:,:,:) = 0._wp 88 ze3(:,:,:) = 0._wp 86 !$OMP PARALLEL 87 !$OMP DO schedule(static) private(jk,jj,ji) 88 DO jk = 1, jpk 89 DO jj = 1, jpj 90 DO ji = 1, jpi 91 ze1(ji,jj,jk) = 0._wp 92 ze2(ji,jj,jk) = 0._wp 93 ze3(ji,jj,jk) = 0._wp 94 END DO 95 END DO 96 END DO 97 !$OMP END DO NOWAIT 89 98 ! 90 99 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 91 100 ! -------------------------------------------------------- 92 zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 93 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 94 ! 101 !$OMP DO schedule(static) private(jk,jj,ji) 102 DO jk = 1, jpk 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 zchl3d(ji,jj,jk) = trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) 106 END DO 107 END DO 108 END DO 109 !$OMP END PARALLEL 110 IF( ln_p5z ) THEN 111 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 112 DO jk = 1, jpk 113 DO jj = 1, jpj 114 DO ji = 1, jpi 115 zchl3d(ji,jj,jk) = zchl3d(ji,jj,jk) + trb(ji,jj,jk,jppch) 116 END DO 117 END DO 118 END DO 119 END IF 120 ! 121 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zchl,irgb) 95 122 DO jk = 1, jpkm1 96 123 DO jj = 1, jpj … … 110 137 IF( l_trcdm2dc ) THEN ! diurnal cycle 111 138 ! 112 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn ) 139 !$OMP PARALLEL DO schedule(static) private(jj,ji) 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 zqsr_corr(ji,jj) = qsr_mean(ji,jj) / ( 1. - fr_i(ji,jj) + rtrn ) 143 END DO 144 END DO 113 145 ! 114 146 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 115 147 ! 148 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 116 149 DO jk = 1, nksrp 117 etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 118 enano (:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 119 ediat (:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 150 DO jj = 1, jpj 151 DO ji = 1, jpi 152 etot_ndcy(ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) 153 enano (ji,jj,jk) = 2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 154 ediat (ji,jj,jk) = 1.6 * ze1(ji,jj,jk) + 0.69 * ze2(ji,jj,jk) + 0.7 * ze3(ji,jj,jk) 155 END DO 156 END DO 120 157 END DO 121 158 IF( ln_p5z ) THEN 159 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 122 160 DO jk = 1, nksrp 123 epico (:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 epico (ji,jj,jk) = 2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 164 END DO 165 END DO 124 166 END DO 125 167 ENDIF 126 168 ! 127 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 169 !$OMP PARALLEL DO schedule(static) private(jj,ji) 170 DO jj = 1, jpj 171 DO ji = 1, jpi 172 zqsr_corr(ji,jj) = qsr(ji,jj) / ( 1. - fr_i(ji,jj) + rtrn ) 173 END DO 174 END DO 128 175 ! 129 176 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) 130 177 ! 178 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 131 179 DO jk = 1, nksrp 132 etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 etot(ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) 183 END DO 184 END DO 133 185 END DO 134 186 ! 135 187 ELSE 136 188 ! 137 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 189 !$OMP PARALLEL DO schedule(static) private(jj,ji) 190 DO jj = 1, jpj 191 DO ji = 1, jpi 192 zqsr_corr(ji,jj) = qsr(ji,jj) / ( 1. - fr_i(ji,jj) + rtrn ) 193 END DO 194 END DO 138 195 ! 139 196 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 140 197 ! 141 DO jk = 1, nksrp 142 etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 143 enano(:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 144 ediat(:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 198 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 199 DO jk = 1, nksrp 200 DO jj = 1, jpj 201 DO ji = 1, jpi 202 etot (ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) 203 enano(ji,jj,jk) = 2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 204 ediat(ji,jj,jk) = 1.6 * ze1(ji,jj,jk) + 0.69 * ze2(ji,jj,jk) + 0.7 * ze3(ji,jj,jk) 205 END DO 206 END DO 145 207 END DO 146 208 IF( ln_p5z ) THEN 147 DO jk = 1, nksrp 148 epico(:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 209 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 210 DO jk = 1, nksrp 211 DO jj = 1, jpj 212 DO ji = 1, jpi 213 epico(ji,jj,jk) = 2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 214 END DO 215 END DO 149 216 END DO 150 217 ENDIF 151 etot_ndcy(:,:,:) = etot(:,:,:) 218 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 219 DO jk = 1, jpk 220 DO jj = 1, jpj 221 DO ji = 1, jpi 222 etot_ndcy(ji,jj,jk) = etot(ji,jj,jk) 223 END DO 224 END DO 225 END DO 152 226 ENDIF 153 227 … … 157 231 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 158 232 ! 159 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) 233 !$OMP PARALLEL 234 !$OMP DO schedule(static) private(jj,ji) 235 DO jj = 1, jpj 236 DO ji = 1, jpi 237 etot3(ji,jj,1) = qsr(ji,jj) * tmask(ji,jj,1) 238 END DO 239 END DO 240 !$OMP DO schedule(static) private(jk,jj,ji) 160 241 DO jk = 2, nksrp + 1 161 etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 162 END DO 242 DO jj = 1, jpj 243 DO ji = 1, jpi 244 etot3(ji,jj,jk) = ( ze0(ji,jj,jk) + ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) ) * tmask(ji,jj,jk) 245 END DO 246 END DO 247 END DO 248 !$OMP END PARALLEL 163 249 ! ! ------------------------ 164 250 ENDIF 165 251 ! !* Euphotic depth and level 166 neln (:,:) = 1 ! ------------------------ 167 heup (:,:) = gdepw_n(:,:,2) 168 heup_01(:,:) = gdepw_n(:,:,2) 252 ! ------------------------ 253 !$OMP PARALLEL 254 !$OMP DO schedule(static) private(jj,ji) 255 DO jj = 1, jpj 256 DO ji = 1, jpi 257 neln(ji,jj) = 1 258 heup (ji,jj) = gdepw_n(ji,jj,2) 259 heup_01(ji,jj) = gdepw_n(ji,jj,2) 260 END DO 261 END DO 169 262 170 263 DO jk = 2, nksrp 264 !$OMP DO schedule(static) private(jj,ji) 171 265 DO jj = 1, jpj 172 266 DO ji = 1, jpi … … 183 277 END DO 184 278 ! 185 heup (:,:) = MIN( 300., heup (:,:) ) 186 heup_01(:,:) = MIN( 300., heup_01(:,:) ) 187 ! !* mean light over the mixed layer 188 zdepmoy(:,:) = 0.e0 ! ------------------------------- 189 zetmp1 (:,:) = 0.e0 190 zetmp2 (:,:) = 0.e0 191 zetmp3 (:,:) = 0.e0 192 zetmp4 (:,:) = 0.e0 279 !$OMP DO schedule(static) private(jj,ji) 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 heup (ji,jj) = MIN( 300., heup (ji,jj) ) 283 heup_01(ji,jj) = MIN( 300., heup_01(ji,jj) ) 284 ! !* mean light over the mixed layer 285 zdepmoy(ji,jj) = 0.e0 ! ------------------------------- 286 zetmp1 (ji,jj) = 0.e0 287 zetmp2 (ji,jj) = 0.e0 288 zetmp3 (ji,jj) = 0.e0 289 zetmp4 (ji,jj) = 0.e0 290 END DO 291 END DO 193 292 194 293 DO jk = 1, nksrp 294 !$OMP DO schedule(static) private(jj,ji) 195 295 DO jj = 1, jpj 196 296 DO ji = 1, jpi … … 206 306 END DO 207 307 ! 208 emoy(:,:,:) = etot(:,:,:) ! remineralisation 209 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 210 ! 308 !$OMP DO schedule(static) private(jk,jj,ji) 309 DO jk = 1, jpk 310 DO jj = 1, jpj 311 DO ji = 1, jpi 312 emoy(ji,jj,jk) = etot(ji,jj,jk) ! remineralisation 313 zpar(ji,jj,jk) = etot_ndcy(ji,jj,jk) ! diagnostic : PAR with no diurnal cycle 314 END DO 315 END DO 316 END DO 317 ! 318 !$OMP DO schedule(static) private(jk,jj,ji,z1_dep) 211 319 DO jk = 1, nksrp 212 320 DO jj = 1, jpj … … 222 330 END DO 223 331 END DO 332 !$OMP END PARALLEL 224 333 ! 225 334 IF( ln_p5z ) THEN 226 zetmp5 (:,:) = 0.e0 335 !$OMP PARALLEL 336 !$OMP DO schedule(static) private(jj,ji) 337 DO jj = 1, jpj 338 DO ji = 1, jpi 339 zetmp5 (ji,jj) = 0.e0 340 END DO 341 END DO 227 342 DO jk = 1, nksrp 343 !$OMP DO schedule(static) private(jj,ji,z1_dep) 228 344 DO jj = 1, jpj 229 345 DO ji = 1, jpi … … 236 352 END DO 237 353 END DO 354 !$OMP END PARALLEL 238 355 ENDIF 239 356 IF( lk_iomput ) THEN … … 274 391 275 392 ! Real shortwave 276 IF( ln_varpar ) THEN ; zqsr(:,:) = par_varsw(:,:) * pqsr(:,:) 277 ELSE ; zqsr(:,:) = xparsw * pqsr(:,:) 393 IF( ln_varpar ) THEN 394 !$OMP PARALLEL DO schedule(static) private(jj,ji) 395 DO jj = 1, jpj 396 DO ji = 1, jpi 397 zqsr(ji,jj) = par_varsw(ji,jj) * pqsr(ji,jj) 398 END DO 399 END DO 400 ELSE 401 !$OMP PARALLEL DO schedule(static) private(jj,ji) 402 DO jj = 1, jpj 403 DO ji = 1, jpi 404 zqsr(ji,jj) = xparsw * pqsr(ji,jj) 405 END DO 406 END DO 278 407 ENDIF 279 408 280 409 ! Light at the euphotic depth 281 IF( PRESENT( pqsr100 ) ) pqsr100(:,:) = 0.01 * 3. * zqsr(:,:) 410 IF( PRESENT( pqsr100 ) ) THEN 411 !$OMP PARALLEL DO schedule(static) private(jj,ji) 412 DO jj = 1, jpj 413 DO ji = 1, jpi 414 pqsr100(ji,jj) = 0.01 * 3. * zqsr(ji,jj) 415 END DO 416 END DO 417 ENDIF 282 418 283 419 IF( PRESENT( pe0 ) ) THEN ! W-level 284 420 ! 285 pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:) ! ( 1 - 3 * alpha ) * q 286 pe1(:,:,1) = zqsr(:,:) 287 pe2(:,:,1) = zqsr(:,:) 288 pe3(:,:,1) = zqsr(:,:) 421 !$OMP PARALLEL 422 !$OMP DO schedule(static) private(jj,ji) 423 DO jj = 1, jpj 424 DO ji = 1, jpi 425 pe0(ji,jj,1) = pqsr(ji,jj) - 3. * zqsr(ji,jj) ! ( 1 - 3 * alpha ) * q 426 pe1(ji,jj,1) = zqsr(ji,jj) 427 pe2(ji,jj,1) = zqsr(ji,jj) 428 pe3(ji,jj,1) = zqsr(ji,jj) 429 END DO 430 END DO 289 431 ! 290 432 DO jk = 2, nksrp + 1 433 !$OMP DO schedule(static) private(jj,ji) 291 434 DO jj = 1, jpj 292 435 DO ji = 1, jpi … … 300 443 ! 301 444 END DO 445 !$OMP END PARALLEL 302 446 ! 303 447 ELSE ! T- level 304 448 ! 305 pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) ) 306 pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) ) 307 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 449 !$OMP PARALLEL 450 !$OMP DO schedule(static) private(jj,ji) 451 DO jj = 1, jpj 452 DO ji = 1, jpi 453 pe1(ji,jj,1) = zqsr(ji,jj) * EXP( -0.5 * ekb(ji,jj,1) ) 454 pe2(ji,jj,1) = zqsr(ji,jj) * EXP( -0.5 * ekg(ji,jj,1) ) 455 pe3(ji,jj,1) = zqsr(ji,jj) * EXP( -0.5 * ekr(ji,jj,1) ) 456 END DO 457 END DO 308 458 ! 309 459 DO jk = 2, nksrp 460 !$OMP DO schedule(static) private(jj,ji) 310 461 DO jj = 1, jpj 311 462 DO ji = 1, jpi … … 316 467 END DO 317 468 END DO 469 !$OMP END PARALLEL 318 470 ! 319 471 ENDIF … … 369 521 INTEGER :: ierr 370 522 INTEGER :: ios ! Local integer output status for namelist read 523 INTEGER :: ji, jj, jk ! dummy loop indices 371 524 REAL(wp), DIMENSION(nbtimes) :: zsteps ! times records 372 525 ! … … 424 577 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 425 578 ! 426 ekr (:,:,:) = 0._wp 427 ekb (:,:,:) = 0._wp 428 ekg (:,:,:) = 0._wp 429 etot (:,:,:) = 0._wp 430 etot_ndcy(:,:,:) = 0._wp 431 enano (:,:,:) = 0._wp 432 ediat (:,:,:) = 0._wp 433 IF( ln_p5z ) epico (:,:,:) = 0._wp 434 IF( ln_qsr_bio ) etot3 (:,:,:) = 0._wp 579 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 580 DO jk = 1, jpk 581 DO jj = 1, jpj 582 DO ji = 1, jpi 583 ekr (ji,jj,jk) = 0._wp 584 ekb (ji,jj,jk) = 0._wp 585 ekg (ji,jj,jk) = 0._wp 586 etot (ji,jj,jk) = 0._wp 587 etot_ndcy(ji,jj,jk) = 0._wp 588 enano (ji,jj,jk) = 0._wp 589 ediat (ji,jj,jk) = 0._wp 590 END DO 591 END DO 592 END DO 593 IF( ln_qsr_bio ) THEN 594 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 595 DO jk = 1, jpk 596 DO jj = 1, jpj 597 DO ji = 1, jpi 598 etot3 (ji,jj,jk) = 0._wp 599 END DO 600 END DO 601 END DO 602 END IF 603 604 IF( ln_p5z ) THEN 605 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 606 DO jk = 1, jpk 607 DO jj = 1, jpj 608 DO ji = 1, jpi 609 epico (ji,jj,jk) = 0._wp 610 END DO 611 END DO 612 END DO 613 END IF 435 614 ! 436 615 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt_init') -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90
r7646 r7698 89 89 ! Initialisation of temprary arrys 90 90 IF( ln_p4z ) THEN 91 zremipoc(:,:,:) = xremip 92 zremigoc(:,:,:) = xremip 91 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 92 DO jk = 1, jpk 93 DO jj = 1, jpj 94 DO ji = 1, jpi 95 zremipoc(ji,jj,jk) = xremip 96 zremigoc(ji,jj,jk) = xremip 97 END DO 98 END DO 99 END DO 93 100 ELSE ! ln_p5z 94 zremipoc(:,:,:) = xremipc 95 zremigoc(:,:,:) = xremipc 101 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 102 DO jk = 1, jpk 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 zremipoc(ji,jj,jk) = xremipc 106 zremigoc(ji,jj,jk) = xremipc 107 END DO 108 END DO 109 END DO 96 110 ENDIF 97 zorem3(:,:,:) = 0. 98 orem (:,:,:) = 0. 99 ztremint(:,:,:) = 0. 100 111 !$OMP PARALLEL 112 !$OMP DO schedule(static) private(jk, jj, ji) 113 DO jk = 1, jpk 114 DO jj = 1, jpj 115 DO ji = 1, jpi 116 zorem3 (ji,jj,jk) = 0. 117 orem (ji,jj,jk) = 0. 118 ztremint(ji,jj,jk) = 0. 119 END DO 120 END DO 121 END DO 122 !OMP END DO NOWAIT 101 123 DO jn = 1, jcpoc 102 alphag(:,:,:,jn) = alphan(jn) 103 alphap(:,:,:,jn) = alphan(jn) 124 !$OMP DO schedule(static) private(jk, jj, ji) 125 DO jk = 1, jpk 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 alphag(ji,jj,jk,jn) = alphan(jn) 129 alphap(ji,jj,jk,jn) = alphan(jn) 130 END DO 131 END DO 132 END DO 104 133 END DO 134 !$OMP END PARALLEL 105 135 106 136 ! ----------------------------------------------------------------------- … … 110 140 ! ----------------------------------------------------------------------- 111 141 DO jk = 2, jpkm1 142 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,alphat,remint,zsizek1,zsizek,zpoc,jn) 112 143 DO jj = 1, jpj 113 144 DO ji = 1, jpi … … 120 151 ! 121 152 IF( gdept_n(ji,jj,jk) > zdep ) THEN 122 alphat = 0.123 remint = 0.124 !125 153 zsizek1 = e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 126 154 zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) … … 155 183 & + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn) & 156 184 & * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2 157 alphat = alphat + alphag(ji,jj,jk,jn) 158 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 185 159 186 END DO 160 187 ELSE … … 174 201 & - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 175 202 & / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) 176 alphat = alphat + alphag(ji,jj,jk,jn)177 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn)178 203 END DO 179 204 ENDIF 205 ! 206 alphat = SUM(alphag(ji,jj,jk,:)) 207 remint = SUM(alphag(ji,jj,jk,:) * reminp(:)) 180 208 ! 181 209 DO jn = 1, jcpoc … … 193 221 END DO 194 222 195 IF( ln_p4z ) THEN ; zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 196 ELSE ; zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 223 IF( ln_p4z ) THEN 224 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 225 DO jk = 1, jpk 226 DO jj = 1, jpj 227 DO ji = 1, jpi 228 zremigoc(ji,jj,jk) = MIN( xremip , ztremint(ji,jj,jk) ) 229 END DO 230 END DO 231 END DO 232 ELSE 233 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 234 DO jk = 1, jpk 235 DO jj = 1, jpj 236 DO ji = 1, jpi 237 zremigoc(ji,jj,jk) = MIN( xremipc, ztremint(ji,jj,jk) ) 238 END DO 239 END DO 240 END DO 197 241 ENDIF 198 242 199 243 IF( ln_p4z ) THEN 244 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremig,zorem2,zofer2,zofer3) 200 245 DO jk = 1, jpkm1 201 246 DO jj = 1, jpj … … 221 266 END DO 222 267 ELSE 268 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremig,zopoc2,zofer2,zopon2,zopop2) 223 269 DO jk = 1, jpkm1 224 270 DO jj = 1, jpj … … 266 312 ! ------------------------------------------------------------------- 267 313 ! 268 totprod(:,:) = 0. 269 totthick(:,:) = 0. 270 totcons(:,:) = 0. 314 !$OMP PARALLEL 315 !$OMP DO schedule(static) private(jj,ji) 316 DO jj = 1, jpj 317 DO ji = 1, jpi 318 totprod(ji,jj) = 0. 319 totthick(ji,jj) = 0. 320 totcons(ji,jj) = 0. 321 END DO 322 END DO 271 323 ! intregrated production and consumption of POC in the mixed layer 272 324 ! ---------------------------------------------------------------- 273 325 ! 274 326 DO jk = 1, jpkm1 327 !$OMP DO schedule(static) private(jj,ji,zdep) 275 328 DO jj = 1, jpj 276 329 DO ji = 1, jpi … … 286 339 END DO 287 340 END DO 341 !$OMP END PARALLEL 288 342 289 343 ! Computation of the lability spectrum in the mixed layer. In the mixed 290 344 ! layer, this spectrum is supposed to be uniform. 291 345 ! --------------------------------------------------------------------- 346 !$OMP DO schedule(static) private(jk,jj,ji,zdep,alphat,remint,jn) 292 347 DO jk = 1, jpkm1 293 348 DO jj = 1, jpj … … 295 350 IF (tmask(ji,jj,jk) == 1.) THEN 296 351 zdep = hmld(ji,jj) 297 alphat = 0.0298 remint = 0.0299 352 IF( gdept_n(ji,jj,jk) <= zdep ) THEN 300 353 DO jn = 1, jcpoc … … 303 356 alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn) & 304 357 & * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 305 alphat = alphat + alphap(ji,jj,jk,jn)306 358 END DO 359 alphat = SUM(alphap(ji,jj,jk,:)) 307 360 DO jn = 1, jcpoc 308 361 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 309 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn)310 362 END DO 363 remint = SUM(alphap(ji,jj,jk,:) * reminp(:)) 311 364 ! Mean remineralization rate in the mixed layer 312 365 ztremint(ji,jj,jk) = MAX( 0., remint ) … … 317 370 END DO 318 371 ! 319 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 320 ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 372 IF( ln_p4z ) THEN 373 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 374 DO jk = 1, jpk 375 DO jj = 1, jpj 376 DO ji = 1, jpi 377 zremipoc(ji,jj,jk) = MIN( xremip , ztremint(ji,jj,jk) ) 378 END DO 379 END DO 380 END DO 381 ELSE 382 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 383 DO jk = 1, jpk 384 DO jj = 1, jpj 385 DO ji = 1, jpi 386 zremipoc(ji,jj,jk) = MIN( xremipc , ztremint(ji,jj,jk) ) 387 END DO 388 END DO 389 END DO 321 390 ENDIF 322 391 … … 330 399 ! 331 400 DO jk = 2, jpkm1 401 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,alphat,remint,zsizek1,zsizek,zpoc,jn) 332 402 DO jj = 1, jpj 333 403 DO ji = 1, jpi … … 335 405 zdep = hmld(ji,jj) 336 406 IF( gdept_n(ji,jj,jk) > zdep ) THEN 337 alphat = 0.338 remint = 0.339 407 ! 340 408 ! the scale factors are corrected with temperature … … 362 430 & * zsizek ) ) 363 431 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 364 alphat = alphat + alphap(ji,jj,jk,jn)365 432 END DO 366 433 ELSE … … 385 452 & - exp( -reminp(jn) * zsizek ) ) 386 453 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 387 alphat = alphat + alphap(ji,jj,jk,jn)388 454 END DO 389 455 ENDIF 456 alphat = SUM(alphap(ji,jj,jk,:)) 390 457 ! Normalization of the lability spectrum so that the 391 458 ! integral is equal to 1 392 459 DO jn = 1, jcpoc 393 460 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 394 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn)395 461 END DO 462 remint = SUM(alphap(ji,jj,jk,:) * reminp(:)) 396 463 ! Mean remineralization rate in the water column 397 464 ztremint(ji,jj,jk) = MAX( 0., remint ) … … 402 469 END DO 403 470 404 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 405 ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 471 IF( ln_p4z ) THEN 472 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 473 DO jk = 1, jpk 474 DO jj = 1, jpj 475 DO ji = 1, jpi 476 zremipoc(ji,jj,jk) = MIN( xremip , ztremint(ji,jj,jk) ) 477 END DO 478 END DO 479 END DO 480 ELSE 481 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 482 DO jk = 1, jpk 483 DO jj = 1, jpj 484 DO ji = 1, jpi 485 zremipoc(ji,jj,jk) = MIN( xremipc , ztremint(ji,jj,jk) ) 486 END DO 487 END DO 488 END DO 406 489 ENDIF 407 490 408 491 IF( ln_p4z ) THEN 492 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremip,zorem,zofer) 409 493 DO jk = 1, jpkm1 410 494 DO jj = 1, jpj … … 427 511 END DO 428 512 ELSE 513 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremip,zopoc,zopon,zopop,zofer) 429 514 DO jk = 1, jpkm1 430 515 DO jj = 1, jpj … … 487 572 !! 488 573 !!---------------------------------------------------------------------- 489 INTEGER :: jn 574 INTEGER :: jn, jk, jj, ji 490 575 REAL(wp) :: remindelta, reminup, remindown 491 576 INTEGER :: ifault … … 557 642 558 643 DO jn = 1, jcpoc 559 alphap(:,:,:,jn) = alphan(jn) 644 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 645 DO jk = 1, jpk 646 DO jj = 1, jpj 647 DO ji = 1, jpi 648 alphap(ji,jj,jk,jn) = alphan(jn) 649 END DO 650 END DO 651 END DO 560 652 END DO 561 653 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r7646 r7698 93 93 CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 94 94 ! 95 zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp96 zprofen (:,:,:) = 0._wp ; zysopt (:,:,:) = 0._wp97 zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia (:,:,:) = 0._wp98 zprbio (:,:,:) = 0._wp ; zprdch (:,:,:) = 0._wp ; zprnch (:,:,:) = 0._wp99 zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp100 101 ! Computation of the optimal production102 prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:)103 104 95 ! compute the day length depending on latitude and the day 105 96 zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 106 97 zcodel = ASIN( SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp ) ) 107 98 99 !$OMP PARALLEL 100 !$OMP DO schedule(static) private(jk,jj,ji) 101 DO jk = 1, jpk 102 DO jj = 1, jpj 103 DO ji = 1, jpi 104 zprorcan(ji,jj,jk) = 0._wp 105 zprorcad(ji,jj,jk) = 0._wp 106 zprofed (ji,jj,jk) = 0._wp 107 zprofen (ji,jj,jk) = 0._wp 108 zysopt (ji,jj,jk) = 0._wp 109 zpronewn(ji,jj,jk) = 0._wp 110 zpronewd(ji,jj,jk) = 0._wp 111 zprdia (ji,jj,jk) = 0._wp 112 zprbio (ji,jj,jk) = 0._wp 113 zprdch (ji,jj,jk) = 0._wp 114 zprnch (ji,jj,jk) = 0._wp 115 zmxl_fac(ji,jj,jk) = 0._wp 116 zmxl_chl(ji,jj,jk) = 0._wp 117 118 ! Computation of the optimal production 119 prmax(ji,jj,jk) = 0.8_wp * r1_rday * tgfunc(ji,jj,jk) 120 END DO 121 END DO 122 END DO 123 108 124 ! day length in hours 109 zstrn(:,:) = 0. 125 !$OMP DO schedule(static) private(jj,ji) 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 zstrn(ji,jj) = 0. 129 END DO 130 END DO 131 !$OMP DO schedule(static) private(jj,ji,zargu) 110 132 DO jj = 1, jpj 111 133 DO ji = 1, jpi … … 117 139 118 140 ! Impact of the day duration and light intermittency on phytoplankton growth 141 !$OMP DO schedule(static) private(jk,jj,ji,zval) 119 142 DO jk = 1, jpkm1 120 143 DO jj = 1 ,jpj … … 132 155 END DO 133 156 134 zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:) 135 zprdia(:,:,:) = zprbio(:,:,:) 157 !$OMP DO schedule(static) private(jk,jj,ji) 158 DO jk = 1, jpk 159 DO jj = 1 ,jpj 160 DO ji = 1, jpi 161 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zmxl_fac(ji,jj,jk) 162 zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 163 END DO 164 END DO 165 END DO 136 166 137 167 ! Maximum light intensity 138 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 168 !$OMP DO schedule(static) private(jj,ji) 169 DO jj = 1 ,jpj 170 DO ji = 1, jpi 171 IF( zstrn(ji,jj) < 1.e0 ) zstrn(ji,jj) = 24. 172 END DO 173 END DO 139 174 140 175 ! Computation of the P-I slope for nanos and diatoms 176 !$OMP DO schedule(static) private(jk,jj,ji,ztn,zadap,zconctemp,zconctemp2) 141 177 DO jk = 1, jpkm1 142 178 DO jj = 1, jpj … … 159 195 160 196 IF( ln_newprod ) THEN 197 !$OMP DO schedule(static) private(jk,jj,ji,zpislopen,zpisloped) 161 198 DO jk = 1, jpkm1 162 199 DO jj = 1, jpj … … 182 219 END DO 183 220 ELSE 221 !$OMP DO schedule(static) private(jk,jj,ji,zpislopen,zpisloped) 184 222 DO jk = 1, jpkm1 185 223 DO jj = 1, jpj … … 206 244 ! Computation of a proxy of the N/C ratio 207 245 ! --------------------------------------- 246 !$OMP DO schedule(static) private(jk,jj,ji,zval) 208 247 DO jk = 1, jpkm1 209 248 DO jj = 1, jpj … … 218 257 END DO 219 258 END DO 220 221 259 !$OMP END DO NOWAIT 260 261 262 !$OMP DO schedule(static) private(jk,jj,ji,zlim,zsilim,zsilfac,zsiborn,zsilfac2) 222 263 DO jk = 1, jpkm1 223 264 DO jj = 1, jpj … … 244 285 END DO 245 286 END DO 287 !$OMP END DO NOWAIT 246 288 247 289 ! Mixed-layer effect on production 248 290 ! Sea-ice effect on production 249 291 292 !$OMP DO schedule(static) private(jk,jj,ji) 250 293 DO jk = 1, jpkm1 251 294 DO jj = 1, jpj … … 260 303 261 304 ! Computation of the various production terms 305 !$OMP DO schedule(static) private(jk,jj,ji,zratio,zmax) 262 306 DO jk = 1, jpkm1 263 307 DO jj = 1, jpj … … 290 334 291 335 ! Computation of the chlorophyll production terms 336 !$OMP DO schedule(static) private(jk,jj,ji,znanotot,zprod,zprochln,chlcnm_n,zprochld,zdiattot) 292 337 DO jk = 1, jpkm1 293 338 DO jj = 1, jpj … … 317 362 318 363 ! Update the arrays TRA which contain the biological sources and sinks 364 !$OMP DO schedule(static) private(jk,jj,ji,zproreg,zproreg2,zdocprod,zfeup) 319 365 DO jk = 1, jpkm1 320 366 DO jj = 1, jpj … … 348 394 ! 349 395 IF( ln_ligand ) THEN 396 !$OMP DO schedule(static) private(jk,jj,ji,zdocprod,zfeup) 350 397 DO jk = 1, jpkm1 351 398 DO jj = 1, jpj … … 360 407 END DO 361 408 ENDIF 409 !$OMP END PARALLEL 362 410 363 411 … … 373 421 ! 374 422 IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) ) THEN 375 zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:) ! primary production by nanophyto 376 CALL iom_put( "PPPHYN" , zw3d ) 423 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 424 DO jk = 1, jpk 425 DO jj = 1, jpj 426 DO ji = 1, jpi 427 zw3d(ji,jj,jk) = zprorcan (ji,jj,jk) * zfact * tmask(ji,jj,jk) ! primary production by nanophyto 428 END DO 429 END DO 430 END DO 431 CALL iom_put( "PPPHYN" , zw3d ) 432 ! 433 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 434 DO jk = 1, jpk 435 DO jj = 1, jpj 436 DO ji = 1, jpi 437 zw3d(ji,jj,jk) = zprorcad (ji,jj,jk) * zfact * tmask(ji,jj,jk) ! primary production by nanophyto 438 END DO 439 END DO 440 END DO 441 CALL iom_put( "PPPHYD" , zw3d ) 442 ENDIF 443 IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) ) THEN 444 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 445 DO jk = 1, jpk 446 DO jj = 1, jpj 447 DO ji = 1, jpi 448 zw3d(ji,jj,jk) = zpronewn (ji,jj,jk) * zfact * tmask(ji,jj,jk) ! new primary production by nanophyto 449 END DO 450 END DO 451 END DO 452 CALL iom_put( "PPNEWN" , zw3d ) 377 453 ! 378 zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) ! primary production by diatomes 379 CALL iom_put( "PPPHYD" , zw3d )380 ENDIF381 IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) ) THEN382 zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:) ! new primary production by nanophyto383 CALL iom_put( "PPNEWN" , zw3d )384 !385 zw3d(:,:,:) = zpronewd(:,:,:) * zfact * tmask(:,:,:) ! new primary production by diatomes386 454 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 455 DO jk = 1, jpk 456 DO jj = 1, jpj 457 DO ji = 1, jpi 458 zw3d(ji,jj,jk) = zpronewd (ji,jj,jk) * zfact * tmask(ji,jj,jk) ! new primary production by nanophyto 459 END DO 460 END DO 461 END DO 462 CALL iom_put( "PPNEWD" , zw3d ) 387 463 ENDIF 388 464 IF( iom_use( "PBSi" ) ) THEN 389 zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ! biogenic silica production 390 CALL iom_put( "PBSi" , zw3d ) 465 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 466 DO jk = 1, jpk 467 DO jj = 1, jpj 468 DO ji = 1, jpi 469 zw3d(ji,jj,jk) = zprorcad(ji,jj,jk) * zfact * tmask(ji,jj,jk) * zysopt(ji,jj,jk) ! biogenic silica production 470 END DO 471 END DO 472 END DO 473 CALL iom_put( "PBSi" , zw3d ) 391 474 ENDIF 392 475 IF( iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) ) THEN 393 zw3d(:,:,:) = zprofen(:,:,:) * zfact * tmask(:,:,:) ! biogenic iron production by nanophyto 394 CALL iom_put( "PFeN" , zw3d ) 395 ! 396 zw3d(:,:,:) = zprofed(:,:,:) * zfact * tmask(:,:,:) ! biogenic iron production by diatomes 397 CALL iom_put( "PFeD" , zw3d ) 476 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 477 DO jk = 1, jpk 478 DO jj = 1, jpj 479 DO ji = 1, jpi 480 zw3d(ji,jj,jk) = zprofen(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! biogenic iron production by nanophyto 481 END DO 482 END DO 483 END DO 484 CALL iom_put( "PFeN" , zw3d ) 485 ! 486 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 487 DO jk = 1, jpk 488 DO jj = 1, jpj 489 DO ji = 1, jpi 490 zw3d(ji,jj,jk) = zprofed(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! biogenic iron production by nanophyto 491 END DO 492 END DO 493 END DO 494 CALL iom_put( "PFeD" , zw3d ) 398 495 ENDIF 399 496 IF( iom_use( "Mumax" ) ) THEN 400 zw3d(:,:,:) = prmax(:,:,:) * tmask(:,:,:) ! Maximum growth rate 401 CALL iom_put( "Mumax" , zw3d ) 497 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 498 DO jk = 1, jpk 499 DO jj = 1, jpj 500 DO ji = 1, jpi 501 zw3d(ji,jj,jk) = prmax(ji,jj,jk) * tmask(ji,jj,jk) ! Maximum growth rate 502 END DO 503 END DO 504 END DO 505 CALL iom_put( "Mumax" , zw3d ) 402 506 ENDIF 403 507 IF( iom_use( "MuN" ) .OR. iom_use( "MuD" ) ) THEN 404 zw3d(:,:,:) = zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ! Realized growth rate for nanophyto 405 CALL iom_put( "MuN" , zw3d ) 406 ! 407 zw3d(:,:,:) = zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ! Realized growth rate for diatoms 408 CALL iom_put( "MuD" , zw3d ) 508 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 509 DO jk = 1, jpk 510 DO jj = 1, jpj 511 DO ji = 1, jpi 512 zw3d(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tmask(ji,jj,jk) ! Realized growth rate for nanophyto 513 END DO 514 END DO 515 END DO 516 CALL iom_put( "MuN" , zw3d ) 517 ! 518 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 519 DO jk = 1, jpk 520 DO jj = 1, jpj 521 DO ji = 1, jpi 522 zw3d(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tmask(ji,jj,jk) ! Realized growth rate for diatoms 523 END DO 524 END DO 525 END DO 526 CALL iom_put( "MuD" , zw3d ) 409 527 ENDIF 410 528 IF( iom_use( "LNlight" ) .OR. iom_use( "LDlight" ) ) THEN 411 zw3d(:,:,:) = zprbio (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term 412 CALL iom_put( "LNlight" , zw3d ) 413 ! 414 zw3d(:,:,:) = zprdia (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term 415 CALL iom_put( "LDlight" , zw3d ) 529 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 530 DO jk = 1, jpk 531 DO jj = 1, jpj 532 DO ji = 1, jpi 533 zw3d(ji,jj,jk) = zprbio (ji,jj,jk) / (prmax(ji,jj,jk) + rtrn) * tmask(ji,jj,jk) ! light limitation term 534 END DO 535 END DO 536 END DO 537 CALL iom_put( "LNlight" , zw3d ) 538 ! 539 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 540 DO jk = 1, jpk 541 DO jj = 1, jpj 542 DO ji = 1, jpi 543 zw3d(ji,jj,jk) = zprdia (ji,jj,jk) / (prmax(ji,jj,jk) + rtrn) * tmask(ji,jj,jk) ! light limitation term 544 END DO 545 END DO 546 END DO 547 CALL iom_put( "LDlight" , zw3d ) 416 548 ENDIF 417 549 IF( iom_use( "TPP" ) ) THEN 418 zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production 419 CALL iom_put( "TPP" , zw3d ) 550 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 551 DO jk = 1, jpk 552 DO jj = 1, jpj 553 DO ji = 1, jpi 554 zw3d(ji,jj,jk) = ( zprorcan(ji,jj,jk) + zprorcad(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! total primary production 555 END DO 556 END DO 557 END DO 558 CALL iom_put( "TPP" , zw3d ) 420 559 ENDIF 421 560 IF( iom_use( "TPNEW" ) ) THEN 422 zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production 423 CALL iom_put( "TPNEW" , zw3d ) 561 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 562 DO jk = 1, jpk 563 DO jj = 1, jpj 564 DO ji = 1, jpi 565 zw3d(ji,jj,jk) = ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! total new production 566 END DO 567 END DO 568 END DO 569 CALL iom_put( "TPNEW" , zw3d ) 424 570 ENDIF 425 571 IF( iom_use( "TPBFE" ) ) THEN 426 zw3d(:,:,:) = ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:) ! total biogenic iron production 427 CALL iom_put( "TPBFE" , zw3d ) 572 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 573 DO jk = 1, jpk 574 DO jj = 1, jpj 575 DO ji = 1, jpi 576 zw3d(ji,jj,jk) = ( zprofen(ji,jj,jk) + zprofed(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! total biogenic iron production 577 END DO 578 END DO 579 END DO 580 CALL iom_put( "TPBFE" , zw3d ) 428 581 ENDIF 429 582 IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN 430 zw2d(:,:) = 0. 583 !$OMP PARALLEL 584 !$OMP DO schedule(static) private(jj,ji) 585 DO jj = 1, jpj 586 DO ji =1 ,jpi 587 zw2d(ji,jj) = 0. 588 END DO 589 END DO 431 590 DO jk = 1, jpkm1 432 zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano 591 !$OMP DO schedule(static) private(jj,ji) 592 DO jj = 1, jpj 593 DO ji =1 ,jpi 594 zw2d(ji,jj) = zw2d(ji,jj) + zprorcan (ji,jj,jk) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert. integrated primary produc. by nano 595 END DO 596 END DO 433 597 ENDDO 598 !$OMP END PARALLEL 434 599 CALL iom_put( "INTPPPHYN" , zw2d ) 435 600 ! 436 zw2d(:,:) = 0. 601 !$OMP PARALLEL 602 !$OMP DO schedule(static) private(jj,ji) 603 DO jj = 1, jpj 604 DO ji =1 ,jpi 605 zw2d(ji,jj) = 0. 606 END DO 607 END DO 437 608 DO jk = 1, jpkm1 438 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom 609 !$OMP DO schedule(static) private(jj,ji) 610 DO jj = 1, jpj 611 DO ji =1 ,jpi 612 zw2d(ji,jj) = zw2d(ji,jj) + zprorcad(ji,jj,jk) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert. integrated primary produc. by diatom 613 END DO 614 END DO 439 615 ENDDO 616 !$OMP END PARALLEL 440 617 CALL iom_put( "INTPPPHYD" , zw2d ) 441 618 ENDIF 442 619 IF( iom_use( "INTPP" ) ) THEN 443 zw2d(:,:) = 0. 620 !$OMP PARALLEL 621 !$OMP DO schedule(static) private(jj,ji) 622 DO jj = 1, jpj 623 DO ji =1 ,jpi 624 zw2d(ji,jj) = 0. 625 END DO 626 END DO 444 627 DO jk = 1, jpkm1 445 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 628 !$OMP DO schedule(static) private(jj,ji) 629 DO jj = 1, jpj 630 DO ji =1 ,jpi 631 zw2d(ji,jj) = zw2d(ji,jj) + ( zprorcan(ji,jj,jk) + zprorcad(ji,jj,jk) ) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert. integrated pp 632 END DO 633 END DO 446 634 ENDDO 635 !$OMP END PARALLEL 447 636 CALL iom_put( "INTPP" , zw2d ) 448 637 ENDIF 449 638 IF( iom_use( "INTPNEW" ) ) THEN 450 zw2d(:,:) = 0. 639 !$OMP PARALLEL 640 !$OMP DO schedule(static) private(jj,ji) 641 DO jj = 1, jpj 642 DO ji =1 ,jpi 643 zw2d(ji,jj) = 0. 644 END DO 645 END DO 451 646 DO jk = 1, jpkm1 452 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod 647 !$OMP DO schedule(static) private(jj,ji) 648 DO jj = 1, jpj 649 DO ji =1 ,jpi 650 zw2d(ji,jj) = zw2d(ji,jj) + ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert. integrated new prod 651 END DO 652 END DO 453 653 ENDDO 654 !$OMP END PARALLEL 454 655 CALL iom_put( "INTPNEW" , zw2d ) 455 656 ENDIF 456 657 IF( iom_use( "INTPBFE" ) ) THEN ! total biogenic iron production ( vertically integrated ) 457 zw2d(:,:) = 0. 658 !$OMP PARALLEL 659 !$OMP DO schedule(static) private(jj,ji) 660 DO jj = 1, jpj 661 DO ji =1 ,jpi 662 zw2d(ji,jj) = 0. 663 END DO 664 END DO 458 665 DO jk = 1, jpkm1 459 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 666 !$OMP DO schedule(static) private(jj,ji) 667 DO jj = 1, jpj 668 DO ji =1 ,jpi 669 zw2d(ji,jj) = zw2d(ji,jj) + ( zprofen(ji,jj,jk) + zprofed(ji,jj,jk) ) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert integr. bfe prod 670 END DO 671 END DO 460 672 ENDDO 673 !$OMP END PARALLEL 461 674 CALL iom_put( "INTPBFE" , zw2d ) 462 675 ENDIF 463 676 IF( iom_use( "INTPBSI" ) ) THEN ! total biogenic silica production ( vertically integrated ) 464 zw2d(:,:) = 0. 677 !$OMP PARALLEL 678 !$OMP DO schedule(static) private(jj,ji) 679 DO jj = 1, jpj 680 DO ji =1 ,jpi 681 zw2d(ji,jj) = 0. 682 END DO 683 END DO 465 684 DO jk = 1, jpkm1 466 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bsi prod 685 !$OMP DO schedule(static) private(jj,ji) 686 DO jj = 1, jpj 687 DO ji =1 ,jpi 688 zw2d(ji,jj) = zw2d(ji,jj) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert integr. bsi prod 689 END DO 690 END DO 467 691 ENDDO 692 !$OMP END PARALLEL 468 693 CALL iom_put( "INTPBSI" , zw2d ) 469 694 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r7646 r7698 78 78 79 79 ! Initialisation of temprary arrys 80 zdepprod(:,:,:) = 1._wp 81 ztempbac(:,:) = 0._wp 82 zfacsib(:,:,:) = xsilab / ( 1.0 - xsilab ) 83 zfacsi(:,:,:) = xsilab 80 !$OMP PARALLEL 81 !$OMP DO schedule(static) private(jk,jj,ji) 82 DO jk = 1, jpk 83 DO jj = 1, jpj 84 DO ji = 1, jpi 85 zdepprod(ji,jj,jk) = 1._wp 86 zfacsib(ji,jj,jk) = xsilab / ( 1.0 - xsilab ) 87 zfacsi(ji,jj,jk) = xsilab 88 END DO 89 END DO 90 END DO 91 !$OMP DO schedule(static) private(jj,ji) 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 ztempbac(ji,jj) = 0._wp 95 END DO 96 END DO 84 97 85 98 ! Computation of the mean phytoplankton concentration as … … 89 102 ! ------------------------------------------------------- 90 103 DO jk = 1, jpkm1 104 !$OMP DO schedule(static) private(jj,ji,zdep,zdepmin) 91 105 DO jj = 1, jpj 92 106 DO ji = 1, jpi … … 105 119 106 120 IF( ln_p4z ) THEN 121 !$OMP DO schedule(static) private(jk,jj,ji,zremik,zolimit) 107 122 DO jk = 1, jpkm1 108 123 DO jj = 1, jpj … … 136 151 END DO 137 152 ELSE 153 !$OMP DO schedule(static) private(jk,jj,ji,zremik,zremikc,zremikn,zremikp,zolimit,zolimic,zolimin,zolimip,zdenitrn,zdenitrp) 138 154 DO jk = 1, jpkm1 139 155 DO jj = 1, jpj … … 181 197 182 198 199 !$OMP DO schedule(static) private(jk,jj,ji,zonitr,zdenitnh4) 183 200 DO jk = 1, jpkm1 184 201 DO jj = 1, jpj … … 199 216 END DO 200 217 END DO 201 202 IF(ln_ctl) THEN ! print mean trends (used for debugging) 203 WRITE(charout, FMT="('rem1')") 204 CALL prt_ctl_trc_info(charout) 205 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 206 ENDIF 207 218 !$OMP END PARALLEL 219 220 IF(ln_ctl) THEN ! print mean trends (used for debugging) 221 WRITE(charout, FMT="('rem1')") 222 CALL prt_ctl_trc_info(charout) 223 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 224 ENDIF 225 226 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zbactfer) 208 227 DO jk = 1, jpkm1 209 228 DO jj = 1, jpj … … 224 243 END DO 225 244 226 227 228 229 230 245 IF(ln_ctl) THEN ! print mean trends (used for debugging) 246 WRITE(charout, FMT="('rem2')") 247 CALL prt_ctl_trc_info(charout) 248 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 249 ENDIF 231 250 232 251 ! Initialization of the array which contains the labile fraction … … 235 254 236 255 DO jk = 1, jpkm1 256 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,zsatur,zsatur2,znusil,zsiremin,zosil) 237 257 DO jj = 1, jpj 238 258 DO ji = 1, jpi … … 264 284 CALL prt_ctl_trc_info(charout) 265 285 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 266 286 ENDIF 267 287 268 288 IF( knt == nrdttrc ) THEN 269 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 270 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 271 ! 272 IF( iom_use( "REMIN" ) ) THEN 273 zw3d(:,:,:) = zolimi(:,:,:) * tmask(:,:,:) * zfact ! Remineralisation rate 274 CALL iom_put( "REMIN" , zw3d ) 275 ENDIF 276 IF( iom_use( "DENIT" ) ) THEN 277 zw3d(:,:,:) = denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zfact ! Denitrification 278 CALL iom_put( "DENIT" , zw3d ) 279 ENDIF 280 ! 281 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 282 ENDIF 289 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 290 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 291 ! 292 IF( iom_use( "REMIN" ) ) THEN 293 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 294 DO jk = 1, jpk 295 DO jj = 1, jpj 296 DO ji = 1, jpi 297 zw3d(ji,jj,jk) = zolimi(ji,jj,jk) * tmask(ji,jj,jk) * zfact ! Remineralisation rate 298 END DO 299 END DO 300 END DO 301 CALL iom_put( "REMIN" , zw3d ) 302 ENDIF 303 IF( iom_use( "DENIT" ) ) THEN 304 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 305 DO jk = 1, jpk 306 DO jj = 1, jpj 307 DO ji = 1, jpi 308 zw3d(ji,jj,jk) = denitr(ji,jj,jk) * rdenit * rno3 * tmask(ji,jj,jk) * zfact ! Denitrification 309 END DO 310 END DO 311 END DO 312 CALL iom_put( "DENIT" , zw3d ) 313 ENDIF 314 ! 315 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 316 ENDIF 283 317 ! 284 318 CALL wrk_dealloc( jpi, jpj, ztempbac ) … … 305 339 & xremikc, xremikn, xremikp 306 340 INTEGER :: ios ! Local integer output status for namelist read 341 INTEGER :: ji, jj, jk 307 342 308 343 REWIND( numnatp_ref ) ! Namelist nampisrem in reference namelist : Pisces remineralization … … 334 369 ENDIF 335 370 ! 336 denitr (:,:,:) = 0._wp 371 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 372 DO jk = 1, jpk 373 DO jj = 1, jpj 374 DO ji = 1, jpi 375 denitr (ji,jj,jk) = 0._wp 376 END DO 377 END DO 378 END DO 337 379 ! 338 380 END SUBROUTINE p4z_rem_init -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r7646 r7698 116 116 CALL fld_read( kt, 1, sf_dust ) 117 117 IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN 118 dust(:,:) = sf_dust(1)%fnow(:,:,1) 118 !$OMP PARALLEL DO schedule(static) private(jj, ji) 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 dust(ji,jj) = sf_dust(1)%fnow(ji,jj,1) 122 END DO 123 END DO 119 124 ELSE 120 dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) ) 125 !$OMP PARALLEL DO schedule(static) private(jj, ji) 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 dust(ji,jj) = sf_dust(1)%fnow(ji,jj,1) * ( 1.0 - fr_i(ji,jj) ) 129 END DO 130 END DO 121 131 ENDIF 122 132 ENDIF … … 126 136 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_solub > 1 ) ) THEN 127 137 CALL fld_read( kt, 1, sf_solub ) 128 solub(:,:) = sf_solub(1)%fnow(:,:,1) 138 !$OMP PARALLEL DO schedule(static) private(jj, ji) 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 solub(ji,jj) = sf_solub(1)%fnow(ji,jj,1) 142 END DO 143 END DO 129 144 ENDIF 130 145 ENDIF … … 137 152 CALL fld_read( kt, 1, sf_river ) 138 153 IF( ln_p4z ) THEN 154 !$OMP PARALLEL DO schedule(static) private(jj, ji, zcoef) 139 155 DO jj = 1, jpj 140 156 DO ji = 1, jpi … … 153 169 END DO 154 170 ELSE ! ln_p5z 171 !$OMP PARALLEL DO schedule(static) private(jj, ji, zcoef) 155 172 DO jj = 1, jpj 156 173 DO ji = 1, jpi … … 179 196 IF( ln_ndepo ) THEN 180 197 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 181 zcoef = rno3 * 14E6 * ryyss 182 CALL fld_read( kt, 1, sf_ndepo ) 183 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) 198 zcoef = rno3 * 14E6 * ryyss 199 CALL fld_read( kt, 1, sf_ndepo ) 200 !$OMP PARALLEL DO schedule(static) private(jj, ji) 201 DO jj = 1, jpj 202 DO ji = 1, jpi 203 nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / zcoef / e3t_n(ji,jj,1) 204 END DO 205 END DO 184 206 ENDIF 185 207 IF( .NOT.ln_linssh ) THEN 186 zcoef = rno3 * 14E6 * ryyss 187 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) 208 zcoef = rno3 * 14E6 * ryyss 209 !$OMP PARALLEL DO schedule(static) private(jj, ji) 210 DO jj = 1, jpj 211 DO ji = 1, jpi 212 nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / zcoef / e3t_n(ji,jj,1) 213 END DO 214 END DO 188 215 ENDIF 189 216 ENDIF … … 292 319 ! online configuration : computed in sbcrnf 293 320 IF( l_offline ) THEN 294 nk_rnf(:,:) = 1 295 h_rnf (:,:) = gdept_n(:,:,1) 321 !$OMP PARALLEL DO schedule(static) private(jj, ji) 322 DO jj = 1, jpj 323 DO ji = 1, jpi 324 nk_rnf(ji,jj) = 1 325 h_rnf (ji,jj) = gdept_n(ji,jj,1) 326 END DO 327 END DO 296 328 ENDIF 297 329 … … 466 498 IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1) 467 499 IF (lwp) WRITE(numout,*) 500 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmaskt) 468 501 DO jk = 1, ik50 469 502 DO jj = 2, jpjm1 … … 480 513 CALL lbc_lnk( zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) 481 514 ! 515 !$OMP PARALLEL 516 !$OMP DO schedule(static) private(jk, jj, ji, zexpide, zdenitide) 482 517 DO jk = 1, jpk 483 518 DO jj = 1, jpj … … 489 524 END DO 490 525 END DO 526 !$OMP END DO NOWAIT 491 527 ! Coastal supply of iron 492 528 ! ------------------------- 493 ironsed(:,:,jpk) = 0._wp 529 !$OMP DO schedule(static) private(jj,ji) 530 DO jj = 1, jpj 531 DO ji = 1, jpi 532 ironsed(ji,jj,jpk) = 0._wp 533 END DO 534 END DO 535 !$OMP DO schedule(static) private(jk,jj,ji) 494 536 DO jk = 1, jpkm1 495 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday ) 496 END DO 537 DO jj = 1, jpj 538 DO ji = 1, jpi 539 ironsed(ji,jj,jk) = sedfeinput * zcmask(ji,jj,jk) / ( e3t_0(ji,jj,jk) * rday ) 540 END DO 541 END DO 542 END DO 543 !$OMP END PARALLEL 497 544 DEALLOCATE( zcmask) 498 545 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r7646 r7698 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 34 !! $Id$ 34 !! $Id$ 35 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- … … 84 84 85 85 86 zdenit2d(:,:) = 0.e0 87 zbureff (:,:) = 0.e0 88 zwork1 (:,:) = 0.e0 89 zwork2 (:,:) = 0.e0 90 zwork3 (:,:) = 0.e0 91 zsedsi (:,:) = 0.e0 92 zsedcal (:,:) = 0.e0 93 zsedc (:,:) = 0.e0 94 86 !$OMP PARALLEL DO schedule(static) private(jj,ji) 87 DO jj = 1, jpj 88 DO ji = 1, jpi 89 zdenit2d(ji,jj) = 0.e0 90 zbureff (ji,jj) = 0.e0 91 zwork1 (ji,jj) = 0.e0 92 zwork2 (ji,jj) = 0.e0 93 zwork3 (ji,jj) = 0.e0 94 zsedsi (ji,jj) = 0.e0 95 zsedcal (ji,jj) = 0.e0 96 zsedc (ji,jj) = 0.e0 97 END DO 98 END DO 95 99 96 100 ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. … … 100 104 CALL wrk_alloc( jpi, jpj, zironice ) 101 105 ! 106 !$OMP PARALLEL 107 !$OMP DO schedule(static) private(jj,ji,zdep,zwflux,zfminus,zfplus) 102 108 DO jj = 1, jpj 103 109 DO ji = 1, jpi … … 110 116 END DO 111 117 ! 112 tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:) 118 !$OMP DO schedule(static) private(jj,ji) 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 tra(ji,jj,1,jpfer) = tra(ji,jj,1,jpfer) + zironice(ji,jj) 122 END DO 123 END DO 124 !$OMP END PARALLEL 113 125 ! 114 126 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) ) & … … 127 139 ! ! Iron and Si deposition at the surface 128 140 IF( ln_solub ) THEN 129 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 141 !$OMP PARALLEL DO schedule(static) private(jj,ji) 142 DO jj = 1, jpj 143 DO ji = 1, jpi 144 zirondep(ji,jj,1) = solub(ji,jj) * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 55.85 + 3.e-10 * r1_ryyss 145 END DO 146 END DO 130 147 ELSE 131 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 148 !$OMP PARALLEL DO schedule(static) private(jj,ji) 149 DO jj = 1, jpj 150 DO ji = 1, jpi 151 zirondep(ji,jj,1) = dustsolub * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 55.85 + 3.e-10 * r1_ryyss 152 END DO 153 END DO 132 154 ENDIF 133 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 134 zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 155 !$OMP PARALLEL DO schedule(static) private(jj,ji) 156 DO jj = 1, jpj 157 DO ji = 1, jpi 158 zsidep(ji,jj) = 8.8 * 0.075 * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 28.1 159 zpdep (ji,jj,1) = 0.1 * 0.021 * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 31. / po4r 160 END DO 161 END DO 135 162 ! ! Iron solubilization of particles in the water column 136 163 ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j 137 164 zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 165 !$OMP PARALLEL 166 !$OMP DO schedule(static) private(jk,jj,ji) 138 167 DO jk = 2, jpkm1 139 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 140 zpdep (:,:,jk) = zirondep(:,:,jk) * 0.023 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 zirondep(ji,jj,jk) = dust(ji,jj) * mfrac * zwdust * rfact2 * EXP( -gdept_n(ji,jj,jk) / 540. ) 171 zpdep (ji,jj,jk) = zirondep(ji,jj,jk) * 0.023 172 END DO 173 END DO 141 174 END DO 142 175 ! ! Iron solubilization of particles in the water column 143 tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep (:,:) 144 tra(:,:,:,jppo4) = tra(:,:,:,jppo4) + zpdep (:,:,:) 145 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:) 176 !$OMP DO schedule(static) private(jj,ji) 177 DO jj = 1, jpj 178 DO ji = 1, jpi 179 tra(ji,jj,1,jpsil) = tra(ji,jj,1,jpsil) + zsidep (ji,jj) 180 END DO 181 END DO 182 !$OMP DO schedule(static) private(jk,jj,ji) 183 DO jk = 1, jpk 184 DO jj = 1, jpj 185 DO ji = 1, jpi 186 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zpdep (ji,jj,jk) 187 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zirondep(ji,jj,jk) 188 END DO 189 END DO 190 END DO 191 !$OMP END PARALLEL 146 192 ! 147 193 IF( lk_iomput ) THEN … … 161 207 ! ---------------------------------------------------------- 162 208 IF( ln_river ) THEN 209 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 163 210 DO jj = 1, jpj 164 211 DO ji = 1, jpi … … 174 221 ENDDO 175 222 IF( ln_p5z ) THEN 223 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 176 224 DO jj = 1, jpj 177 225 DO ji = 1, jpi … … 189 237 ! ---------------------------------------------------------- 190 238 IF( ln_ndepo ) THEN 191 tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 192 tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 239 !$OMP PARALLEL DO schedule(static) private(jj,ji) 240 DO jj = 1, jpj 241 DO ji = 1, jpi 242 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + nitdep(ji,jj) * rfact2 243 tra(ji,jj,1,jptal) = tra(ji,jj,1,jptal) - rno3 * nitdep(ji,jj) * rfact2 244 ENDDO 245 ENDDO 193 246 ENDIF 194 247 … … 196 249 ! ------------------------------------------------------ 197 250 IF( ln_ironsed ) THEN 198 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 199 IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2 251 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 252 DO jk = 1, jpk 253 DO jj = 1, jpj 254 DO ji = 1, jpi 255 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + ironsed(ji,jj,jk) * rfact2 256 END DO 257 END DO 258 END DO 259 260 IF( ln_ligand ) THEN 261 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 262 DO jk = 1, jpk 263 DO jj = 1, jpj 264 DO ji = 1, jpi 265 tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) + ( ironsed(ji,jj,jk) * fep_rats ) * rfact2 266 END DO 267 END DO 268 END DO 269 END IF 200 270 ! 201 271 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) & … … 206 276 ! ------------------------------------------------------ 207 277 IF( ln_hydrofe ) THEN 208 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 278 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 279 DO jk = 1, jpk 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + hydrofe(ji,jj,jk) * rfact2 283 END DO 284 END DO 285 END DO 209 286 IF( ln_ligand ) THEN 210 tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( hydrofe(:,:,:) * fep_rath ) * rfact2 211 tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 287 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 288 DO jk = 1, jpk 289 DO jj = 1, jpj 290 DO ji = 1, jpi 291 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + ( hydrofe(ji,jj,jk) * fep_rath ) * rfact2 292 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + ( hydrofe(ji,jj,jk) * lgw_rath ) * rfact2 293 END DO 294 END DO 295 END DO 212 296 ENDIF 213 297 ! … … 218 302 ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 219 303 ! -------------------------------------------------------------------- 304 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep) 220 305 DO jj = 1, jpj 221 306 DO ji = 1, jpi … … 229 314 ! 230 315 IF( ln_ligand ) THEN 316 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep) 231 317 DO jj = 1, jpj 232 318 DO ji = 1, jpi … … 242 328 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 243 329 ! ------------------------------------------------------- 330 !$OMP PARALLEL 331 !$OMP DO schedule(static) private(jj,ji,ikt,zflx,zo2,zno3,zdep) 244 332 DO jj = 1, jpj 245 333 DO ji = 1, jpi … … 267 355 ! The factor for calcite comes from the alkalinity effect 268 356 ! ------------------------------------------------------------- 357 !$OMP DO schedule(static) private(jj,ji,ikt,zfactcal) 269 358 DO jj = 1, jpj 270 359 DO ji = 1, jpi … … 280 369 END DO 281 370 END DO 371 !$OMP END PARALLEL 282 372 zsumsedsi = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 283 373 zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday … … 291 381 IF( .NOT.lk_sed ) zrivsil = 1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn ) 292 382 383 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwsc,zsiloss,zcaloss) 293 384 DO jj = 1, jpj 294 385 DO ji = 1, jpi … … 305 396 ! 306 397 IF( .NOT.lk_sed ) THEN 398 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwsc,zsiloss,zcaloss,zfactcal,zrivalk) 307 399 DO jj = 1, jpj 308 400 DO ji = 1, jpi … … 325 417 ENDIF 326 418 ! 419 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4) 327 420 DO jj = 1, jpj 328 421 DO ji = 1, jpi … … 339 432 ! 340 433 IF( ln_ligand ) THEN 434 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwssfep) 341 435 DO jj = 1, jpj 342 436 DO ji = 1, jpi … … 350 444 ! 351 445 IF( ln_p5z ) THEN 446 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4) 352 447 DO jj = 1, jpj 353 448 DO ji = 1, jpi … … 367 462 ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification 368 463 ! in the sediments and just above the sediments. Not very clever, but simpliest option. 464 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4,zrivno3,zwstpoc,zpdenit,z1pdenit,zolimit,zdenitt,zwstpop,zwstpon) 369 465 DO jj = 1, jpj 370 466 DO ji = 1, jpi … … 402 498 ! Small source iron from particulate inorganic iron 403 499 !----------------------------------- 500 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 404 501 DO jk = 1, jpkm1 405 zlight (:,:,jk) = ( 1.- EXP( -etot_ndcy(:,:,jk) / diazolight ) ) * ( 1. - fr_i(:,:) ) 406 zsoufer(:,:,jk) = zlight(:,:,jk) * 2E-11 / ( 2E-11 + biron(:,:,jk) ) 502 DO jj = 1, jpj 503 DO ji = 1, jpi 504 zlight (ji,jj,jk) = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) * ( 1. - fr_i(ji,jj) ) 505 zsoufer(ji,jj,jk) = zlight(ji,jj,jk) * 2E-11 / ( 2E-11 + biron(ji,jj,jk) ) 506 END DO 507 END DO 407 508 ENDDO 408 509 IF( ln_p4z ) THEN 510 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zlim,zfact,ztrfer,ztrpo4s) 409 511 DO jk = 1, jpkm1 410 512 DO jj = 1, jpj … … 423 525 END DO 424 526 ELSE ! p5z 527 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztemp,zmudia,xdianh4,xdiano3,zlim,zfact,ztrfer,ztrdp) 425 528 DO jk = 1, jpkm1 426 529 DO jj = 1, jpj … … 448 551 ! ---------------------------------------- 449 552 IF( ln_p4z ) THEN 553 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact) 450 554 DO jk = 1, jpkm1 451 555 DO jj = 1, jpj … … 462 566 END DO 463 567 ELSE ! p5z 568 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact) 464 569 DO jk = 1, jpkm1 465 570 DO jj = 1, jpj … … 497 602 IF( iom_use("Nfix" ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) ) ! nitrogen fixation 498 603 IF( iom_use("INTNFIX") ) THEN ! nitrogen fixation rate in ocean ( vertically integrated ) 499 zwork1(:,:) = 0. 604 !$OMP PARALLEL 605 !$OMP DO schedule(static) private(jj,ji) 606 DO jj = 1, jpj 607 DO ji = 1, jpi 608 zwork1(ji,jj) = 0. 609 END DO 610 ENDDO 500 611 DO jk = 1, jpkm1 501 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 612 !$OMP DO schedule(static) private(jj,ji) 613 DO jj = 1, jpj 614 DO ji = 1, jpi 615 zwork1(ji,jj) = zwork1(ji,jj) + nitrpot(ji,jj,jk) * nitrfix * zfact * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 616 END DO 617 END DO 502 618 ENDDO 619 !$OMP END PARALLEL 503 620 CALL iom_put( "INTNFIX" , zwork1 ) 504 621 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r7646 r7698 74 74 ! Initialization of some global variables 75 75 ! --------------------------------------- 76 prodpoc(:,:,:) = 0. 77 conspoc(:,:,:) = 0. 78 prodgoc(:,:,:) = 0. 79 consgoc(:,:,:) = 0. 76 !$OMP PARALLEL 77 !$OMP DO schedule(static) private(jk, jj, ji) 78 DO jk = 1, jpk 79 DO jj = 1, jpj 80 DO ji = 1,jpi 81 prodpoc(ji,jj,jk) = 0. 82 conspoc(ji,jj,jk) = 0. 83 prodgoc(ji,jj,jk) = 0. 84 consgoc(ji,jj,jk) = 0. 85 END DO 86 END DO 87 END DO 80 88 81 89 ! … … 83 91 ! by data and from the coagulation theory 84 92 ! ----------------------------------------------------------- 93 !$OMP DO schedule(static) private(jk, jj, ji, zmax, zfact) 85 94 DO jk = 1, jpkm1 86 95 DO jj = 1, jpj … … 94 103 95 104 ! limit the values of the sinking speeds to avoid numerical instabilities 96 wsbio3(:,:,:) = wsbio 105 !$OMP DO schedule(static) private(jk, jj, ji) 106 DO jk = 1, jpk 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 wsbio3(ji,jj,jk) = wsbio 110 END DO 111 END DO 112 END DO 113 !$OMP END PARALLEL 97 114 98 115 ! … … 112 129 iiter1 = 1 113 130 iiter2 = 1 131 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zwsmax) REDUCTION(MAX:iiter1, iiter2) 114 132 DO jk = 1, jpkm1 115 133 DO jj = 1, jpj … … 131 149 ENDIF 132 150 151 !$OMP PARALLEL 152 !$OMP DO schedule(static) private(jk, jj, ji, zwsmax) 133 153 DO jk = 1,jpkm1 134 154 DO jj = 1, jpj … … 143 163 END DO 144 164 145 wscal (:,:,:) = wsbio4(:,:,:)146 147 165 ! Initializa to zero all the sinking arrays 148 166 ! ----------------------------------------- 149 sinking (:,:,:) = 0.e0 150 sinking2(:,:,:) = 0.e0 151 sinkcal (:,:,:) = 0.e0 152 sinkfer (:,:,:) = 0.e0 153 sinksil (:,:,:) = 0.e0 154 sinkfer2(:,:,:) = 0.e0 167 !$OMP DO schedule(static) private(jk, jj, ji) 168 DO jk = 1, jpk 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 sinking (ji,jj,jk) = 0.e0 172 sinking2(ji,jj,jk) = 0.e0 173 sinkcal (ji,jj,jk) = 0.e0 174 sinkfer (ji,jj,jk) = 0.e0 175 sinksil (ji,jj,jk) = 0.e0 176 sinkfer2(ji,jj,jk) = 0.e0 177 wscal (ji,jj,jk) = wsbio4(ji,jj,jk) 178 END DO 179 END DO 180 END DO 181 !$OMP END PARALLEL 155 182 156 183 ! Compute the sedimentation term using p4zsink2 for all the sinking particles … … 169 196 170 197 IF( ln_p5z ) THEN 171 sinkingn (:,:,:) = 0.e0 172 sinking2n(:,:,:) = 0.e0 173 sinkingp (:,:,:) = 0.e0 174 sinking2p(:,:,:) = 0.e0 198 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 199 DO jk = 1, jpk 200 DO jj = 1, jpj 201 DO ji = 1, jpi 202 sinkingn (ji,jj,jk) = 0.e0 203 sinking2n(ji,jj,jk) = 0.e0 204 sinkingp (ji,jj,jk) = 0.e0 205 sinking2p(ji,jj,jk) = 0.e0 206 END DO 207 END DO 208 END DO 175 209 176 210 ! Compute the sedimentation term using p4zsink2 for all the sinking particles … … 188 222 189 223 IF( ln_ligand ) THEN 190 wsfep (:,:,:) = wfep 224 !$OMP PARALLEL 225 !$OMP DO schedule(static) private(jk, jj, ji) 226 DO jk = 1, jpk 227 DO jj = 1, jpj 228 DO ji = 1, jpi 229 wsfep (ji,jj,jk) = wfep 230 END DO 231 END DO 232 END DO 233 !$OMP DO schedule(static) private(jk, jj, ji, zwsmax) 191 234 DO jk = 1,jpkm1 192 235 DO jj = 1, jpj … … 199 242 END DO 200 243 END DO 244 !$OMP END DO NOWAIT 201 245 ! 202 sinkfep(:,:,:) = 0.e0 246 !$OMP DO schedule(static) private(jk, jj, ji) 247 DO jk = 1, jpk 248 DO jj = 1, jpj 249 DO ji = 1, jpi 250 sinkfep(ji,jj,jk) = 0.e0 251 END DO 252 END DO 253 END DO 254 !$OMP END PARALLEL 203 255 DO jit = 1, iiter1 204 256 CALL p4z_sink2( wsfep, sinkfep , jpfep, iiter1 ) … … 217 269 ! 218 270 IF( iom_use( "EPC100" ) ) THEN 219 zw2d(:,:) = ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of carbon at 100m 220 CALL iom_put( "EPC100" , zw2d ) 271 !$OMP PARALLEL DO schedule(static) private(jj, ji) 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 zw2d(ji,jj) = ( sinking(ji,jj,ik100) + sinking2(ji,jj,ik100) ) * zfact * tmask(ji,jj,1) ! Export of carbon at 100m 275 END DO 276 END DO 277 CALL iom_put( "EPC100" , zw2d ) 221 278 ENDIF 222 279 IF( iom_use( "EPFE100" ) ) THEN 223 zw2d(:,:) = ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of iron at 100m 224 CALL iom_put( "EPFE100" , zw2d ) 280 !$OMP PARALLEL DO schedule(static) private(jj, ji) 281 DO jj = 1, jpj 282 DO ji = 1, jpi 283 zw2d(ji,jj) = ( sinkfer(ji,jj,ik100) + sinkfer2(ji,jj,ik100) ) * zfact * tmask(ji,jj,1) ! Export of iron at 100m 284 END DO 285 END DO 286 CALL iom_put( "EPFE100" , zw2d ) 225 287 ENDIF 226 288 IF( iom_use( "EPCAL100" ) ) THEN 227 zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m 228 CALL iom_put( "EPCAL100" , zw2d ) 289 !$OMP PARALLEL DO schedule(static) private(jj, ji) 290 DO jj = 1, jpj 291 DO ji = 1, jpi 292 zw2d(ji,jj) = sinkcal(ji,jj,ik100) * zfact * tmask(ji,jj,1) ! Export of calcite at 100m 293 END DO 294 END DO 295 CALL iom_put( "EPCAL100" , zw2d ) 229 296 ENDIF 230 297 IF( iom_use( "EPSI100" ) ) THEN 231 zw2d(:,:) = sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m 232 CALL iom_put( "EPSI100" , zw2d ) 298 !$OMP PARALLEL DO schedule(static) private(jj, ji) 299 DO jj = 1, jpj 300 DO ji = 1, jpi 301 zw2d(ji,jj) = sinksil(ji,jj,ik100) * zfact * tmask(ji,jj,1) ! Export of bigenic silica at 100m 302 END DO 303 END DO 304 CALL iom_put( "EPSI100" , zw2d ) 233 305 ENDIF 234 306 IF( iom_use( "EXPC" ) ) THEN 235 zw3d(:,:,:) = ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of carbon in the water column 236 CALL iom_put( "EXPC" , zw3d ) 307 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 308 DO jk = 1, jpk 309 DO jj = 1, jpj 310 DO ji = 1, jpi 311 zw3d(ji,jj,jk) = ( sinking(ji,jj,jk) + sinking2(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! Export of carbon in the water column 312 END DO 313 END DO 314 END DO 315 CALL iom_put( "EXPC" , zw3d ) 237 316 ENDIF 238 317 IF( iom_use( "EXPFE" ) ) THEN 239 zw3d(:,:,:) = ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of iron 240 CALL iom_put( "EXPFE" , zw3d ) 318 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 319 DO jk = 1, jpk 320 DO jj = 1, jpj 321 DO ji = 1, jpi 322 zw3d(ji,jj,jk) = ( sinkfer(ji,jj,jk) + sinkfer2(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! Export of iron 323 END DO 324 END DO 325 END DO 326 CALL iom_put( "EXPFE" , zw3d ) 241 327 ENDIF 242 328 IF( iom_use( "EXPCAL" ) ) THEN 243 zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite 244 CALL iom_put( "EXPCAL" , zw3d ) 329 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 330 DO jk = 1, jpk 331 DO jj = 1, jpj 332 DO ji = 1, jpi 333 zw3d(ji,jj,jk) = sinkcal(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! Export of calcite 334 END DO 335 END DO 336 END DO 337 CALL iom_put( "EXPCAL" , zw3d ) 245 338 ENDIF 246 339 IF( iom_use( "EXPSI" ) ) THEN 247 zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica 248 CALL iom_put( "EXPSI" , zw3d ) 340 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 341 DO jk = 1, jpk 342 DO jj = 1, jpj 343 DO ji = 1, jpi 344 zw3d(ji,jj,jk) = sinksil(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! Export of bigenic silica 345 END DO 346 END DO 347 END DO 348 CALL iom_put( "EXPSI" , zw3d ) 249 349 ENDIF 250 350 IF( iom_use( "tcexp" ) ) CALL iom_put( "tcexp" , t_oce_co2_exp * zfact ) ! molC/s … … 312 412 zstep = rfact2 / REAL( kiter, wp ) / 2. 313 413 314 ztraz(:,:,:) = 0.e0 315 zakz (:,:,:) = 0.e0 316 ztrb (:,:,:) = trb(:,:,:,jp_tra) 317 414 !$OMP PARALLEL 415 !$OMP DO schedule(static) private(jk, jj, ji) 416 DO jk = 1, jpk 417 DO jj = 1, jpj 418 DO ji = 1, jpi 419 ztraz(ji,jj,jk) = 0.e0 420 zakz (ji,jj,jk) = 0.e0 421 ztrb (ji,jj,jk) = trb(ji,jj,jk,jp_tra) 422 END DO 423 END DO 424 END DO 425 !$OMP END DO NOWAIT 426 !$OMP DO schedule(static) private(jk, jj, ji) 318 427 DO jk = 1, jpkm1 319 zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) 320 END DO 321 zwsink2(:,:,1) = 0.e0 322 428 DO jj = 1, jpj 429 DO ji = 1, jpi 430 zwsink2(ji,jj,jk+1) = -pwsink(ji,jj,jk) / rday * tmask(ji,jj,jk+1) 431 END DO 432 END DO 433 END DO 434 435 !$OMP DO schedule(static) private(jj, ji) 436 DO jj = 1, jpj 437 DO ji = 1, jpi 438 zwsink2(ji,jj,1) = 0.e0 439 END DO 440 END DO 441 !$OMP END DO NOWAIT 323 442 324 443 ! Vertical advective flux 325 444 DO jn = 1, 2 326 445 ! first guess of the slopes interior values 446 !$OMP DO schedule(static) private(jk,jj,ji) 327 447 DO jk = 2, jpkm1 328 ztraz(:,:,jk) = ( trb(:,:,jk-1,jp_tra) - trb(:,:,jk,jp_tra) ) * tmask(:,:,jk) 329 END DO 330 ztraz(:,:,1 ) = 0.0 331 ztraz(:,:,jpk) = 0.0 448 DO jj = 1, jpj 449 DO ji = 1, jpi 450 ztraz(ji,jj,jk) = ( trb(ji,jj,jk-1,jp_tra) - trb(ji,jj,jk,jp_tra) ) * tmask(ji,jj,jk) 451 END DO 452 END DO 453 END DO 454 !$OMP END DO NOWAIT 455 !$OMP DO schedule(static) private(jj, ji) 456 DO jj = 1, jpj 457 DO ji = 1, jpi 458 ztraz(ji,jj,1 ) = 0.0 459 ztraz(ji,jj,jpk) = 0.0 460 END DO 461 END DO 332 462 333 463 ! slopes 464 !$OMP DO schedule(static) private(jk, jj, ji, zign) 334 465 DO jk = 2, jpkm1 335 466 DO jj = 1,jpj … … 342 473 343 474 ! Slopes limitation 475 !$OMP DO schedule(static) private(jk, jj, ji) 344 476 DO jk = 2, jpkm1 345 477 DO jj = 1, jpj … … 352 484 353 485 ! vertical advective flux 486 !$OMP DO schedule(static) private(jk, jj, ji, zigma, zew) 354 487 DO jk = 1, jpkm1 355 488 DO jj = 1, jpj … … 363 496 ! 364 497 ! Boundary conditions 365 psinkflx(:,:,1 ) = 0.e0 366 psinkflx(:,:,jpk) = 0.e0 498 !$OMP DO schedule(static) private(jj, ji) 499 DO jj = 1, jpj 500 DO ji = 1, jpi 501 psinkflx(ji,jj,1 ) = 0.e0 502 psinkflx(ji,jj,jpk) = 0.e0 503 END DO 504 END DO 367 505 506 !$OMP DO schedule(static) private(jk, jj, ji, zflx) 368 507 DO jk=1,jpkm1 369 508 DO jj = 1,jpj … … 377 516 ENDDO 378 517 518 !$OMP DO schedule(static) private(jk, jj, ji, zflx) 379 519 DO jk = 1,jpkm1 380 520 DO jj = 1,jpj … … 386 526 END DO 387 527 388 trb(:,:,:,jp_tra) = ztrb(:,:,:) 389 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 528 !$OMP DO schedule(static) private(jk, jj, ji) 529 DO jk = 1, jpk 530 DO jj = 1, jpj 531 DO ji = 1, jpi 532 trb(ji,jj,jk,jp_tra) = ztrb(ji,jj,jk) 533 psinkflx(ji,jj,jk) = 2. * psinkflx(ji,jj,jk) 534 END DO 535 END DO 536 END DO 537 !$OMP END PARALLEL 390 538 ! 391 539 CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r7646 r7698 99 99 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 100 100 DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter 101 trb(:,:,:,jn) = trn(:,:,:,jn) 101 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 102 DO jk = 1, jpk 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 106 END DO 107 END DO 108 END DO 102 109 END DO 103 110 ENDIF … … 125 132 CALL p4z_flx( kt, jnt ) ! Compute surface fluxes 126 133 ! 127 xnegtr(:,:,:) = 1.e0 134 !$OMP PARALLEL 135 !$OMP DO schedule(static) private(jk, jj, ji) 136 DO jk = 1, jpk 137 DO jj = 1, jpj 138 DO ji = 1, jpi 139 xnegtr(ji,jj,jk) = 1.e0 140 END DO 141 END DO 142 END DO 128 143 DO jn = jp_pcs0, jp_pcs1 144 !$OMP DO schedule(static) private(jk, jj, ji, ztra) 129 145 DO jk = 1, jpk 130 146 DO jj = 1, jpj … … 141 157 ! ! 142 158 DO jn = jp_pcs0, jp_pcs1 143 trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 159 !$OMP DO schedule(static) private(jk, jj, ji) 160 DO jk = 1, jpk 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) + xnegtr(ji,jj,jk) * tra(ji,jj,jk,jn) 164 END DO 165 END DO 166 END DO 144 167 END DO 145 168 ! 146 169 DO jn = jp_pcs0, jp_pcs1 147 tra(:,:,:,jn) = 0._wp 148 END DO 170 !$OMP DO schedule(static) private(jk, jj, ji) 171 DO jk = 1, jpk 172 DO jj = 1, jpj 173 DO ji = 1, jpi 174 tra(ji,jj,jk,jn) = 0._wp 175 END DO 176 END DO 177 END DO 178 END DO 179 !$OMP END PARALLEL 149 180 ! 150 181 IF( ln_top_euler ) THEN 151 182 DO jn = jp_pcs0, jp_pcs1 152 trn(:,:,:,jn) = trb(:,:,:,jn) 183 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 184 DO jk = 1, jpk 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 trn(ji,jj,jk,jn) = trb(ji,jj,jk,jn) 188 END DO 189 END DO 190 END DO 153 191 END DO 154 192 ENDIF … … 349 387 ! 350 388 INTEGER, INTENT( in ) :: kt ! time step 389 INTEGER :: ji, jj, jk 351 390 ! 352 391 REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) … … 357 396 REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn 358 397 REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb 398 REAL(wp), POINTER, DIMENSION(:,:,:) :: zctrn_jptal, zctrn_jppo4, zctrn_jppo3, zctrn_jpsil !workspace arrays 399 REAL(wp), POINTER, DIMENSION(:,:,:) :: zctrb_jptal, zctrb_jppo4, zctrb_jppo3, zctrb_jpsil !workspace arrays 359 400 !!--------------------------------------------------------------------- 360 401 … … 366 407 IF( cn_cfg == "orca" .AND. .NOT. lk_c1d ) THEN ! ORCA configuration (not 1D) ! 367 408 ! ! --------------------------- ! 409 CALL wrk_alloc( jpi, jpj, jpk, zctrn_jptal, zctrn_jppo4, zctrn_jppo3, zctrn_jpsil ) 410 CALL wrk_alloc( jpi, jpj, jpk, zctrb_jptal, zctrb_jppo4, zctrb_jppo3, zctrb_jpsil ) 411 368 412 ! set total alkalinity, phosphate, nitrate & silicate 369 413 zarea = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6 370 414 371 zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea 372 zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 373 zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 374 zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 375 376 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn 377 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn 378 379 IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn 380 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn 381 382 IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn 383 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn 384 385 IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn 386 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn ) 415 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 416 DO jk = 1, jpk 417 DO jj = 1, jpj 418 DO ji = 1, jpi 419 zctrn_jptal(ji,jj,jk) = trn(ji,jj,jk,jptal) * cvol(ji,jj,jk) 420 zctrn_jppo4(ji,jj,jk) = trn(ji,jj,jk,jppo4) * cvol(ji,jj,jk) 421 zctrn_jppo3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * cvol(ji,jj,jk) 422 zctrn_jpsil(ji,jj,jk) = trn(ji,jj,jk,jpsil) * cvol(ji,jj,jk) 423 END DO 424 END DO 425 END DO 426 427 zalksumn = glob_sum( zctrn_jptal(:,:,:) ) * zarea 428 zpo4sumn = glob_sum( zctrn_jppo4(:,:,:) ) * zarea * po4r 429 zno3sumn = glob_sum( zctrn_jppo3(:,:,:) ) * zarea * rno3 430 zsilsumn = glob_sum( zctrn_jpsil(:,:,:) ) * zarea 431 432 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 433 DO jk = 1, jpk 434 DO jj = 1, jpj 435 DO ji = 1, jpi 436 trn(ji,jj,jk,jpsil) = MIN( 400.e-6,trn(ji,jj,jk,jpsil) * silmean / zsilsumn ) 437 trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) * alkmean / zalksumn 438 trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) * po4mean / zpo4sumn 439 trn(ji,jj,jk,jpno3) = trn(ji,jj,jk,jpno3) * no3mean / zno3sumn 440 END DO 441 END DO 442 END DO 443 444 IF(lwp) THEN 445 WRITE(numout,*) ' TALKN mean : ', zalksumn 446 WRITE(numout,*) ' PO4N mean : ', zpo4sumn 447 WRITE(numout,*) ' NO3N mean : ', zno3sumn 448 WRITE(numout,*) ' SiO3N mean : ', zsilsumn 449 END IF 387 450 ! 388 451 ! 389 452 IF( .NOT. ln_top_euler ) THEN 390 zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea 391 zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 392 zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 393 zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 394 395 IF(lwp) WRITE(numout,*) ' ' 396 IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb 397 trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 398 399 IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb 400 trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 401 402 IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb 403 trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 404 405 IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb 406 trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 453 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 454 DO jk = 1, jpk 455 DO jj = 1, jpj 456 DO ji = 1, jpi 457 zctrb_jptal(ji,jj,jk) = trb(ji,jj,jk,jptal) * cvol(ji,jj,jk) 458 zctrb_jppo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) * cvol(ji,jj,jk) 459 zctrb_jppo3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * cvol(ji,jj,jk) 460 zctrb_jpsil(ji,jj,jk) = trb(ji,jj,jk,jpsil) * cvol(ji,jj,jk) 461 END DO 462 END DO 463 END DO 464 465 zalksumb = glob_sum( zctrb_jptal(:,:,:) ) * zarea 466 zpo4sumb = glob_sum( zctrb_jppo4(:,:,:) ) * zarea * po4r 467 zno3sumb = glob_sum( zctrb_jppo3(:,:,:) ) * zarea * rno3 468 zsilsumb = glob_sum( zctrb_jpsil(:,:,:) ) * zarea 469 470 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 471 DO jk = 1, jpk 472 DO jj = 1, jpj 473 DO ji = 1, jpi 474 trb(ji,jj,jk,jpsil) = MIN( 400.e-6,trb(ji,jj,jk,jpsil) * silmean / zsilsumb ) 475 trb(ji,jj,jk,jptal) = trb(ji,jj,jk,jptal) * alkmean / zalksumb 476 trb(ji,jj,jk,jppo4) = trb(ji,jj,jk,jppo4) * po4mean / zpo4sumb 477 trb(ji,jj,jk,jpno3) = trb(ji,jj,jk,jpno3) * no3mean / zno3sumb 478 END DO 479 END DO 480 END DO 481 482 IF(lwp) THEN 483 WRITE(numout,*) ' ' 484 WRITE(numout,*) ' TALKB mean : ', zalksumb 485 WRITE(numout,*) ' PO4B mean : ', zpo4sumb 486 WRITE(numout,*) ' NO3B mean : ', zno3sumb 487 WRITE(numout,*) ' SiO3B mean : ', zsilsumb 488 END IF 407 489 ENDIF 490 ! 491 CALL wrk_dealloc( jpi, jpj, jpk, zctrb_jptal, zctrb_jppo4, zctrb_jppo3, zctrb_jpsil ) 492 CALL wrk_dealloc( jpi, jpj, jpk, zctrn_jptal, zctrn_jppo4, zctrn_jppo3, zctrn_jpsil ) 408 493 ! 409 494 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r7646 r7698 191 191 !-------------------------------------------------------------- 192 192 IF( .NOT.ln_rsttr ) THEN 193 trn(:,:,:,jpdic) = sco2 194 trn(:,:,:,jpdoc) = bioma0 195 trn(:,:,:,jptal) = alka0 196 trn(:,:,:,jpoxy) = oxyg0 197 trn(:,:,:,jpcal) = bioma0 198 trn(:,:,:,jppo4) = po4 / po4r 199 trn(:,:,:,jppoc) = bioma0 200 trn(:,:,:,jpgoc) = bioma0 201 trn(:,:,:,jpbfe) = bioma0 * 5.e-6 202 trn(:,:,:,jpsil) = silic1 203 trn(:,:,:,jpdsi) = bioma0 * 0.15 204 trn(:,:,:,jpgsi) = bioma0 * 5.e-6 205 trn(:,:,:,jpphy) = bioma0 206 trn(:,:,:,jpdia) = bioma0 207 trn(:,:,:,jpzoo) = bioma0 208 trn(:,:,:,jpmes) = bioma0 209 trn(:,:,:,jpfer) = 0.6E-9 210 trn(:,:,:,jpsfe) = bioma0 * 5.e-6 211 trn(:,:,:,jpdfe) = bioma0 * 5.e-6 212 trn(:,:,:,jpnfe) = bioma0 * 5.e-6 213 trn(:,:,:,jpnch) = bioma0 * 12. / 55. 214 trn(:,:,:,jpdch) = bioma0 * 12. / 55. 215 trn(:,:,:,jpno3) = no3 216 trn(:,:,:,jpnh4) = bioma0 217 IF( ln_ligand) THEN 218 trn(:,:,:,jplgw) = 0.6E-9 219 trn(:,:,:,jpfep) = 0. * 5.e-6 220 ENDIF 221 IF( ln_p5z ) THEN 222 trn(:,:,:,jpdon) = bioma0 223 trn(:,:,:,jpdop) = bioma0 224 trn(:,:,:,jppon) = bioma0 225 trn(:,:,:,jppop) = bioma0 226 trn(:,:,:,jpgon) = bioma0 227 trn(:,:,:,jpgop) = bioma0 228 trn(:,:,:,jpnph) = bioma0 229 trn(:,:,:,jppph) = bioma0 230 trn(:,:,:,jppic) = bioma0 231 trn(:,:,:,jpnpi) = bioma0 232 trn(:,:,:,jpppi) = bioma0 233 trn(:,:,:,jpndi) = bioma0 234 trn(:,:,:,jppdi) = bioma0 235 trn(:,:,:,jppfe) = bioma0 * 5.e-6 236 trn(:,:,:,jppch) = bioma0 * 12. / 55. 237 ENDIF 193 !$OMP PARALLEL 194 !$OMP DO schedule(static) private(jk,jj,ji) 195 DO jk = 1, jpk 196 DO jj = 1, jpj 197 DO ji = 1, jpi 198 trn(ji,jj,jk,jpdic) = sco2 199 trn(ji,jj,jk,jpdoc) = bioma0 200 trn(ji,jj,jk,jptal) = alka0 201 trn(ji,jj,jk,jpoxy) = oxyg0 202 trn(ji,jj,jk,jpcal) = bioma0 203 trn(ji,jj,jk,jppo4) = po4 / po4r 204 trn(ji,jj,jk,jppoc) = bioma0 205 trn(ji,jj,jk,jpgoc) = bioma0 206 trn(ji,jj,jk,jpbfe) = bioma0 * 5.e-6 207 trn(ji,jj,jk,jpsil) = silic1 208 trn(ji,jj,jk,jpdsi) = bioma0 * 0.15 209 trn(ji,jj,jk,jpgsi) = bioma0 * 5.e-6 210 trn(ji,jj,jk,jpphy) = bioma0 211 trn(ji,jj,jk,jpdia) = bioma0 212 trn(ji,jj,jk,jpzoo) = bioma0 213 trn(ji,jj,jk,jpmes) = bioma0 214 trn(ji,jj,jk,jpfer) = 0.6E-9 215 trn(ji,jj,jk,jpsfe) = bioma0 * 5.e-6 216 trn(ji,jj,jk,jpdfe) = bioma0 * 5.e-6 217 trn(ji,jj,jk,jpnfe) = bioma0 * 5.e-6 218 trn(ji,jj,jk,jpnch) = bioma0 * 12. / 55. 219 trn(ji,jj,jk,jpdch) = bioma0 * 12. / 55. 220 trn(ji,jj,jk,jpno3) = no3 221 trn(ji,jj,jk,jpnh4) = bioma0 222 IF( ln_ligand) THEN 223 trn(ji,jj,jk,jplgw) = 0.6E-9 224 trn(ji,jj,jk,jpfep) = 0. * 5.e-6 225 ENDIF 226 IF( ln_p5z ) THEN 227 trn(ji,jj,jk,jpdon) = bioma0 228 trn(ji,jj,jk,jpdop) = bioma0 229 trn(ji,jj,jk,jppon) = bioma0 230 trn(ji,jj,jk,jppop) = bioma0 231 trn(ji,jj,jk,jpgon) = bioma0 232 trn(ji,jj,jk,jpgop) = bioma0 233 trn(ji,jj,jk,jpnph) = bioma0 234 trn(ji,jj,jk,jppph) = bioma0 235 trn(ji,jj,jk,jppic) = bioma0 236 trn(ji,jj,jk,jpnpi) = bioma0 237 trn(ji,jj,jk,jpppi) = bioma0 238 trn(ji,jj,jk,jpndi) = bioma0 239 trn(ji,jj,jk,jppdi) = bioma0 240 trn(ji,jj,jk,jppfe) = bioma0 * 5.e-6 241 trn(ji,jj,jk,jppch) = bioma0 * 12. / 55. 242 ENDIF 243 END DO 244 END DO 245 END DO 238 246 ! initialize the half saturation constant for silicate 239 247 ! ---------------------------------------------------- 240 xksi(:,:) = 2.e-6 241 xksimax(:,:) = xksi(:,:) 248 !$OMP DO schedule(static) private(jj,ji) 249 DO jj = 1, jpj 250 DO ji = 1, jpi 251 xksi(ji,jj) = 2.e-6 252 xksimax(ji,jj) = xksi(ji,jj) 253 END DO 254 END DO 255 !$OMP END PARALLEL 242 256 END IF 243 257 -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r7646 r7698 61 61 !!---------------------------------------------------------------------- 62 62 !! NEMO/TOP 3.7 , NEMO Consortium (2015) 63 !! $Id$ 63 !! $Id$ 64 64 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 65 65 !!---------------------------------------------------------------------- … … 76 76 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 77 ! 78 INTEGER :: jk ! dummy loop index78 INTEGER :: jk, jj, ji ! dummy loop index 79 79 CHARACTER (len=22) :: charout 80 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn ! effective velocity … … 86 86 ! !== effective transport ==! 87 87 IF( l_offline ) THEN 88 zun(:,:,:) = un(:,:,:) ! effective transport already in un/vn/wn 89 zvn(:,:,:) = vn(:,:,:) 90 zwn(:,:,:) = wn(:,:,:) 88 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 89 DO jk = 1, jpk 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zun(ji,jj,jk) = un(ji,jj,jk) ! effective transport already in un/vn/wn 93 zvn(ji,jj,jk) = vn(ji,jj,jk) 94 zwn(ji,jj,jk) = wn(ji,jj,jk) 95 END DO 96 END DO 97 END DO 91 98 ELSE 92 99 ! 100 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 93 101 DO jk = 1, jpkm1 94 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport 95 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 96 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 102 DO jj = 1, jpj 103 DO ji = 1, jpi 104 zun(ji,jj,jk) = e2u (ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) ! eulerian transport 105 zvn(ji,jj,jk) = e1v (ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 106 zwn(ji,jj,jk) = e1e2t(ji,jj) * wn(ji,jj,jk) 107 END DO 108 END DO 97 109 END DO 98 110 ! 99 111 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 100 zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 101 zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 112 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 113 DO jk = 1, jpk 114 DO jj = 1, jpj 115 DO ji = 1, jpi 116 zun(ji,jj,jk) = zun(ji,jj,jk) + un_td(ji,jj,jk) 117 zvn(ji,jj,jk) = zvn(ji,jj,jk) + vn_td(ji,jj,jk) 118 END DO 119 END DO 120 END DO 102 121 ENDIF 103 122 ! … … 107 126 IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport 108 127 ! 109 zun(:,:,jpk) = 0._wp ! no transport trough the bottom 110 zvn(:,:,jpk) = 0._wp 111 zwn(:,:,jpk) = 0._wp 128 !$OMP PARALLEL DO schedule(static) private(jj,ji) 129 DO jj = 1, jpj 130 DO ji = 1, jpi 131 zun(ji,jj,jpk) = 0._wp ! no transport trough the bottom 132 zvn(ji,jj,jpk) = 0._wp 133 zwn(ji,jj,jpk) = 0._wp 134 END DO 135 END DO 112 136 ! 113 137 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r7646 r7698 31 31 !!---------------------------------------------------------------------- 32 32 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 33 !! $Id$ 33 !! $Id$ 34 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 35 35 !!---------------------------------------------------------------------- … … 61 61 IF( l_trdtrc ) THEN 62 62 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends 63 ztrtrd(:,:,:,:) = tra(:,:,:,:) 63 !$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 64 DO jn = 1, jptra 65 DO jk = 1, jpk 66 DO jj = 1, jpj 67 DO ji = 1, jpi 68 ztrtrd(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 69 END DO 70 END DO 71 END DO 72 END DO 64 73 ENDIF 65 74 … … 88 97 IF( l_trdtrc ) THEN ! save the horizontal diffusive trends for further diagnostics 89 98 DO jn = 1, jptra 90 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 99 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 100 DO jk = 1, jpk 101 DO jj = 1, jpj 102 DO ji = 1, jpi 103 ztrtrd(ji,jj,jk,jn) = tra(ji,jj,jk,jn) - ztrtrd(ji,jj,jk,jn) 104 END DO 105 END DO 106 END DO 91 107 CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 92 108 END DO -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r6403 r7698 76 76 IF( l_trdtrc ) THEN 77 77 CALL wrk_alloc( jpi,jpj,jpk,jptra, ztrtrd ) 78 ztrtrd(:,:,:,:) = tra(:,:,:,:) 78 !$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 79 DO jn = 1, jptra 80 DO jk = 1, jpk 81 DO jj = 1, jpj 82 DO ji = 1, jpi 83 ztrtrd(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 84 END DO 85 END DO 86 END DO 87 END DO 79 88 ENDIF 80 89 ! !* set the lateral diffusivity coef. for passive tracer 81 90 CALL wrk_alloc( jpi,jpj,jpk, zahu, zahv ) 82 zahu(:,:,:) = rldf * ahtu(:,:,:) 83 zahv(:,:,:) = rldf * ahtv(:,:,:) 91 !$OMP PARALLEL 92 !$OMP DO schedule(static) private(jk,jj,ji) 93 DO jk = 1, jpk 94 DO jj = 1, jpj 95 DO ji = 1, jpi 96 zahu(ji,jj,jk) = rldf * ahtu(ji,jj,jk) 97 zahv(ji,jj,jk) = rldf * ahtv(ji,jj,jk) 98 END DO 99 END DO 100 END DO 84 101 ! !* Enhanced zonal diffusivity coefficent in the equatorial domain 102 !$OMP DO schedule(static) private(jk,jj,ji,zdep) 85 103 DO jk= 1, jpk 86 104 DO jj = 1, jpj … … 93 111 END DO 94 112 END DO 113 !$OMP END DO NOWAIT 114 !$OMP END PARALLEL 95 115 ! 96 116 SELECT CASE ( nldf ) !* compute lateral mixing trend and add it to the general trend … … 112 132 IF( l_trdtrc ) THEN ! send the trends for further diagnostics 113 133 DO jn = 1, jptra 114 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 134 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 135 DO jk = 1, jpk 136 DO jj = 1, jpj 137 DO ji = 1, jpi 138 ztrtrd(ji,jj,jk,jn) = tra(ji,jj,jk,jn) - ztrtrd(ji,jj,jk,jn) 139 END DO 140 END DO 141 END DO 115 142 CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 116 143 END DO -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r7646 r7698 46 46 !!---------------------------------------------------------------------- 47 47 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 48 !! $Id$ 48 !! $Id$ 49 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 50 !!---------------------------------------------------------------------- … … 77 77 INTEGER, INTENT( in ) :: kt ! ocean time-step index 78 78 ! 79 INTEGER :: jk, jn ! dummy loop indices79 INTEGER :: jk, jn, jj, ji ! dummy loop indices 80 80 REAL(wp) :: zfact ! temporary scalar 81 81 CHARACTER (len=22) :: charout … … 101 101 IF( l_trdtrc ) THEN ! trends: store now fields before the Asselin filter application 102 102 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt ) 103 ztrdt(:,:,:,:) = trn(:,:,:,:) 103 !$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 104 DO jn = 1, jptra 105 DO jk = 1, jpk 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 ztrdt(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 109 END DO 110 END DO 111 END DO 112 END DO 104 113 ENDIF 105 114 ! ! Leap-Frog + Asselin filter time stepping 106 115 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! Euler time-stepping at first time-step (only swap) 116 !$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 107 117 DO jn = 1, jptra 108 118 DO jk = 1, jpkm1 109 trn(:,:,jk,jn) = tra(:,:,jk,jn) 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 122 END DO 123 END DO 110 124 END DO 111 125 END DO … … 127 141 DO jk = 1, jpkm1 128 142 zfact = 1._wp / r2dttrc 129 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 143 !$OMP PARALLEL DO schedule(static) private(jj,ji) 144 DO jj = 1, jpj 145 DO ji = 1, jpi 146 ztrdt(ji,jj,jk,jn) = ( trb(ji,jj,jk,jn) - ztrdt(ji,jj,jk,jn) ) * zfact 147 END DO 148 END DO 130 149 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 131 150 END DO -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r7646 r7698 29 29 !!---------------------------------------------------------------------- 30 30 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 31 !! $Id$ 31 !! $Id$ 32 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 33 !!---------------------------------------------------------------------- … … 140 140 REAL(wp) :: zcoef, ztrcorn, ztrmasn ! " " 141 141 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! workspace arrays 142 REAL(wp), POINTER, DIMENSION(:,:,:) :: zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin ! workspace arrays 142 143 REAL(wp) :: zs2rdt 143 144 LOGICAL :: lldebug = .FALSE. … … 147 148 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 148 149 150 CALL wrk_alloc( jpi, jpj, jpk, zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin ) 149 151 IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved 150 152 … … 155 157 156 158 IF( l_trdtrc ) THEN 157 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 158 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 159 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 160 DO jk = 1, jpk 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 ztrtrdb(ji,jj,jk) = ptrb(ji,jj,jk,jn) ! save input trb for trend computation 164 ztrtrdn(ji,jj,jk) = ptrn(ji,jj,jk,jn) 165 END DO 166 END DO 167 END DO 159 168 ENDIF 160 169 ! ! sum over the global domain 161 ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 162 ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 163 164 ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 165 ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 170 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 171 DO jk = 1, jpk 172 DO jj = 1, jpj 173 DO ji = 1, jpi 174 zcptrbmin(ji,jj,jk) = MIN( 0., ptrb(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 175 zcptrnmin(ji,jj,jk) = MIN( 0., ptrn(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 176 zcptrbmax(ji,jj,jk) = MAX( 0., ptrb(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 177 zcptrnmax(ji,jj,jk) = MAX( 0., ptrn(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 178 END DO 179 END DO 180 END DO 181 ztrcorb = glob_sum( zcptrbmin(:,:,:) ) 182 ztrcorn = glob_sum( zcptrnmin(:,:,:) ) 183 ztrmasb = glob_sum( zcptrbmax(:,:,:) ) 184 ztrmasn = glob_sum( zcptrnmax(:,:,:) ) 166 185 167 186 IF( ztrcorb /= 0 ) THEN 168 187 zcoef = 1. + ztrcorb / ztrmasb 188 !$OMP PARALLEL DO schedule(static) private(jk) 169 189 DO jk = 1, jpkm1 170 ptrb(:,:,jk,jn) = MAX( 0., ptrb(:,:,jk,jn) ) 171 ptrb(:,:,jk,jn) = ptrb(:,:,jk,jn) * zcoef * tmask(:,:,jk) 190 DO jj = 1, jpj 191 DO ji = 1, jpi 192 ptrb(ji,jj,jk,jn) = MAX( 0., ptrb(ji,jj,jk,jn) ) 193 ptrb(ji,jj,jk,jn) = ptrb(ji,jj,jk,jn) * zcoef * tmask(ji,jj,jk) 194 END DO 195 END DO 172 196 END DO 173 197 ENDIF … … 175 199 IF( ztrcorn /= 0 ) THEN 176 200 zcoef = 1. + ztrcorn / ztrmasn 201 !$OMP PARALLEL DO schedule(static) private(jk) 177 202 DO jk = 1, jpkm1 178 ptrn(:,:,jk,jn) = MAX( 0., ptrn(:,:,jk,jn) ) 179 ptrn(:,:,jk,jn) = ptrn(:,:,jk,jn) * zcoef * tmask(:,:,jk) 203 DO jj = 1, jpj 204 DO ji = 1, jpi 205 ptrn(ji,jj,jk,jn) = MAX( 0., ptrn(ji,jj,jk,jn) ) 206 ptrn(ji,jj,jk,jn) = ptrn(ji,jj,jk,jn) * zcoef * tmask(ji,jj,jk) 207 END DO 208 END DO 180 209 END DO 181 210 ENDIF … … 184 213 ! 185 214 zs2rdt = 1. / ( 2. * rdt ) 186 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 187 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 215 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 216 DO jk = 1, jpk 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 ztrtrdb(ji,jj,jk) = ( ptrb(ji,jj,jk,jn) - ztrtrdb(ji,jj,jk) ) * zs2rdt 220 ztrtrdn(ji,jj,jk) = ( ptrn(ji,jj,jk,jn) - ztrtrdn(ji,jj,jk) ) * zs2rdt 221 END DO 222 END DO 223 END DO 224 188 225 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 189 226 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling … … 199 236 200 237 IF( l_trdtrc ) THEN 201 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 202 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 203 ENDIF 204 205 DO jk = 1, jpkm1 206 DO jj = 1, jpj 207 DO ji = 1, jpi 208 ptrn(ji,jj,jk,jn) = MAX( 0. , ptrn(ji,jj,jk,jn) ) 209 ptrb(ji,jj,jk,jn) = MAX( 0. , ptrb(ji,jj,jk,jn) ) 210 END DO 211 END DO 212 END DO 213 214 IF( l_trdtrc ) THEN 238 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 239 DO jk = 1, jpk 240 DO jj = 1, jpj 241 DO ji = 1, jpi 242 ztrtrdb(ji,jj,jk) = ptrb(ji,jj,jk,jn) ! save input trb for trend computation 243 ztrtrdn(ji,jj,jk) = ptrn(ji,jj,jk,jn) 244 END DO 245 END DO 246 END DO 247 END IF 248 249 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 250 DO jk = 1, jpkm1 251 DO jj = 1, jpj 252 DO ji = 1, jpi 253 ptrn(ji,jj,jk,jn) = MAX( 0. , ptrn(ji,jj,jk,jn) ) 254 ptrb(ji,jj,jk,jn) = MAX( 0. , ptrb(ji,jj,jk,jn) ) 255 END DO 256 END DO 257 END DO 258 259 IF( l_trdtrc ) THEN 215 260 ! 216 261 zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 217 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 218 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 262 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 263 DO jk = 1, jpk 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 ztrtrdb(ji,jj,jk) = ( ptrb(ji,jj,jk,jn) - ztrtrdb(ji,jj,jk) ) * zs2rdt 267 ztrtrdn(ji,jj,jk) = ( ptrn(ji,jj,jk,jn) - ztrtrdn(ji,jj,jk) ) * zs2rdt 268 END DO 269 END DO 270 END DO 219 271 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 220 272 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling … … 227 279 228 280 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 281 CALL wrk_dealloc( jpi, jpj, jpk, zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin ) 229 282 230 283 END SUBROUTINE trc_rad_sms -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r7646 r7698 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 34 !! $Id$ 34 !! $Id$ 35 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- … … 61 61 INTEGER, INTENT( in ) :: kt ! ocean time-step index 62 62 ! 63 INTEGER :: ji, jj, j n ! dummy loop indices63 INTEGER :: ji, jj, jk, jn ! dummy loop indices 64 64 REAL(wp) :: zse3t, zrtrn, zratio, zfact ! temporary scalars 65 65 REAL(wp) :: zswitch, zftra, zcd, zdtra, ztfx, ztra ! temporary scalars … … 83 83 ! ! (2) embedded sea-ice : salt and volume fluxes and pressure 84 84 END SELECT 85 85 86 86 87 IF( kt == nittrc000 ) THEN … … 98 99 ELSE ! No restart or restart not found: Euler forward time stepping 99 100 zfact = 1._wp 100 sbc_trc_b(:,:,:) = 0._wp 101 !$OMP PARALLEL DO schedule(static) private(jn,jj,ji) 102 DO jn = 1, jptra 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 sbc_trc_b(ji,jj,jn) = 0._wp 106 END DO 107 END DO 108 END DO 101 109 ENDIF 102 110 ELSE ! Swap of forcing fields 103 111 IF( ln_top_euler ) THEN 104 112 zfact = 1._wp 105 sbc_trc_b(:,:,:) = 0._wp 113 !$OMP PARALLEL DO schedule(static) private(jn,jj,ji) 114 DO jn = 1, jptra 115 DO jj = 1, jpj 116 DO ji = 1, jpi 117 sbc_trc_b(ji,jj,jn) = 0._wp 118 END DO 119 END DO 120 END DO 106 121 ELSE 107 122 zfact = 0.5_wp 108 sbc_trc_b(:,:,:) = sbc_trc(:,:,:) 123 !$OMP PARALLEL DO schedule(static) private(jn,jj,ji) 124 DO jn = 1, jptra 125 DO jj = 1, jpj 126 DO ji = 1, jpi 127 sbc_trc_b(ji,jj,jn) = sbc_trc(ji,jj,jn) 128 END DO 129 END DO 130 END DO 109 131 ENDIF 110 132 ! … … 116 138 ! 117 139 IF( .NOT.ln_linssh ) THEN ! online coupling with vvl 118 zsfx(:,:) = 0._wp 140 !$OMP PARALLEL DO schedule(static) private(jj,ji) 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 zsfx(ji,jj) = 0._wp 144 END DO 145 END DO 119 146 ELSE ! online coupling free surface or offline with free surface 120 zsfx(:,:) = emp(:,:) 147 !$OMP PARALLEL DO schedule(static) private(jj,ji) 148 DO jj = 1, jpj 149 DO ji = 1, jpi 150 zsfx(ji,jj) = emp(ji,jj) 151 END DO 152 END DO 121 153 ENDIF 122 154 … … 124 156 DO jn = 1, jptra 125 157 ! 126 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 127 158 IF( l_trdtrc ) THEN 159 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 160 DO jk = 1, jpk 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 ztrtrd(ji,jj,jk) = tra(ji,jj,jk,jn) ! save trends 164 END DO 165 END DO 166 END DO ! online coupling free surface or offline with free surface 167 END IF 128 168 IF ( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice) 129 169 170 !$OMP PARALLEL DO schedule(static) private(jj, ji) 130 171 DO jj = 2, jpj 131 172 DO ji = fs_2, fs_jpim1 ! vector opt. … … 136 177 ELSE 137 178 179 !$OMP PARALLEL DO schedule(static) private(jj,ji,zse3t,zftra,zcd,ztfx,zdtra,zratio) 138 180 DO jj = 2, jpj 139 181 DO ji = fs_2, fs_jpim1 ! vector opt. … … 159 201 CALL lbc_lnk( sbc_trc(:,:,jn), 'T', 1. ) 160 202 ! Concentration dilution effect on tracers due to evaporation & precipitation 203 !$OMP PARALLEL DO schedule(static) private(jj,ji,zse3t) 161 204 DO jj = 2, jpj 162 205 DO ji = fs_2, fs_jpim1 ! vector opt. … … 167 210 ! 168 211 IF( l_trdtrc ) THEN 169 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 212 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 213 DO jk = 1, jpk 214 DO jj = 1, jpj 215 DO ji = 1, jpi 216 ztrtrd(ji,jj,jk) = tra(ji,jj,jk,jn) - ztrtrd(ji,jj,jk) 217 END DO 218 END DO 219 END DO ! online coupling free surface or offline with free surface 170 220 CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 171 221 END IF -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r7646 r7698 40 40 !!---------------------------------------------------------------------- 41 41 !! NEMO/TOP 3.7 , NEMO Consortium (2015) 42 !! $Id$ 42 !! $Id$ 43 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- … … 53 53 INTEGER, INTENT( in ) :: kt ! ocean time-step index 54 54 ! 55 INTEGER :: jk, jn 55 INTEGER :: jk, jn, jj, ji 56 56 CHARACTER (len=22) :: charout 57 57 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd ! 4D workspace … … 62 62 IF( l_trdtrc ) THEN 63 63 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 64 ztrtrd(:,:,:,:) = tra(:,:,:,:) 64 !$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 65 DO jn = 1, jptra 66 DO jk = 1, jpk 67 DO jj = 1, jpj 68 DO ji = 1, jpi 69 ztrtrd(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 70 END DO 71 END DO 72 END DO 73 END DO 65 74 ENDIF 66 75 … … 72 81 IF( l_trdtrc ) THEN ! save the vertical diffusive trends for further diagnostics 73 82 DO jn = 1, jptra 83 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 74 84 DO jk = 1, jpkm1 75 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn) 85 DO jj = 1, jpj 86 DO ji = 1, jpi 87 ztrtrd(ji,jj,jk,jn) = ( ( tra(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) / r2dttrc ) - ztrtrd(ji,jj,jk,jn) 88 END DO 89 END DO 76 90 END DO 77 91 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) -
trunk/NEMOGCM/NEMO/TOP_SRC/trcice.F90
r7646 r7698 38 38 !!--------------------------------------------------------------------- 39 39 ! --- Variable declarations --- ! 40 INTEGER :: jn, jj, ji ! dummy loop indices 40 41 41 42 IF(lwp) THEN … … 49 50 CALL trc_nam_ice 50 51 ! 51 trc_i(:,:,:) = 0.0d0 ! by default 52 trc_o(:,:,:) = 0.0d0 ! by default 52 !$OMP PARALLEL DO schedule(static) private(jn,jj,ji) 53 DO jn = 1, jptra 54 DO jj = 1, jpj 55 DO ji = 1, jpi 56 trc_i(ji,jj,jn) = 0.0d0 ! by default 57 trc_o(ji,jj,jn) = 0.0d0 ! by default 58 END DO 59 END DO 60 END DO 53 61 54 62 IF ( nn_ice_tr == 1 ) THEN -
trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r7646 r7698 105 105 !! ** Purpose : passive tracers inventories at initialsation phase 106 106 !!---------------------------------------------------------------------- 107 INTEGER :: jk, jn ! dummy loop indices107 INTEGER :: jk, jn, jj, ji ! dummy loop indices 108 108 CHARACTER (len=25) :: charout 109 109 !!---------------------------------------------------------------------- 110 110 ! ! masked grid volume 111 !$OMP PARALLEL 112 !$OMP DO schedule(static) private(jk,jj,ji) 111 113 DO jk = 1, jpk 112 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 113 END DO 114 DO jj = 1, jpj 115 DO ji = 1, jpi 116 cvol(ji,jj,jk) = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 117 END DO 118 END DO 119 END DO 120 ! 121 !$OMP DO schedule(static) private(jn) 122 DO jn = 1, jptra 123 trai(jn) = 0._wp ! initial content of all tracers 124 END DO 125 !$OMP END PARALLEL 114 126 ! ! total volume of the ocean 115 127 areatot = glob_sum( cvol(:,:,:) ) 116 128 ! 117 trai(:) = 0._wp ! initial content of all tracers118 129 DO jn = 1, jptra 119 130 trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) … … 220 231 USE trcdta ! initialisation from files 221 232 ! 222 INTEGER :: jn, jl ! dummy loop indices233 INTEGER :: jn, jl, jk, jj, ji ! dummy loop indices 223 234 !!---------------------------------------------------------------------- 224 235 ! … … 254 265 ENDIF 255 266 ! 256 trb(:,:,:,:) = trn(:,:,:,:) 267 !$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 268 DO jn = 1, jptra 269 DO jk = 1, jpk 270 DO jj = 1, jpj 271 DO ji = 1, jpi 272 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 273 END DO 274 END DO 275 END DO 276 END DO 257 277 ! 258 278 ENDIF 259 279 260 tra(:,:,:,:) = 0._wp 280 !$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 281 DO jn = 1, jptra 282 DO jk = 1, jpk 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 tra(ji,jj,jk,jn) = 0._wp 286 END DO 287 END DO 288 END DO 289 END DO 261 290 ! ! Partial top/bottom cell: GRADh(trn) 262 291 END SUBROUTINE trc_ini_state -
trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r7646 r7698 268 268 !! ** purpose : Compute tracers statistics 269 269 !!---------------------------------------------------------------------- 270 INTEGER :: jk, j n270 INTEGER :: jk, jj, ji, jn 271 271 REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 272 272 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol … … 279 279 ENDIF 280 280 ! 281 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 281 282 DO jk = 1, jpk 282 zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 zvol(ji,jj,jk) = e1e2t(ji,jj) * e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 286 END DO 287 END DO 283 288 END DO 284 289 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r7646 r7698 37 37 !!---------------------------------------------------------------------- 38 38 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 39 !! $Id$ 39 !! $Id$ 40 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- … … 53 53 !!------------------------------------------------------------------- 54 54 INTEGER, INTENT( in ) :: kt ! ocean time-step index 55 INTEGER :: jk, jn ! dummy loop indices55 INTEGER :: jk, jn, jj, ji ! dummy loop indices 56 56 REAL(wp) :: ztrai 57 57 CHARACTER (len=25) :: charout … … 70 70 ! 71 71 IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution 72 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 72 73 DO jk = 1, jpk 73 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 74 DO jj = 1, jpj 75 DO ji = 1, jpi 76 cvol(ji,jj,jk) = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 77 END DO 78 END DO 74 79 END DO 75 80 areatot = glob_sum( cvol(:,:,:) ) … … 87 92 ENDIF 88 93 ! 89 tra(:,:,:,:) = 0.e0 94 DO jn = 1, jptra 95 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 96 DO jk = 1, jpk 97 DO jj = 1, jpj 98 DO ji = 1, jpi 99 tra(ji,jj,jk,jn) = 0._wp 100 END DO 101 END DO 102 END DO 103 END DO 90 104 ! 91 105 CALL trc_rst_opn ( kt ) ! Open tracer restart file -
trunk/NEMOGCM/SETTE/prepare_job.sh
r6140 r7698 68 68 # 69 69 70 usage=" Usage : ./prepare_job.sh INPUT_FILE_CONFIG_NAME NUMBER_PROC TEST_NAME MPI_FLAG JOB_FILE NUM_XIO_SERVERS "71 usage=" example : ./prepare_job.sh input_ORCA2_LIM_PISCES.cfg 8 SHORT no/yes $JOB_FILE 0 "70 usage=" Usage : ./prepare_job.sh INPUT_FILE_CONFIG_NAME NUMBER_PROC TEST_NAME MPI_FLAG JOB_FILE NUM_XIO_SERVERS NUM_OMP_THREADS" 71 usage=" example : ./prepare_job.sh input_ORCA2_LIM_PISCES.cfg 8 SHORT no/yes $JOB_FILE 0 2" 72 72 73 73 … … 94 94 JOB_FILE=$5 95 95 NXIO_PROC=$6 96 NOMP_THR=$7 96 97 97 98 # export EXE_DIR. This directory is used to execute model … … 293 294 echo NB_PROC_NODE ${NB_PROC_NODE} 294 295 ;; 296 ifort_athena_*) 297 NB_PROC_NODE=$(( 16 / NOMP_THR )) 298 ;; 295 299 *) 296 300 NB_NODES=${NB_PROC} … … 305 309 -e"s/TOTAL_NPROCS/${TOTAL_NPROCS}/" \ 306 310 -e"s/NPROCS/${NB_PROC}/" \ 311 -e"s/OMP_NTHR/${NOMP_THR}/" \ 307 312 -e"s/NXIOPROCS/${NXIO_PROC}/" \ 308 313 -e"s:DEF_SETTE_DIR:${SETTE_DIR}:" -e"s:DEF_INPUT_DIR:${INPUT_DIR}:" \ … … 321 326 XC40_METO*) 322 327 cat run_sette_test.job | sed -e"s/SELECT/${SELECT}/" > run_sette_test1.job 328 mv run_sette_test1.job run_sette_test.job 329 ;; 330 ifort_athena_*) 331 cat run_sette_test.job | sed -e"s/NPROC_NODE/${NB_PROC_NODE}/" > run_sette_test1.job 323 332 mv run_sette_test1.job run_sette_test.job 324 333 ;; -
trunk/NEMOGCM/SETTE/sette.sh
r7646 r7698 36 36 # "yes" to run in MPMD (detached) mode with stand-alone IO servers 37 37 # "no" to run in SPMD (attached) mode without separate IO servers 38 # USING_OMP : flag to control the use of OpenMP parallelization 38 39 # NUM_XIOSERVERS : number of stand-alone IO servers to employ 39 40 # set to zero if USING_MPMD="no" … … 88 89 # 89 90 # Compiler among those in NEMOGCM/ARCH 90 COMPILER=X64_ADA_DEBUG 91 export USING_OMP="no" 92 # 93 if [ ${USING_OMP} == "yes" ] 94 then 95 COMPILER=ifort_athena_xios_omp 96 else 97 COMPILER=ifort_athena_xios 98 fi 91 99 export BATCH_COMMAND_PAR="llsubmit" 92 100 export BATCH_COMMAND_SEQ=$BATCH_COMMAND_PAR … … 120 128 fi 121 129 # 130 # Settings which control the hybrid parallel execution 131 # 132 OMP_NTHR=1 133 if [ ${USING_OMP} == "yes" ] 134 then 135 OMP_NTHR=8 136 fi 122 137 123 138 # Directory to run the tests … … 179 194 fi 180 195 cd ${SETTE_DIR} 181 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 196 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 182 197 183 198 cd ${SETTE_DIR} … … 215 230 fi 216 231 cd ${SETTE_DIR} 217 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 232 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 218 233 cd ${SETTE_DIR} 219 234 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 250 265 fi 251 266 cd ${SETTE_DIR} 252 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 267 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 253 268 cd ${SETTE_DIR} 254 269 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 278 293 fi 279 294 cd ${SETTE_DIR} 280 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 295 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 281 296 cd ${SETTE_DIR} 282 297 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 316 331 fi 317 332 cd ${SETTE_DIR} 318 . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 333 . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 319 334 320 335 cd ${SETTE_DIR} … … 351 366 fi 352 367 cd ${SETTE_DIR} 353 . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 368 . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 354 369 cd ${SETTE_DIR} 355 370 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 386 401 fi 387 402 cd ${SETTE_DIR} 388 . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 403 . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 389 404 cd ${SETTE_DIR} 390 405 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 415 430 416 431 cd ${SETTE_DIR} 417 . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 432 . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 418 433 cd ${SETTE_DIR} 419 434 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 463 478 fi 464 479 cd ${SETTE_DIR} 465 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 480 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 466 481 467 482 cd ${SETTE_DIR} … … 513 528 fi 514 529 cd ${SETTE_DIR} 515 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 530 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 516 531 cd ${SETTE_DIR} 517 532 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 561 576 fi 562 577 cd ${SETTE_DIR} 563 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 578 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 564 579 cd ${SETTE_DIR} 565 580 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 601 616 fi 602 617 cd ${SETTE_DIR} 603 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 618 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 604 619 cd ${SETTE_DIR} 605 620 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 650 665 fi 651 666 cd ${SETTE_DIR} 652 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 667 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 653 668 654 669 cd ${SETTE_DIR} … … 693 708 fi 694 709 cd ${SETTE_DIR} 695 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 710 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 696 711 cd ${SETTE_DIR} 697 712 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 740 755 fi 741 756 cd ${SETTE_DIR} 742 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 757 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 743 758 cd ${SETTE_DIR} 744 759 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 780 795 fi 781 796 cd ${SETTE_DIR} 782 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 797 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 783 798 cd ${SETTE_DIR} 784 799 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 816 831 fi 817 832 cd ${SETTE_DIR} 818 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 833 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 819 834 820 835 cd ${SETTE_DIR} … … 847 862 fi 848 863 cd ${SETTE_DIR} 849 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 864 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 850 865 cd ${SETTE_DIR} 851 866 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 881 896 fi 882 897 cd ${SETTE_DIR} 883 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 898 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 884 899 cd ${SETTE_DIR} 885 900 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 907 922 fi 908 923 cd ${SETTE_DIR} 909 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 924 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 910 925 cd ${SETTE_DIR} 911 926 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 945 960 fi 946 961 cd ${SETTE_DIR} 947 . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 962 . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 948 963 949 964 cd ${SETTE_DIR} … … 976 991 done 977 992 cd ${SETTE_DIR} 978 . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 993 . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 979 994 cd ${SETTE_DIR} 980 995 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1012 1027 fi 1013 1028 cd ${SETTE_DIR} 1014 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1029 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1015 1030 1016 1031 cd ${SETTE_DIR} … … 1048 1063 fi 1049 1064 cd ${SETTE_DIR} 1050 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1065 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1051 1066 cd ${SETTE_DIR} 1052 1067 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1082 1097 fi 1083 1098 cd ${SETTE_DIR} 1084 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1099 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1085 1100 cd ${SETTE_DIR} 1086 1101 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1110 1125 fi 1111 1126 cd ${SETTE_DIR} 1112 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1127 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1113 1128 cd ${SETTE_DIR} 1114 1129 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1159 1174 fi 1160 1175 cd ${SETTE_DIR} 1161 . ./prepare_job.sh input_ORCA2_LIM3_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1176 . ./prepare_job.sh input_ORCA2_LIM3_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1162 1177 cd ${SETTE_DIR} 1163 1178 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1198 1213 fi 1199 1214 cd ${SETTE_DIR} 1200 . ./prepare_job.sh input_ORCA2_LIM3_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1215 . ./prepare_job.sh input_ORCA2_LIM3_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1201 1216 cd ${SETTE_DIR} 1202 1217 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1242 1257 fi 1243 1258 cd ${SETTE_DIR} 1244 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1259 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1245 1260 cd ${SETTE_DIR} 1246 1261 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1284 1299 fi 1285 1300 cd ${SETTE_DIR} 1286 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1301 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1287 1302 cd ${SETTE_DIR} 1288 1303 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1318 1333 fi 1319 1334 cd ${SETTE_DIR} 1320 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1335 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1321 1336 cd ${SETTE_DIR} 1322 1337 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1367 1382 fi 1368 1383 cd ${SETTE_DIR} 1369 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1384 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1370 1385 1371 1386 cd ${SETTE_DIR} … … 1419 1434 fi 1420 1435 cd ${SETTE_DIR} 1421 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1436 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1422 1437 cd ${SETTE_DIR} 1423 1438 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1464 1479 fi 1465 1480 cd ${SETTE_DIR} 1466 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1481 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1467 1482 cd ${SETTE_DIR} 1468 1483 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1502 1517 fi 1503 1518 cd ${SETTE_DIR} 1504 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1519 . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR} 1505 1520 cd ${SETTE_DIR} 1506 1521 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
Note: See TracChangeset
for help on using the changeset viewer.
