- Timestamp:
- 2017-03-03T12:46:59+01:00 (7 years ago)
- Location:
- trunk/NEMOGCM
- Files:
-
- 121 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_hgr.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/USR/usrdef_istate.F90 (modified) (3 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) (36 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) (34 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90
r7698 r7753 75 75 ! upstream advection with initial mass fluxes & intermediate update 76 76 ! -------------------------------------------------------------------- 77 !$OMP PARALLEL78 !$OMP DO schedule(static) private(jj,ji,zfp_ui,zfm_ui,zfp_vj,zfm_vj)79 77 DO jj = 1, jpjm1 ! upstream tracer flux in the i and j direction 80 78 DO ji = 1, fs_jpim1 ! vector opt. … … 88 86 END DO 89 87 90 !$OMP DO schedule(static) private(jj,ji,ztra)91 88 DO jj = 2, jpjm1 ! total intermediate advective trends 92 89 DO ji = fs_2, fs_jpim1 ! vector opt. … … 98 95 END DO 99 96 END DO 100 !$OMP END PARALLEL101 97 CALL lbc_lnk( zt_ups, 'T', 1. ) ! Lateral boundary conditions (unchanged sign) 102 98 … … 105 101 SELECT CASE( nn_limadv_ord ) 106 102 CASE ( 20 ) ! centered second order 107 !$OMP PARALLEL DO schedule(static) private(jj,ji)108 103 DO jj = 2, jpjm1 109 104 DO ji = fs_2, fs_jpim1 ! vector opt. … … 116 111 CALL macho( kt, nn_limadv_ord, pdt, ptc, puc, pvc, pubox, pvbox, zt_u, zt_v ) 117 112 ! 118 !$OMP PARALLEL DO schedule(static) private(jj,ji)119 113 DO jj = 2, jpjm1 120 114 DO ji = fs_2, fs_jpim1 ! vector opt. … … 128 122 ! antidiffusive flux : high order minus low order 129 123 ! -------------------------------------------------- 130 !$OMP PARALLEL DO schedule(static) private(jj,ji)131 124 DO jj = 2, jpjm1 132 125 DO ji = fs_2, fs_jpim1 ! vector opt. … … 143 136 ! final trend with corrected fluxes 144 137 ! ------------------------------------ 145 !$OMP PARALLEL DO schedule(static) private(jj,ji,ztra)146 138 DO jj = 2, jpjm1 147 139 DO ji = fs_2, fs_jpim1 ! vector opt. … … 195 187 ! 196 188 ! !-- advective form update in zzt --! 197 !$OMP PARALLEL DO schedule(static) private(jj,ji)198 189 DO jj = 2, jpjm1 199 190 DO ji = fs_2, fs_jpim1 ! vector opt. … … 214 205 ! 215 206 ! !-- advective form update in zzt --! 216 !$OMP PARALLEL DO schedule(static) private(jj,ji)217 207 DO jj = 2, jpjm1 218 208 DO ji = fs_2, fs_jpim1 … … 263 253 ! 264 254 ! !-- Laplacian in i-direction --! 265 !$OMP PARALLEL DO schedule(static) private(jj,ji)266 255 DO jj = 2, jpjm1 ! First derivative (gradient) 267 256 DO ji = 1, fs_jpim1 … … 276 265 ! 277 266 ! !-- BiLaplacian in i-direction --! 278 !$OMP PARALLEL DO schedule(static) private(jj,ji)279 267 DO jj = 2, jpjm1 ! Third derivative 280 268 DO ji = 1, fs_jpim1 … … 293 281 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 294 282 ! 295 !$OMP PARALLEL DO schedule(static) private(jj,ji)296 283 DO jj = 1, jpj 297 284 DO ji = 1, fs_jpim1 ! vector opt. … … 303 290 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 304 291 ! 305 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu)306 292 DO jj = 1, jpj 307 293 DO ji = 1, fs_jpim1 ! vector opt. … … 315 301 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 316 302 ! 317 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2)318 303 DO jj = 1, jpj 319 304 DO ji = 1, fs_jpim1 ! vector opt. … … 330 315 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 331 316 ! 332 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2)333 317 DO jj = 1, jpj 334 318 DO ji = 1, fs_jpim1 ! vector opt. … … 345 329 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 346 330 ! 347 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2,zdx4)348 331 DO jj = 1, jpj 349 332 DO ji = 1, fs_jpim1 ! vector opt. … … 397 380 ! 398 381 ! !-- Laplacian in j-direction --! 399 !$OMP PARALLEL400 !$OMP DO schedule(static) private(jj,ji)401 382 DO jj = 1, jpjm1 ! First derivative (gradient) 402 383 DO ji = fs_2, fs_jpim1 … … 404 385 END DO 405 386 END DO 406 !$OMP DO schedule(static) private(jj,ji)407 387 DO jj = 2, jpjm1 ! Second derivative (Laplacian) 408 388 DO ji = fs_2, fs_jpim1 … … 410 390 END DO 411 391 END DO 412 !$OMP END PARALLEL413 392 CALL lbc_lnk( ztv2, 'T', 1. ) 414 393 ! 415 394 ! !-- BiLaplacian in j-direction --! 416 !$OMP PARALLEL417 !$OMP DO schedule(static) private(jj,ji)418 395 DO jj = 1, jpjm1 ! First derivative 419 396 DO ji = fs_2, fs_jpim1 … … 421 398 END DO 422 399 END DO 423 !$OMP DO schedule(static) private(jj,ji)424 400 DO jj = 2, jpjm1 ! Second derivative 425 401 DO ji = fs_2, fs_jpim1 … … 427 403 END DO 428 404 END DO 429 !$OMP END PARALLEL430 405 CALL lbc_lnk( ztv4, 'T', 1. ) 431 406 ! … … 435 410 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 436 411 ! 437 !$OMP PARALLEL DO schedule(static) private(jj,ji)438 412 DO jj = 1, jpjm1 439 413 DO ji = 1, jpi … … 444 418 ! 445 419 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 446 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv)447 420 DO jj = 1, jpjm1 448 421 DO ji = 1, jpi … … 456 429 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 457 430 ! 458 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2)459 431 DO jj = 1, jpjm1 460 432 DO ji = 1, jpi … … 471 443 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 472 444 ! 473 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2)474 445 DO jj = 1, jpjm1 475 446 DO ji = 1, jpi … … 486 457 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 487 458 ! 488 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2,zdy4)489 459 DO jj = 1, jpjm1 490 460 DO ji = 1, jpi … … 543 513 544 514 ! clem test 545 !$OMP PARALLEL DO schedule(static) private(jj,ji)546 515 DO jj = 2, jpjm1 547 516 DO ji = fs_2, fs_jpim1 ! vector opt. … … 553 522 554 523 ! Determine ice masks for before and after tracers 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 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 565 527 566 528 ! Search local extrema … … 571 533 ! zbdo(:,:) = MIN( pbef(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) ), & 572 534 ! & 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(:,:) ) ) 573 539 574 540 z1_dt = 1._wp / pdt 575 576 !$OMP PARALLEL577 !$OMP DO schedule(static) private(jj,ji)578 DO jj = 1, jpj579 DO ji = 1, jpi580 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 DO585 END DO586 587 !$OMP DO schedule(static) private(jj,ji,zup,zdo,zpos,zneg,zbt)588 541 DO jj = 2, jpjm1 589 542 DO ji = fs_2, fs_jpim1 ! vector opt. … … 604 557 END DO 605 558 END DO 606 !$OMP END PARALLEL607 559 CALL lbc_lnk_multi( zbetup, 'T', 1., zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) 608 560 609 561 ! monotonic flux in the i & j direction (paa & pbb) 610 562 ! ------------------------------------- 611 !$OMP PARALLEL DO schedule(static) private(jj,ji,zau,zbu,zcu,zav,zbv,zcv)612 563 DO jj = 2, jpjm1 613 564 DO ji = fs_2, fs_jpim1 ! vector opt. -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r7698 r7753 58 58 INTEGER, INTENT(in) :: kt ! number of iteration 59 59 !! 60 INTEGER :: j i, jj, jl, jk ! dummy loop indices60 INTEGER :: 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 !$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) 71 ! ice velocities before rheology 72 u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 73 v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 77 74 78 ! Landfast ice parameterization: define max bottom friction 79 tau_icebfr(ji,jj) = 0._wp 80 END DO 81 END DO 75 ! Landfast ice parameterization: define max bottom friction 76 tau_icebfr(:,:) = 0._wp 82 77 IF( ln_landfast ) THEN 83 78 DO jl = 1, jpl 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 79 WHERE( ht_i(:,:,jl) > ht_n(:,:) * rn_gamma ) tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 90 80 END DO 91 81 ENDIF -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r7698 r7753 254 254 255 255 CASE( 0 ) 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 256 ahiu(:,:) = rn_ahi0_ref 257 ahiv(:,:) = rn_ahi0_ref 263 258 264 259 IF(lwp) WRITE(numout,*) '' … … 270 265 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain 271 266 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 267 ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 276 268 ! (60deg = min latitude for ice cover) 277 ahiv(ji,jj) = rn_ahi0_ref * zd_max * 1.e-05_wp 278 END DO 279 END DO 269 ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 280 270 281 271 IF(lwp) WRITE(numout,*) '' … … 290 280 za00 = rn_ahi0_ref * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 291 281 ! (60deg = min latitude for ice cover) 292 !$OMP PARALLEL DO schedule(static) private(jj,ji)293 282 DO jj = 1, jpj 294 283 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r7698 r7753 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 , DIMENSION(4) :: itest88 INTEGER , POINTER, DIMENSION(:) :: 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 ) 94 95 95 96 IF(lwp) WRITE(numout,*) … … 105 106 ! init surface temperature 106 107 DO jl = 1, jpl 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 108 t_su (:,:,jl) = rt0 * tmask(:,:,1) 109 tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 114 110 END DO 115 111 116 112 ! init basal temperature (considered at freezing point) 117 113 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 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 114 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 124 115 125 116 … … 131 122 IF( ln_limini_file )THEN 132 123 ! 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 ! 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 ! 149 135 ELSE ! ln_limini_file = F 150 136 … … 153 139 !-------------------------------------------------------------------- 154 140 ! no ice if sst <= t-freez + ttest 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 141 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 142 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 143 END WHERE 166 144 167 145 !----------------------------- … … 169 147 !----------------------------- 170 148 ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 171 !$OMP DO schedule(static) private(jj,ji)172 149 DO jj = 1, jpj 173 150 DO ji = 1, jpi … … 189 166 END DO 190 167 END DO 191 !$OMP END PARALLEL192 168 ! 193 169 ENDIF ! ln_limini_file 194 170 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 171 zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) ! ice volume 202 172 !--------------------------------------------------------------------- 203 173 ! 3.2) Distribute ice concentration and thickness into the categories … … 206 176 ! then we check whether the distribution fullfills 207 177 ! volume and area conservation, positivity and ice categories bounds 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 178 zh_i_ini(:,:,:) = 0._wp 179 za_i_ini(:,:,:) = 0._wp 217 180 ! 218 !$OMP DO schedule(static) private(jj,ji,jl0,jl,i_fill,zarg,zV,zdv,zconv,itest)219 181 DO jj = 1, jpj 220 182 DO ji = 1, jpi … … 327 289 END DO 328 290 END DO 329 !$OMP END PARALLEL330 291 331 292 !--------------------------------------------------------------------- … … 335 296 ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature 336 297 DO jl = 1, jpl ! loop over categories 337 !$OMP PARALLEL DO schedule(static) private(jj,ji)338 298 DO jj = 1, jpj 339 299 DO ji = 1, jpi … … 373 333 ENDIF 374 334 375 !$OMP PARALLEL376 335 ! Snow temperature and heat content 377 336 DO jk = 1, nlay_s 378 337 DO jl = 1, jpl ! loop over categories 379 !$OMP DO schedule(static) private(jj,ji)380 338 DO jj = 1, jpj 381 339 DO ji = 1, jpi … … 394 352 DO jk = 1, nlay_i 395 353 DO jl = 1, jpl ! loop over categories 396 !$OMP DO schedule(static) private(jj,ji)397 354 DO jj = 1, jpj 398 355 DO ji = 1, jpi … … 413 370 END DO 414 371 372 tn_ice (:,:,:) = t_su (:,:,:) 373 374 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 387 415 388 DO jl = 1, jpl 416 !$OMP DO schedule(static) private(jj,ji) 417 DO jj = 1, jpj418 DO ji = 1, jpi419 tn_ice (ji,jj,jl) = t_su (ji,jj,jl)420 END DO389 DO jk = 1, nlay_i 390 t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 391 END DO 392 DO jk = 1, nlay_s 393 t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 421 394 END DO 422 395 END DO 423 !$OMP END PARALLEL424 425 ELSE ! if ln_limini=false426 !$OMP PARALLEL427 DO jl = 1, jpl428 !$OMP DO schedule(static) private(jj,ji)429 DO jj = 1, jpj430 DO ji = 1, jpi431 a_i (ji,jj,jl) = 0._wp432 v_i (ji,jj,jl) = 0._wp433 v_s (ji,jj,jl) = 0._wp434 smv_i(ji,jj,jl) = 0._wp435 oa_i (ji,jj,jl) = 0._wp436 ht_i (ji,jj,jl) = 0._wp437 ht_s (ji,jj,jl) = 0._wp438 sm_i (ji,jj,jl) = 0._wp439 o_i (ji,jj,jl) = 0._wp440 END DO441 END DO442 END DO443 444 DO jk = 1, nlay_i445 DO jl = 1, jpl446 !$OMP DO schedule(static) private(jj,ji)447 DO jj = 1, jpj448 DO ji = 1, jpi449 e_i(ji,jj,jl,jk) = 0._wp450 END DO451 END DO452 END DO453 END DO454 DO jk = 1, nlay_s455 DO jl = 1, jpl456 !$OMP DO schedule(static) private(jj,ji)457 DO jj = 1, jpj458 DO ji = 1, jpi459 e_s(ji,jj,jl,jk) = 0._wp460 END DO461 END DO462 END DO463 END DO464 465 DO jl = 1, jpl466 DO jk = 1, nlay_i467 !$OMP DO schedule(static) private(jj,ji)468 DO jj = 1, jpj469 DO ji = 1, jpi470 t_i(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1)471 END DO472 END DO473 END DO474 DO jk = 1, nlay_s475 !$OMP DO schedule(static) private(jj,ji)476 DO jj = 1, jpj477 DO ji = 1, jpi478 t_s(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1)479 END DO480 END DO481 END DO482 END DO483 !$OMP END PARALLEL484 396 485 397 ENDIF ! ln_limini 486 398 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 399 at_i (:,:) = 0.0_wp 494 400 DO jl = 1, jpl 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 401 at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 501 402 END DO 502 403 ! 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 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 574 446 575 447 !!!clem … … 581 453 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 ) 582 454 CALL wrk_dealloc( jpi, jpj, zswitch ) 455 Call wrk_dealloc( 4, itest ) 583 456 584 457 END SUBROUTINE lim_istate -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r7698 r7753 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_ai118 117 ! 119 118 INTEGER, PARAMETER :: nitermax = 20 … … 123 122 IF( nn_timing == 1 ) CALL timing_start('limitd_me') 124 123 125 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross , z_ai)124 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross ) 126 125 127 126 ! conservation test … … 136 135 ! 137 136 138 !$OMP PARALLEL DO schedule(static) private(jj,ji)139 137 DO jj = 1, jpj ! Initialize arrays. 140 138 DO ji = 1, jpi … … 194 192 ! closing rate to a gross closing rate. 195 193 ! NOTE: 0 < aksum <= 1 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 194 closing_gross(:,:) = closing_net(:,:) / aksum(:,:) 203 195 204 196 ! correction to closing rate and opening if closing rate is excessive … … 206 198 ! Reduce the closing rate if more than 100% of the open water 207 199 ! would be removed. Reduce the opening rate proportionately. 208 !$OMP DO schedule(static) private(jj,ji,za,zfac)209 200 DO jj = 1, jpj 210 201 DO ji = 1, jpi … … 225 216 ! would be removed. Reduce the opening rate proportionately. 226 217 DO jl = 1, jpl 227 !$OMP DO schedule(static) private(jj,ji,za,zfac)228 218 DO jj = 1, jpj 229 219 DO ji = 1, jpi … … 236 226 END DO 237 227 END DO 238 !$OMP END PARALLEL239 228 240 229 ! 3.3 Redistribute area, volume, and energy. … … 247 236 !-----------------------------------------------------------------------------! 248 237 ! This is in general not equal to one because of divergence during transport 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 238 asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 271 239 272 240 ! 3.5 Do we keep on iterating ??? … … 276 244 277 245 iterate_ridging = 0 278 !$OMP DO schedule(static) private(jj,ji)279 246 DO jj = 1, jpj 280 247 DO ji = 1, jpi … … 291 258 END DO 292 259 END DO 293 !$OMP END PARALLEL294 260 295 261 IF( lk_mpp ) CALL mpp_max( iterate_ridging ) … … 323 289 IF( ln_ctl ) CALL lim_prt3D( 'limitd_me' ) 324 290 325 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross , z_ai)291 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross ) 326 292 ! 327 293 IF( nn_timing == 1 ) CALL timing_stop('limitd_me') … … 340 306 REAL(wp) :: Gstari, astari, hrmean, zdummy ! local scalar 341 307 REAL(wp), POINTER, DIMENSION(:,:,:) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 342 REAL(wp), POINTER, DIMENSION(:,:) :: z_ai343 308 !------------------------------------------------------------------------------! 344 309 345 310 CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 346 CALL wrk_alloc( jpi,jpj,z_ai )347 311 348 312 Gstari = 1.0/rn_gstar 349 313 astari = 1.0/rn_astar 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 314 aksum(:,:) = 0.0 315 athorn(:,:,:) = 0.0 316 aridge(:,:,:) = 0.0 317 araft (:,:,:) = 0.0 369 318 370 319 ! Zero out categories with very small areas 371 320 CALL lim_var_zapsmall 372 321 373 !$OMP PARALLEL374 322 ! Ice thickness needed for rafting 375 323 DO jl = 1, jpl 376 !$OMP DO schedule(static) private(jj,ji,rswitch)377 324 DO jj = 1, jpj 378 325 DO ji = 1, jpi … … 389 336 ! Compute total area of ice plus open water. 390 337 ! This is in general not equal to one because of divergence during transport 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 338 asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 339 413 340 ! Compute cumulative thickness distribution function 414 341 ! Compute the cumulative thickness distribution function Gsum, 415 342 ! where Gsum(n) is the fractional area in categories 0 to n. 416 343 ! initial value (in h = 0) equals open water area 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 344 Gsum(:,:,-1) = 0._wp 345 Gsum(:,:,0 ) = ato_i(:,:) 424 346 ! for each value of h, you have to add ice concentration then 425 347 DO jl = 1, jpl 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 348 Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 432 349 END DO 433 350 434 351 ! Normalize the cumulative distribution to 1 435 352 DO jl = 0, jpl 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 353 Gsum(:,:,jl) = Gsum(:,:,jl) / asum(:,:) 442 354 END DO 443 !$OMP END PARALLEL444 355 445 356 ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn) … … 458 369 IF( nn_partfun == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975) 459 370 DO jl = 0, jpl 460 !$OMP PARALLEL DO schedule(static) private(jj,ji)461 371 DO jj = 1, jpj 462 372 DO ji = 1, jpi … … 477 387 ! 478 388 zdummy = 1._wp / ( 1._wp - EXP(-astari) ) ! precompute exponential terms using Gsum as a work array 479 !$OMP PARALLEL480 389 DO jl = -1, jpl 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 390 Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 487 391 END DO 488 392 DO jl = 0, jpl 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 393 athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 394 END DO 497 395 ! 498 396 ENDIF … … 502 400 ! 503 401 DO jl = 1, jpl 504 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdummy)505 402 DO jj = 1, jpj 506 403 DO ji = 1, jpi … … 515 412 ! 516 413 DO jl = 1, jpl 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 414 aridge(:,:,jl) = athorn(:,:,jl) 523 415 END DO 524 416 ! … … 526 418 ! 527 419 DO jl = 1, jpl 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 420 araft(:,:,jl) = athorn(:,:,jl) 534 421 END DO 535 422 ! … … 562 449 !----------------------------------------------------------------- 563 450 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 451 aksum(:,:) = athorn(:,:,0) 571 452 ! Transfer function 572 453 DO jl = 1, jpl !all categories have a specific transfer function 573 !$OMP DO schedule(static) private(jj,ji,hrmean)574 454 DO jj = 1, jpj 575 455 DO ji = 1, jpi … … 596 476 END DO 597 477 END DO 598 !$OMP END PARALLEL599 478 ! 600 479 CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 601 CALL wrk_dealloc( jpi,jpj,z_ai )602 480 ! 603 481 END SUBROUTINE lim_itd_me_ridgeprep … … 661 539 ! 1) Compute change in open water area due to closing and opening. 662 540 !------------------------------------------------------------------------------- 663 !$OMP PARALLEL DO schedule(static) private(jj,ji)664 541 DO jj = 1, jpj 665 542 DO ji = 1, jpi … … 691 568 END DO 692 569 693 !$OMP PARALLEL694 !$OMP DO schedule(static) private(ij,jj,ji)695 570 DO ij = 1, icells 696 571 ji = indxi(ij) ; jj = indxj(ij) … … 785 660 !-------------------------------------------------------------------- 786 661 DO jk = 1, nlay_i 787 !$OMP DO schedule(static) private(ij,jj,ji)788 662 DO ij = 1, icells 789 663 ji = indxi(ij) ; jj = indxj(ij) … … 813 687 DO jl2 = 1, jpl 814 688 ! over categories to which ridged/rafted ice is transferred 815 !$OMP DO schedule(static) private(ij,jj,ji,hL,hR,farea)816 689 DO ij = 1, icells 817 690 ji = indxi(ij) ; jj = indxj(ij) … … 848 721 ! Transfer ice energy to category jl2 by ridging 849 722 DO jk = 1, nlay_i 850 !$OMP DO schedule(static) private(ij,jj,ji)851 723 DO ij = 1, icells 852 724 ji = indxi(ij) ; jj = indxj(ij) … … 856 728 ! 857 729 END DO ! jl2 858 !$OMP END PARALLEL859 730 860 731 END DO ! jl1 (deforming categories) 732 861 733 ! 862 734 CALL wrk_dealloc( jpij, indxi, indxj ) … … 897 769 ! 1) Initialize 898 770 !------------------------------------------------------------------------------! 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 771 strength(:,:) = 0._wp 905 772 906 773 !------------------------------------------------------------------------------! … … 914 781 IF( kstrngth == 1 ) THEN 915 782 z1_3 = 1._wp / 3._wp 916 !$OMP PARALLEL917 783 DO jl = 1, jpl 918 !$OMP DO schedule(static) private(jj,ji)919 784 DO jj= 1, jpj 920 785 DO ji = 1, jpi … … 945 810 END DO 946 811 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 812 strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) * tmask(:,:,1) 954 813 ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation 955 814 ksmooth = 1 … … 959 818 !------------------------------------------------------------------------------! 960 819 ELSE ! kstrngth ne 1: Hibler (1979) form 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 820 ! 821 strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) ) ) * tmask(:,:,1) 968 822 ! 969 823 ksmooth = 1 … … 976 830 ! CAN BE REMOVED 977 831 IF( ln_icestr_bvf ) THEN 978 !$OMP PARALLEL DO schedule(static) private(jj,ji)979 832 DO jj = 1, jpj 980 833 DO ji = 1, jpi … … 993 846 IF ( ksmooth == 1 ) THEN 994 847 995 !$OMP PARALLEL996 !$OMP DO schedule(static) private(jj,ji)997 848 DO jj = 2, jpjm1 998 849 DO ji = 2, jpim1 … … 1008 859 END DO 1009 860 1010 !$OMP DO schedule(static) private(jj,ji)1011 861 DO jj = 2, jpjm1 1012 862 DO ji = 2, jpim1 … … 1014 864 END DO 1015 865 END DO 1016 !$OMP END PARALLEL1017 866 CALL lbc_lnk( strength, 'T', 1. ) 1018 867 … … 1025 874 1026 875 IF ( numit == nit000 + nn_fsbc - 1 ) THEN 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 876 zstrp1(:,:) = 0._wp 877 zstrp2(:,:) = 0._wp 1034 878 ENDIF 1035 879 1036 !$OMP PARALLEL DO schedule(static) private(jj,ji,numts_rm,zp)1037 880 DO jj = 2, jpjm1 1038 881 DO ji = 2, jpim1 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r7698 r7753 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 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 108 dummy_es(:,:,:) = e_s(:,:,1,:) 116 109 CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_init) 117 110 ENDIF … … 128 121 ENDIF 129 122 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 123 zdhice(:,:,:) = 0._wp 139 124 DO jl = klbnd, kubnd 140 !$OMP DO schedule(static) private(jj,ji,rswitch)141 125 DO jj = 1, jpj 142 126 DO ji = 1, jpi … … 153 137 ! 2) Compute fractional ice area in each grid cell 154 138 !----------------------------------------------------------------------------------------------- 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 139 at_i(:,:) = 0._wp 161 140 DO jl = klbnd, kubnd 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 141 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 142 END DO 170 143 171 144 !----------------------------------------------------------------------------------------------- … … 190 163 !----------------------------------------------------------------------------------------------- 191 164 !- 4.1 Compute category boundaries 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 165 zhbnew(:,:,:) = 0._wp 201 166 202 167 DO jl = klbnd, kubnd - 1 203 !$OMP DO schedule(static) private(ji,ii,ij,zslope)204 168 DO ji = 1, nbrem 205 169 ii = nind_i(ji) … … 219 183 220 184 !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 221 !$OMP DO schedule(static) private(ji,ii,ij)222 185 DO ji = 1, nbrem 223 186 ii = nind_i(ji) … … 242 205 243 206 END DO 244 !$OMP END PARALLEL245 207 246 208 !----------------------------------------------------------------------------------------------- … … 261 223 ! 6) Fill arrays with lowermost / uppermost boundaries of 'new' categories 262 224 !----------------------------------------------------------------------------------------------- 263 !$OMP PARALLEL DO schedule(static) private(jj,ji)264 225 DO jj = 1, jpj 265 226 DO ji = 1, jpi … … 293 254 294 255 !- 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)296 256 DO ji = 1, nbrem 297 257 ii = nind_i(ji) … … 339 299 !----------------------------------------------------------------------------------------------- 340 300 341 !$OMP PARALLEL342 301 DO jl = klbnd, kubnd - 1 343 !$OMP DO schedule(static) private(jj,ji)344 302 DO jj = 1, jpj 345 303 DO ji = 1, jpi … … 350 308 END DO 351 309 352 !$OMP DO schedule(static) private(ji,ii,ij,zetamax,zetamin,zx1,zwk1,zwk2,zx2,zx3,nd)353 310 DO ji = 1, nbrem 354 311 ii = nind_i(ji) … … 385 342 END DO 386 343 END DO 387 !$OMP END PARALLEL388 344 389 345 !!---------------------------------------------------------------------------------------------- … … 396 352 !!---------------------------------------------------------------------------------------------- 397 353 398 !$OMP PARALLEL DO schedule(static) private(ji,ii,ij)399 354 DO ji = 1, nbrem 400 355 ii = nind_i(ji) … … 422 377 CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid) 423 378 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 379 dummy_es(:,:,:) = e_s(:,:,1,:) 432 380 CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_final) 433 381 fieldid = ' e_s : limitd_th ' … … 473 421 !!------------------------------------------------------------------ 474 422 ! 475 !$OMP PARALLEL DO schedule(static) private(jj,ji,zh13,zh23,zdhr,zwk1,zwk2)476 423 DO jj = 1, jpj 477 424 DO ji = 1, jpi … … 553 500 554 501 DO jl = klbnd, kubnd 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 502 zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl) 561 503 END DO 562 504 … … 577 519 END DO 578 520 579 !$OMP PARALLEL DO schedule(static) private(ji,ii,ij,jl1,jl2,rswitch,zdvsnow,zdesnow,zdo_aice,zdsm_vice,zdaTsf)580 521 DO ji = 1, nbrem 581 522 ii = nind_i(ji) … … 643 584 644 585 DO jk = 1, nlay_i 645 !$OMP PARALLEL DO schedule(static) private(ji,ii,ij,jl1,jl2,zdeice)646 586 DO ji = 1, nbrem 647 587 ii = nind_i(ji) … … 668 608 669 609 DO jl = klbnd, kubnd 670 !$OMP PARALLEL DO schedule(static) private(jj,ji)671 610 DO jj = 1, jpj 672 611 DO ji = 1, jpi … … 724 663 ! 1) Compute ice thickness. 725 664 !------------------------------------------------------------------------------ 726 !$OMP PARALLEL727 665 DO jl = klbnd, kubnd 728 !$OMP DO schedule(static) private(jj,ji,rswitch)729 666 DO jj = 1, jpj 730 667 DO ji = 1, jpi … … 743 680 !------------------------- 744 681 DO jl = klbnd, kubnd 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 682 zdonor(:,:,jl) = 0 683 zdaice(:,:,jl) = 0._wp 684 zdvice(:,:,jl) = 0._wp 685 END DO 755 686 756 687 !------------------------- … … 765 696 zshiftflag = 0 766 697 767 !$OMP PARALLEL DO schedule(static) private(jj,ji) REDUCTION(MAX:zshiftflag)768 698 DO jj = 1, jpj 769 699 DO ji = 1, jpi … … 786 716 CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 787 717 ! Reset shift parameters 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 718 zdonor(:,:,jl) = 0 719 zdaice(:,:,jl) = 0._wp 720 zdvice(:,:,jl) = 0._wp 796 721 ENDIF 797 722 ! … … 809 734 zshiftflag = 0 810 735 811 !$OMP PARALLEL DO schedule(static) private(jj,ji) REDUCTION(MAX:zshiftflag)812 736 DO jj = 1, jpj 813 737 DO ji = 1, jpi 814 738 IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 739 ! 815 740 zshiftflag = 1 816 741 zdonor(ji,jj,jl) = jl + 1 … … 826 751 CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 827 752 ! Reset shift parameters 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 753 zdonor(:,:,jl) = 0 754 zdaice(:,:,jl) = 0._wp 755 zdvice(:,:,jl) = 0._wp 836 756 ENDIF 837 757 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r7698 r7753 164 164 !------------------------------------------------------------------------------! 165 165 ! ocean/land mask 166 !$OMP PARALLEL DO schedule(static) private(jj, ji)167 166 DO jj = 1, jpjm1 168 167 DO ji = 1, jpim1 ! NO vector opt. … … 173 172 174 173 ! Lateral boundary conditions on velocity (modify 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) 174 zwf(:,:) = zfmask(:,:) 183 175 DO jj = 2, jpjm1 184 176 DO ji = fs_2, fs_jpim1 ! vector opt. … … 188 180 END DO 189 181 END DO 190 !$OMP DO schedule(static) private(jj)191 182 DO jj = 2, jpjm1 192 183 IF( zfmask(1,jj) == 0._wp ) THEN … … 197 188 ENDIF 198 189 END DO 199 !$OMP DO schedule(static) private(ji)200 190 DO ji = 2, jpim1 201 191 IF( zfmask(ji,1) == 0._wp ) THEN … … 206 196 ENDIF 207 197 END DO 208 !$OMP END PARALLEL209 198 CALL lbc_lnk( zfmask, 'F', 1._wp ) 210 199 … … 236 225 237 226 ! Initialise stress tensor 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 227 zs1 (:,:) = stress1_i (:,:) 228 zs2 (:,:) = stress2_i (:,:) 229 zs12(:,:) = stress12_i(:,:) 246 230 247 231 ! Ice strength … … 249 233 250 234 ! scale factors 251 !$OMP PARALLEL DO schedule(static) private(jj, ji)252 235 DO jj = 2, jpjm1 253 236 DO ji = fs_2, fs_jpim1 … … 272 255 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 273 256 ! 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 257 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 280 258 ! 281 259 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! 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 260 zpice(:,:) = ssh_m(:,:) 288 261 ENDIF 289 262 290 !$OMP PARALLEL DO schedule(static) private(jj,ji,zm1,zm2,zm3,zmassU,zmassV)291 263 DO jj = 2, jpjm1 292 264 DO ji = fs_2, fs_jpim1 … … 345 317 ! !----------------------! 346 318 IF(ln_ctl) THEN ! Convergence test 347 !$OMP PARALLEL DO schedule(static) private(jj, ji)348 319 DO jj = 1, jpjm1 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 320 zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 321 zv_ice(:,jj) = v_ice(:,jj) 353 322 END DO 354 323 ENDIF 355 324 356 325 ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 357 !$OMP PARALLEL DO schedule(static) private(jj, ji)358 326 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 359 327 DO ji = 1, jpim1 … … 368 336 CALL lbc_lnk( zds, 'F', 1. ) 369 337 370 !$OMP PARALLEL DO schedule(static) private(jj,ji,zds2,zdiv,zdiv2,zdt,zdt2,zdelta)371 338 DO jj = 2, jpjm1 372 339 DO ji = 2, jpim1 ! no vector loop … … 403 370 CALL lbc_lnk( zp_delt, 'T', 1. ) 404 371 405 !$OMP PARALLEL DO schedule(static) private(jj,ji,zp_delf)406 372 DO jj = 1, jpjm1 407 373 DO ji = 1, jpim1 … … 419 385 420 386 ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 421 !$OMP PARALLEL DO schedule(static) private(jj,ji)422 387 DO jj = 2, jpjm1 423 388 DO ji = fs_2, fs_jpim1 … … 455 420 IF( MOD(jter,2) .EQ. 0 ) THEN ! even iterations 456 421 457 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch)458 422 DO jj = 2, jpjm1 459 423 DO ji = fs_2, fs_jpim1 … … 500 464 IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' ) 501 465 502 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch)503 466 DO jj = 2, jpjm1 504 467 DO ji = fs_2, fs_jpim1 … … 546 509 ELSE ! odd iterations 547 510 548 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch)549 511 DO jj = 2, jpjm1 550 512 DO ji = fs_2, fs_jpim1 … … 590 552 IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' ) 591 553 592 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch)593 554 DO jj = 2, jpjm1 594 555 DO ji = fs_2, fs_jpim1 … … 637 598 638 599 IF(ln_ctl) THEN ! Convergence test 639 !$OMP PARALLEL DO schedule(static) private(jj, ji)640 600 DO jj = 2 , jpjm1 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 601 zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 644 602 END DO 645 603 zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) … … 654 612 ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 655 613 !------------------------------------------------------------------------------! 656 !$OMP PARALLEL DO schedule(static) private(jj, ji)657 614 DO jj = 1, jpjm1 658 615 DO ji = 1, jpim1 … … 667 624 CALL lbc_lnk( zds, 'F', 1. ) 668 625 669 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdt,zdt2,zds2,zdelta,rswitch)670 626 DO jj = 2, jpjm1 671 627 DO ji = 2, jpim1 ! no vector loop … … 700 656 701 657 ! --- Store the stress tensor for the next time step --- ! 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 658 stress1_i (:,:) = zs1 (:,:) 659 stress2_i (:,:) = zs2 (:,:) 660 stress12_i(:,:) = zs12(:,:) 710 661 ! 711 662 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r7698 r7753 130 130 WRITE(zchar,'(I2.2)') jl 131 131 znam = 'v_i'//'_htc'//zchar 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 132 z2d(:,:) = v_i(:,:,jl) 138 133 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 139 134 znam = 'v_s'//'_htc'//zchar 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 135 z2d(:,:) = v_s(:,:,jl) 146 136 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 147 137 znam = 'smv_i'//'_htc'//zchar 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 138 z2d(:,:) = smv_i(:,:,jl) 154 139 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 155 140 znam = 'oa_i'//'_htc'//zchar 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 141 z2d(:,:) = oa_i(:,:,jl) 162 142 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 163 143 znam = 'a_i'//'_htc'//zchar 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 144 z2d(:,:) = a_i(:,:,jl) 170 145 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 171 146 znam = 't_su'//'_htc'//zchar 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 147 z2d(:,:) = t_su(:,:,jl) 178 148 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 179 149 END DO … … 182 152 WRITE(zchar,'(I2.2)') jl 183 153 znam = 'tempt_sl1'//'_htc'//zchar 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 154 z2d(:,:) = e_s(:,:,1,jl) 190 155 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 191 156 END DO … … 196 161 WRITE(zchar1,'(I2.2)') jk 197 162 znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 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 163 z2d(:,:) = e_i(:,:,jk,jl) 204 164 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 205 165 END DO … … 221 181 WRITE(zchar,'(I2.2)') jl 222 182 znam = 'sxice'//'_htc'//zchar 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 183 z2d(:,:) = sxice(:,:,jl) 229 184 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 230 185 znam = 'syice'//'_htc'//zchar 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 186 z2d(:,:) = syice(:,:,jl) 237 187 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 238 188 znam = 'sxxice'//'_htc'//zchar 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 189 z2d(:,:) = sxxice(:,:,jl) 245 190 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 246 191 znam = 'syyice'//'_htc'//zchar 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 192 z2d(:,:) = syyice(:,:,jl) 253 193 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 254 194 znam = 'sxyice'//'_htc'//zchar 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 195 z2d(:,:) = sxyice(:,:,jl) 261 196 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 262 197 znam = 'sxsn'//'_htc'//zchar 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 198 z2d(:,:) = sxsn(:,:,jl) 269 199 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 270 200 znam = 'sysn'//'_htc'//zchar 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 201 z2d(:,:) = sysn(:,:,jl) 277 202 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 278 203 znam = 'sxxsn'//'_htc'//zchar 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 204 z2d(:,:) = sxxsn(:,:,jl) 285 205 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 286 206 znam = 'syysn'//'_htc'//zchar 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 207 z2d(:,:) = syysn(:,:,jl) 293 208 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 294 209 znam = 'sxysn'//'_htc'//zchar 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 210 z2d(:,:) = sxysn(:,:,jl) 301 211 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 302 212 znam = 'sxa'//'_htc'//zchar 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 213 z2d(:,:) = sxa(:,:,jl) 309 214 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 310 215 znam = 'sya'//'_htc'//zchar 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 216 z2d(:,:) = sya(:,:,jl) 317 217 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 318 218 znam = 'sxxa'//'_htc'//zchar 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 219 z2d(:,:) = sxxa(:,:,jl) 325 220 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 326 221 znam = 'syya'//'_htc'//zchar 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 222 z2d(:,:) = syya(:,:,jl) 333 223 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 334 224 znam = 'sxya'//'_htc'//zchar 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 225 z2d(:,:) = sxya(:,:,jl) 341 226 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 342 227 znam = 'sxc0'//'_htc'//zchar 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 228 z2d(:,:) = sxc0(:,:,jl) 349 229 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 350 230 znam = 'syc0'//'_htc'//zchar 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 231 z2d(:,:) = syc0(:,:,jl) 357 232 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 358 233 znam = 'sxxc0'//'_htc'//zchar 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 234 z2d(:,:) = sxxc0(:,:,jl) 365 235 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 366 236 znam = 'syyc0'//'_htc'//zchar 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 237 z2d(:,:) = syyc0(:,:,jl) 373 238 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 374 239 znam = 'sxyc0'//'_htc'//zchar 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 240 z2d(:,:) = sxyc0(:,:,jl) 381 241 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 382 242 znam = 'sxsal'//'_htc'//zchar 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 243 z2d(:,:) = sxsal(:,:,jl) 389 244 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 390 245 znam = 'sysal'//'_htc'//zchar 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 246 z2d(:,:) = sysal(:,:,jl) 397 247 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 398 248 znam = 'sxxsal'//'_htc'//zchar 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 249 z2d(:,:) = sxxsal(:,:,jl) 405 250 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 406 251 znam = 'syysal'//'_htc'//zchar 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 252 z2d(:,:) = syysal(:,:,jl) 413 253 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 414 254 znam = 'sxysal'//'_htc'//zchar 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 255 z2d(:,:) = sxysal(:,:,jl) 421 256 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 422 257 znam = 'sxage'//'_htc'//zchar 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 258 z2d(:,:) = sxage(:,:,jl) 429 259 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 430 260 znam = 'syage'//'_htc'//zchar 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 261 z2d(:,:) = syage(:,:,jl) 437 262 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 438 263 znam = 'sxxage'//'_htc'//zchar 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 264 z2d(:,:) = sxxage(:,:,jl) 445 265 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 446 266 znam = 'syyage'//'_htc'//zchar 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 267 z2d(:,:) = syyage(:,:,jl) 453 268 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 454 269 znam = 'sxyage'//'_htc'//zchar 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 270 z2d(:,:) = sxyage(:,:,jl) 461 271 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 462 272 END DO … … 473 283 WRITE(zchar1,'(I2.2)') jk 474 284 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 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 285 z2d(:,:) = sxe(:,:,jk,jl) 481 286 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 482 287 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 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 288 z2d(:,:) = sye(:,:,jk,jl) 489 289 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 490 290 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 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 291 z2d(:,:) = sxxe(:,:,jk,jl) 497 292 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 498 293 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 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 294 z2d(:,:) = syye(:,:,jk,jl) 505 295 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 506 296 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 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 297 z2d(:,:) = sxye(:,:,jk,jl) 513 298 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 514 299 END DO -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r7698 r7753 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 !$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 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 134 120 ENDIF 135 121 … … 137 123 CALL wrk_alloc( jpi,jpj, zalb ) 138 124 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 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 159 129 IF( iom_use('alb_ice' ) ) CALL iom_put( "alb_ice" , zalb(:,:) ) ! ice albedo output 160 130 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 131 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b ) 177 132 IF( iom_use('albedo' ) ) CALL iom_put( "albedo" , zalb(:,:) ) ! ice albedo output 178 133 179 134 CALL wrk_dealloc( jpi,jpj, zalb ) 180 135 181 !$OMP PARALLEL182 !$OMP DO schedule(static) private(jj,ji,jl,zqsr,zqmass)183 136 DO jj = 1, jpj 184 137 DO ji = 1, jpi … … 233 186 ! salt flux at the ocean surface ! 234 187 !------------------------------------------! 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 188 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) & 189 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:) 243 190 244 191 !-------------------------------------------------------------! … … 246 193 !-------------------------------------------------------------! 247 194 IF( nn_ice_embd /= 0 ) THEN 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 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 259 201 ENDIF 260 202 … … 262 204 ! Storing the transmitted variables ! 263 205 !-----------------------------------------------! 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 206 fr_i (:,:) = at_i(:,:) ! Sea-ice fraction 207 tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature 280 208 281 209 !------------------------------------------------------------------------! … … 284 212 CALL wrk_alloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 285 213 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 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 214 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 294 215 CALL wrk_dealloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 295 216 … … 339 260 ! 340 261 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)342 262 DO jj = 2, jpjm1 !* update the modulus of stress at ocean surface (T-point) 343 263 DO ji = fs_2, fs_jpim1 … … 354 274 CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. ) 355 275 ! 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 276 utau_oce(:,:) = utau(:,:) !* save the air-ocean stresses at ice time-step 277 vtau_oce(:,:) = vtau(:,:) 363 278 ! 364 279 ENDIF … … 366 281 ! !== every ocean time-step ==! 367 282 ! 368 !$OMP PARALLEL DO schedule(static) private(jj,ji,zat_u,zat_v,zutau_ice,zvtau_ice)369 283 DO jj = 2, jpjm1 !* update the stress WITHOUT a ice-ocean rotation angle 370 284 DO ji = fs_2, fs_jpim1 ! Vect. Opt. … … 405 319 IF( lim_sbc_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' ) 406 320 ! 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 321 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case 322 sice_0(:,:) = sice 415 323 ! ! decrease ocean & ice reference salinities in the Baltic Sea area 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 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 427 329 ! 428 330 IF( .NOT. ln_rstart ) THEN 429 331 ! ! embedded sea ice 430 332 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice 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 333 snwice_mass (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 334 snwice_mass_b(:,:) = snwice_mass(:,:) 438 335 ELSE 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 336 snwice_mass (:,:) = 0._wp ! no mass exchanges 337 snwice_mass_b(:,:) = 0._wp ! no mass exchanges 446 338 ENDIF 447 339 IF( nn_ice_embd == 2 ) THEN ! full embedment (case 2) deplete the initial ssh below sea-ice area 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 340 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 341 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 455 342 456 343 !!gm I really don't like this stuff here... Find a way to put that elsewhere or differently 457 344 !!gm 458 345 IF( .NOT.ln_linssh ) THEN 459 !$OMP PARALLEL460 !$OMP DO schedule(static) private(jj,ji)461 346 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 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 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)) ) 468 349 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 350 e3t_a(:,:,:) = e3t_b(:,:,:) 478 351 ! Reconstruction of all vertical scale factors at now and before time-steps 479 352 ! ========================================================================= … … 495 368 ! ---------------------- 496 369 !!gm not sure of that.... 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 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(:,:) 373 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 (:,:) 505 377 END DO 506 DO jk = 2, jpk507 !$OMP DO schedule(static) private(jj,ji)508 DO jj = 1, jpj509 DO ji = 1, jpi510 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 DO514 END DO515 END DO516 !$OMP END PARALLEL517 378 ENDIF 518 379 ENDIF -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r7698 r7753 110 110 !---------------------------------------------! 111 111 IF( ln_limdyn ) THEN 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) 112 zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 113 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 121 114 DO jj = 2, jpjm1 122 115 DO ji = fs_2, fs_jpim1 … … 126 119 END DO 127 120 END DO 128 !$OMP END PARALLEL129 121 ELSE ! if no ice dynamics => transmit directly the atmospheric stress to the ocean 130 !$OMP PARALLEL DO schedule(static) private(jj,ji)131 122 DO jj = 2, jpjm1 132 123 DO ji = fs_2, fs_jpim1 … … 142 133 ! Initialization and units change 143 134 !----------------------------------! 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 135 ftr_ice(:,:,:) = 0._wp ! part of solar radiation transmitted through the ice 153 136 154 137 ! Change the units of heat content; from J/m2 to J/m3 155 138 DO jl = 1, jpl 156 139 DO jk = 1, nlay_i 157 !$OMP DO schedule(static) private(jj,ji,rswitch)158 140 DO jj = 1, jpj 159 141 DO ji = 1, jpi … … 165 147 END DO 166 148 DO jk = 1, nlay_s 167 !$OMP DO schedule(static) private(jj,ji,rswitch)168 149 DO jj = 1, jpj 169 150 DO ji = 1, jpi … … 179 160 ! Partial computation of forcing for the thermodynamic sea ice model 180 161 !--------------------------------------------------------------------! 181 !$OMP DO schedule(static) private(jj,ji,rswitch,zqld,zqfr,zfric_u)182 162 DO jj = 1, jpj 183 163 DO ji = 1, jpi … … 221 201 END DO 222 202 END DO 223 !$OMP END PARALLEL224 203 225 204 ! In case we bypass open-water ice formation 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 205 IF( .NOT. ln_limdO ) qlead(:,:) = 0._wp 234 206 ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere 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 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 251 209 252 210 ! --------------------------------------------------------------------- … … 256 214 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 257 215 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 258 !$OMP DO schedule(static) private(jj,ji)259 216 DO jj = 1, jpj 260 217 DO ji = 1, jpi … … 266 223 END DO 267 224 END DO 268 !$OMP END PARALLEL269 225 270 226 !------------------------------------------------------------------------------! … … 332 288 333 289 ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 334 !$OMP PARALLEL335 290 DO jl = 1, jpl 336 291 DO jk = 1, 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 292 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 343 293 END DO 344 294 DO jk = 1, nlay_s 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 295 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s 351 296 END DO 352 297 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 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(:,:,:) 365 303 366 304 ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat) 367 305 DO jl = 1, jpl 368 !$OMP DO schedule(static) private(jj,ji,rswitch)369 306 DO jj = 1, jpj 370 307 DO ji = 1, jpi … … 374 311 END DO 375 312 END DO 376 !$OMP END PARALLEL377 313 378 314 CALL lim_var_zapsmall -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90
r7698 r7753 113 113 zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) ) 114 114 115 !$OMP PARALLEL116 !$OMP DO schedule(static) private(jj,ji,zdfloe,zperi,zwlat)117 115 DO jj = 1, jpj 118 116 DO ji = 1, jpi … … 137 135 !---------------------------------------------------------------------------------------------! 138 136 DO jl = jpl, 1, -1 139 !$OMP DO schedule(static) private(jj,ji,rswitch,zda)140 137 DO jj = 1, jpj 141 138 DO ji = 1, jpi … … 166 163 167 164 ! total concentration 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 165 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 166 182 167 ! --- ensure that ht_i = 0 where a_i = 0 --- 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 168 WHERE( a_i == 0._wp ) ht_i = 0._wp 193 169 ! 194 170 CALL wrk_dealloc( jpi,jpj, zda_tot ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r7698 r7753 125 125 ! 2) Convert units for ice internal energy 126 126 !------------------------------------------------------------------------------| 127 !$OMP PARALLEL128 127 DO jl = 1, jpl 129 128 DO jk = 1, nlay_i 130 !$OMP DO schedule(static) private(jj,ji,rswitch)131 129 DO jj = 1, jpj 132 130 DO ji = 1, jpi … … 152 150 ! 153 151 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 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 171 158 172 159 IF( ln_frazil ) THEN … … 175 162 ! Physical constants 176 163 !-------------------- 164 hicol(:,:) = 0._wp 177 165 178 166 zhicrit = 0.04 ! frazil ice thickness … … 181 169 zgamafr = 0.03 182 170 183 !$OMP PARALLEL184 !$OMP DO schedule(static) private(jj,ji)185 DO jj = 1, jpj186 DO ji = 1, jpi187 hicol(ji,jj) = 0._wp188 END DO189 END DO190 191 !$OMP DO schedule(static) private(jj,ji,ztaux,ztauy,ztenagm,rswitch,zvfrx,zvfry,zvgx,zvgy,zvrel2,iter,zf,zfp)192 171 DO jj = 2, jpjm1 193 172 DO ji = 2, jpim1 … … 247 226 END DO 248 227 END DO 249 !$OMP END PARALLEL250 228 ! 251 229 CALL lbc_lnk( zvrel, 'T', 1. ) … … 452 430 453 431 DO jk = 1, nlay_i 454 !$OMP PARALLEL DO schedule(static) private(ji,jl,rswitch)455 432 DO ji = 1, nbpac 456 433 jl = jcat(ji) … … 471 448 qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp 472 449 DO jk = 1, nlay_i 473 !$OMP PARALLEL DO schedule(static) private(ji)474 450 DO ji = 1, nbpac 475 451 h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i … … 479 455 480 456 ! new volumes including lateral/bottom accretion + residual 481 !$OMP PARALLEL DO schedule(static) private(ji,rswitch,zv_newfra)482 457 DO ji = 1, nbpac 483 458 rswitch = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) ) … … 497 472 !----------------- 498 473 DO jl = 1, jpl 499 !$OMP PARALLEL DO schedule(static) private(ji,zdv)500 474 DO ji = 1, nbpac 501 475 zdv = zv_i_1d(ji,jl) - zv_b(ji,jl) … … 528 502 DO jl = 1, jpl 529 503 DO jk = 1, nlay_i 530 !$OMP PARALLEL DO schedule(static) private(jj,ji)531 504 DO jj = 1, jpj 532 505 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r7698 r7753 114 114 zviold = v_i 115 115 zvsold = v_s 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 116 zsmvold(:,:) = SUM( smv_i(:,:,:), dim=3 ) 117 zeiold (:,:) = et_i 118 zesold (:,:) = et_s 119 120 !--- Thickness correction init. --- ! 121 zatold(:,:) = at_i 123 122 DO jl = 1, jpl 124 !$OMP DO schedule(static) private(jj,ji)125 DO jj = 1, jpj126 DO ji = 1, jpi127 zsmvold(ji,jj) = zsmvold(ji,jj) + smv_i(ji,jj,jl)128 END DO129 END DO130 END DO131 !$OMP DO schedule(static) private(jj,ji)132 DO jj = 1, jpj133 DO ji = 1, jpi134 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 DO140 END DO141 DO jl = 1, jpl142 !$OMP DO schedule(static) private(jj,ji,rswitch)143 123 DO jj = 1, jpj 144 124 DO ji = 1, jpi … … 150 130 END DO 151 131 ! --- Record max of the surrounding ice thicknesses for correction in case advection creates ice too thick --- ! 132 zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 152 133 DO jl = 1, jpl 153 !$OMP DO schedule(static) private(jj,ji)154 DO jj = 1, jpj155 DO ji = 1, jpi156 zhimax(ji,jj,jl) = ht_i(ji,jj,jl) + ht_s(ji,jj,jl)157 END DO158 END DO159 END DO160 !$OMP END PARALLEL161 DO jl = 1, jpl162 !$OMP PARALLEL DO schedule(static) private(jj,ji)163 134 DO jj = 2, jpjm1 164 135 DO ji = 2, jpim1 … … 202 173 zdt = rdt_ice / REAL(initad) 203 174 204 !$OMP PARALLEL205 175 ! transport 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 176 zudy(:,:) = u_ice(:,:) * e2u(:,:) 177 zvdx(:,:) = v_ice(:,:) * e1v(:,:) 213 178 214 179 ! define velocity for advection: u*grad(H) 215 !$OMP DO schedule(static) private(jj,ji)216 180 DO jj = 2, jpjm1 217 181 DO ji = fs_2, fs_jpim1 … … 227 191 END DO 228 192 END DO 229 !$OMP END PARALLEL230 193 231 194 ! advection … … 245 208 END DO 246 209 ! 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 210 at_i(:,:) = a_i(:,:,1) ! total ice fraction 254 211 DO jl = 2, jpl 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 212 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 213 END DO 263 214 ! 264 215 CALL wrk_dealloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box ) … … 279 230 ENDIF 280 231 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 232 zarea(:,:) = e1e2t(:,:) 233 234 !------------------------- 235 ! transported fields 236 !------------------------- 237 z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:) ! Open water area 293 238 DO jl = 1, jpl 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 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 305 245 DO jk = 1, nlay_i 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 246 z0ei (:,:,jk,jl) = e_i (:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 247 END DO 248 END DO 315 249 316 250 … … 402 336 ! Recover the properties from their contents 403 337 !------------------------------------------- 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 338 ato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) 411 339 DO jl = 1, jpl 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 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(:,:) 423 346 DO jk = 1, nlay_i 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 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 439 352 DO jl = 2, jpl 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 353 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 354 END DO 448 355 449 356 CALL wrk_dealloc( jpi,jpj, zarea ) … … 462 369 ! mask eddy diffusivity coefficient at ocean U- and V-points 463 370 jm=1 464 !$OMP PARALLEL465 371 DO jl = 1, jpl 466 !$OMP DO schedule(static) private(jj,ji)467 372 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 468 373 DO ji = 1 , fs_jpim1 … … 474 379 END DO 475 380 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 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 518 387 ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased) 519 388 ! zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1 520 389 ! zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1 521 390 DO jk = 1, nlay_i 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 391 zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 529 392 END DO 530 393 END DO … … 532 395 ! --- Prepare diffusion for open water area --- ! 533 396 ! mask eddy diffusivity coefficient at ocean U- and V-points 534 !$OMP DO schedule(static) private(jj,ji)535 397 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 536 398 DO ji = 1 , fs_jpim1 … … 542 404 END DO 543 405 ! 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 406 zhdfptab(:,:,jm)= ato_i (:,:); 551 407 552 408 ! --- Apply diffusion --- ! … … 555 411 ! --- Recover properties --- ! 556 412 jm=1 557 !$OMP PARALLEL558 413 DO jl = 1, jpl 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 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 602 420 ! Sample of adding more variables to apply lim_hdf 603 421 ! variable_1 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 604 422 ! variable_2 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 605 423 DO jk = 1, nlay_i 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 424 e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 425 END DO 426 END DO 427 ato_i (:,:) = zhdfptab(:,:,jm) 622 428 623 429 ENDIF 624 430 625 431 ! --- diags --- 626 !$OMP PARALLEL DO schedule(static) private(jj,ji)627 432 DO jj = 1, jpj 628 433 DO ji = 1, jpi … … 641 446 642 447 !--- Thickness correction in case too high --- ! 643 !$OMP PARALLEL644 448 DO jl = 1, jpl 645 !$OMP DO schedule(static) private(jj,ji,rswitch,zdv)646 449 DO jj = 1, jpj 647 450 DO ji = 1, jpi … … 678 481 679 482 ! Force the upper limit of ht_i to always be < hi_max (99 m). 680 !$OMP DO schedule(static) private(jj,ji,rswitch)681 483 DO jj = 1, jpj 682 484 DO ji = 1, jpi … … 686 488 END DO 687 489 END DO 688 !$OMP END PARALLEL689 490 690 491 ENDIF … … 694 495 !------------------------------------------------------------ 695 496 ! 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 497 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 713 498 IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2 714 499 DO jl = 1, jpl 715 !$OMP PARALLEL DO schedule(static) private(jj,ji,rswitch,zda)716 500 DO jj = 1, jpj 717 501 DO ji = 1, jpi … … 726 510 727 511 ! --- agglomerate variables ----------------- 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 512 vt_i(:,:) = SUM( v_i(:,:,:), dim=3 ) 513 vt_s(:,:) = SUM( v_s(:,:,:), dim=3 ) 514 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 747 515 748 516 ! --- open water = 1 if at_i=0 -------------------------------- 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 517 WHERE( at_i == 0._wp ) ato_i = 1._wp 756 518 757 519 ! conservation test -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r7698 r7753 70 70 ! ice concentration should not exceed amax 71 71 !----------------------------------------------------- 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 72 at_i(:,:) = 0._wp 79 73 DO jl = 1, jpl 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 74 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 86 75 END DO 87 76 88 77 DO jl = 1, jpl 89 !$OMP DO schedule(static) private(jj, ji)90 78 DO jj = 1, jpj 91 79 DO ji = 1, jpi … … 97 85 END DO 98 86 END DO 99 !$OMP END PARALLEL100 87 101 88 !--------------------- … … 104 91 IF ( nn_icesal == 2 ) THEN 105 92 DO jl = 1, jpl 106 !$OMP PARALLEL DO schedule(static) private(jj,ji,zsal,rswitch)107 93 DO jj = 1, jpj 108 94 DO ji = 1, jpi … … 132 118 ! ------------------------------------------------- 133 119 DO jl = 1, jpl 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 120 afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 140 121 END DO 141 122 142 !$OMP PARALLEL DO schedule(static) private(jj, ji)143 123 DO jj = 1, jpj 144 124 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r7698 r7753 71 71 ! Constrain the thickness of the smallest category above himin 72 72 !---------------------------------------------------------------------- 73 !$OMP PARALLEL74 !$OMP DO schedule(static) private(jj,ji,rswitch)75 73 DO jj = 1, jpj 76 74 DO ji = 1, jpi … … 87 85 ! ice concentration should not exceed amax 88 86 !----------------------------------------------------- 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 87 at_i(:,:) = 0._wp 95 88 DO jl = 1, jpl 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 89 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 102 90 END DO 103 91 104 92 DO jl = 1, jpl 105 !$OMP DO schedule(static) private(jj, ji)106 93 DO jj = 1, jpj 107 94 DO ji = 1, jpi … … 113 100 END DO 114 101 END DO 115 !$OMP END PARALLEL116 102 117 103 !--------------------- … … 120 106 IF ( nn_icesal == 2 ) THEN 121 107 DO jl = 1, jpl 122 !$OMP PARALLEL DO schedule(static) private(jj,ji,zsal,rswitch)123 108 DO jj = 1, jpj 124 109 DO ji = 1, jpi … … 149 134 ! Ice drift 150 135 !------------ 151 !$OMP PARALLEL DO schedule(static) private(jj, ji)152 136 DO jj = 2, jpjm1 153 137 DO ji = 2, jpim1 … … 164 148 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 165 149 !mask velocities 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 150 u_ice(:,:) = u_ice(:,:) * umask(:,:,1) 151 v_ice(:,:) = v_ice(:,:) * vmask(:,:,1) 174 152 175 153 ! ------------------------------------------------- … … 177 155 ! ------------------------------------------------- 178 156 DO jl = 1, jpl 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 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 186 159 END DO 187 160 afx_tot = afx_thd + afx_dyn 188 161 189 !$OMP DO schedule(static) private(jj, ji)190 162 DO jj = 1, jpj 191 163 DO ji = 1, jpi … … 201 173 END DO 202 174 END DO 203 !$OMP END PARALLEL204 175 205 176 ! conservation test -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r7698 r7753 80 80 !!------------------------------------------------------------------ 81 81 INTEGER, INTENT( in ) :: kn ! =1 at_i & vt only ; = what is needed 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_s, ze_i83 82 ! 84 83 INTEGER :: ji, jj, jk, jl ! dummy loop indices 85 84 !!------------------------------------------------------------------ 86 85 87 CALL wrk_alloc( jpi, jpj, nlay_s, ze_s )88 CALL wrk_alloc( jpi, jpj, nlay_i, ze_i )89 86 ! integrated values 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 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 ) 163 92 164 93 ! open water fraction 165 !$OMP DO schedule(static) private(jj, ji)166 94 DO jj = 1, jpj 167 95 DO ji = 1, jpi … … 169 97 END DO 170 98 END DO 171 !$OMP END PARALLEL172 99 173 100 IF( kn > 1 ) THEN 174 101 175 !$OMP PARALLEL176 102 ! mean ice/snow thickness 177 !$OMP DO schedule(static) private(jj,ji,rswitch)178 103 DO jj = 1, jpj 179 104 DO ji = 1, jpi … … 185 110 186 111 ! mean temperature (K), salinity and age 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 112 smt_i(:,:) = 0._wp 113 tm_i(:,:) = 0._wp 114 tm_su(:,:) = 0._wp 115 om_i (:,:) = 0._wp 196 116 DO jl = 1, jpl 197 117 198 !$OMP DO schedule(static) private(jj,ji,rswitch)199 118 DO jj = 1, jpj 200 119 DO ji = 1, jpi … … 206 125 207 126 DO jk = 1, nlay_i 208 !$OMP DO schedule(static) private(jj,ji,rswitch)209 127 DO jj = 1, jpj 210 128 DO ji = 1, jpi … … 218 136 END DO 219 137 END DO 220 !$OMP END PARALLEL221 138 tm_i = tm_i + rt0 222 139 tm_su = tm_su + rt0 223 140 ! 224 141 ENDIF 225 CALL wrk_dealloc( jpi, jpj, nlay_s, ze_s )226 CALL wrk_dealloc( jpi, jpj, nlay_i, ze_i )227 142 ! 228 143 END SUBROUTINE lim_var_agg … … 244 159 ! Ice thickness, snow thickness, ice salinity, ice age 245 160 !------------------------------------------------------- 246 !$OMP PARALLEL 247 DO jl = 1, jpl 248 !$OMP DO schedule(static) private(jj,ji,rswitch) 161 DO jl = 1, jpl 249 162 DO jj = 1, jpj 250 163 DO ji = 1, jpi … … 255 168 END DO 256 169 ! Force the upper limit of ht_i to always be < hi_max (99 m). 257 !$OMP DO schedule(static) private(jj,ji,rswitch)258 170 DO jj = 1, jpj 259 171 DO ji = 1, jpi … … 265 177 266 178 DO jl = 1, jpl 267 !$OMP DO schedule(static) private(jj,ji,rswitch)268 179 DO jj = 1, jpj 269 180 DO ji = 1, jpi … … 277 188 IF( nn_icesal == 2 )THEN 278 189 DO jl = 1, jpl 279 !$OMP DO schedule(static) private(jj,ji,rswitch)280 190 DO jj = 1, jpj 281 191 DO ji = 1, jpi … … 288 198 END DO 289 199 ENDIF 290 !$OMP END PARALLEL291 200 292 201 CALL lim_var_salprof ! salinity profile … … 295 204 ! Ice temperatures 296 205 !------------------- 297 !$OMP PARALLEL298 206 DO jl = 1, jpl 299 207 DO jk = 1, nlay_i 300 !$OMP DO schedule(static) private(jj,ji,rswitch,zq_i,ztmelts,zaaa,zbbb,zccc,zdiscrim)301 208 DO jj = 1, jpj 302 209 DO ji = 1, jpi … … 324 231 DO jl = 1, jpl 325 232 DO jk = 1, nlay_s 326 !$OMP DO schedule(static) private(jj,ji,rswitch,zq_s)327 233 DO jj = 1, jpj 328 234 DO ji = 1, jpi … … 339 245 340 246 ! integrated values 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 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 360 251 ! 361 252 END SUBROUTINE lim_var_glo2eqv … … 409 300 !--------------------------------------- 410 301 IF( nn_icesal == 1 ) THEN 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 302 s_i (:,:,:,:) = rn_icesal 303 sm_i(:,:,:) = rn_icesal 431 304 ENDIF 432 305 … … 436 309 IF( nn_icesal == 2 ) THEN 437 310 ! 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 311 DO jk = 1, nlay_i 312 s_i(:,:,jk,:) = sm_i(:,:,:) 449 313 END DO 450 314 ! 451 315 DO jl = 1, jpl ! Slope of the linear profile 452 !$OMP DO schedule(static) private(jj,ji,rswitch)453 316 DO jj = 1, jpj 454 317 DO ji = 1, jpi … … 457 320 END DO 458 321 END DO 459 !$OMP END DO NOWAIT460 322 END DO 461 323 ! … … 463 325 zfac1 = zsi1 / ( zsi1 - zsi0 ) 464 326 ! 327 zalpha(:,:,:) = 0._wp 465 328 DO jl = 1, jpl 466 !$OMP DO schedule(static) private(jj, ji)467 DO jj = 1, jpj468 DO ji = 1, jpi469 zalpha(ji,jj,jl) = 0._wp470 END DO471 END DO472 END DO473 DO jl = 1, jpl474 !$OMP DO schedule(static) private(jj,ji,zswi0,zswi01,rswitch)475 329 DO jj = 1, jpj 476 330 DO ji = 1, jpi … … 491 345 DO jl = 1, jpl 492 346 DO jk = 1, nlay_i 493 !$OMP DO schedule(static) private(jj,ji,zs_zero)494 347 DO jj = 1, jpj 495 348 DO ji = 1, jpi … … 504 357 END DO 505 358 END DO 506 !$OMP END PARALLEL507 359 ! 508 360 ENDIF ! nn_icesal … … 514 366 IF( nn_icesal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 515 367 ! 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 368 sm_i(:,:,:) = 2.30_wp 526 369 ! 527 370 DO jl = 1, jpl … … 529 372 zargtemp = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 530 373 zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) ) 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 374 s_i(:,:,jk,jl) = zsal 375 END DO 376 END DO 540 377 ! 541 378 ENDIF ! nn_icesal … … 559 396 !!------------------------------------------------------------------ 560 397 ! 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 398 bvm_i(:,:) = 0._wp 399 bv_i (:,:,:) = 0._wp 576 400 DO jl = 1, jpl 577 401 DO jk = 1, nlay_i 578 !$OMP DO schedule(static) private(jj,ji,rswitch)579 402 DO jj = 1, jpj 580 403 DO ji = 1, jpi … … 586 409 END DO 587 410 588 !$OMP DO schedule(static) private(jj,ji,rswitch)589 411 DO jj = 1, jpj 590 412 DO ji = 1, jpi … … 594 416 END DO 595 417 END DO 596 !$OMP END PARALLEL597 418 ! 598 419 END SUBROUTINE lim_var_bv … … 697 518 REAL(wp) :: zsal, zvi, zvs, zei, zes 698 519 !!------------------------------------------------------------------- 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 520 at_i (:,:) = 0._wp 521 DO jl = 1, jpl 522 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 713 523 END DO 714 524 … … 719 529 !----------------------------------------------------------------- 720 530 DO jk = 1, nlay_i 721 !$OMP DO schedule(static) private(jj,ji,rswitch,zei)722 531 DO jj = 1 , jpj 723 532 DO ji = 1 , jpi … … 736 545 END DO 737 546 738 !$OMP DO schedule(static) private(jj,ji,rswitch,zsal,zvi,zvs,zes)739 547 DO jj = 1 , jpj 740 548 DO ji = 1 , jpi … … 775 583 776 584 ! to be sure that at_i is the sum of 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 585 at_i (:,:) = 0._wp 586 DO jl = 1, jpl 587 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 790 588 END DO 791 589 792 590 ! open water = 1 if at_i=0 793 !$OMP DO schedule(static) private(jj,ji,rswitch)794 591 DO jj = 1, jpj 795 592 DO ji = 1, jpi … … 798 595 END DO 799 596 END DO 800 !$OMP END PARALLEL801 597 802 598 ! -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r7698 r7753 74 74 75 75 ! tresholds for outputs 76 !$OMP PARALLEL77 !$OMP DO schedule(static) private(jj,ji)78 76 DO jj = 1, jpj 79 77 DO ji = 1, jpi … … 82 80 END DO 83 81 DO jl = 1, jpl 84 !$OMP DO schedule(static) private(jj,ji)85 82 DO jj = 1, jpj 86 83 DO ji = 1, jpi … … 89 86 END DO 90 87 END DO 91 !$OMP END PARALLEL92 88 ! 93 89 ! fluxes … … 108 104 ! velocity 109 105 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)111 106 DO jj = 2 , jpjm1 112 107 DO ji = 2 , jpim1 … … 178 173 179 174 IF ( iom_use( "vfxthin" ) ) THEN ! ice production for open water + thin ice (<20cm) => comparable to observations 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 175 WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog 176 ELSEWHERE ; z2d = 0._wp 177 END WHERE 190 178 CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp ) 191 179 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r7698 r7753 156 156 USE lib_mpp, ONLY: ctl_warn, mpp_sum 157 157 ! 158 INTEGER :: ji, jj ! dummy loop indices159 158 INTEGER :: bdy_oce_alloc 160 159 !!---------------------------------------------------------------------- … … 164 163 ! 165 164 ! Initialize masks 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 165 bdytmask(:,:) = 1._wp 166 bdyumask(:,:) = 1._wp 167 bdyvmask(:,:) = 1._wp 174 168 ! 175 169 IF( lk_mpp ) CALL mpp_sum ( bdy_oce_alloc ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r7698 r7753 62 62 INTEGER :: ios ! Local integer output status for namelist read 63 63 INTEGER :: ierror ! Local integer for memory allocation 64 INTEGER :: ji, jj, jk65 64 ! 66 65 NAMELIST/nam_dia25h/ ln_dia25h … … 135 134 ! ------------------------- ! 136 135 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) 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) 149 # if defined key_zdfgls || defined key_zdftke 150 en_25h(ji,jj,jk) = en(ji,jj,jk) 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(:,:,:) 144 # if defined key_zdfgls || defined key_zdftke 145 en_25h(:,:,:) = en(:,:,:) 151 146 #endif 152 147 # if defined key_zdfgls 153 rmxln_25h(ji,jj,jk) = mxln(ji,jj,jk) 154 #endif 155 END DO 156 END DO 157 END DO 148 rmxln_25h(:,:,:) = mxln(:,:,:) 149 #endif 158 150 #if defined key_lim3 || defined key_lim2 159 151 CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') … … 231 223 ENDIF 232 224 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) 252 # if defined key_zdfgls || defined key_zdftke 253 en_25h(ji,jj,jk) = en_25h(ji,jj,jk) + en(ji,jj,jk) 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 # if defined key_zdfgls || defined key_zdftke 234 en_25h(:,:,:) = en_25h(:,:,:) + en(:,:,:) 254 235 #endif 255 236 # if defined key_zdfgls 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 237 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) + mxln(:,:,:) 238 #endif 262 239 cnt_25h = cnt_25h + 1 263 240 … … 276 253 ENDIF 277 254 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 297 # if defined key_zdfgls || defined key_zdftke 298 en_25h(ji,jj,jk) = en_25h(ji,jj,jk) / 25.0_wp 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 263 # if defined key_zdfgls || defined key_zdftke 264 en_25h(:,:,:) = en_25h(:,:,:) / 25.0_wp 299 265 #endif 300 266 # if defined key_zdfgls 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 267 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) / 25.0_wp 268 #endif 307 269 308 270 IF (lwp) WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output' 309 271 zmdi=1.e+20 !missing data indicator for masking 310 272 ! write tracers (instantaneous) 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 273 zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 319 274 CALL iom_put("temper25h", zw3d) ! potential temperature 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 275 zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 328 276 CALL iom_put( "salin25h", zw3d ) ! salinity 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 277 zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 335 278 CALL iom_put( "ssh25h", zw2d ) ! sea surface 336 279 337 280 338 281 ! Write velocities (instantaneous) 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 282 zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:)) 347 283 CALL iom_put("vozocrtx25h", zw3d) ! i-current 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 284 zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:)) 356 285 CALL iom_put("vomecrty25h", zw3d ) ! j-current 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 286 287 zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 365 288 CALL iom_put("vomecrtz25h", zw3d ) ! k-current 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 289 zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 374 290 CALL iom_put("avt25h", zw3d ) ! diffusivity 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 291 zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 383 292 CALL iom_put("avm25h", zw3d) ! viscosity 384 293 #if defined key_zdftke || defined key_zdfgls 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 294 zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 393 295 CALL iom_put("tke25h", zw3d) ! tke 394 296 #endif 395 297 #if defined key_zdfgls 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 298 zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 404 299 CALL iom_put( "mxln25h",zw3d) 405 300 #endif 406 301 407 302 ! After the write reset the values to cnt=1 and sum values equal current value 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) 427 # if defined key_zdfgls || defined key_zdftke 428 en_25h(ji,jj,jk) = en(ji,jj,jk) 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(:,:,:) 311 # if defined key_zdfgls || defined key_zdftke 312 en_25h(:,:,:) = en(:,:,:) 429 313 #endif 430 314 # if defined key_zdfgls 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 315 rmxln_25h(:,:,:) = mxln(:,:,:) 316 #endif 437 317 cnt_25h = 1 438 318 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
r7698 r7753 89 89 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 90 90 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 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 91 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 97 92 ENDIF 98 93 ! … … 111 106 IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN 112 107 ! 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 108 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 109 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 122 110 CALL eos( ztsn, zrhd, gdept_n(:,:,:) ) ! now in situ density using initial salinity 123 111 ! 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 112 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 131 113 DO jk = 1, jpkm1 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 114 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 115 END DO 140 116 IF( ln_linssh ) THEN 141 117 IF( ln_isfcav ) THEN 142 !$OMP PARALLEL DO schedule(static) private(jj, ji)143 118 DO ji = 1, jpi 144 119 DO jj = 1, jpj … … 147 122 END DO 148 123 ELSE 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 124 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 155 125 END IF 156 126 !!gm … … 158 128 !!gm 159 129 END IF 160 !161 zarho = SUM( area(:,:) * zbotpres(:,:) )162 130 ! 131 zarho = SUM( area(:,:) * zbotpres(:,:) ) 163 132 IF( lk_mpp ) CALL mpp_sum( zarho ) 164 133 zssh_steric = - zarho / area_tot … … 167 136 ! ! steric sea surface height 168 137 CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) ) ! now in situ and potential density 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 138 zrhop(:,:,jpk) = 0._wp 175 139 CALL iom_put( 'rhop', zrhop ) 176 140 ! 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 141 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 184 142 DO jk = 1, jpkm1 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 143 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 191 144 END DO 192 145 IF( ln_linssh ) THEN 193 146 IF ( ln_isfcav ) THEN 194 !$OMP DO schedule(static) private(jj, ji)195 147 DO ji = 1,jpi 196 148 DO jj = 1,jpj … … 199 151 END DO 200 152 ELSE 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 153 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 207 154 END IF 208 155 END IF 209 !$OMP END PARALLEL210 156 ! 211 zarho = SUM( area(:,:) * zbotpres(:,:) ) 157 zarho = SUM( area(:,:) * zbotpres(:,:) ) 212 158 IF( lk_mpp ) CALL mpp_sum( zarho ) 213 159 zssh_steric = - zarho / area_tot … … 216 162 ! ! ocean bottom pressure 217 163 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 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 164 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 224 165 CALL iom_put( 'botpres', zbotpres ) 225 166 ! … … 272 213 ! work is not being done against stratification 273 214 CALL wrk_alloc( jpi, jpj, zpe ) 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 215 zpe(:,:) = 0._wp 280 216 IF( lk_zdfddm ) THEN 281 !$OMP PARALLEL DO schedule(static) private(ji,jj,jk,zrw,zaw,zbw)282 217 DO ji=1,jpi 283 218 DO jj=1,jpj … … 297 232 ENDDO 298 233 ELSE 299 !$OMP PARALLEL DO schedule(static) private(ji,jj,jk)300 234 DO ji = 1, jpi 301 235 DO jj = 1, jpj … … 389 323 INTEGER :: ik 390 324 INTEGER :: ji, jj, jk ! dummy loop indices 391 REAL(wp) :: zztmp , zsum325 REAL(wp) :: zztmp 392 326 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 393 327 ! … … 407 341 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 408 342 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 343 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 415 344 416 345 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot ) 417 346 418 347 vol0 = 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 348 thick0(:,:) = 0._wp 426 349 DO jk = 1, jpkm1 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 350 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 351 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 352 END DO 442 353 IF( lk_mpp ) CALL mpp_sum( vol0 ) 443 354 … … 447 358 CALL iom_close( inum ) 448 359 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 360 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 361 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 459 362 IF( ln_zps ) THEN ! z-coord. partial steps 460 !$OMP DO schedule(static) private(jj, ji, ik, zztmp)461 363 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 462 364 DO ji = 1, jpi … … 469 371 END DO 470 372 ENDIF 471 !$OMP END PARALLEL472 373 ! 473 374 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90
r7698 r7753 71 71 72 72 ! calculate Courant numbers 73 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)74 73 DO jk = 1, jpk 75 74 DO jj = 1, jpj … … 173 172 !!---------------------------------------------------------------------- 174 173 175 INTEGER :: ji, jj, jk ! dummy loop indices176 174 177 175 IF( nn_diacfl == 1 ) THEN … … 183 181 184 182 ALLOCATE( zcu_cfl(jpi, jpj, jpk), zcv_cfl(jpi, jpj, jpk), zcw_cfl(jpi, jpj, jpk) ) 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 183 184 zcu_cfl(:,:,:)=0.0 185 zcv_cfl(:,:,:)=0.0 186 zcw_cfl(:,:,:)=0.0 187 195 188 IF( lwp ) THEN 196 189 WRITE(numout,*) -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r7698 r7753 88 88 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 ) 89 89 ! 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 90 tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ; 91 tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ; 99 92 ! ------------------------- ! 100 93 ! 1 - Trends due to forcing ! … … 115 108 IF( ln_linssh ) THEN 116 109 IF( ln_isfcav ) THEN 117 !$OMP PARALLEL DO schedule(static) private(jj,ji)118 110 DO ji=1,jpi 119 111 DO jj=1,jpj … … 123 115 END DO 124 116 ELSE 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 117 z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) 118 z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) 132 119 END IF 133 120 z_wn_trd_t = - glob_sum( z2d0 ) … … 158 145 IF( ln_linssh ) THEN 159 146 IF( ln_isfcav ) THEN 160 !$OMP PARALLEL DO schedule(static) private(jj,ji)161 147 DO ji = 1, jpi 162 148 DO jj = 1, jpj … … 166 152 END DO 167 153 ELSE 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 154 z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) 155 z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 175 156 END IF 176 157 z_ssh_hc = glob_sum_full( z2d0 ) … … 294 275 IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 295 276 IF(lwp) WRITE(numout,*) '~~~~~~~' 296 !$OMP PARALLEL 297 !$OMP DO schedule(static) private(jj,ji) 298 DO j j = 1, jpj299 DO ji = 1, jpi300 surf_ini(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj) ! initial ocean surface301 ssh_ini(ji,jj) = sshn(ji,jj) ! initial ssh302 END DO277 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 278 ssh_ini(:,:) = sshn(:,:) ! initial ssh 279 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 303 284 END DO 304 !$OMP DO schedule(static) private(jk,jj,ji)305 DO jk = 1, jpk306 DO jj = 1, jpj307 DO ji = 1, jpi308 ! 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 factors310 hc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) ! initial heat content311 sc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) ! initial salt content312 END DO313 END DO314 END DO315 !$OMP END PARALLEL316 285 frc_v = 0._wp ! volume trend due to forcing 317 286 frc_t = 0._wp ! heat content - - - - … … 319 288 IF( ln_linssh ) THEN 320 289 IF ( ln_isfcav ) THEN 321 !$OMP PARALLEL DO schedule(static) private(jj,ji)322 290 DO ji=1,jpi 323 291 DO jj=1,jpj … … 327 295 ENDDO 328 296 ELSE 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 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 336 299 END IF 337 300 frc_wn_t = 0._wp ! initial heat content misfit due to free surface … … 382 345 INTEGER :: ierror ! local integer 383 346 INTEGER :: ios 384 INTEGER :: ji, jj, jk ! dummy loop indices385 347 !! 386 348 NAMELIST/namhsb/ ln_diahsb … … 422 384 ! 2 - Time independant variables and file opening ! 423 385 ! ----------------------------------------------- ! 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 386 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 430 387 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 431 388 -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r7698 r7753 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 , jj, ji! local integers386 INTEGER :: jn ! 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 !$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 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 445 440 ENDIF 446 441 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 442 btmsk(:,:,1) = tmask_i(:,:) ! global ocean 454 443 455 444 DO jn = 1, nptr 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 445 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 462 446 END DO 463 447 464 448 ! Initialise arrays to zero because diatpr is called before they are first calculated 465 449 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 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 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 ! 478 456 ENDIF 479 457 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r7698 r7753 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)164 163 DO jj = 1, jpj 165 164 DO ji = 1, jpi … … 174 173 CALL iom_put( "sss", tsn(:,:,1,jp_sal) ) ! surface salinity 175 174 IF ( iom_use("sbs") ) THEN 176 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot)177 175 DO jj = 1, jpj 178 176 DO ji = 1, jpi … … 185 183 186 184 IF ( iom_use("taubot") ) THEN ! bottom stress 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) 185 z2d(:,:) = 0._wp 195 186 DO jj = 2, jpjm1 196 187 DO ji = fs_2, fs_jpim1 ! vector opt. … … 203 194 ENDDO 204 195 ENDDO 205 !$OMP END PARALLEL206 196 CALL lbc_lnk( z2d, 'T', 1. ) 207 197 CALL iom_put( "taubot", z2d ) … … 211 201 CALL iom_put( "ssu", un(:,:,1) ) ! surface i-current 212 202 IF ( iom_use("sbu") ) THEN 213 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot)214 203 DO jj = 1, jpj 215 204 DO ji = 1, jpi … … 224 213 CALL iom_put( "ssv", vn(:,:,1) ) ! surface j-current 225 214 IF ( iom_use("sbv") ) THEN 226 !$OMP PARALLEL DO schedule(static) private(jj, ji,jkbot)227 215 DO jj = 1, jpj 228 216 DO ji = 1, jpi … … 237 225 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 238 226 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 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) 227 z2d(:,:) = rau0 * e1e2t(:,:) 247 228 DO jk = 1, jpk 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 229 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 230 END DO 255 231 CALL iom_put( "w_masstr" , z3d ) 256 232 IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) … … 265 241 266 242 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 267 !$OMP PARALLEL DO schedule(static) private(jj, ji, zztmp, zztmpx, zztmpy)268 243 DO jj = 2, jpjm1 ! sst gradient 269 244 DO ji = fs_2, fs_jpim1 ! vector opt. … … 277 252 CALL lbc_lnk( z2d, 'T', 1. ) 278 253 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 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 254 z2d(:,:) = SQRT( z2d(:,:) ) 285 255 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 286 256 ENDIF … … 288 258 ! clem: heat and salt content 289 259 IF( iom_use("heatc") ) THEN 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 260 z2d(:,:) = 0._wp 297 261 DO jk = 1, jpkm1 298 !$OMP DO schedule(static) private(jj, ji)299 262 DO jj = 1, jpj 300 263 DO ji = 1, jpi … … 303 266 END DO 304 267 END DO 305 !$OMP END PARALLEL306 268 CALL iom_put( "heatc", (rau0 * rcp) * z2d ) ! vertically integrated heat content (J/m2) 307 269 ENDIF 308 270 309 271 IF( iom_use("saltc") ) THEN 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 272 z2d(:,:) = 0._wp 317 273 DO jk = 1, jpkm1 318 !$OMP DO schedule(static) private(jj, ji)319 274 DO jj = 1, jpj 320 275 DO ji = 1, jpi … … 323 278 END DO 324 279 END DO 325 !$OMP END PARALLEL326 280 CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 327 281 ENDIF 328 282 ! 329 283 IF ( iom_use("eken") ) THEN 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) 284 rke(:,:,jk) = 0._wp ! kinetic energy 338 285 DO jk = 1, jpkm1 339 286 DO jj = 2, jpjm1 … … 353 300 ENDDO 354 301 ENDDO 355 !$OMP END PARALLEL356 302 CALL lbc_lnk( rke, 'T', 1. ) 357 303 CALL iom_put( "eken", rke ) … … 361 307 ! 362 308 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 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 309 z3d(:,:,jpk) = 0.e0 310 z2d(:,:) = 0.e0 371 311 DO jk = 1, jpkm1 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 312 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 313 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 314 END DO 381 315 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 382 316 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum … … 384 318 385 319 IF( iom_use("u_heattr") ) THEN 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 320 z2d(:,:) = 0.e0 393 321 DO jk = 1, jpkm1 394 !$OMP DO schedule(static) private(jj, ji)395 322 DO jj = 2, jpjm1 396 323 DO ji = fs_2, fs_jpim1 ! vector opt. … … 399 326 END DO 400 327 END DO 401 !$OMP END PARALLEL402 328 CALL lbc_lnk( z2d, 'U', -1. ) 403 329 CALL iom_put( "u_heattr", (0.5 * rcp) * z2d ) ! heat transport in i-direction … … 405 331 406 332 IF( iom_use("u_salttr") ) THEN 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 333 z2d(:,:) = 0.e0 414 334 DO jk = 1, jpkm1 415 !$OMP DO schedule(static) private(jj, ji)416 335 DO jj = 2, jpjm1 417 336 DO ji = fs_2, fs_jpim1 ! vector opt. … … 420 339 END DO 421 340 END DO 422 !$OMP END PARALLEL423 341 CALL lbc_lnk( z2d, 'U', -1. ) 424 342 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction … … 427 345 428 346 IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 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) 347 z3d(:,:,jpk) = 0.e0 437 348 DO jk = 1, jpkm1 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 349 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 350 END DO 445 351 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 446 352 ENDIF 447 353 448 354 IF( iom_use("v_heattr") ) THEN 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 355 z2d(:,:) = 0.e0 456 356 DO jk = 1, jpkm1 457 !$OMP DO schedule(static) private(jj, ji)458 357 DO jj = 2, jpjm1 459 358 DO ji = fs_2, fs_jpim1 ! vector opt. … … 462 361 END DO 463 362 END DO 464 !$OMP END PARALLEL465 363 CALL lbc_lnk( z2d, 'V', -1. ) 466 364 CALL iom_put( "v_heattr", (0.5 * rcp) * z2d ) ! heat transport in j-direction … … 468 366 469 367 IF( iom_use("v_salttr") ) THEN 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 368 z2d(:,:) = 0.e0 477 369 DO jk = 1, jpkm1 478 !$OMP DO schedule(static) private(jj, ji)479 370 DO jj = 2, jpjm1 480 371 DO ji = fs_2, fs_jpim1 ! vector opt. … … 483 374 END DO 484 375 END DO 485 !$OMP END PARALLEL486 376 CALL lbc_lnk( z2d, 'V', -1. ) 487 377 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction … … 490 380 ! Vertical integral of temperature 491 381 IF( iom_use("tosmint") ) THEN 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 382 z2d(:,:)=0._wp 499 383 DO jk = 1, jpkm1 500 !$OMP DO schedule(static) private(jj, ji)501 384 DO jj = 2, jpjm1 502 385 DO ji = fs_2, fs_jpim1 ! vector opt. … … 505 388 END DO 506 389 END DO 507 !$OMP END PARALLEL508 390 CALL lbc_lnk( z2d, 'T', -1. ) 509 391 CALL iom_put( "tosmint", z2d ) … … 512 394 ! Vertical integral of salinity 513 395 IF( iom_use("somint") ) THEN 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 396 z2d(:,:)=0._wp 521 397 DO jk = 1, jpkm1 522 !$OMP DO schedule(static) private(jj, ji)523 398 DO jj = 2, jpjm1 524 399 DO ji = fs_2, fs_jpim1 ! vector opt. … … 527 402 END DO 528 403 END DO 529 !$OMP END PARALLEL530 404 CALL lbc_lnk( z2d, 'T', -1. ) 531 405 CALL iom_put( "somint", z2d ) … … 918 792 ENDIF 919 793 IF( .NOT.ln_linssh ) THEN 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 794 zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 928 795 CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T ) ! level thickness 929 796 CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T ) ! t-point depth … … 937 804 ! in linear free surface case) 938 805 IF( ln_linssh ) THEN 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 806 zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 945 807 CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sst 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 808 zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 952 809 CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sss 953 810 ENDIF … … 985 842 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 986 843 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 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 844 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 995 845 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 996 846 ENDIF … … 998 848 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 999 849 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 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 850 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 1008 851 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 1009 852 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/depth_e3.F90
r7698 r7753 150 150 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdept_3d, pdepw_3d ! depth = SUM( e3 ) [m] 151 151 ! 152 INTEGER :: jk , jj, ji! dummy loop indices152 INTEGER :: jk ! dummy loop indices 153 153 !!---------------------------------------------------------------------- 154 154 ! 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 155 pdepw_3d(:,:,1) = 0.0_wp 156 pdept_3d(:,:,1) = 0.5_wp * pe3w_3d(:,:,1) 157 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 ) 162 160 END DO 163 DO jk = 2, jpk164 !$OMP DO schedule(static) private(jj,ji)165 DO jj = 1, jpj166 DO ji = 1, jpi167 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 DO170 END DO171 END DO172 !$OMP END PARALLEL173 161 ! 174 162 END SUBROUTINE e3_to_depth_3d -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r7698 r7753 133 133 CALL dom_msk( ik_top, ik_bot ) ! Masks 134 134 ! 135 !$OMP PARALLEL136 !$OMP DO schedule(static) private(jj,ji,ik)137 135 DO jj = 1, jpj ! depth of the iceshelves 138 136 DO ji = 1, jpi … … 142 140 END DO 143 141 ! 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 142 ht_0(:,:) = 0._wp ! Reference ocean thickness 143 hu_0(:,:) = 0._wp 144 hv_0(:,:) = 0._wp 145 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) 152 149 END DO 153 DO jk = 1, jpk154 !$OMP DO schedule(static) private(jj,ji,ik)155 DO jj = 1, jpj156 DO ji = 1, jpi157 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 DO161 END DO162 END DO163 !$OMP END PARALLEL164 150 ! 165 151 ! !== time varying part of coordinate system ==! … … 180 166 e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- ! 181 167 ! 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 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(:,:) ) 189 170 ! 190 171 ! before ! now ! after ! -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r7698 r7753 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 !$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 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 126 121 ELSE 127 122 IF( ln_read_cfg ) THEN … … 135 130 ! !== associated horizontal metrics ==! 136 131 ! 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 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(:,:) 149 139 IF( ie1e2u_v == 0 ) THEN ! u- & v-surfaces have not been defined 150 140 IF(lwp) WRITE(numout,*) ' u- & v-surfaces calculated as e1 e2 product' 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 141 e1e2u (:,:) = e1u(:,:) * e2u(:,:) ! compute them 142 e1e2v (:,:) = e1v(:,:) * e2v(:,:) 158 143 ELSE 159 144 IF(lwp) WRITE(numout,*) ' u- & v-surfaces have been read in "mesh_mask" file:' 160 145 IF(lwp) WRITE(numout,*) ' grid size reduction in strait(s) is used' 161 146 ENDIF 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 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(:,:) 172 152 ! 173 153 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r7698 r7753 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 !$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) 139 tmask(:,:,:) = 0._wp 149 140 DO jj = 1, jpj 150 141 DO ji = 1, jpi … … 156 147 END DO 157 148 END DO 158 !$OMP END PARALLEL159 149 !SF add here lbc_lnk: bug not still understood : cause now domain configuration is read ! 160 150 !!gm I don't understand why... … … 171 161 ! ------------------------ 172 162 IF ( ln_bdy .AND. ln_mask_file ) THEN 173 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)174 163 DO jk = 1, jpkm1 175 164 DO jj = 1, jpj … … 184 173 ! ---------------------------------------- 185 174 ! NB: at this point, fmask is designed for free slip lateral boundary condition 186 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)187 175 DO jk = 1, jpk 188 176 DO jj = 1, jpjm1 … … 204 192 ! Ocean/land mask at wu-, wv- and w points (computed from tmask) 205 193 !----------------------------------------- 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 194 wmask (:,:,1) = tmask(:,:,1) ! surface 195 wumask(:,:,1) = umask(:,:,1) 196 wvmask(:,:,1) = vmask(:,:,1) 197 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) 214 201 END DO 215 !$OMP DO schedule(static) private(jk,jj,ji)216 DO jk = 2, jpk ! interior values217 DO jj = 1, jpj218 DO ji = 1, jpi219 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 DO223 END DO224 END DO225 !$OMP END PARALLEL226 202 227 203 … … 240 216 ! 241 217 ! ! halo mask : 0 on the halo and 1 elsewhere 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 218 tmask_h(:,:) = 1._wp 248 219 tmask_h( 1 :iif, : ) = 0._wp ! first columns 249 220 tmask_h(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns) … … 270 241 ! 271 242 ! ! interior mask : 2D ocean mask x halo mask 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 243 tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 278 244 279 245 … … 284 250 CALL wrk_alloc( jpi,jpj, zwf ) 285 251 ! 286 !$OMP PARALLEL287 252 DO jk = 1, jpk 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) 253 zwf(:,:) = fmask(:,:,jk) 295 254 DO jj = 2, jpjm1 296 255 DO ji = fs_2, fs_jpim1 ! vector opt. … … 301 260 END DO 302 261 END DO 303 !$OMP DO schedule(static) private(jj)304 262 DO jj = 2, jpjm1 305 263 IF( fmask(1,jj,jk) == 0._wp ) THEN … … 310 268 ENDIF 311 269 END DO 312 !$OMP DO schedule(static) private(ji)313 270 DO ji = 2, jpim1 314 271 IF( fmask(ji,1,jk) == 0._wp ) THEN … … 320 277 END DO 321 278 END DO 322 !$OMP END PARALLEL323 279 ! 324 280 CALL wrk_dealloc( jpi,jpj, zwf ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r7698 r7753 135 135 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 136 136 CALL dom_vvl_rst( nit000, 'READ' ) 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 137 e3t_a(:,:,jpk) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all 143 138 ! 144 139 ! !== Set of all other vertical scale factors ==! (now and before) … … 158 153 ! 159 154 ! !== depth of t and w-point ==! (set the isf depth as it is in the initial timestep) 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 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 171 160 DO jk = 2, jpk ! vertical sum 172 !$OMP DO schedule(static) private(jj,ji,zcoef)173 161 DO jj = 1,jpj 174 162 DO ji = 1,jpi … … 190 178 ! 191 179 ! !== thickness of the water column !! (ocean portion only) 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 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) 185 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) 201 191 END DO 202 DO jk = 2, jpkm1203 !$OMP DO schedule(static) private(jj,ji)204 DO jj = 1, jpj205 DO ji = 1, jpi206 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 DO212 END DO213 END DO214 192 ! 215 193 ! !== inverse of water column thickness ==! (u- and v- points) 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 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 226 199 ! !== z_tilde coordinate case ==! (Restoring frequencies) 227 200 IF( ln_vvl_ztilde ) THEN … … 229 202 ! ! Values in days provided via the namelist 230 203 ! ! use rsmall to avoid possible division by zero errors with faulty settings 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 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 ) 238 206 ! 239 207 IF( ln_vvl_ztilde_as_zstar ) THEN ! z-star emulation using z-tile 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 208 frq_rst_e3t(:,:) = 0._wp !Ignore namelist settings 209 frq_rst_hdv(:,:) = 1._wp / rdt 247 210 ENDIF 248 211 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 249 !$OMP PARALLEL DO schedule(static) private(jj,ji)250 212 DO jj = 1, jpj 251 213 DO ji = 1, jpi … … 343 305 ! ! --------------------------------------------- ! 344 306 ! 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 307 z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 308 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) 351 311 END DO 352 !$OMP DO schedule(static) private(jk,jj,ji)353 DO jk = 1, jpkm1354 DO jj = 1, jpj355 DO ji = 1, jpi356 ! 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 DO359 END DO360 END DO361 !$OMP END PARALLEL362 312 ! 363 313 IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate ! … … 368 318 ! 1 - barotropic divergence 369 319 ! ------------------------- 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 320 zhdiv(:,:) = 0._wp 321 zht(:,:) = 0._wp 378 322 DO jk = 1, jpkm1 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 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(:,:) ) 394 327 395 328 ! 2 - Low frequency baroclinic horizontal divergence (z-tilde case only) … … 397 330 IF( ln_vvl_ztilde ) THEN 398 331 IF( kt > nit000 ) THEN 399 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)400 332 DO jk = 1, jpkm1 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 333 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:) & 334 & * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) ) 407 335 END DO 408 336 ENDIF … … 411 339 ! II - after z_tilde increments of vertical scale factors 412 340 ! ======================================================= 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 341 tilde_e3t_a(:,:,:) = 0._wp ! tilde_e3t_a used to store tendency terms 421 342 422 343 ! 1 - High frequency divergence term 423 344 ! ---------------------------------- 424 345 IF( ln_vvl_ztilde ) THEN ! z_tilde case 425 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)426 346 DO jk = 1, jpkm1 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 347 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 432 348 END DO 433 349 ELSE ! layer case 434 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)435 350 DO jk = 1, jpkm1 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 351 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 441 352 END DO 442 353 ENDIF … … 445 356 ! ------------------ 446 357 IF( ln_vvl_ztilde ) THEN 447 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)448 358 DO jk = 1, jpk 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 359 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk) 454 360 END DO 455 361 ENDIF … … 457 363 ! 3 - Thickness diffusion term 458 364 ! ---------------------------- 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 365 zwu(:,:) = 0._wp 366 zwv(:,:) = 0._wp 467 367 DO jk = 1, jpkm1 ! a - first derivative: diffusive fluxes 468 !$OMP DO schedule(static) private(jj,ji)469 368 DO jj = 1, jpjm1 470 369 DO ji = 1, fs_jpim1 ! vector opt. … … 478 377 END DO 479 378 END DO 480 !$OMP DO schedule(static) private(jj,ji)481 379 DO jj = 1, jpj ! b - correction for last oceanic u-v points 482 380 DO ji = 1, jpi … … 485 383 END DO 486 384 END DO 487 !$OMP DO schedule(static) private(jk,jj,ji)488 385 DO jk = 1, jpkm1 ! c - second derivative: divergence of diffusive fluxes 489 386 DO jj = 2, jpjm1 … … 495 392 END DO 496 393 END DO 497 !$OMP END PARALLEL498 394 ! ! d - thickness diffusion transport: boundary conditions 499 395 ! (stored for tracer advction and continuity equation) … … 511 407 ENDIF 512 408 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp ) 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 409 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 522 410 523 411 ! Maximum deformation control 524 412 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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) 413 ze3t(:,:,jpk) = 0._wp 532 414 DO jk = 1, jpkm1 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 415 ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 416 END DO 540 417 z_tmax = MAXVAL( ze3t(:,:,:) ) 541 418 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain … … 565 442 ! - ML - end test 566 443 ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 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 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(:,:,:) ) 577 446 578 447 ! 579 448 ! "tilda" change in the after scale factor 580 449 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 581 !$OMP DO schedule(static) private(jk,jj,ji)582 450 DO jk = 1, jpkm1 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 451 dtilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - tilde_e3t_b(:,:,jk) 588 452 END DO 589 453 ! III - Barotropic repartition of the sea surface height over the baroclinic profile … … 593 457 ! i.e. locally and not spread over the water column. 594 458 ! (keep in mind that the idea is to reduce Eulerian velocity as much as possible) 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 459 zht(:,:) = 0. 601 460 DO jk = 1, jpkm1 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) 461 zht(:,:) = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk) 462 END DO 463 z_scale(:,:) = - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 616 464 DO jk = 1, jpkm1 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 465 dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 466 END DO 467 624 468 ENDIF 625 469 626 470 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde or layer coordinate ! 627 471 ! ! ---baroclinic part--------- ! 628 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)629 472 DO jk = 1, jpkm1 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 473 e3t_a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 635 474 END DO 636 475 ENDIF … … 645 484 END IF 646 485 ! 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 486 zht(:,:) = 0.0_wp 654 487 DO jk = 1, jpkm1 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 488 zht(:,:) = zht(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 489 END DO 663 490 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 664 491 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 665 492 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 666 493 ! 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 494 zht(:,:) = 0.0_wp 674 495 DO jk = 1, jpkm1 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 496 zht(:,:) = zht(:,:) + e3t_a(:,:,jk) * tmask(:,:,jk) 497 END DO 683 498 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 684 499 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 685 500 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 686 501 ! 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 502 zht(:,:) = 0.0_wp 694 503 DO jk = 1, jpkm1 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 504 zht(:,:) = zht(:,:) + e3t_b(:,:,jk) * tmask(:,:,jk) 505 END DO 703 506 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 704 507 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain … … 729 532 ! *********************************** ! 730 533 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 534 hu_a(:,:) = e3u_a(:,:,1) * umask(:,:,1) 535 hv_a(:,:) = e3v_a(:,:,1) * vmask(:,:,1) 739 536 DO jk = 2, jpkm1 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 537 hu_a(:,:) = hu_a(:,:) + e3u_a(:,:,jk) * umask(:,:,jk) 538 hv_a(:,:) = hv_a(:,:) + e3v_a(:,:,jk) * vmask(:,:,jk) 747 539 END DO 748 540 ! ! Inverse of the local depth 749 541 !!gm BUG ? don't understand the use of umask_i here ..... 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 542 r1_hu_a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) ) 543 r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) 758 544 ! 759 545 CALL wrk_dealloc( jpi,jpj, zht, z_scale, zwu, zwv, zhdiv ) … … 810 596 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 811 597 IF( neuler == 0 .AND. kt == nit000 ) THEN 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 598 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 820 599 ELSE 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 600 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 601 & + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 830 602 ENDIF 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 839 ENDIF 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 603 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 604 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(:,:,:) 853 611 854 612 ! Compute all missing vertical scale factor and depths … … 870 628 871 629 ! t- and w- points depth (set the isf depth as it is in the initial step) 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 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(:,:) 881 633 DO jk = 2, jpk 882 ! !$OMP DO schedule(static) private(jj,ji,zcoef)883 634 DO jj = 1,jpj 884 635 DO ji = 1,jpi … … 896 647 ! Local depth and Inverse of the local depth of the water 897 648 ! ------------------------------------------------------- 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 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) 653 DO jk = 2, jpkm1 654 ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 907 655 END DO 908 DO jk = 2, jpkm1 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 656 917 657 ! write restart file 918 658 ! ================== … … 954 694 ! 955 695 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean 956 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)957 696 DO jk = 1, jpk 958 697 DO jj = 1, jpjm1 … … 965 704 END DO 966 705 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 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 706 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 975 707 ! 976 708 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean 977 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)978 709 DO jk = 1, jpk 979 710 DO jj = 1, jpjm1 … … 986 717 END DO 987 718 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 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 719 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 996 720 ! 997 721 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 998 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)999 722 DO jk = 1, jpk 1000 723 DO jj = 1, jpjm1 … … 1008 731 END DO 1009 732 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 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 733 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 1018 734 ! 1019 735 CASE( 'W' ) !* from T- to W-point : vertical simple mean 1020 736 ! 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 737 pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1) 1028 738 ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing 1029 739 !!gm BUG? use here wmask in case of ISF ? to be checked 1030 !$OMP DO schedule(static) private(jk,jj,ji)1031 740 DO jk = 2, jpk 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 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 1042 746 ! 1043 747 CASE( 'UW' ) !* from U- to UW-point : vertical simple mean 1044 748 ! 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 749 pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1) 1052 750 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 1053 751 !!gm BUG? use here wumask in case of ISF ? to be checked 1054 !$OMP DO schedule(static) private(jk,jj,ji)1055 752 DO jk = 2, jpk 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 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 1066 758 ! 1067 759 CASE( 'VW' ) !* from V- to VW-point : vertical simple mean 1068 760 ! 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 761 pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1) 1076 762 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 1077 763 !!gm BUG? use here wvmask in case of ISF ? to be checked 1078 !$OMP DO schedule(static) private(jk,jj,ji)1079 764 DO jk = 2, jpk 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 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 1090 770 END SELECT 1091 771 ! … … 1225 905 sshb(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) !!gm I don't understand that ! 1226 906 sshn(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 1227 ssha(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 907 ssha(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 1228 908 ENDIF 1229 909 ENDDO -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r7698 r7753 72 72 INTEGER, DIMENSION(:,:), INTENT(out) :: k_top, k_bot ! ocean first and last level indices 73 73 ! 74 INTEGER :: j i, jj, jk ! dummy loop index74 INTEGER :: 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 !$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 116 gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 117 DO jk = 2, jpk 118 gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk) 122 119 END DO 123 DO jk = 2, jpk124 !$OMP DO schedule(static) private(jj, ji)125 DO jj = 1, jpj126 DO ji = 1, jpi127 gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)128 END DO129 END DO130 END DO131 !$OMP END PARALLEL132 120 ! 133 121 IF(lwp) THEN ! Control print … … 202 190 INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top , k_bot ! first & last ocean level 203 191 ! 204 INTEGER :: jk , jj, ji! dummy loop index192 INTEGER :: jk ! dummy loop index 205 193 INTEGER :: inum ! local logical unit 206 194 REAL(WP) :: z_zco, z_zps, z_sco, z_cav … … 266 254 ! !* ocean top and bottom level 267 255 CALL iom_get( inum, jpdom_data, 'top_level' , z2d , lrowattr=ln_use_jattr ) ! 1st wet T-points (ISF) 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 256 k_top(:,:) = INT( z2d(:,:) ) 274 257 CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d , lrowattr=ln_use_jattr ) ! last wet T-points 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 258 k_bot(:,:) = INT( z2d(:,:) ) 281 259 ! 282 260 ! bathymetry with orography (wetting and drying only) … … 317 295 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 318 296 ! 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 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 328 301 ! ! N.B. top k-index of W-level = mikt 329 302 ! ! bottom k-index of W-level = mbkt+1 330 !$OMP DO schedule(static) private(jj, ji)331 303 DO jj = 1, jpjm1 332 304 DO ji = 1, jpim1 … … 340 312 END DO 341 313 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 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 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 ) 417 320 ! 418 321 CALL wrk_dealloc( jpi,jpj, zk ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
r7698 r7753 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)164 163 DO jj = mj0(ij0), mj1(ij1) 165 164 DO ji = mi0(ii0), mi1(ii1) … … 182 181 !!gm end 183 182 ! 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 183 ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:) ! NO mask 184 ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 193 185 ! 194 186 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 201 193 ENDIF 202 194 ! 203 !$OMP PARALLEL DO schedule(static) private(jj, ji, jk, zl, jkk, zi)204 195 DO jj = 1, jpj ! vertical interpolation of T & S 205 196 DO ji = 1, jpi … … 235 226 ELSE !== z- or zps- coordinate ==! 236 227 ! 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 228 ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:) ! Mask 229 ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 246 230 ! 247 231 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)249 232 DO jj = 1, jpj 250 233 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r7698 r7753 59 59 !! ** Purpose : Initialization of the dynamics and tracer fields. 60 60 !!---------------------------------------------------------------------- 61 INTEGER :: ji, jj, jk , jn! dummy loop indices61 INTEGER :: ji, jj, jk ! 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 !$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 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 99 82 100 83 IF( ln_rstart ) THEN ! Restart from a file … … 114 97 CALL dta_tsd( nit000, tsb ) ! read 3D T and S data at nit000 115 98 ! 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 99 sshb(:,:) = 0._wp ! set the ocean at rest 100 ub (:,:,:) = 0._wp 101 vb (:,:,:) = 0._wp 134 102 ! 135 103 ELSE ! user defined initial T and S 136 104 CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb ) 137 105 ENDIF 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 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 166 111 CALL div_hor( 0 ) ! compute interior hdivn value 167 112 !!gm hdivn(:,:,:) = 0._wp … … 197 142 ! Do it whatever the free surface method, these arrays being eventually used 198 143 ! 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 144 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 145 ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 207 146 ! 208 147 !!gm the use of umsak & vmask is not necessary below as un, vn, ub, vb are always masked 209 148 DO jk = 1, jpkm1 210 !$OMP DO schedule(static) private(jj, ji)211 149 DO jj = 1, jpj 212 150 DO ji = 1, jpi … … 220 158 END DO 221 159 ! 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 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(:,:) 233 165 ! 234 166 IF( nn_timing == 1 ) CALL timing_stop('istate_init') -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
r7698 r7753 72 72 ENDIF 73 73 ! 74 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)75 74 DO jk = 1, jpkm1 !== Horizontal divergence ==! 76 75 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r7698 r7753 47 47 INTEGER, INTENT(in) :: kt ! ocean time-step index 48 48 !! 49 INTEGER :: j k, ji, jj ! dummy loop indexes49 INTEGER :: 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 !$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 67 ztrdu(:,:,:) = ua(:,:,:) 68 ztrdv(:,:,:) = va(:,:,:) 76 69 ENDIF 77 70 78 71 79 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)80 72 DO jj = 2, jpjm1 81 73 DO ji = 2, jpim1 … … 90 82 ! 91 83 IF( ln_isfcav ) THEN ! ocean cavities 92 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)93 84 DO jj = 2, jpjm1 94 85 DO ji = 2, jpim1 … … 108 99 ! 109 100 IF( l_trddyn ) THEN ! trends: send trends to trddyn for further diagnostics 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 101 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 102 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 119 103 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 120 104 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r7698 r7753 84 84 !!---------------------------------------------------------------------- 85 85 INTEGER, INTENT(in) :: kt ! ocean time-step index 86 INTEGER :: jk, jj, ji87 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 88 87 !!---------------------------------------------------------------------- … … 92 91 IF( l_trddyn ) THEN ! Temporary saving of ua and va trends (l_trddyn) 93 92 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 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 93 ztrdu(:,:,:) = ua(:,:,:) 94 ztrdv(:,:,:) = va(:,:,:) 103 95 ENDIF 104 96 ! … … 113 105 ! 114 106 IF( l_trddyn ) THEN ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 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 107 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 108 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 124 109 CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 125 110 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) … … 213 198 ! 214 199 ! initialisation of ice shelf load 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 200 IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0 223 201 IF ( ln_isfcav ) THEN 224 202 CALL wrk_alloc( jpi,jpj, 2, ztstop) … … 234 212 235 213 ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 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 214 ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp 243 215 244 216 ! compute density of the water displaced by the ice shelf … … 254 226 ! divided by 2 later 255 227 ziceload = 0._wp 256 !$OMP PARALLEL257 !$OMP DO schedule(static) private(jj,ji,ikt,jk)258 228 DO jj = 1, jpj 259 229 DO ji = 1, jpi … … 268 238 END DO 269 239 END DO 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 240 riceload(:,:)=ziceload(:,:) ! need to be saved for diaar5 277 241 278 242 CALL wrk_dealloc( jpi,jpj, 2, ztstop) … … 318 282 319 283 ! Surface value 320 !$OMP PARALLEL321 !$OMP DO schedule(static) private(ji,jj, zcoef1)322 284 DO jj = 2, jpjm1 323 285 DO ji = fs_2, fs_jpim1 ! vector opt. … … 335 297 ! interior value (2=<jk=<jpkm1) 336 298 DO jk = 2, jpkm1 337 !$OMP DO schedule(static) private(ji,jj, zcoef1)338 299 DO jj = 2, jpjm1 339 300 DO ji = fs_2, fs_jpim1 ! vector opt. … … 352 313 END DO 353 314 END DO 354 !$OMP END DO NOWAIT 355 END DO 356 !$OMP END PARALLEL 315 END DO 357 316 ! 358 317 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) … … 392 351 393 352 ! Surface value (also valid in partial step case) 394 !$OMP PARALLEL395 !$OMP DO schedule(static) private(ji,jj,zcoef1)396 353 DO jj = 2, jpjm1 397 354 DO ji = fs_2, fs_jpim1 ! vector opt. … … 408 365 ! interior value (2=<jk=<jpkm1) 409 366 DO jk = 2, jpkm1 410 !$OMP DO schedule(static) private(ji,jj, zcoef1)411 367 DO jj = 2, jpjm1 412 368 DO ji = fs_2, fs_jpim1 ! vector opt. … … 428 384 429 385 ! 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)431 386 DO jj = 2, jpjm1 432 387 DO ji = 2, jpim1 … … 449 404 END DO 450 405 END DO 451 !$OMP END PARALLEL452 406 ! 453 407 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r7698 r7753 96 96 IF( l_trddyn ) THEN ! Save ua and va trends 97 97 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 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 98 ztrdu(:,:,:) = ua(:,:,:) 99 ztrdv(:,:,:) = va(:,:,:) 107 100 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 101 102 zhke(:,:,jpk) = 0._wp 114 103 115 104 IF (ln_bdy) THEN … … 144 133 ! 145 134 CASE ( nkeg_C2 ) !-- Standard scheme --! 146 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv)147 135 DO jk = 1, jpkm1 148 136 DO jj = 2, jpj … … 158 146 ! 159 147 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! 160 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv)161 148 DO jk = 1, jpkm1 162 149 DO jj = 2, jpjm1 … … 181 168 IF (ln_bdy) THEN 182 169 ! restore velocity masks at points outside boundary 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) 170 un(:,:,:) = un(:,:,:) * umask(:,:,:) 171 vn(:,:,:) = vn(:,:,:) * vmask(:,:,:) 172 ENDIF 173 174 175 ! 196 176 DO jk = 1, jpkm1 !== grad( KE ) added to the general momentum trends ==! 197 177 DO jj = 2, jpjm1 … … 204 184 ! 205 185 IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic 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 186 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 187 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 215 188 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 216 189 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r7698 r7753 61 61 !!---------------------------------------------------------------------- 62 62 INTEGER, INTENT(in) :: kt ! ocean time-step index 63 INTEGER :: jk, jj, ji64 63 ! 65 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 70 69 IF( l_trddyn ) THEN ! temporary save of momentum trends 71 70 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 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 71 ztrdu(:,:,:) = ua(:,:,:) 72 ztrdv(:,:,:) = va(:,:,:) 81 73 ENDIF 82 74 … … 90 82 91 83 IF( l_trddyn ) THEN ! save the horizontal diffusive trends for further diagnostics 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 84 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 85 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 101 86 CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 102 87 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90
r7698 r7753 75 75 ! 76 76 ! ! =============== 77 !$OMP PARALLEL78 77 DO jk = 1, jpkm1 ! Horizontal slab 79 78 ! ! =============== 80 !$OMP DO schedule(static) private(jj, ji)81 79 DO jj = 2, jpj 82 80 DO ji = fs_2, jpi ! vector opt. … … 95 93 END DO 96 94 ! 97 !$OMP DO schedule(static) private(jj, ji)98 95 DO jj = 2, jpjm1 ! - curl( curl) + grad( div ) 99 96 DO ji = fs_2, fs_jpim1 ! vector opt. … … 109 106 ! ! =============== 110 107 END DO ! End of slab 111 !$OMP END PARALLEL112 108 ! ! =============== 113 109 CALL wrk_dealloc( jpi, jpj, zcur, zdiv ) … … 132 128 !!---------------------------------------------------------------------- 133 129 INTEGER , INTENT(in ) :: kt ! ocean time-step index 134 INTEGER :: jk, jj, ji135 130 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pub, pvb ! before velocity fields 136 131 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! momentum trend … … 149 144 ENDIF 150 145 ! 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 146 zulap(:,:,:) = 0._wp 147 zvlap(:,:,:) = 0._wp 160 148 ! 161 149 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
r7698 r7753 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 !$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 117 zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 118 zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 119 DO jk = 2, jpkm1 120 zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 121 zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 124 122 END DO 125 DO jk = 2, jpkm1 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 123 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) 133 126 END DO 134 !$OMP DO schedule(static) private(jk,jj,ji)135 DO jk = 1, jpkm1136 DO jj = 1, jpj137 DO ji = 1, jpi138 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 DO141 END DO142 END DO143 !$OMP END PARALLEL144 127 ! 145 128 IF( .NOT.ln_bt_fw ) THEN … … 148 131 ! In the forward case, this is done below after asselin filtering 149 132 ! so that asselin contribution is removed at the same time 150 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)151 133 DO jk = 1, jpkm1 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 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 160 137 ENDIF 161 138 ENDIF … … 184 161 ! 185 162 IF( ln_dyn_trd ) THEN ! 3D output: total momentum trends 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 163 zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 164 zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 195 165 CALL iom_put( "utrd_tot", zua ) ! total momentum trends, except the asselin time filter 196 166 CALL iom_put( "vtrd_tot", zva ) 197 167 ENDIF 198 168 ! 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 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) 209 172 ENDIF 210 173 … … 212 175 ! ------------------------------------------ 213 176 IF( neuler == 0 .AND. kt == nit000 ) THEN !* Euler at first time-step: only swap 214 !$OMP PARALLEL215 !$OMP DO schedule(static) private(jk,jj,ji)216 177 DO jk = 1, jpkm1 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 178 un(:,:,jk) = ua(:,:,jk) ! un <-- ua 179 vn(:,:,jk) = va(:,:,jk) 180 END DO 181 IF(.NOT.ln_linssh ) THEN 182 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) 222 186 END DO 223 END DO 224 !$OMP END DO NOWAIT 225 IF(.NOT.ln_linssh ) THEN 226 !$OMP DO schedule(static) private(jk,jj,ji) 227 DO jk = 1, jpkm1 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 235 END DO 236 ENDIF 237 !$OMP END PARALLEL 187 ENDIF 238 188 ELSE !* Leap-Frog : Asselin filter and swap 239 189 ! ! =============! 240 190 IF( ln_linssh ) THEN ! Fixed volume ! 241 191 ! ! =============! 242 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf)243 192 DO jk = 1, jpkm1 244 193 DO jj = 1, jpj … … 261 210 ! ---------------------------------------------------- 262 211 IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN ! No asselin filtering on thicknesses if forward time splitting 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 212 e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 269 213 ELSE 270 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)271 214 DO jk = 1, jpkm1 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 215 e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 277 216 END DO 278 217 ! Add volume filter correction: compatibility with tracer advection scheme … … 280 219 zcoef = atfp * rdt * r1_rau0 281 220 IF ( .NOT. ln_isf ) THEN ! if no ice shelf melting 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 221 e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 222 & - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 289 223 ELSE ! if ice shelf melting 290 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt)291 224 DO jj = 1, jpj 292 225 DO ji = 1, jpi … … 304 237 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 305 238 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 306 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf)307 239 DO jk = 1, jpkm1 308 240 DO jj = 1, jpj … … 325 257 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 326 258 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 327 !$OMP PARALLEL328 !$OMP DO schedule(static) private(jk, jj, ji, zue3a, zve3a, zue3n, zve3n, zue3b, zve3b, zuf, zvf)329 259 DO jk = 1, jpkm1 330 260 DO jj = 1, jpj … … 347 277 END DO 348 278 END DO 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 279 e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor 280 e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 357 281 ! 358 282 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) … … 364 288 ! Revert "before" velocities to time split estimate 365 289 ! Doing it here also means that asselin filter contribution is removed 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 290 zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 291 zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 292 DO jk = 2, jpkm1 293 zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 294 zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 373 295 END DO 374 DO jk = 2, jpkm1 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 296 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) 382 299 END DO 383 !$OMP DO schedule(static) private(jk,jj,ji)384 DO jk = 1, jpkm1385 DO jj = 1, jpj386 DO ji = 1, jpi387 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 DO390 END DO391 END DO392 !$OMP END PARALLEL393 300 ENDIF 394 301 ! … … 401 308 ! 402 309 IF(.NOT.ln_linssh ) THEN 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 310 hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 311 hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 312 DO jk = 2, jpkm1 313 hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 314 hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 410 315 END DO 411 DO jk = 2, jpkm1 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 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) 324 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) 439 329 END DO 440 DO jk = 2, jpkm1 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 450 END DO 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 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(:,:) 461 334 ! 462 335 IF( .NOT.ln_dynspg_ts ) THEN ! output the barotropic currents … … 465 338 ENDIF 466 339 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 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 340 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 341 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 476 342 CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 477 343 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r7698 r7753 83 83 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 84 84 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 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 85 ztrdu(:,:,:) = ua(:,:,:) 86 ztrdv(:,:,:) = va(:,:,:) 94 87 ENDIF 95 88 ! … … 98 91 .OR. nn_ice_embd == 2 ) THEN ! embedded sea-ice 99 92 ! 100 !$OMP PARALLEL DO schedule(static) private(jj, ji)101 93 DO jj = 2, jpjm1 102 94 DO ji = fs_2, fs_jpim1 ! vector opt. … … 108 100 IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN !== Atmospheric pressure gradient (added later in time-split case) ==! 109 101 zg_2 = grav * 0.5 110 !$OMP PARALLEL DO schedule(static) private(jj, ji)111 102 DO jj = 2, jpjm1 ! gradient of Patm using inverse barometer ssh 112 103 DO ji = fs_2, fs_jpim1 ! vector opt. … … 124 115 CALL upd_tide( kt ) ! update tide potential 125 116 ! 126 !$OMP PARALLEL DO schedule(static) private(jj, ji)127 117 DO jj = 2, jpjm1 ! add tide potential forcing 128 118 DO ji = fs_2, fs_jpim1 ! vector opt. … … 138 128 zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 139 129 zgrau0r = - grav * r1_rau0 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) 130 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zgrau0r 148 131 DO jj = 2, jpjm1 149 132 DO ji = fs_2, fs_jpim1 ! vector opt. … … 152 135 END DO 153 136 END DO 154 !$OMP END PARALLEL155 137 ! 156 138 CALL wrk_dealloc( jpi,jpj, zpice ) 157 139 ENDIF 158 140 ! 159 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)160 141 DO jk = 1, jpkm1 !== Add all terms to the general trend 161 142 DO jj = 2, jpjm1 … … 177 158 ! 178 159 IF( l_trddyn ) THEN ! save the surface pressure gradient trends for further diagnostics 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 160 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 161 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 188 162 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 189 163 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7698 r7753 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)226 225 DO jj = 1, jpjm1 227 226 DO ji = 1, jpim1 … … 232 231 END DO 233 232 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 234 !$OMP PARALLEL DO schedule(static) private(jj, ji)235 233 DO jj = 1, jpjm1 236 234 DO ji = 1, jpim1 … … 245 243 CALL lbc_lnk( zwz, 'F', 1._wp ) 246 244 ! 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) 245 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 253 246 DO jj = 2, jpj 254 247 DO ji = 2, jpi … … 259 252 END DO 260 253 END DO 261 !$OMP END PARALLEL262 254 ! 263 255 ELSE !== all other schemes (ENE, ENS, MIX) 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 256 zwz(:,:) = 0._wp 257 zhf(:,:) = 0._wp 271 258 272 259 !!gm assume 0 in both cases (xhich is almost surely WRONG ! ) as hvatf has been removed … … 288 275 ELSE 289 276 !zhf(:,:) = hbatf(:,:) 290 !$OMP PARALLEL DO schedule(static) private(ji,jj)291 277 DO jj = 1, jpjm1 292 278 DO ji = 1, jpim1 … … 303 289 END IF 304 290 305 !$OMP PARALLEL306 !$OMP DO schedule(static) private(ji,jj)307 291 DO jj = 1, jpjm1 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 292 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 311 293 END DO 312 294 !!gm end 313 295 314 296 DO jk = 1, jpkm1 315 !$OMP DO schedule(static) private(ji,jj)316 297 DO jj = 1, jpjm1 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 298 zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 299 END DO 300 END DO 323 301 CALL lbc_lnk( zhf, 'F', 1._wp ) 324 302 ! JC: TBC. hf should be greater than 0 325 !$OMP PARALLEL326 !$OMP DO schedule(static) private(jj, ji)327 303 DO jj = 1, jpj 328 304 DO ji = 1, jpi … … 330 306 END DO 331 307 END DO 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 308 zwz(:,:) = ff_f(:,:) * zwz(:,:) 339 309 ENDIF 340 310 ENDIF … … 354 324 ! !* e3*d/dt(Ua) (Vertically integrated) 355 325 ! ! -------------------------------------------------- 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 326 zu_frc(:,:) = 0._wp 327 zv_frc(:,:) = 0._wp 328 ! 329 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) 363 332 END DO 364 333 ! 365 DO jk = 1, jpkm1 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 373 END DO 374 ! 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 334 zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 335 zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 336 ! 382 337 ! 383 338 ! !* baroclinic momentum trend (remove the vertical mean trend) 384 !$OMP DO schedule(static) private(jk,jj,ji)385 339 DO jk = 1, jpkm1 ! ----------------------------------------------------------- 386 340 DO jj = 2, jpjm1 … … 391 345 END DO 392 346 END DO 393 !$OMP END DO NOWAIT394 347 395 348 !!gm Question here when removing the Vertically integrated trends, we remove the vertically integrated NL trends on momentum.... … … 399 352 ! !* barotropic Coriolis trends (vorticity scheme dependent) 400 353 ! ! -------------------------------------------------------- 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 354 zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:) ! now fluxes 355 zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 409 356 ! 410 357 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)412 358 DO jj = 2, jpjm1 413 359 DO ji = fs_2, fs_jpim1 ! vector opt. … … 423 369 ! 424 370 ELSEIF ( ln_dynvor_ens ) THEN ! enstrophy conserving scheme 425 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zx1)426 371 DO jj = 2, jpjm1 427 372 DO ji = fs_2, fs_jpim1 ! vector opt. … … 436 381 ! 437 382 ELSEIF ( ln_dynvor_een ) THEN ! enstrophy and energy conserving scheme 438 !$OMP PARALLEL DO schedule(static) private(jj,ji)439 383 DO jj = 2, jpjm1 440 384 DO ji = fs_2, fs_jpim1 ! vector opt. … … 456 400 IF( .NOT.ln_linssh ) THEN ! Variable volume : remove surface pressure gradient 457 401 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 458 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2)459 402 DO jj = 2, jpjm1 460 403 DO ji = 2, jpim1 … … 497 440 END DO 498 441 499 !$OMP PARALLEL DO schedule(static) private(jj,ji)500 442 DO jj = 2, jpjm1 501 443 DO ji = 2, jpim1 … … 509 451 ELSE 510 452 511 !$OMP PARALLEL DO schedule(static) private(jj,ji)512 453 DO jj = 2, jpjm1 513 454 DO ji = fs_2, fs_jpim1 ! vector opt. … … 520 461 ENDIF 521 462 522 !$OMP PARALLEL DO schedule(static) private(jj,ji)523 463 DO jj = 2, jpjm1 ! Remove coriolis term (and possibly spg) from barotropic trend 524 464 DO ji = fs_2, fs_jpim1 … … 530 470 ! ! Add bottom stress contribution from baroclinic velocities: 531 471 IF (ln_bt_fw) THEN 532 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv)533 472 DO jj = 2, jpjm1 534 473 DO ji = fs_2, fs_jpim1 ! vector opt. … … 540 479 END DO 541 480 ELSE 542 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv)543 481 DO jj = 2, jpjm1 544 482 DO ji = fs_2, fs_jpim1 ! vector opt. … … 553 491 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 554 492 IF( ln_wd ) THEN 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 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(:,:) 562 495 ELSE 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 496 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:) 497 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 570 498 END IF 571 499 ! 572 500 ! ! Add top stress contribution from baroclinic velocities: 573 501 IF( ln_bt_fw ) THEN 574 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv)575 502 DO jj = 2, jpjm1 576 503 DO ji = fs_2, fs_jpim1 ! vector opt. … … 582 509 END DO 583 510 ELSE 584 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv)585 511 DO jj = 2, jpjm1 586 512 DO ji = fs_2, fs_jpim1 ! vector opt. … … 594 520 ! 595 521 ! Note that the "unclipped" top friction parameter is used even with explicit drag 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 522 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:) 523 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:) 603 524 ! 604 525 IF (ln_bt_fw) THEN ! Add wind forcing 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 526 zu_frc(:,:) = zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 527 zv_frc(:,:) = zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 612 528 ELSE 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 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(:,:) 620 531 ENDIF 621 532 ! 622 533 IF ( ln_apr_dyn ) THEN ! Add atm pressure forcing 623 534 IF (ln_bt_fw) THEN 624 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)625 535 DO jj = 2, jpjm1 626 536 DO ji = fs_2, fs_jpim1 ! vector opt. … … 632 542 END DO 633 543 ELSE 634 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)635 544 DO jj = 2, jpjm1 636 545 DO ji = fs_2, fs_jpim1 ! vector opt. … … 649 558 ! ! Surface net water flux and rivers 650 559 IF (ln_bt_fw) THEN 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 560 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 657 561 ELSE 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 562 zssh_frc(:,:) = zraur * z1_2 * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 563 & + fwfisf(:,:) + fwfisf_b(:,:) ) 665 564 ENDIF 666 565 ! 667 566 IF( ln_sdw ) THEN ! Stokes drift divergence added if necessary 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 567 zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:) 674 568 ENDIF 675 569 ! … … 677 571 ! ! Include the IAU weighted SSH increment 678 572 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 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 573 zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 685 574 ENDIF 686 575 #endif … … 700 589 ! Initialize barotropic variables: 701 590 IF( ll_init )THEN 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 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 713 597 ENDIF 714 598 715 599 ! 716 600 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 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 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(:,:) 730 609 ELSE ! CENTRED integration: start from BEFORE fields 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 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(:,:) 744 618 ENDIF 745 619 ! … … 747 621 ! 748 622 ! Initialize sums: 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 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 759 628 ! ! ==================== ! 760 629 DO jn = 1, icycle ! sub-time-step loop ! … … 780 649 781 650 ! Extrapolate barotropic velocities at step jit+0.5: 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 651 ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 652 va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 789 653 790 654 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 791 655 ! ! ------------------ 792 656 ! Extrapolate Sea Level at step jit+0.5: 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 657 zsshp2_e(:,:) = za1 * sshn_e(:,:) + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 800 658 ! 801 !$OMP DO schedule(static) private(jj,ji)802 659 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 803 660 DO ji = 2, fs_jpim1 ! Vector opt. … … 810 667 END DO 811 668 END DO 812 !$OMP END PARALLEL813 669 CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 814 670 ! 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 671 zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points 672 zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 822 673 ELSE 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 674 zhup2_e (:,:) = hu_n(:,:) 675 zhvp2_e (:,:) = hv_n(:,:) 830 676 ENDIF 831 677 ! !* after ssh … … 834 680 ! considering fluxes below: 835 681 ! 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 682 zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:) ! fluxes at jn+0.5 683 zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 844 684 ! 845 685 #if defined key_agrif … … 872 712 ! Sum over sub-time-steps to compute advective velocities 873 713 za2 = wgtbtp2(jn) 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 714 un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 715 vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 883 716 ! 884 717 ! Set next sea level: 885 !$OMP DO schedule(static) private(jj,ji)886 718 DO jj = 2, jpjm1 887 719 DO ji = fs_2, fs_jpim1 ! vector opt. … … 890 722 END DO 891 723 END DO 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 724 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 725 899 726 CALL lbc_lnk( ssha_e, 'T', 1._wp ) 900 727 … … 907 734 ! Sea Surface Height at u-,v-points (vvl case only) 908 735 IF( .NOT.ln_linssh ) THEN 909 !$OMP PARALLEL DO schedule(static) private(jj,ji)910 736 DO jj = 2, jpjm1 911 737 DO ji = 2, jpim1 ! NO Vector Opt. … … 940 766 ENDIF 941 767 ! 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 768 zsshp2_e(:,:) = za0 * ssha_e(:,:) + za1 * sshn_e (:,:) & 769 & + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 949 770 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 950 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2)951 771 DO jj = 2, jpjm1 952 772 DO ji = 2, jpim1 … … 993 813 IF( .NOT.ln_linssh .AND. .NOT.ln_dynadv_vec ) THEN !* Vector form 994 814 ! 995 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1)996 815 DO jj = 2, jpjm1 997 816 DO ji = 2, jpim1 … … 1007 826 END DO 1008 827 1009 IF( ln_wd ) THEN1010 !$OMP PARALLEL DO schedule(static) private(jj,ji)1011 DO jj = 1, jpj1012 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 DO1016 END DO1017 END IF1018 828 ENDIF 1019 829 ! … … 1026 836 ! 1027 837 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)1029 838 DO jj = 2, jpjm1 1030 839 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1039 848 ! 1040 849 ELSEIF ( ln_dynvor_ens ) THEN !== enstrophy conserving scheme ==! 1041 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1)1042 850 DO jj = 2, jpjm1 1043 851 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1052 860 ! 1053 861 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==! 1054 !$OMP PARALLEL DO schedule(static) private(jj,ji)1055 862 DO jj = 2, jpjm1 1056 863 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1070 877 ! Add tidal astronomical forcing if defined 1071 878 IF ( ln_tide .AND. ln_tide_pot ) THEN 1072 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)1073 879 DO jj = 2, jpjm1 1074 880 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1082 888 ! 1083 889 ! Add bottom stresses: 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 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(:,:) 1096 896 ! 1097 897 ! Surface pressure trend: 1098 898 1099 899 IF( ln_wd ) THEN 1100 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)1101 900 DO jj = 2, jpjm1 1102 901 DO ji = 2, jpim1 … … 1109 908 END DO 1110 909 ELSE 1111 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)1112 910 DO jj = 2, jpjm1 1113 911 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1124 922 ! Set next velocities: 1125 923 IF( ln_dynadv_vec .OR. ln_linssh ) THEN !* Vector form 1126 !$OMP PARALLEL DO schedule(static) private(jj,ji)1127 924 DO jj = 2, jpjm1 1128 925 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1142 939 ! 1143 940 ELSE !* Flux form 1144 !$OMP PARALLEL DO schedule(static) private(jj,ji,zhura,zhvra)1145 941 DO jj = 2, jpjm1 1146 942 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1173 969 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 1174 970 IF( ln_wd ) THEN 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 971 hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1) 972 hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1) 1182 973 ELSE 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 974 hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 975 hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 1190 976 END IF 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 977 hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) ) 978 hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) ) 1198 979 ! 1199 980 ENDIF … … 1208 989 ! !* Swap 1209 990 ! ! ---- 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 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(:,:) 1226 1002 1227 1003 ! !* Sum over whole bt loop … … 1229 1005 za1 = wgtbtp1(jn) 1230 1006 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! Sum velocities 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 1007 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) 1008 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) 1238 1009 ELSE ! Sum transports 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 1010 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) * hu_e (:,:) 1011 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) * hv_e (:,:) 1246 1012 ENDIF 1247 1013 ! ! Sum sea level 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 1014 ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:) 1254 1015 ! ! ==================== ! 1255 1016 END DO ! end loop ! … … 1260 1021 ! 1261 1022 ! Set advection velocity correction: 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 1023 zwx(:,:) = un_adv(:,:) 1024 zwy(:,:) = vn_adv(:,:) 1269 1025 IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN 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 1026 un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 1027 vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 1277 1028 ELSE 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 1029 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 1030 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 1285 1031 END IF 1286 1032 1287 1033 IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 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 1034 ub2_b(:,:) = zwx(:,:) 1035 vb2_b(:,:) = zwy(:,:) 1295 1036 ENDIF 1296 1037 ! 1297 1038 ! Update barotropic trend: 1298 1039 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 1299 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)1300 1040 DO jk=1,jpkm1 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 1041 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 1042 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b 1307 1043 END DO 1308 1044 ELSE 1309 1045 ! At this stage, ssha has been corrected: compute new depths at velocity points 1310 !$OMP PARALLEL DO schedule(static) private(jj,ji)1311 1046 DO jj = 1, jpjm1 1312 1047 DO ji = 1, jpim1 ! NO Vector Opt. … … 1321 1056 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 1322 1057 ! 1323 !$OMP PARALLEL1324 !$OMP DO schedule(static) private(jk,jj,ji)1325 1058 DO jk=1,jpkm1 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 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 1332 1061 END DO 1333 !$OMP END DO NOWAIT1334 1062 ! Save barotropic velocities not transport: 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) 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 ! 1346 1067 DO jk = 1, jpkm1 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 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 ! 1355 1072 END DO 1356 1073 ! … … 1364 1081 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 1365 1082 IF( Agrif_NbStepint() == 0 ) THEN 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 1083 ub2_i_b(:,:) = 0._wp 1084 vb2_i_b(:,:) = 0._wp 1373 1085 END IF 1374 1086 ! 1375 1087 za1 = 1._wp / REAL(Agrif_rhot(), wp) 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 1088 ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:) 1089 vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 1383 1090 ENDIF 1384 1091 #endif -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r7698 r7753 97 97 !!---------------------------------------------------------------------- 98 98 INTEGER, INTENT( in ) :: kt ! ocean time-step index 99 INTEGER :: jk, jj, ji100 99 ! 101 100 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 110 109 CASE ( np_ENE ) !* energy conserving scheme 111 110 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 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 111 ztrdu(:,:,:) = ua(:,:,:) 112 ztrdv(:,:,:) = va(:,:,:) 121 113 CALL vor_ene( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 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 114 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 115 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 131 116 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 117 ztrdu(:,:,:) = ua(:,:,:) 118 ztrdv(:,:,:) = va(:,:,:) 141 119 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 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 120 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 121 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 151 122 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 152 123 ELSE ! total vorticity trend … … 157 128 CASE ( np_ENS ) !* enstrophy conserving scheme 158 129 IF( l_trddyn ) THEN ! trend diagnostics: splitthe trend in two 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 130 ztrdu(:,:,:) = ua(:,:,:) 131 ztrdv(:,:,:) = va(:,:,:) 168 132 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 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 133 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 134 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 178 135 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 136 ztrdu(:,:,:) = ua(:,:,:) 137 ztrdv(:,:,:) = va(:,:,:) 188 138 CALL vor_ens( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 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 139 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 140 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 198 141 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 199 142 ELSE ! total vorticity trend … … 204 147 CASE ( np_MIX ) !* mixed ene-ens scheme 205 148 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 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 149 ztrdu(:,:,:) = ua(:,:,:) 150 ztrdv(:,:,:) = va(:,:,:) 215 151 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend (ens) 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 152 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 153 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 225 154 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 155 ztrdu(:,:,:) = ua(:,:,:) 156 ztrdv(:,:,:) = va(:,:,:) 235 157 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend (ene) 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 158 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 159 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 245 160 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 246 161 ELSE ! total vorticity trend … … 252 167 CASE ( np_EEN ) !* energy and enstrophy conserving scheme 253 168 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 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 169 ztrdu(:,:,:) = ua(:,:,:) 170 ztrdv(:,:,:) = va(:,:,:) 263 171 CALL vor_een( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 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 172 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 173 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 273 174 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 175 ztrdu(:,:,:) = ua(:,:,:) 176 ztrdv(:,:,:) = va(:,:,:) 283 177 CALL vor_een( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 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 178 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 179 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 293 180 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 294 181 ELSE ! total vorticity trend … … 357 244 SELECT CASE( kvor ) !== vorticity considered ==! 358 245 CASE ( np_COR ) !* Coriolis (planetary vorticity) 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 246 zwz(:,:) = ff_f(:,:) 365 247 CASE ( np_RVO ) !* relative vorticity 366 !$OMP PARALLEL DO schedule(static) private(jj,ji)367 248 DO jj = 1, jpjm1 368 249 DO ji = 1, fs_jpim1 ! vector opt. … … 372 253 END DO 373 254 CASE ( np_MET ) !* metric term 374 !$OMP PARALLEL DO schedule(static) private(jj,ji)375 255 DO jj = 1, jpjm1 376 256 DO ji = 1, fs_jpim1 ! vector opt. … … 381 261 END DO 382 262 CASE ( np_CRV ) !* Coriolis + relative vorticity 383 !$OMP PARALLEL DO schedule(static) private(jj,ji)384 263 DO jj = 1, jpjm1 385 264 DO ji = 1, fs_jpim1 ! vector opt. … … 390 269 END DO 391 270 CASE ( np_CME ) !* Coriolis + metric 392 !$OMP PARALLEL DO schedule(static) private(jj,ji)393 271 DO jj = 1, jpjm1 394 272 DO ji = 1, fs_jpim1 ! vector opt. … … 404 282 ! 405 283 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 406 !$OMP PARALLEL DO schedule(static) private(jj,ji)407 284 DO jj = 1, jpjm1 408 285 DO ji = 1, fs_jpim1 ! vector opt. … … 413 290 414 291 IF( ln_sco ) THEN 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 292 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 293 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 294 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 423 295 ELSE 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 296 zwx(:,:) = e2u(:,:) * pun(:,:,jk) 297 zwy(:,:) = e1v(:,:) * pvn(:,:,jk) 431 298 ENDIF 432 299 ! !== compute and add the vorticity term trend =! 433 !$OMP PARALLEL DO schedule(static) private(jj, ji, zy1, zy2, zx1, zx2)434 300 DO jj = 2, jpjm1 435 301 DO ji = fs_2, fs_jpim1 ! vector opt. … … 621 487 SELECT CASE( nn_een_e3f ) ! == reciprocal of e3 at F-point 622 488 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 623 !$OMP PARALLEL DO schedule(static) private(jj,ji,ze3)624 489 DO jj = 1, jpjm1 625 490 DO ji = 1, fs_jpim1 ! vector opt. … … 632 497 END DO 633 498 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)635 499 DO jj = 1, jpjm1 636 500 DO ji = 1, fs_jpim1 ! vector opt. … … 648 512 SELECT CASE( kvor ) !== vorticity considered ==! 649 513 CASE ( np_COR ) !* Coriolis (planetary vorticity) 650 !$OMP PARALLEL DO schedule(static) private(jj,ji)651 514 DO jj = 1, jpjm1 652 515 DO ji = 1, fs_jpim1 ! vector opt. … … 655 518 END DO 656 519 CASE ( np_RVO ) !* relative vorticity 657 !$OMP PARALLEL DO schedule(static) private(jj,ji)658 520 DO jj = 1, jpjm1 659 521 DO ji = 1, fs_jpim1 ! vector opt. … … 664 526 END DO 665 527 CASE ( np_MET ) !* metric term 666 !$OMP PARALLEL DO schedule(static) private(jj,ji)667 528 DO jj = 1, jpjm1 668 529 DO ji = 1, fs_jpim1 ! vector opt. … … 673 534 END DO 674 535 CASE ( np_CRV ) !* Coriolis + relative vorticity 675 !$OMP PARALLEL DO schedule(static) private(jj,ji)676 536 DO jj = 1, jpjm1 677 537 DO ji = 1, fs_jpim1 ! vector opt. … … 682 542 END DO 683 543 CASE ( np_CME ) !* Coriolis + metric 684 !$OMP PARALLEL DO schedule(static) private(jj,ji)685 544 DO jj = 1, jpjm1 686 545 DO ji = 1, fs_jpim1 ! vector opt. … … 696 555 ! 697 556 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 698 !$OMP PARALLEL DO schedule(static) private(jj,ji)699 557 DO jj = 1, jpjm1 700 558 DO ji = 1, fs_jpim1 ! vector opt. … … 707 565 ! 708 566 ! !== horizontal fluxes ==! 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 567 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 568 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 716 569 717 570 ! !== compute and add the vorticity term trend =! 718 571 jj = 2 719 572 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 720 721 573 DO ji = 2, jpi ! split in 2 parts due to vector opt. 722 574 ztne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) … … 725 577 ztsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 726 578 END DO 727 !$OMP PARALLEL728 !$OMP DO schedule(static) private(jj,ji)729 579 DO jj = 3, jpj 730 580 DO ji = fs_2, jpi ! vector opt. ok because we start at jj = 3 … … 735 585 END DO 736 586 END DO 737 !$OMP DO schedule(static) private(jj,ji,zua,zva)738 587 DO jj = 2, jpjm1 739 588 DO ji = fs_2, fs_jpim1 ! vector opt. … … 746 595 END DO 747 596 END DO 748 !$OMP END PARALLEL749 597 ! ! =============== 750 598 END DO ! End of slab … … 801 649 IF(lwp) WRITE(numout,*) ' change fmask value in the angles (T) ln_vorlat = ', ln_vorlat 802 650 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)804 651 DO jk = 1, jpk 805 652 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r7698 r7753 77 77 IF( l_trddyn ) THEN ! Save ua and va trends 78 78 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 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 79 ztrdu(:,:,:) = ua(:,:,:) 80 ztrdv(:,:,:) = va(:,:,:) 88 81 ENDIF 89 82 90 !$OMP PARALLEL91 83 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 92 !$OMP DO schedule(static) private(jj, ji)93 84 DO jj = 2, jpj ! vertical fluxes 94 85 DO ji = fs_2, jpi ! vector opt. … … 96 87 END DO 97 88 END DO 98 !$OMP DO schedule(static) private(jj, ji)99 89 DO jj = 2, jpjm1 ! vertical momentum advection at w-point 100 90 DO ji = fs_2, fs_jpim1 ! vector opt. … … 104 94 END DO 105 95 END DO 106 !$OMP END PARALLEL107 96 ! 108 97 ! Surface and bottom advective fluxes set to zero 109 98 IF ( ln_isfcav ) THEN 110 !$OMP PARALLEL DO schedule(static) private(jj, ji)111 99 DO jj = 2, jpjm1 112 100 DO ji = fs_2, fs_jpim1 ! vector opt. … … 118 106 END DO 119 107 ELSE 120 !$OMP PARALLEL DO schedule(static) private(jj, ji)121 108 DO jj = 2, jpjm1 122 109 DO ji = fs_2, fs_jpim1 ! vector opt. … … 129 116 END IF 130 117 131 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zua, zva)132 118 DO jk = 1, jpkm1 ! Vertical momentum advection at u- and v-points 133 119 DO jj = 2, jpjm1 … … 144 130 145 131 IF( l_trddyn ) THEN ! save the vertical advection trends for diagnostic 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 132 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 133 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 155 134 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 156 135 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r7698 r7753 53 53 !! 54 54 INTEGER, INTENT( in ) :: kt ! ocean time-step index 55 INTEGER :: ji, jj, jk ! dummy loop indices56 55 ! 57 56 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 67 66 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 68 67 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 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 68 ztrdu(:,:,:) = ua(:,:,:) 69 ztrdv(:,:,:) = va(:,:,:) 78 70 ENDIF 79 71 … … 86 78 87 79 IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics 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 80 ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:) 81 ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:) 97 82 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 98 83 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r7698 r7753 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)95 94 DO jk = 1, jpkm1 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 95 ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 96 va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 102 97 END DO 103 98 ELSE ! applied on thickness weighted velocity 104 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)105 99 DO jk = 1, jpkm1 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 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) 114 104 END DO 115 105 ENDIF … … 122 112 ! 123 113 IF( ln_bfrimp ) THEN 124 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)125 114 DO jj = 2, jpjm1 126 115 DO ji = 2, jpim1 … … 132 121 END DO 133 122 IF ( ln_isfcav ) THEN 134 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)135 123 DO jj = 2, jpjm1 136 124 DO ji = 2, jpim1 … … 150 138 ! G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a 151 139 IF( ln_bfrimp .AND. ln_dynspg_ts ) THEN 152 !$OMP PARALLEL153 !$OMP DO schedule(static) private(jk,jj,ji)154 140 DO jk = 1, jpkm1 ! remove barotropic velocities 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) 141 ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk) 142 va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk) 143 END DO 163 144 DO jj = 2, jpjm1 ! Add bottom/top stress due to barotropic component only 164 145 DO ji = fs_2, fs_jpim1 ! vector opt. … … 171 152 END DO 172 153 END DO 173 !$OMP END DO NOWAIT174 !$OMP END PARALLEL175 154 IF( ln_isfcav ) THEN ! Ocean cavities (ISF) 176 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv, ze3ua, ze3va)177 155 DO jj = 2, jpjm1 178 156 DO ji = fs_2, fs_jpim1 ! vector opt. … … 194 172 ! non zero value at the ocean bottom depending on the bottom friction used. 195 173 ! 196 !$OMP PARALLEL197 !$OMP DO schedule(static) private(jk, jj, ji, ze3ua, zzwi, zzws)198 174 DO jk = 1, jpkm1 ! Matrix 199 175 DO jj = 2, jpjm1 … … 208 184 END DO 209 185 END DO 210 !$OMP DO schedule(static) private(jj, ji)211 186 DO jj = 2, jpjm1 ! Surface boundary conditions 212 187 DO ji = fs_2, fs_jpim1 ! vector opt. … … 232 207 ! 233 208 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 234 !$OMP DO schedule(static) private(jj, ji)235 209 DO jj = 2, jpjm1 236 210 DO ji = fs_2, fs_jpim1 ! vector opt. … … 238 212 END DO 239 213 END DO 240 !$OMP END DO NOWAIT 241 END DO 242 ! 243 !$OMP DO schedule(static) private(jj, ji, ze3ua) 214 END DO 215 ! 244 216 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 245 217 DO ji = fs_2, fs_jpim1 ! vector opt. … … 250 222 END DO 251 223 DO jk = 2, jpkm1 252 !$OMP DO schedule(static) private(jj, ji)253 224 DO jj = 2, jpjm1 254 225 DO ji = fs_2, fs_jpim1 … … 258 229 END DO 259 230 ! 260 !$OMP DO schedule(static) private(jj, ji)261 231 DO jj = 2, jpjm1 !== thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk ==! 262 232 DO ji = fs_2, fs_jpim1 ! vector opt. … … 265 235 END DO 266 236 DO jk = jpk-2, 1, -1 267 !$OMP DO schedule(static) private(jj, ji)268 237 DO jj = 2, jpjm1 269 238 DO ji = fs_2, fs_jpim1 … … 279 248 ! non zero value at the ocean bottom depending on the bottom friction used 280 249 ! 281 !$OMP DO schedule(static) private(jk, jj, ji, ze3va, zzwi, zzws)282 250 DO jk = 1, jpkm1 ! Matrix 283 251 DO jj = 2, jpjm1 … … 292 260 END DO 293 261 END DO 294 !$OMP DO schedule(static) private(jj, ji)295 262 DO jj = 2, jpjm1 ! Surface boundary conditions 296 263 DO ji = fs_2, fs_jpim1 ! vector opt. … … 316 283 ! 317 284 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 318 !$OMP DO schedule(static) private(jj, ji)319 285 DO jj = 2, jpjm1 320 286 DO ji = fs_2, fs_jpim1 ! vector opt. … … 322 288 END DO 323 289 END DO 324 !$OMP END DO NOWAIT 325 END DO 326 ! 327 !$OMP DO schedule(static) private(jj, ji, ze3va) 290 END DO 291 ! 328 292 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 329 293 DO ji = fs_2, fs_jpim1 ! vector opt. … … 334 298 END DO 335 299 DO jk = 2, jpkm1 336 !$OMP DO schedule(static) private(jj, ji)337 300 DO jj = 2, jpjm1 338 301 DO ji = fs_2, fs_jpim1 ! vector opt. … … 342 305 END DO 343 306 ! 344 !$OMP DO schedule(static) private(jj, ji)345 307 DO jj = 2, jpjm1 !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk ==! 346 308 DO ji = fs_2, fs_jpim1 ! vector opt. … … 349 311 END DO 350 312 DO jk = jpk-2, 1, -1 351 !$OMP DO schedule(static) private(jj, ji)352 313 DO jj = 2, jpjm1 353 314 DO ji = fs_2, fs_jpim1 … … 355 316 END DO 356 317 END DO 357 !$OMP END DO NOWAIT 358 END DO 359 !$OMP END PARALLEL 318 END DO 360 319 361 320 ! J. Chanut: Lines below are useless ? … … 363 322 !!gm I almost sure it is !!!! 364 323 IF( ln_bfrimp ) THEN 365 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)366 324 DO jj = 2, jpjm1 367 325 DO ji = 2, jpim1 … … 373 331 END DO 374 332 IF (ln_isfcav) THEN 375 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)376 333 DO jj = 2, jpjm1 377 334 DO ji = 2, jpim1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r7698 r7753 72 72 INTEGER, INTENT(in) :: kt ! time step 73 73 ! 74 INTEGER :: jk , jj, ji! dummy loop indice74 INTEGER :: jk ! 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 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 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 109 103 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 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 104 zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 116 105 END DO 117 106 ! ! Sea surface elevation time stepping … … 119 108 ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 120 109 ! 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 110 ssha(:,:) = ( sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:) 111 128 112 IF ( .NOT.ln_dynspg_ts ) THEN 129 113 ! These lines are not necessary with time splitting since … … 141 125 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN ! Include the IAU weighted SSH increment 142 126 CALL ssh_asm_inc( kt ) 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 127 ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 149 128 ENDIF 150 129 #endif … … 192 171 IF(lwp) WRITE(numout,*) '~~~~~ ' 193 172 ! 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 173 wn(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all) 200 174 ENDIF 201 175 ! !------------------------------! … … 207 181 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases 208 182 CALL wrk_alloc( jpi, jpj, jpk, zhdiv ) 209 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)210 183 ! 211 184 DO jk = 1, jpkm1 … … 223 196 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 224 197 ! computation of w 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 198 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk) & 199 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 232 200 END DO 233 201 ! IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 … … 235 203 ELSE ! z_star and linear free surface cases 236 204 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 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 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) 245 208 END DO 246 209 ENDIF 247 210 248 211 IF( ln_bdy ) THEN 249 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)250 212 DO jk = 1, jpkm1 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 213 wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 256 214 END DO 257 215 ENDIF … … 283 241 INTEGER, INTENT(in) :: kt ! ocean time-step index 284 242 ! 285 INTEGER :: ji, jj, jk ! dummy loop indices286 243 REAL(wp) :: zcoef ! local scalar 287 244 !!---------------------------------------------------------------------- … … 297 254 IF( ( neuler == 0 .AND. kt == nit000 ) .OR. & 298 255 & ( ln_bt_fw .AND. ln_dynspg_ts ) ) THEN 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 256 sshb(:,:) = sshn(:,:) ! before <-- now 257 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) 306 258 ! 307 259 ELSE !== Leap-Frog time-stepping: Asselin filter + swap ==! 308 260 ! ! before <-- now filtered 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 261 sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 315 262 IF( .NOT.ln_linssh ) THEN ! before <-- with forcing removed 316 263 zcoef = atfp * rdt * r1_rau0 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 264 sshb(:,:) = sshb(:,:) - zcoef * ( emp_b(:,:) - emp (:,:) & 265 & - rnf_b(:,:) + rnf (:,:) & 266 & + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:) 325 267 ENDIF 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 268 sshn(:,:) = ssha(:,:) ! now <-- after 332 269 ENDIF 333 270 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
r7698 r7753 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 !$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 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 110 98 ! ! domain for icebergs 111 99 IF( lk_mpp .AND. jpni == 1 ) CALL ctl_stop( 'icbinit: having ONE processor in x currently does not work' ) … … 120 108 nicbfldproc(:) = -1 121 109 122 !$OMP PARALLEL DO schedule(static) private(jj, ji)123 110 DO jj = 1, jpj 124 111 DO ji = 1, jpi … … 231 218 CALL flush(numicb) 232 219 ENDIF 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 220 221 src_calving (:,:) = 0._wp 222 src_calving_hflx(:,:) = 0._wp 223 240 224 ! assign each new iceberg with a unique number constructed from the processor number 241 225 ! and incremented by the total number of processors … … 252 236 IF( ivar > 0 ) THEN 253 237 CALL iom_get ( inum, jpdom_data, 'maxclass', src_calving ) ! read the max distribution array 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 238 berg_grid%maxclass(:,:) = INT( src_calving ) 239 src_calving(:,:) = 0._wp 268 240 ENDIF 269 241 CALL iom_close( inum ) ! close file -
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r7698 r7753 381 381 ! 382 382 ! WARNING ptab is defined only between nld and nle 383 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)384 383 DO jk = 1, jpk 385 384 DO jj = nlcj+1, jpj ! added line(s) (inner only) … … 400 399 ! !* Cyclic east-west 401 400 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 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 401 ptab( 1 ,:,:) = ptab(jpim1,:,:) 402 ptab(jpi,:,:) = ptab( 2 ,:,:) 409 403 ELSE !* closed 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 404 IF( .NOT. cd_type == 'F' ) ptab( 1 :jpreci,:,:) = zland ! south except F-point 405 ptab(nlci-jpreci+1:jpi ,:,:) = zland ! north 424 406 ENDIF 425 407 ! North-south cyclic 426 408 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south only with no mpp split in latitude 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 409 ptab(:,1 , :) = ptab(:, jpjm1,:) 410 ptab(:,jpj,:) = ptab(:, 2,:) 434 411 ELSE ! ! North-South boundaries (closed) 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 412 IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj,:) = zland ! south except F-point 413 ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north 449 414 ENDIF 450 415 ! … … 458 423 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 459 424 iihom = nlci-nreci 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 425 DO jl = 1, jpreci 426 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 427 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 468 428 END DO 469 429 END SELECT … … 495 455 SELECT CASE ( nbondi ) 496 456 CASE ( -1 ) 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 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) 523 468 END DO 524 469 END SELECT … … 530 475 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 531 476 ijhom = nlcj-nrecj 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 477 DO jl = 1, jprecj 478 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 479 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 540 480 END DO 541 481 ENDIF … … 567 507 SELECT CASE ( nbondj ) 568 508 CASE ( -1 ) 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 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) 595 520 END DO 596 521 END SELECT … … 992 917 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 993 918 iihom = nlci-nreci 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 919 DO jl = 1, jpreci 920 zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 921 zt2we(:,jl,1) = pt2d(iihom +jl,:) 1000 922 END DO 1001 923 END SELECT … … 1027 949 SELECT CASE ( nbondi ) 1028 950 CASE ( -1 ) 1029 !$OMP PARALLEL DO schedule(static) private(jj,jl)1030 951 DO jl = 1, jpreci 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) 952 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 953 END DO 954 CASE ( 0 ) 1037 955 DO jl = 1, jpreci 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) 956 pt2d(jl ,:) = zt2we(:,jl,2) 957 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 958 END DO 959 CASE ( 1 ) 1045 960 DO jl = 1, jpreci 1046 DO jj = 1, jpj 1047 pt2d(jl ,jj) = zt2we(jj,jl,2) 1048 END DO 961 pt2d(jl ,:) = zt2we(:,jl,2) 1049 962 END DO 1050 963 END SELECT … … 1057 970 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 1058 971 ijhom = nlcj-nrecj 1059 !$OMP PARALLEL DO schedule(static) private(ji,jl)1060 972 DO jl = 1, jprecj 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 973 zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 974 zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 1065 975 END DO 1066 976 ENDIF … … 1092 1002 SELECT CASE ( nbondj ) 1093 1003 CASE ( -1 ) 1094 !$OMP PARALLEL DO schedule(static) private(ji,jl)1095 1004 DO jl = 1, jprecj 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) 1005 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1006 END DO 1007 CASE ( 0 ) 1102 1008 DO jl = 1, jprecj 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) 1009 pt2d(:,jl ) = zt2sn(:,jl,2) 1010 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1011 END DO 1012 CASE ( 1 ) 1110 1013 DO jl = 1, jprecj 1111 DO ji = 1, jpi 1112 pt2d(ji,jl ) = zt2sn(ji,jl,2) 1113 END DO 1014 pt2d(:,jl ) = zt2sn(:,jl,2) 1114 1015 END DO 1115 1016 END SELECT -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90
r7698 r7753 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)151 150 DO jj = 1, jpj 152 151 DO ji = 1, jpi … … 160 159 IF(lwp) WRITE(numout,*) ' momentum bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 161 160 za00 = pah0 / ( zd_max * zd_max * zd_max ) 162 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2)163 161 DO jj = 1, jpj 164 162 DO ji = 1, jpi … … 173 171 ENDIF 174 172 ! ! deeper values (LAP and BLP cases) 175 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)176 173 DO jk = 2, jpk 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 174 pah1(:,:,jk) = pah1(:,:,1) * tmask(:,:,jk) 175 pah2(:,:,jk) = pah2(:,:,1) * fmask(:,:,jk) 183 176 END DO 184 177 ! … … 187 180 IF(lwp) WRITE(numout,*) ' tracer laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)' 188 181 za00 = pah0 / zd_max 189 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2)190 182 DO jj = 1, jpj 191 183 DO ji = 1, jpi … … 199 191 IF(lwp) WRITE(numout,*) ' tracer bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 200 192 za00 = pah0 / ( zd_max * zd_max * zd_max ) 201 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2)202 193 DO jj = 1, jpj 203 194 DO ji = 1, jpi … … 212 203 ENDIF 213 204 ! ! deeper values (LAP and BLP cases) 214 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)215 205 DO jk = 2, jpk 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 206 pah1(:,:,jk) = pah1(:,:,1) * umask(:,:,jk) 207 pah2(:,:,jk) = pah2(:,:,1) * vmask(:,:,jk) 222 208 END DO 223 209 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
r7698 r7753 155 155 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays') 156 156 ! 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 157 ahmt(:,:,jpk) = 0._wp ! last level always 0 158 ahmf(:,:,jpk) = 0._wp 164 159 ! 165 160 ! ! value of eddy mixing coef. … … 178 173 CASE( 0 ) !== constant ==! 179 174 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = constant ' 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 175 ahmt(:,:,:) = zah0 * tmask(:,:,:) 176 ahmf(:,:,:) = zah0 * fmask(:,:,:) 189 177 ! 190 178 CASE( 10 ) !== fixed profile ==! 191 179 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( depth )' 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 180 ahmt(:,:,1) = zah0 * tmask(:,:,1) ! constant surface value 181 ahmf(:,:,1) = zah0 * fmask(:,:,1) 199 182 CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 200 183 ! … … 208 191 !! do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 209 192 !! 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)211 193 DO jk = 2, jpkm1 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 194 ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk) 195 ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk) 218 196 END DO 219 197 ! … … 231 209 !!gm Question : info for LAP or BLP case to take into account the SQRT in the bilaplacian case ???? 232 210 !! 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)234 211 DO jk = 1, jpkm1 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 212 ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk) 213 ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk) 241 214 END DO 242 215 ! … … 266 239 ! 267 240 ! Set local gridscale values 268 !$OMP PARALLEL DO schedule(static) private(jj,ji)269 241 DO jj = 2, jpjm1 270 242 DO ji = fs_2, fs_jpim1 … … 279 251 ! 280 252 IF( ln_dynldf_blp .AND. .NOT. l_ldfdyn_time ) THEN ! bilapcian and no time variation: 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 253 ahmt(:,:,:) = SQRT( ahmt(:,:,:) ) ! take the square root of the coefficient 254 ahmf(:,:,:) = SQRT( ahmf(:,:,:) ) 290 255 ENDIF 291 256 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r7698 r7753 135 135 z1_slpmax = 1._wp / rn_slpmax 136 136 ! 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) 137 zww(:,:,:) = 0._wp 138 zwz(:,:,:) = 0._wp 139 ! 150 140 DO jk = 1, jpk !== i- & j-gradient of density ==! 151 141 DO jj = 1, jpjm1 … … 156 146 END DO 157 147 END DO 158 !$OMP END PARALLEL159 148 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 160 !$OMP PARALLEL DO schedule(static) private(jj, ji)161 149 DO jj = 1, jpjm1 162 150 DO ji = 1, jpim1 … … 167 155 ENDIF 168 156 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the bottom ocean level 169 !$OMP PARALLEL DO schedule(static) private(jj, ji)170 157 DO jj = 1, jpjm1 171 158 DO ji = 1, jpim1 … … 176 163 ENDIF 177 164 ! 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) 165 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 186 166 DO jk = 2, jpkm1 187 167 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point … … 190 170 ! ! umask(ik+1) /= 0 => all pn2 /= 0 => zdzr divides by 2 191 171 ! ! NB: 1/(tmask+1) = (1-.5*tmask) substitute a / by a * ==> faster 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 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 200 175 ! 201 176 ! !== Slopes just below the mixed layer ==! … … 207 182 ! 208 183 IF ( ln_isfcav ) THEN 209 !$OMP PARALLEL DO schedule(static) private(jj,ji)210 184 DO jj = 2, jpjm1 211 185 DO ji = fs_2, fs_jpim1 ! vector opt. … … 217 191 END DO 218 192 ELSE 219 !$OMP PARALLEL DO schedule(static) private(jj,ji)220 193 DO jj = 2, jpjm1 221 194 DO ji = fs_2, fs_jpim1 ! vector opt. … … 226 199 END IF 227 200 228 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zau, zav, zbu, zbv, zfj, zfi, zdepu, zdepv)229 201 DO jk = 2, jpkm1 !* Slopes at u and v points 230 202 DO jj = 2, jpjm1 … … 267 239 ! 268 240 ! !* horizontal Shapiro filter 269 !$OMP PARALLEL270 !$OMP DO schedule(static) private(jk, jj, ji)271 241 DO jk = 2, jpkm1 272 242 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only … … 313 283 ! =========================== | wslpj = mij( d/dj( prd ) / d/dz( prd ) 314 284 ! 315 !$OMP DO schedule(static) private(jk, jj, ji, zbw, zfk, zck, zbi, zbj, zai, zaj, zci, zcj)316 285 DO jk = 2, jpkm1 317 286 DO jj = 2, jpjm1 … … 349 318 END DO 350 319 END DO 351 !$OMP END PARALLEL352 320 CALL lbc_lnk( zwz, 'T', -1. ) ; CALL lbc_lnk( zww, 'T', -1. ) ! lateral boundary conditions 353 321 ! 354 322 ! !* horizontal Shapiro filter 355 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcofw, zck)356 323 DO jk = 2, jpkm1 357 324 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only … … 703 670 z1_slpmax = 1._wp / rn_slpmax 704 671 ! 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 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 713 676 ! 714 677 ! !== surface mixed layer mask ! 715 !$OMP DO schedule(static) private(jk, jj, ji, ik)716 678 DO jk = 1, jpk ! =1 inside the mixed layer, =0 otherwise 717 679 DO jj = 1, jpj … … 724 686 END DO 725 687 END DO 726 !$OMP END DO NOWAIT727 688 728 689 … … 737 698 !----------------------------------------------------------------------- 738 699 ! 739 !$OMP DO schedule(static) private(jj, ji, iku, ikv, zbu, zbv, zau, zav, ik, ikm1, zbw, zci, zcj, zai, zaj, zbi, zbj)740 700 DO jj = 2, jpjm1 741 701 DO ji = 2, jpim1 … … 782 742 END DO 783 743 END DO 784 !$OMP END PARALLEL785 744 !!gm this lbc_lnk should be useless.... 786 745 CALL lbc_lnk( uslpml , 'U', -1. ) ; CALL lbc_lnk( vslpml , 'V', -1. ) ! lateral boundary cond. (sign change) … … 832 791 ! Direction of lateral diffusion (tracers and/or momentum) 833 792 ! ------------------------------ 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 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 858 798 !!gm I no longer understand this..... 859 799 !!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
r7698 r7753 116 116 !! aeiu, aeiv initialized once for all or l_ldfeiv_time set to true 117 117 !!---------------------------------------------------------------------- 118 INTEGER :: jk , jj, ji! dummy loop indices118 INTEGER :: jk ! 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 !$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 186 ahtu(:,:,jpk) = 0._wp ! last level always 0 187 ahtv(:,:,jpk) = 0._wp 193 188 ! 194 189 ! ! value of eddy mixing coef. … … 205 200 CASE( 0 ) !== constant ==! 206 201 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = constant = ', rn_aht_0 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 202 ahtu(:,:,:) = zah0 * umask(:,:,:) 203 ahtv(:,:,:) = zah0 * vmask(:,:,:) 216 204 ! 217 205 CASE( 10 ) !== fixed profile ==! 218 206 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( depth )' 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 207 ahtu(:,:,1) = zah0 * umask(:,:,1) ! constant surface value 208 ahtv(:,:,1) = zah0 * vmask(:,:,1) 226 209 CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 227 210 ! … … 232 215 CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 233 216 CALL iom_close( inum ) 234 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)235 217 DO jk = 2, jpkm1 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 218 ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 219 ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 242 220 END DO 243 221 ! … … 266 244 CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 267 245 CALL iom_close( inum ) 268 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)269 246 DO jk = 1, jpkm1 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 247 ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk) 248 ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk) 276 249 END DO 277 250 ! … … 294 267 ! 295 268 IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN 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 269 ahtu(:,:,:) = SQRT( ahtu(:,:,:) ) 270 ahtv(:,:,:) = SQRT( ahtv(:,:,:) ) 305 271 ENDIF 306 272 ! … … 347 313 ! ! increase to rn_aht_0 within 20N-20S 348 314 IF( ln_ldfeiv .AND. nn_aei_ijk_t == 21 ) THEN ! use the already computed aei. 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 315 ahtu(:,:,1) = aeiu(:,:,1) 316 ahtv(:,:,1) = aeiv(:,:,1) 356 317 ELSE ! compute aht. 357 318 CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv ) … … 360 321 z1_f20 = 1._wp / ( 2._wp * omega * SIN( rad * 20._wp ) ) ! 1 / ff(20 degrees) 361 322 zaht_min = 0.2_wp * rn_aht_0 ! minimum value for aht 362 !$OMP PARALLEL363 !$OMP DO schedule(static) private(jj,ji,zaht,zahf)364 323 DO jj = 1, jpj 365 324 DO ji = 1, jpi … … 372 331 END DO 373 332 END DO 374 !$OMP DO schedule(static) private(jk,jj,ji)375 333 DO jk = 2, jpkm1 ! deeper value = surface value 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 334 ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 335 ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 336 END DO 384 337 ! 385 338 CASE( 31 ) !== time varying 3D field ==! = F( local velocity ) 386 339 IF( ln_traldf_lap ) THEN ! laplacian operator |u| e /12 387 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)388 340 DO jk = 1, jpkm1 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 341 ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 342 ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 395 343 END DO 396 344 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)398 345 DO jk = 1, jpkm1 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 346 ahtu(:,:,jk) = SQRT( ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 ) * e1u(:,:) 347 ahtv(:,:,jk) = SQRT( ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 ) * e2v(:,:) 405 348 END DO 406 349 ENDIF … … 435 378 !! l_ldfeiv_time : =T if EIV coefficients vary with time 436 379 !!---------------------------------------------------------------------- 437 INTEGER :: jk , jj, ji! dummy loop indices380 INTEGER :: jk ! dummy loop indices 438 381 INTEGER :: ierr, inum, ios ! local integer 439 382 ! … … 476 419 CASE( 0 ) !== constant ==! 477 420 IF(lwp) WRITE(numout,*) ' eddy induced velocity coef. = constant = ', 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 421 aeiu(:,:,:) = rn_aeiv_0 422 aeiv(:,:,:) = rn_aeiv_0 487 423 ! 488 424 CASE( 10 ) !== fixed profile ==! 489 425 IF(lwp) WRITE(numout,*) ' eddy induced velocity coef. = F( depth )' 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 426 aeiu(:,:,1) = rn_aeiv_0 ! constant surface value 427 aeiv(:,:,1) = rn_aeiv_0 497 428 CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 498 429 ! … … 503 434 CALL iom_get ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 504 435 CALL iom_close( inum ) 505 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)506 436 DO jk = 2, jpk 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 437 aeiu(:,:,jk) = aeiu(:,:,1) 438 aeiv(:,:,jk) = aeiv(:,:,1) 513 439 END DO 514 440 ! … … 572 498 CALL wrk_alloc( jpi,jpj, zn, zah, zhw, zross, zaeiw ) 573 499 ! 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 500 zn (:,:) = 0._wp ! Local initialization 501 zhw (:,:) = 5._wp 502 zah (:,:) = 0._wp 503 zross(:,:) = 0._wp 583 504 ! ! Compute lateral diffusive coefficient at T-point 584 505 IF( ln_traldf_triad ) THEN 585 506 DO jk = 1, jpk 586 !$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w)587 507 DO jj = 2, jpjm1 588 508 DO ji = 2, jpim1 … … 603 523 ELSE 604 524 DO jk = 1, jpk 605 !$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w)606 525 DO jj = 2, jpjm1 607 526 DO ji = 2, jpim1 … … 623 542 END IF 624 543 625 !$OMP PARALLEL626 !$OMP DO schedule(static) private(jj,ji,zfw)627 544 DO jj = 2, jpjm1 628 545 DO ji = fs_2, fs_jpim1 ! vector opt. … … 637 554 ! !== Bound on eiv coeff. ==! 638 555 z1_f20 = 1._wp / ( 2._wp * omega * sin( rad * 20._wp ) ) 639 !$OMP DO schedule(static) private(jj,ji,zzaei)640 556 DO jj = 2, jpjm1 641 557 DO ji = fs_2, fs_jpim1 ! vector opt. … … 644 560 END DO 645 561 END DO 646 !$OMP END PARALLEL647 562 CALL lbc_lnk( zaeiw(:,:), 'W', 1. ) ! lateral boundary condition 648 563 ! 649 !$OMP PARALLEL DO schedule(static) private(jj,ji)650 564 DO jj = 2, jpjm1 !== aei at u- and v-points ==! 651 565 DO ji = fs_2, fs_jpim1 ! vector opt. … … 656 570 CALL lbc_lnk( paeiu(:,:,1), 'U', 1. ) ; CALL lbc_lnk( paeiv(:,:,1), 'V', 1. ) ! lateral boundary condition 657 571 658 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)659 572 DO jk = 2, jpkm1 !== deeper values equal the surface one ==! 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 573 paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk) 574 paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk) 666 575 END DO 667 576 ! … … 715 624 716 625 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) 626 zpsi_uw(:,:, 1 ) = 0._wp ; zpsi_vw(:,:, 1 ) = 0._wp 627 zpsi_uw(:,:,jpk) = 0._wp ; zpsi_vw(:,:,jpk) = 0._wp 628 ! 728 629 DO jk = 2, jpkm1 729 630 DO jj = 1, jpjm1 … … 737 638 END DO 738 639 ! 739 !$OMP DO schedule(static) private(jk,jj,ji)740 640 DO jk = 1, jpkm1 741 641 DO jj = 1, jpjm1 … … 746 646 END DO 747 647 END DO 748 !$OMP END DO NOWAIT749 !$OMP DO schedule(static) private(jk,jj,ji)750 648 DO jk = 1, jpkm1 751 649 DO jj = 2, jpjm1 … … 756 654 END DO 757 655 END DO 758 !$OMP END PARALLEL759 656 ! 760 657 ! ! diagnose the eddy induced velocity and associated heat transport … … 798 695 CALL wrk_alloc( jpi,jpj,jpk, zw3d ) 799 696 ! 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) 697 zw3d(:,:,jpk) = 0._wp ! bottom value always 0 698 ! 810 699 DO jk = 1, jpkm1 ! e2u e3u u_eiv = -dk[psi_uw] 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 700 zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 701 END DO 818 702 CALL iom_put( "uoce_eiv", zw3d ) 819 703 ! 820 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)821 704 DO jk = 1, jpkm1 ! e1v e3v v_eiv = -dk[psi_vw] 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 705 zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 827 706 END DO 828 707 CALL iom_put( "voce_eiv", zw3d ) 829 708 ! 830 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)831 709 DO jk = 1, jpkm1 ! e1 e2 w_eiv = dk[psix] + dk[psix] 832 710 DO jj = 2, jpjm1 … … 846 724 zztmp = 0.5_wp * rau0 * rcp 847 725 IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 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 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 894 744 DO jk = 1, jpkm1 895 !$OMP DO schedule(static) private(jj,ji)896 745 DO jj = 2, jpjm1 897 746 DO ji = fs_2, fs_jpim1 ! vector opt. … … 902 751 END DO 903 752 END DO 904 !$OMP END PARALLEL905 753 CALL lbc_lnk( zw2d, 'V', -1. ) 906 754 CALL iom_put( "veiv_heattr", zztmp * zw2d ) ! heat transport in j-direction … … 911 759 zztmp = 0.5_wp * 0.5 912 760 IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN 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 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 959 779 DO jk = 1, jpkm1 960 !$OMP DO schedule(static) private(jj,ji)961 780 DO jj = 2, jpjm1 962 781 DO ji = fs_2, fs_jpim1 ! vector opt. … … 967 786 END DO 968 787 END DO 969 !$OMP END PARALLEL970 788 CALL lbc_lnk( zw2d, 'V', -1. ) 971 789 CALL iom_put( "veiv_salttr", zztmp * zw2d ) ! salt transport in j-direction -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
r7698 r7753 115 115 116 116 ! Computation of ice albedo (free of snow) 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 117 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb(:,:,:) = ralb_im 118 ELSE WHERE ; zalb(:,:,:) = ralb_if 119 END WHERE 129 120 130 121 WHERE ( 1.5 < ph_ice ) ; zalb_it = zalb … … 135 126 ELSE WHERE ; zalb_it = 0.1 + 3.6 * ph_ice 136 127 END WHERE 137 !$OMP PARALLEL 138 !$OMP DO schedule(static) private(jl, jj, ji,zswitch,zalb_sf,zalb_sm,zalb_st) 128 139 129 DO jl = 1, ijpl 140 130 DO jj = 1, jpj … … 166 156 END DO 167 157 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 158 pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rcloud ! Oberhuber correction for overcast sky 177 159 178 160 !------------------------------------------ … … 211 193 z1_c2 = 1. / 0.03 212 194 ! Computation of the snow/ice albedo 213 !$OMP PARALLEL DO schedule(static) private(jl, jj, ji,zswitch,zalb_sf,zalb_sm,zalb_st)214 195 DO jl = 1, ijpl 215 196 DO jj = 1, jpj … … 249 230 !! 250 231 REAL(wp) :: zcoef 251 INTEGER :: ji, jj ! dummy loop indices252 232 !!---------------------------------------------------------------------- 253 233 ! 254 234 zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 ) ! Parameterization of Briegled and Ramanathan, 1982 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 235 pa_oce_cs(:,:) = zcoef 236 pa_oce_os(:,:) = 0.06 ! Parameterization of Kondratyev, 1969 and Payne, 1972 262 237 ! 263 238 END SUBROUTINE albedo_oce -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r7698 r7753 66 66 ! ! 'ij->e' = (i,j) components to east 67 67 ! ! 'ij->n' = (i,j) components to north 68 INTEGER :: ji, jj ! dummy loop indices69 68 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: prot 70 69 !!---------------------------------------------------------------------- … … 83 82 CASE( 'en->i' ) ! east-north to i-component 84 83 SELECT CASE (cd_type) 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 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(:,:) 113 88 CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 114 89 END SELECT 115 90 CASE ('en->j') ! east-north to j-component 116 91 SELECT CASE (cd_type) 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 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(:,:) 145 96 CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 146 97 END SELECT 147 98 CASE ('ij->e') ! (i,j)-components to east 148 99 SELECT CASE (cd_type) 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 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(:,:) 177 104 CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 178 105 END SELECT 179 106 CASE ('ij->n') ! (i,j)-components to north 180 107 SELECT CASE (cd_type) 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 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(:,:) 209 112 CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 210 113 END SELECT … … 254 157 ! (computation done on the north stereographic polar plane) 255 158 ! 256 !$OMP PARALLEL257 !$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)259 159 DO jj = 2, jpjm1 260 160 DO ji = fs_2, jpi ! vector opt. … … 348 248 ! =============== ! 349 249 350 !$OMP DO schedule(static) private(jj,ji)351 250 DO jj = 2, jpjm1 352 251 DO ji = fs_2, jpi ! vector opt. … … 369 268 END DO 370 269 END DO 371 !$OMP END DO NOWAIT372 !$OMP END PARALLEL373 270 374 271 ! =========================== ! -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90
r7698 r7753 316 316 #if defined key_cice 317 317 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 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 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) 332 321 ENDIF 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 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) 344 328 ENDIF 345 329 #endif … … 398 382 ! 399 383 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 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 412 387 ! ----------------------------------------------------------------------------- ! 413 388 ! 0 Wind components and module at T-point relative to the moving ocean ! 414 389 ! ----------------------------------------------------------------------------- ! 415 390 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._wp 394 zwnd_j(:,:) = 0._wp 416 395 #if defined key_cyclone 417 396 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)419 397 DO jj = 2, jpjm1 420 398 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 424 402 END DO 425 403 #endif 426 !$OMP PARALLEL DO schedule(static) private(jj, ji)427 404 DO jj = 2, jpjm1 428 405 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 434 411 CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. ) 435 412 ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 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 413 wndm(:,:) = SQRT( zwnd_i(:,:) * zwnd_i(:,:) & 414 & + zwnd_j(:,:) * zwnd_j(:,:) ) * tmask(:,:,1) 415 444 416 ! ----------------------------------------------------------------------------- ! 445 417 ! I Radiative FLUXES ! … … 449 421 zztmp = 1. - albo 450 422 IF( ln_dm2dc ) THEN ; qsr(:,:) = zztmp * sbc_dcy( 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 458 ENDIF 459 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 423 ELSE ; qsr(:,:) = zztmp * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) 424 ENDIF 425 426 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 466 427 467 428 … … 500 461 END IF 501 462 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) 463 Cd_oce(:,:) = Cd(:,:) ! record value of pure ocean-atm. drag (clem) 464 511 465 DO jj = 1, jpj ! tau module, i and j component 512 466 DO ji = 1, jpi … … 517 471 END DO 518 472 END DO 519 !$OMP END PARALLEL520 473 521 474 ! ! add the HF tau contribution to the wind stress module 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 475 IF( lhftau ) taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 530 476 531 477 CALL iom_put( "taum_oce", taum ) ! output wind stress module … … 534 480 ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 535 481 ! 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)537 482 DO jj = 1, jpjm1 538 483 DO ji = 1, fs_jpim1 … … 551 496 552 497 ! zqla used as temporary array, for rho*U (common term of bulk formulae): 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 498 zqla(:,:) = zrhoa(:,:) * zU_zu(:,:) 559 499 560 500 IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN 561 501 !! q_air and t_air are given at 10m (wind reference height) 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 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 569 504 ELSE 570 505 !! q_air and t_air are not given at 10m (wind reference height) 571 506 ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 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 507 zevap(:,:) = rn_efac*MAX( 0._wp, zqla(:,:)*Ce(:,:)*(zsq(:,:) - zq_zu(:,:) ) ) ! Evaporation ! using bulk wind speed 578 508 zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - zt_zu(:,:) ) ! Sensible Heat ! using bulk wind speed 579 509 ENDIF … … 597 527 ! ----------------------------------------------------------------------------- ! 598 528 ! 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 ! 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 ! 613 540 #if defined key_lim3 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)541 qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) ! non solar without emp (only needed by LIM3) 542 qsr_oce(:,:) = qsr(:,:) 616 543 #endif 617 END DO618 END DO619 544 ! 620 545 IF ( nn_ice == 0 ) THEN … … 626 551 CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean 627 552 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 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 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] 635 555 CALL iom_put( 'snowpre', sprecip * 86400. ) ! Snow 636 556 CALL iom_put( 'precip' , tprecip * 86400. ) ! Total precipitation … … 679 599 CALL wrk_alloc( jpi,jpj, Cd ) 680 600 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 601 Cd(:,:) = Cd_ice 687 602 688 603 ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) … … 698 613 zrhoa (:,:) = rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 699 614 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 615 !!gm brutal.... 616 utau_ice (:,:) = 0._wp 617 vtau_ice (:,:) = 0._wp 618 wndm_ice (:,:) = 0._wp 619 !!gm end 710 620 711 621 ! ----------------------------------------------------------------------------- ! … … 715 625 CASE( 'I' ) ! B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation) 716 626 ! 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)718 627 DO jj = 2, jpjm1 719 628 DO ji = 2, jpim1 ! B grid : NO vector opt … … 740 649 ! 741 650 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)743 651 DO jj = 2, jpj 744 652 DO ji = fs_2, jpi ! vect. opt. … … 748 656 END DO 749 657 END DO 750 !$OMP PARALLEL DO schedule(static) private(jj,ji)751 658 DO jj = 2, jpjm1 752 659 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 793 700 REAL(wp) :: zztmp, z1_lsub ! - - 794 701 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw ! long wave heat flux over ice 795 REAL(wp), DIMENSION(:,:,:), POINTER :: zevap_ice3d, zqns_ice3d, zqsr_ice3d796 702 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qsb ! sensible heat flux over ice 797 703 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqlw ! long wave heat sensitivity over ice 798 704 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqsb ! sensible heat sensitivity over ice 799 705 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw ! evaporation and snw distribution after wind blowing (LIM3) 800 REAL(wp), DIMENSION(:,:) , POINTER :: zevap_ice2d, zqns_ice2d, zqsr_ice2d801 706 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa 802 707 REAL(wp), DIMENSION(:,:) , POINTER :: Cd ! transfer coefficient for momentum (tau) … … 805 710 IF( nn_timing == 1 ) CALL timing_start('blk_ice_flx') 806 711 ! 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)712 CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 713 CALL wrk_alloc( jpi,jpj, zrhoa) 809 714 CALL wrk_alloc( jpi,jpj, Cd ) 810 715 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 716 Cd(:,:) = Cd_ice 817 717 818 718 ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) … … 831 731 ! 832 732 zztmp = 1. / ( 1. - albo ) 833 !$OMP PARALLEL 834 !$OMP DO schedule(static) private(jl,jj,ji,zst2,zst3) ! ========================== ! 835 DO jl = 1, jpl ! Loop over ice categories ! 836 ! ! ========================== ! 733 ! ! ========================== ! 734 DO jl = 1, jpl ! Loop over ice categories ! 735 ! ! ========================== ! 837 736 DO jj = 1 , jpj 838 737 DO ji = 1, jpi … … 882 781 END DO 883 782 ! 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 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] 892 785 CALL iom_put( 'snowpre', sprecip * 86400. ) ! Snow precipitation 893 786 CALL iom_put( 'precip' , tprecip * 86400. ) ! Total precipitation … … 898 791 ! --- evaporation --- ! 899 792 z1_lsub = 1._wp / Lsub 900 !$OMP PARALLEL 901 !$OMP DO schedule(static) private(jl,jj,ji) 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 799 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 ) 818 819 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 902 820 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 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 909 823 END DO 910 !911 !$OMP DO schedule(static) private(jj, ji)912 DO jj = 1, jpj913 DO ji = 1, jpi914 zevap (ji,jj) = rn_efac * ( emp(ji,jj) + tprecip(ji,jj) ) ! evaporation over ocean915 916 ! --- evaporation minus precipitation --- !917 zsnw(ji,jj) = 0._wp918 END DO919 END DO920 !$OMP END PARALLEL921 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow distribution over ice after wind blowing922 !$OMP PARALLEL923 !$OMP DO schedule(static) private(jj,ji)924 DO jj = 1, jpj925 DO ji = 1, jpi926 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 DO928 END DO929 !$OMP END DO NOWAIT930 !$OMP DO schedule(static) private(jl,jj,ji)931 DO jl = 1, jpl932 DO jj = 1 , jpj933 DO ji = 1, jpi934 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 DO938 END DO939 END DO940 !$OMP END DO NOWAIT941 !$OMP DO schedule(static) private(jj,ji)942 DO jj = 1, jpj943 DO ji = 1, jpi944 zevap_ice2d(ji,jj) = 0._wp945 zqns_ice2d(ji,jj) = 0._wp946 zqsr_ice2d(ji,jj) = 0._wp947 END DO948 END DO949 DO jl = 1, jpl950 !$OMP DO schedule(static) private(jj,ji)951 DO jj = 1 , jpj952 DO ji = 1, jpi953 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 DO957 END DO958 END DO959 !$OMP DO schedule(static) private(jj,ji)960 DO jj = 1 , jpj961 DO ji = 1, jpi962 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 sst967 & + ( tprecip(ji,jj) - sprecip(ji,jj) ) * ( sf(jp_tair)%fnow(ji,jj,1) - rt0 ) * rcp & ! liquid precip at Tair968 & + 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 DO980 END DO981 !$OMP END DO NOWAIT982 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)985 DO jl = 1, jpl986 DO jj = 1, jpj987 DO ji = 1, jpi988 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=0990 END DO991 END DO992 END DO993 !$OMP END PARALLEL994 824 995 825 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) … … 1001 831 ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 1002 832 ! 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 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 ) 1010 835 ! 1011 836 ! … … 1019 844 ENDIF 1020 845 1021 CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb , zevap_ice3d, zqns_ice3d, zqsr_ice3d)846 CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 1022 847 CALL wrk_dealloc( jpi,jpj, zrhoa ) 1023 CALL wrk_dealloc( jpi,jpj, Cd , zevap_ice2d, zqns_ice2d, zqsr_ice2d)848 CALL wrk_dealloc( jpi,jpj, Cd ) 1024 849 ! 1025 850 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_flx') … … 1083 908 !!---------------------------------------------------------------------------------- 1084 909 ! 1085 !$OMP PARALLEL DO schedule(static) private(jj,ji,ztmp,ze_sat)1086 910 DO jj = 1, jpj 1087 911 DO ji = 1, jpi … … 1120 944 !!---------------------------------------------------------------------------------- 1121 945 ! 1122 !$OMP PARALLEL DO schedule(static) private(jj,ji,zrv,ziRT)1123 946 DO jj = 1, jpj 1124 947 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90
r7698 r7753 114 114 ! 115 115 INTEGER :: j_itt 116 INTEGER :: ji, jj ! dummy loop indices117 116 LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U 118 117 INTEGER , PARAMETER :: nb_itt = 4 ! number of itterations … … 142 141 !! Neutral coefficients at 10m: 143 142 IF( ln_cdgw ) THEN ! wave drag case 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 143 cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) 144 ztmp0 (:,:) = cdn_wave(:,:) 151 145 ELSE 152 146 ztmp0 = cd_neutral_10m( U_blk ) … … 251 245 !!---------------------------------------------------------------------------------- 252 246 ! 253 !$OMP PARALLEL DO schedule(static) private(jj,ji,zw,zw6,zgt33)254 247 DO jj = 1, jpj 255 248 DO ji = 1, jpi … … 291 284 !!---------------------------------------------------------------------------------- 292 285 ! 293 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx2,zx,zstab)294 286 DO jj = 1, jpj 295 287 DO ji = 1, jpi … … 326 318 !!---------------------------------------------------------------------------------- 327 319 ! 328 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx2,zstab)329 320 DO jj = 1, jpj 330 321 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r7698 r7753 109 109 ! 4 = Pure Coupled formulation) 110 110 !! 111 INTEGER :: jl , jj, ji! dummy loop index111 INTEGER :: jl ! 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 !$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 135 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) 136 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 142 137 143 138 ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 144 139 CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) 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 140 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 152 141 153 142 ! Mask sea ice surface temperature (set to rt0 over land) 154 143 DO jl = 1, jpl 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 144 t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 161 145 END DO 162 !$OMP END PARALLEL163 146 ! 164 147 !------------------------------------------------! … … 178 161 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 179 162 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 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 163 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 164 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 187 165 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 188 166 ENDIF … … 202 180 CALL lim_dyn( kt ) ! rheology 203 181 ELSE 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 182 u_ice(:,:) = rn_uice * umask(:,:,1) ! or prescribed velocity 183 v_ice(:,:) = rn_vice * vmask(:,:,1) 211 184 ENDIF 212 185 CALL lim_trp( kt ) ! -- Ice transport (Advection/diffusion) … … 227 200 CALL lim_var_agg(1) ! at_i for coupling (via pfrld) 228 201 ! 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 202 pfrld(:,:) = 1._wp - at_i(:,:) 203 phicif(:,:) = vt_i(:,:) 236 204 237 205 !------------------------------------------------------! … … 252 220 CASE( jp_blk ) ! bulk formulation 253 221 ! albedo depends on cloud fraction because of non-linear spectral effects 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 222 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 262 223 CALL blk_ice_flx( t_su, alb_ice ) 263 224 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) … … 265 226 CASE ( jp_purecpl ) 266 227 ! albedo depends on cloud fraction because of non-linear spectral effects 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 228 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 275 229 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 276 230 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) … … 331 285 !! ** purpose : Allocate all the dynamic arrays of the LIM-3 modules 332 286 !!---------------------------------------------------------------------- 333 INTEGER :: j l, ji, jj, ierr287 INTEGER :: ji, jj, ierr 334 288 !!---------------------------------------------------------------------- 335 289 IF(lwp) WRITE(numout,*) … … 380 334 IF( ln_limdiahsb) CALL lim_diahsb_init ! initialization for diags 381 335 ! 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) 336 fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction 337 tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu 338 ! 401 339 DO jj = 1, jpj 402 340 DO ji = 1, jpi … … 406 344 END DO 407 345 END DO 408 !$OMP END PARALLEL409 346 ! 410 347 nstart = numit + nn_fsbc … … 590 527 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdevap_ice ! sublimation sensitivity 591 528 ! 592 INTEGER :: jl , jj, ji! dummy loop index529 INTEGER :: jl ! dummy loop index 593 530 ! 594 531 REAL(wp), POINTER, DIMENSION(:,:) :: zalb_m ! Mean albedo over all categories … … 613 550 z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 614 551 z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 615 616 !$OMP PARALLEL617 552 DO jl = 1, jpl 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 553 pdqn_ice (:,:,jl) = z_dqn_m(:,:) 554 pdevap_ice(:,:,jl) = z_devap_m(:,:) 626 555 END DO 627 556 ! 628 557 DO jl = 1, jpl 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 558 pqns_ice (:,:,jl) = z_qns_m(:,:) 559 pqsr_ice (:,:,jl) = z_qsr_m(:,:) 560 pevap_ice(:,:,jl) = z_evap_m(:,:) 637 561 END DO 638 !$OMP END PARALLEL639 562 ! 640 563 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) … … 648 571 ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) ) 649 572 DO jl = 1, jpl 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 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(:,:) ) 658 576 END DO 659 577 ! … … 672 590 !! ** purpose : store ice variables at "before" time step 673 591 !!---------------------------------------------------------------------- 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 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 ) 730 603 731 604 END SUBROUTINE sbc_lim_bef … … 739 612 !! of the time step 740 613 !!---------------------------------------------------------------------- 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 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 759 627 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 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) 779 645 780 646 END SUBROUTINE sbc_lim_diag0 -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r7698 r7753 84 84 !! - nsbc: type of sbc 85 85 !!---------------------------------------------------------------------- 86 INTEGER :: ji, jj, jn ! dummy loop indices87 86 INTEGER :: ios, icpt ! local integer 88 87 LOGICAL :: ll_purecpl, ll_opa, ll_not_nemo ! local logical … … 241 240 IF( .NOT.ln_isf ) THEN !* No ice-shelf in the domain : allocate and set to zero 242 241 IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 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 242 fwfisf (:,:) = 0._wp ; risf_tsc (:,:,:) = 0._wp 243 fwfisf_b(:,:) = 0._wp ; risf_tsc_b(:,:,:) = 0._wp 260 244 END IF 261 245 IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero 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 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) 280 253 281 254 ! ! Choice of the Surface Boudary Condition (set nsbc) … … 383 356 !!---------------------------------------------------------------------- 384 357 INTEGER, INTENT(in) :: kt ! ocean time step 385 INTEGER :: ji, jj, jn ! dummy loop indices386 358 ! 387 359 LOGICAL :: ll_sas, ll_opa ! local logical … … 393 365 IF( kt /= nit000 ) THEN ! Swap of forcing fields ! 394 366 ! ! ---------------------------------------- ! 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 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 (:,:) 405 372 IF ( ln_rnf ) THEN 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 373 rnf_b (:,: ) = rnf (:,: ) 374 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 423 375 ENDIF 424 376 ENDIF … … 449 401 END SELECT 450 402 IF ( ln_wave .AND. ln_tauoc) THEN ! Wave stress subctracted 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 403 utau(:,:) = utau(:,:)*tauoc_wave(:,:) 404 vtau(:,:) = vtau(:,:)*tauoc_wave(:,:) 405 taum(:,:) = taum(:,:)*tauoc_wave(:,:) 459 406 ! 460 407 SELECT CASE( nsbc ) … … 510 457 CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b ) ! before salt flux (T-point) 511 458 ELSE 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 459 sfx_b (:,:) = sfx(:,:) 518 460 ENDIF 519 461 ELSE !* no restart: set from nit000 values 520 462 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000' 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 463 utau_b(:,:) = utau(:,:) 464 vtau_b(:,:) = vtau(:,:) 465 qns_b (:,:) = qns (:,:) 466 emp_b (:,:) = emp (:,:) 467 sfx_b (:,:) = sfx (:,:) 531 468 ENDIF 532 469 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r7698 r7753 103 103 INTEGER, INTENT(in) :: kt ! ocean time step 104 104 ! 105 INTEGER :: ji, jj , jn! dummy loop indices106 INTEGER :: z_err = 0 105 INTEGER :: ji, jj ! 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 ) 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 122 IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt 130 123 ! 131 124 ! ! set temperature & salinity content of runoffs 132 125 IF( ln_rnf_tem ) THEN ! use runoffs temperature data 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 126 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 139 127 CALL eos_fzp( sss_m(:,:), ztfrz(:,:) ) 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 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 151 134 ELSE ! use SST as runoffs temperature 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 135 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 136 ENDIF 159 137 ! ! use runoffs salinity data 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) 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) 169 140 CALL iom_put( "runoffs", rnf ) ! output runoffs arrays 170 141 ENDIF … … 181 152 ELSE !* no restart: set from nit000 values 182 153 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' 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 154 rnf_b (:,: ) = rnf (:,: ) 155 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 200 156 ENDIF 201 157 ENDIF … … 231 187 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phdivn ! horizontal divergence 232 188 !! 233 INTEGER :: ji, jj, jk , jn! dummy loop indices189 INTEGER :: ji, jj, jk ! dummy loop indices 234 190 REAL(wp) :: zfact ! local scalar 235 191 !!---------------------------------------------------------------------- … … 239 195 IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==! 240 196 IF( ln_linssh ) THEN !* constant volume case : just apply the runoff input flow 241 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk)242 197 DO jj = 1, jpj 243 198 DO ji = 1, jpi … … 248 203 END DO 249 204 ELSE !* variable volume case 250 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk)251 205 DO jj = 1, jpj ! update the depth over which runoffs are distributed 252 206 DO ji = 1, jpi … … 263 217 ENDIF 264 218 ELSE !== runoff put only at the surface ==! 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 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) 272 221 ENDIF 273 222 ! … … 286 235 !!---------------------------------------------------------------------- 287 236 CHARACTER(len=32) :: rn_dep_file ! runoff file name 288 INTEGER :: ji, jj, jk, jm , jn! dummy loop indices237 INTEGER :: ji, jj, jk, jm ! dummy loop indices 289 238 INTEGER :: ierror, inum ! temporary integer 290 239 INTEGER :: ios ! Local integer output status for namelist read … … 307 256 ln_rnf_mouth = .FALSE. ! default definition needed for example by sbc_ssr or by tra_adv_muscl 308 257 nkrnf = 0 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 258 rnf (:,:) = 0.0_wp 259 rnf_b (:,:) = 0.0_wp 260 rnfmsk (:,:) = 0.0_wp 261 rnfmsk_z(:) = 0.0_wp 324 262 RETURN 325 263 ENDIF … … 400 338 CALL iom_close( inum ) ! close file 401 339 ! 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) 340 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 410 341 DO jj = 1, jpj 411 342 DO ji = 1, jpi … … 423 354 END DO 424 355 END DO 425 !$OMP DO schedule(static) private(jj, ji, jk)426 356 DO jj = 1, jpj ! set the associated depth 427 357 DO ji = 1, jpi … … 432 362 END DO 433 363 END DO 434 !$OMP END PARALLEL435 364 ! 436 365 ELSE IF( ln_rnf_depth_ini ) THEN ! runoffs applied at the surface … … 452 381 DEALLOCATE( zrnfcl ) 453 382 ! 383 h_rnf(:,:) = 1. 384 ! 454 385 zacoef = rn_dep_max / rn_rnf_max ! coef of linear relation between runoff and its depth (150m for max of runoff) 455 386 ! 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) 387 WHERE( zrnf(:,:) > 0._wp ) h_rnf(:,:) = zacoef * zrnf(:,:) ! compute depth for all runoffs 388 ! 467 389 DO jj = 1, jpj ! take in account min depth of ocean rn_hmin 468 390 DO ji = 1, jpi … … 474 396 END DO 475 397 ! 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) 398 nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed 483 399 DO jj = 1, jpj 484 400 DO ji = 1, jpi … … 493 409 END DO 494 410 END DO 495 !$OMP END PARALLEL496 411 ! 497 412 DEALLOCATE( zrnf ) 498 413 ! 499 !$OMP PARALLEL DO schedule(static) private(jj, ji, jk)500 414 DO jj = 1, jpj ! set the associated depth 501 415 DO ji = 1, jpi … … 514 428 ENDIF 515 429 ELSE ! runoffs applied at the surface 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 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 542 436 ! 543 437 ! ! ======================== … … 572 466 IF(lwp) WRITE(numout,*) 573 467 IF(lwp) WRITE(numout,*) ' No specific treatment at river mouths' 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 468 rnfmsk (:,:) = 0._wp 469 rnfmsk_z(:) = 0._wp 587 470 nkrnf = 0 588 471 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r7698 r7753 59 59 ! 60 60 ! !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 61 !$OMP PARALLEL DO schedule(static) private(jj, ji)62 61 DO jj = 1, jpj 63 62 DO ji = 1, jpi … … 69 68 IF( nn_fsbc == 1 ) THEN ! Instantaneous surface fields ! 70 69 ! ! ---------------------------------------- ! 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 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) 94 76 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 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 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(:,:) 119 84 ! 120 85 ELSE … … 126 91 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 127 92 zcoef = REAL( nn_fsbc - 1, wp ) 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 144 ENDIF 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 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) 97 ENDIF 98 sss_m(:,:) = zcoef * zts(:,:,jp_sal) 151 99 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 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 166 ENDIF 167 ! 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 100 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 101 ELSE ; ssh_m(:,:) = zcoef * sshn(:,:) 102 ENDIF 103 ! 104 e3t_m(:,:) = zcoef * e3t_n(:,:,1) 105 ! 106 frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 176 107 ! ! ---------------------------------------- ! 177 108 ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN ! Initialisation: New mean computation ! 178 109 ! ! ---------------------------------------- ! 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 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 191 117 ENDIF 192 118 ! ! ---------------------------------------- ! 193 119 ! ! Cumulate at each time step ! 194 120 ! ! ---------------------------------------- ! 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 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) 218 127 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 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 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(:,:) 243 135 244 136 ! ! ---------------------------------------- ! … … 246 138 ! ! ---------------------------------------- ! 247 139 zcoef = 1. / REAL( nn_fsbc, wp ) 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 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 [-] 260 147 ! 261 148 ENDIF … … 303 190 !!---------------------------------------------------------------------- 304 191 REAL(wp) :: zcoef, zf_sbc ! local scalar 305 INTEGER :: ji, jj ! loop index306 192 !!---------------------------------------------------------------------- 307 193 ! … … 331 217 CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m ) 332 218 ELSE 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 219 frq_m(:,:) = 1._wp ! default definition 339 220 ENDIF 340 221 ! … … 342 223 IF(lwp) WRITE(numout,*) ' restart with a change in the frequency of mean from ', zf_sbc, ' to ', nn_fsbc 343 224 zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc 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 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(:,:) 356 232 ELSE 357 233 IF(lwp) WRITE(numout,*) ' mean fields read in the ocean restart file' … … 363 239 ! 364 240 IF(lwp) WRITE(numout,*) ' default initialisation of ss._m arrays' 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 241 ssu_m(:,:) = ub(:,:,1) 242 ssv_m(:,:) = vb(:,:,1) 372 243 IF( l_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 373 244 ELSE ; sst_m(:,:) = tsn(:,:,1,jp_tem) 374 245 ENDIF 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 246 sss_m(:,:) = tsn (:,:,1,jp_sal) 247 ssh_m(:,:) = sshn (:,:) 248 e3t_m(:,:) = e3t_n(:,:,1) 249 frq_m(:,:) = 1._wp 384 250 ! 385 251 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r7698 r7753 93 93 ! 94 94 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 95 !$OMP PARALLEL DO schedule(static) private(jj,ji,zqrp)96 95 DO jj = 1, jpj 97 96 DO ji = 1, jpi … … 106 105 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux only (sfx)) 107 106 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 108 !$OMP PARALLEL DO schedule(static) private(jj, ji, zerp)109 107 DO jj = 1, jpj 110 108 DO ji = 1, jpi … … 120 118 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 121 119 zerp_bnd = rn_sssr_bnd / rday ! - - 122 !$OMP PARALLEL DO schedule(static) private(jj, ji, zerp)123 120 DO jj = 1, jpj 124 121 DO ji = 1, jpi -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r7698 r7753 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)240 239 DO jk = 1, jpkm1 241 240 DO jj = 1, jpj … … 278 277 CASE( np_seos ) !== simplified EOS ==! 279 278 ! 280 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn)281 279 DO jk = 1, jpkm1 282 280 DO jj = 1, jpj … … 347 345 END DO 348 346 ! 349 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, jsmp, jdof, zh, zt, zstemp, zs, ztm, zn3, zn2, zn1)350 347 DO jk = 1, jpkm1 351 348 DO jj = 1, jpj … … 402 399 ! Non-stochastic equation of state 403 400 ELSE 404 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn)405 401 DO jk = 1, jpkm1 406 402 DO jj = 1, jpj … … 445 441 CASE( np_seos ) !== simplified EOS ==! 446 442 ! 447 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn)448 443 DO jk = 1, jpkm1 449 444 DO jj = 1, jpj … … 498 493 IF( nn_timing == 1 ) CALL timing_start('eos2d') 499 494 ! 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 495 prd(:,:) = 0._wp 506 496 ! 507 497 SELECT CASE( neos ) … … 509 499 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 510 500 ! 511 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn3, zn2, zn1, zn0, zn)512 501 DO jj = 1, jpjm1 513 502 DO ji = 1, fs_jpim1 ! vector opt. … … 549 538 CASE( np_seos ) !== simplified EOS ==! 550 539 ! 551 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn)552 540 DO jj = 1, jpjm1 553 541 DO ji = 1, fs_jpim1 ! vector opt. … … 601 589 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 602 590 ! 603 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn)604 591 DO jk = 1, jpkm1 605 592 DO jj = 1, jpj … … 659 646 CASE( np_seos ) !== simplified EOS ==! 660 647 ! 661 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn)662 648 DO jk = 1, jpkm1 663 649 DO jj = 1, jpj … … 712 698 IF( nn_timing == 1 ) CALL timing_start('rab_2d') 713 699 ! 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 700 pab(:,:,:) = 0._wp 722 701 ! 723 702 SELECT CASE ( neos ) … … 725 704 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 726 705 ! 727 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn3, zn2, zn1, zn0, zn)728 706 DO jj = 1, jpjm1 729 707 DO ji = 1, fs_jpim1 ! vector opt. … … 784 762 CASE( np_seos ) !== simplified EOS ==! 785 763 ! 786 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn)787 764 DO jj = 1, jpjm1 788 765 DO ji = 1, fs_jpim1 ! vector opt. … … 940 917 IF( nn_timing == 1 ) CALL timing_start('bn2') 941 918 ! 942 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zrw, zaw, zbw)943 919 DO jk = 2, jpkm1 ! interior points only (2=< jk =< jpkm1 ) 944 920 DO jj = 1, jpj ! surface and bottom value set to zero one for all in istate.F90 … … 976 952 !! Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC) 977 953 !!---------------------------------------------------------------------- 978 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celsius]979 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu]954 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celsius] 955 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 980 956 ! Leave result array automatic rather than making explicitly allocated 981 957 REAL(wp), DIMENSION(jpi,jpj) :: ptmp ! potential temperature [Celsius] … … 993 969 z1_T0 = 1._wp/40._wp 994 970 ! 995 !$OMP PARALLEL DO schedule(static) private(jj, ji, zt, zs, ztm, zn,zd)996 971 DO jj = 1, jpj 997 972 DO ji = 1, jpi … … 1049 1024 ! 1050 1025 z1_S0 = 1._wp / 35.16504_wp 1051 !$OMP PARALLEL1052 !$OMP DO schedule(static) private(jj, ji, zs)1053 1026 DO jj = 1, jpj 1054 1027 DO ji = 1, jpi … … 1058 1031 END DO 1059 1032 END DO 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 1033 ptf(:,:) = ptf(:,:) * psal(:,:) 1034 ! 1035 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1076 1036 ! 1077 1037 CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==! 1078 1038 ! 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 1039 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) & 1040 & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:) 1086 1041 ! 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 1042 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1095 1043 ! 1096 1044 CASE DEFAULT … … 1186 1134 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 1187 1135 ! 1188 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn2, zn1, zn0, zn)1189 1136 DO jk = 1, jpkm1 1190 1137 DO jj = 1, jpj … … 1250 1197 CASE( np_seos ) !== Vallis (2006) simplified EOS ==! 1251 1198 ! 1252 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn)1253 1199 DO jk = 1, jpkm1 1254 1200 DO jj = 1, jpj -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r7698 r7753 88 88 INTEGER, INTENT( in ) :: kt ! ocean time-step index 89 89 ! 90 INTEGER :: ji, jj,jk ! dummy loop index90 INTEGER :: 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 !$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 100 zun(:,:,:) = 0.0 101 zvn(:,:,:) = 0.0 102 zwn(:,:,:) = 0.0 110 103 ! 111 104 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 … … 117 110 ! !== effective transport ==! 118 111 IF( ln_wave .AND. ln_sdw ) THEN 119 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)120 112 DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift 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 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) ) 128 116 END DO 129 117 ELSE 130 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)131 118 DO jk = 1, jpkm1 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 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) 139 122 END DO 140 123 ENDIF 141 124 ! 142 125 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 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 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 162 133 ! 163 134 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & … … 176 147 IF( l_trdtra ) THEN !* Save ta and sa trends 177 148 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 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 149 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 150 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 187 151 ENDIF 188 152 ! … … 205 169 ! 206 170 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 207 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)208 171 DO jk = 1, jpkm1 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 172 ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 173 ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 215 174 END DO 216 175 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r7698 r7753 113 113 IF( l_trd .OR. l_hst ) THEN 114 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 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 115 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 125 116 ENDIF 126 117 ! 127 118 IF( l_ptr ) THEN 128 119 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 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 120 zptry(:,:,:) = 0._wp 137 121 ENDIF 138 122 ! ! surface & bottom value : flux set to zero one for all 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 123 zwz(:,:, 1 ) = 0._wp 124 zwx(:,:,jpk) = 0._wp ; zwy(:,:,jpk) = 0._wp ; zwz(:,:,jpk) = 0._wp 125 ! 126 zwi(:,:,:) = 0._wp 159 127 ! 160 128 DO jn = 1, kjpt !== loop over the tracers ==! … … 162 130 ! !== upstream advection with initial mass fluxes & intermediate update ==! 163 131 ! !* upstream tracer flux in the i and j direction 164 !$OMP PARALLEL165 !$OMP DO schedule(static) private(jk, jj, ji, zfp_vj, zfm_vj, zfp_ui,zfm_ui)166 132 DO jk = 1, jpkm1 167 133 DO jj = 1, jpjm1 … … 177 143 END DO 178 144 END DO 179 !$OMP END DO NOWAIT180 145 ! !* upstream tracer flux in the k direction *! 181 !$OMP DO schedule(static) private(jk, jj, ji, zfp_wk, zfm_wk)182 146 DO jk = 2, jpkm1 ! Interior value ( multiplied by wmask) 183 147 DO jj = 1, jpj … … 189 153 END DO 190 154 END DO 191 !$OMP END PARALLEL192 155 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as zwz has been w-masked) 193 156 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 194 !$OMP PARALLEL DO schedule(static) private(jj, ji)195 157 DO jj = 1, jpj 196 158 DO ji = 1, jpi … … 199 161 END DO 200 162 ELSE ! no cavities: only at the ocean surface 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 163 zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 207 164 ENDIF 208 165 ENDIF 209 166 ! 210 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztra)211 167 DO jk = 1, jpkm1 !* trend and after field with monotonic scheme 212 168 DO jj = 2, jpjm1 … … 225 181 ! 226 182 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 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 183 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 237 184 END IF 238 185 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 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 186 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 249 187 ! 250 188 ! !== anti-diffusive flux : high order minus low order ==! … … 253 191 ! 254 192 CASE( 2 ) !- 2nd order centered 255 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)256 193 DO jk = 1, jpkm1 257 194 DO jj = 1, jpjm1 … … 264 201 ! 265 202 CASE( 4 ) !- 4th order centered 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) 203 zltu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 204 zltv(:,:,jpk) = 0._wp 275 205 DO jk = 1, jpkm1 ! Laplacian 276 206 DO jj = 1, jpjm1 ! 1st derivative (gradient) … … 287 217 END DO 288 218 END DO 289 !$OMP END PARALLEL290 219 CALL lbc_lnk( zltu, 'T', 1. ) ; CALL lbc_lnk( zltv, 'T', 1. ) ! Lateral boundary cond. (unchanged sgn) 291 220 ! 292 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v)293 221 DO jk = 1, jpkm1 ! Horizontal advective fluxes 294 222 DO jj = 1, jpjm1 … … 304 232 ! 305 233 CASE( 41 ) !- 4th order centered ==>> !!gm coding attempt need to be tested 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) 234 ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 235 ztv(:,:,jpk) = 0._wp 315 236 DO jk = 1, jpkm1 ! 1st derivative (gradient) 316 237 DO jj = 1, jpjm1 … … 321 242 END DO 322 243 END DO 323 !$OMP END PARALLEL324 244 CALL lbc_lnk( ztu, 'U', -1. ) ; CALL lbc_lnk( ztv, 'V', -1. ) ! Lateral boundary cond. (unchanged sgn) 325 245 ! 326 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v, zC4t_u, zC4t_v)327 246 DO jk = 1, jpkm1 ! Horizontal advective fluxes 328 247 DO jj = 2, jpjm1 … … 345 264 ! 346 265 CASE( 2 ) !- 2nd order centered 347 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)348 266 DO jk = 2, jpkm1 349 267 DO jj = 2, jpjm1 … … 357 275 CASE( 4 ) !- 4th order COMPACT 358 276 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)360 277 DO jk = 2, jpkm1 361 278 DO jj = 2, jpjm1 … … 368 285 END SELECT 369 286 IF( ln_linssh ) THEN ! top ocean value: high order = upstream ==>> zwz=0 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 287 zwz(:,:,1) = 0._wp ! only ocean surface as interior zwz values have been w-masked 376 288 ENDIF 377 289 ! … … 385 297 ! !== final trend with corrected fluxes ==! 386 298 ! 387 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)388 299 DO jk = 1, jpkm1 389 300 DO jj = 2, jpjm1 … … 398 309 ! 399 310 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 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 311 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 312 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 313 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 410 314 ENDIF 411 315 ! … … 421 325 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 422 326 IF( l_ptr ) THEN 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 327 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 431 328 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 432 329 ENDIF … … 765 662 zbig = 1.e+40_wp 766 663 zrtrn = 1.e-15_wp 664 zbetup(:,:,:) = 0._wp ; zbetdo(:,:,:) = 0._wp 767 665 768 666 ! Search local extrema … … 774 672 & paft * tmask + zbig * ( 1._wp - tmask ) ) 775 673 776 !$OMP PARALLEL777 !$OMP DO schedule(static) private(jk, jj, ji)778 DO jk = 1, jpk779 DO jj = 1, jpj780 DO ji = 1, jpi781 zbetup(ji,jj,jk) = 0._wp782 zbetdo(ji,jj,jk) = 0._wp783 END DO784 END DO785 END DO786 !$OMP DO schedule(static) private(jk, jj, ji, ikm1, zup, zdo, zpos, zneg, zbt)787 674 DO jk = 1, jpkm1 788 675 ikm1 = MAX(jk-1,1) … … 819 706 END DO 820 707 END DO 821 !$OMP END PARALLEL822 708 CALL lbc_lnk( zbetup, 'T', 1. ) ; CALL lbc_lnk( zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) 823 709 824 710 ! 3. monotonic flux in the i & j direction (paa & pbb) 825 711 ! ---------------------------------------- 826 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, za, zb, zc, zav, zbv, zcv, zau, zbu, zcu)827 712 DO jk = 1, jpkm1 828 713 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
r7698 r7753 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)330 329 DO jj = 2, jpj ! "coriolis+ time^-1" at u- & v-points 331 330 DO ji = fs_2, jpi ! vector opt. … … 348 347 ! 349 348 z1_t2 = 1._wp / ( rn_time * rn_time ) 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 349 r1_ft(:,:) = 1._wp / SQRT( ff_t(:,:) * ff_t(:,:) + z1_t2 ) 356 350 ! 357 351 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
r7698 r7753 108 108 ! 109 109 ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 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 110 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 118 111 ! 119 112 IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked) 120 113 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 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 114 upsmsk(:,:) = 0._wp ! not upstream by default 128 115 ! 129 !$OMP DO schedule(static) private(jk,jj,ji)130 116 DO jk = 1, jpkm1 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 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 141 121 ENDIF 142 122 ! … … 156 136 ! 157 137 ! !-- first guess of the slopes 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) 138 zwx(:,:,jpk) = 0._wp ! bottom values 139 zwy(:,:,jpk) = 0._wp 167 140 DO jk = 1, jpkm1 ! interior values 168 141 DO jj = 1, jpjm1 … … 173 146 END DO 174 147 END DO 175 !$OMP END DO NOWAIT176 !$OMP END PARALLEL177 148 CALL lbc_lnk( zwx, 'U', -1. ) ! lateral boundary conditions (changed sign) 178 149 CALL lbc_lnk( zwy, 'V', -1. ) 179 150 ! !-- Slopes of tracer 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) 151 zslpx(:,:,jpk) = 0._wp ! bottom values 152 zslpy(:,:,jpk) = 0._wp 189 153 DO jk = 1, jpkm1 ! interior values 190 154 DO jj = 2, jpj … … 198 162 END DO 199 163 ! 200 !$OMP DO schedule(static) private(jk, jj, ji)201 164 DO jk = 1, jpkm1 !-- Slopes limitation 202 165 DO jj = 2, jpj … … 212 175 END DO 213 176 ! 214 !$OMP DO schedule(static) private(jk, jj, ji, z0u, zalpha, zu, zv, zzwx, zzwy, z0v)215 177 DO jk = 1, jpkm1 !-- MUSCL horizontal advective fluxes 216 178 DO jj = 2, jpjm1 … … 233 195 END DO 234 196 END DO 235 !$OMP END DO NOWAIT236 !$OMP END PARALLEL237 197 CALL lbc_lnk( zwx, 'U', -1. ) ; CALL lbc_lnk( zwy, 'V', -1. ) ! lateral boundary conditions (changed sign) 238 198 ! 239 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)240 199 DO jk = 1, jpkm1 !-- Tracer advective trend 241 200 DO jj = 2, jpjm1 … … 260 219 ! 261 220 ! !-- first guess of the slopes 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) 221 zwx(:,:, 1 ) = 0._wp ! surface & bottom boundary conditions 222 zwx(:,:,jpk) = 0._wp 271 223 DO jk = 2, jpkm1 ! interior values 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 224 zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) 277 225 END DO 278 226 ! !-- Slopes of tracer 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) 227 zslpx(:,:,1) = 0._wp ! surface values 287 228 DO jk = 2, jpkm1 ! interior value 288 229 DO jj = 1, jpj … … 293 234 END DO 294 235 END DO 295 !$OMP DO schedule(static) private(jk, jj, ji)296 236 DO jk = 2, jpkm1 !-- Slopes limitation 297 237 DO jj = 1, jpj ! interior values … … 303 243 END DO 304 244 END DO 305 !$OMP DO schedule(static) private(jk, jj, ji, z0w, zalpha, zw, zzwx, zzwy)306 245 DO jk = 1, jpk-2 !-- vertical advective flux 307 246 DO jj = 2, jpjm1 … … 316 255 END DO 317 256 END DO 318 !$OMP END DO NOWAIT319 !$OMP END PARALLEL320 257 IF( ln_linssh ) THEN ! top values, linear free surface only 321 258 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 322 !$OMP PARALLEL DO schedule(static) private(jj, ji)323 259 DO jj = 1, jpj 324 260 DO ji = 1, jpi … … 327 263 END DO 328 264 ELSE ! no cavities: only at the ocean surface 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 265 zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 335 266 ENDIF 336 267 ENDIF 337 268 ! 338 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)339 269 DO jk = 1, jpkm1 !-- vertical advective trend 340 270 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r7698 r7753 76 76 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 77 ! 78 INTEGER :: ji, jj , jk! dummy loop indices78 INTEGER :: ji, jj ! 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 !$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 86 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 94 87 ENDIF 95 88 ! ! Add the geothermal trend on temperature 96 !$OMP PARALLEL DO schedule(static) private(jj, ji)97 89 DO jj = 2, jpjm1 98 90 DO ji = 2, jpim1 … … 104 96 ! 105 97 IF( l_trdtra ) THEN ! Send the trend for diagnostics 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 98 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 114 99 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 115 100 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt ) … … 177 162 CASE ( 1 ) !* constant flux 178 163 IF(lwp) WRITE(numout,*) ' *** constant heat flux = ', 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 164 qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst 185 165 ! 186 166 CASE ( 2 ) !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 … … 199 179 200 180 CALL fld_read( nit000, 1, sf_qgh ) ! Read qgh data 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 181 qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2 207 182 ! 208 183 CASE DEFAULT -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r7698 r7753 105 105 !!---------------------------------------------------------------------- 106 106 INTEGER, INTENT( in ) :: kt ! ocean time-step 107 INTEGER :: ji, jj, jk ! dummy loop indices108 107 ! 109 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds … … 114 113 IF( l_trdtra ) THEN !* Save the input trends 115 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 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 115 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 116 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 125 117 ENDIF 126 118 … … 154 146 155 147 IF( l_trdtra ) THEN ! send the trends for further diagnostics 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 148 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 149 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 165 150 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 166 151 CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) … … 210 195 DO jn = 1, kjpt ! tracer loop 211 196 ! ! =========== 212 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik)213 197 DO jj = 1, jpj 214 198 DO ji = 1, jpi … … 218 202 END DO 219 203 ! 220 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik)221 204 DO jj = 2, jpjm1 ! Compute the trend 222 205 DO ji = 2, jpim1 … … 374 357 ENDIF 375 358 ! !* bottom variables (T, S, alpha, beta, depth, velocity) 376 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik)377 359 DO jj = 1, jpj 378 360 DO ji = 1, jpi … … 392 374 IF( nn_bbl_ldf == 1 ) THEN ! diffusive bbl ! 393 375 ! !-------------------! 394 !$OMP PARALLEL DO schedule(static) private(jj,ji,za,zb,zgdrho,zsign)395 376 DO jj = 1, jpjm1 ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 396 377 DO ji = 1, fs_jpim1 ! vector opt. … … 425 406 ! 426 407 CASE( 1 ) != use of upper velocity 427 !$OMP PARALLEL DO schedule(static) private(jj,ji,za,zb,zgdrho,zsign,zsigna)428 408 DO jj = 1, jpjm1 ! criteria: grad(rho).grad(h)<0 and grad(rho).grad(h)<0 429 409 DO ji = 1, fs_jpim1 ! vector opt. … … 457 437 CASE( 2 ) != bbl velocity = F( delta rho ) 458 438 zgbbl = grav * rn_gambbl 459 !$OMP PARALLEL DO schedule(static) private(jj,ji,iid,iis,ikud,ikus,za,zb,zgdrho,ijd,ijs,ikvd,ikvs)460 439 DO jj = 1, jpjm1 ! criteria: rho_up > rho_down 461 440 DO ji = 1, fs_jpim1 ! vector opt. … … 554 533 555 534 ! !* vertical index of "deep" bottom u- and v-points 556 !$OMP PARALLEL DO schedule(static) private(jj,ji)557 535 DO jj = 1, jpjm1 ! (the "shelf" bottom k-indices are mbku and mbkv) 558 536 DO ji = 1, jpim1 … … 569 547 ! !* sign of grad(H) at u- and v-points 570 548 mgrhu(jpi,:) = 0 ; mgrhu(:,jpj) = 0 ; mgrhv(jpi,:) = 0 ; mgrhv(:,jpj) = 0 571 !$OMP PARALLEL DO schedule(static) private(jj,ji)572 549 DO jj = 1, jpjm1 573 550 DO ji = 1, jpim1 … … 577 554 END DO 578 555 ! 579 !$OMP PARALLEL DO schedule(static) private(jj,ji)580 556 DO jj = 1, jpjm1 !* bbl thickness at u- (v-) point 581 557 DO ji = 1, jpim1 ! minimum of top & bottom e3u_0 (e3v_0) … … 587 563 ! 588 564 ! !* masked diffusive flux coefficients 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 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) 596 567 597 568 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r7698 r7753 102 102 IF( l_trdtra ) THEN !* Save ta and sa trends 103 103 CALL wrk_alloc( jpi,jpj,jpk,jpts, ztrdts ) 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 104 ztrdts(:,:,:,:) = tsa(:,:,:,:) 114 105 ENDIF 115 106 ! !== input T-S data at kt ==! … … 120 111 CASE( 0 ) !* newtonian damping throughout the water column *! 121 112 DO jn = 1, jpts 122 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)123 113 DO jk = 1, jpkm1 124 114 DO jj = 2, jpjm1 … … 131 121 ! 132 122 CASE ( 1 ) !* no damping in the turbocline (avt > 5 cm2/s) *! 133 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)134 123 DO jk = 1, jpkm1 135 124 DO jj = 2, jpjm1 … … 146 135 ! 147 136 CASE ( 2 ) !* no damping in the mixed layer *! 148 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)149 137 DO jk = 1, jpkm1 150 138 DO jj = 2, jpjm1 … … 163 151 ! 164 152 IF( l_trdtra ) THEN ! trend diagnostic 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 153 ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:) 175 154 CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 176 155 CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r7698 r7753 57 57 !!---------------------------------------------------------------------- 58 58 INTEGER, INTENT( in ) :: kt ! ocean time-step index 59 INTEGER :: jk, jj, ji ! dummy loop indices60 59 !! 61 60 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds … … 66 65 IF( l_trdtra ) THEN !* Save ta and sa trends 67 66 CALL wrk_alloc( jpi,jpj,jpk, ztrdt, ztrds ) 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 67 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 68 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 77 69 ENDIF 78 70 ! … … 89 81 ! 90 82 IF( l_trdtra ) THEN !* save the horizontal diffusive trends for further diagnostics 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 83 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 84 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 100 85 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 101 86 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r7698 r7753 125 125 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 126 126 ! 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 127 akz (:,:,:) = 0._wp 128 ah_wslp2(:,:,:) = 0._wp 136 129 ENDIF 137 130 ! … … 158 151 IF( kpass == 1 ) THEN !== first pass only ==! 159 152 ! 160 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w)161 153 DO jk = 2, jpkm1 162 154 DO jj = 2, jpjm1 … … 180 172 ! 181 173 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 182 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)183 174 DO jk = 2, jpkm1 184 175 DO jj = 2, jpjm1 … … 194 185 ! 195 186 IF( ln_traldf_blp ) THEN ! bilaplacian operator 196 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)197 187 DO jk = 2, jpkm1 198 188 DO jj = 1, jpjm1 … … 204 194 END DO 205 195 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 206 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ze3w_2, zcoef0)207 196 DO jk = 2, jpkm1 208 197 DO jj = 1, jpjm1 … … 217 206 ! 218 207 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 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 208 akz(:,:,:) = ah_wslp2(:,:,:) 227 209 ENDIF 228 210 ENDIF … … 236 218 !!---------------------------------------------------------------------- 237 219 !!gm : bug.... why (x,:,:)? (1,jpj,:) and (jpi,1,:) should be sufficient.... 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 220 zdit (1,:,:) = 0._wp ; zdit (jpi,:,:) = 0._wp 221 zdjt (1,:,:) = 0._wp ; zdjt (jpi,:,:) = 0._wp 246 222 !!end 247 223 248 224 ! Horizontal tracer gradient 249 !$OMP DO schedule(static) private(jk, jj, ji)250 225 DO jk = 1, jpkm1 251 226 DO jj = 1, jpjm1 … … 256 231 END DO 257 232 END DO 258 !$OMP END PARALLEL259 233 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 260 !$OMP PARALLEL DO schedule(static) private(jj, ji)261 234 DO jj = 1, jpjm1 ! bottom correction (partial bottom cell) 262 235 DO ji = 1, fs_jpim1 ! vector opt. … … 266 239 END DO 267 240 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 268 !$OMP PARALLEL DO schedule(static) private(jj, ji)269 241 DO jj = 1, jpjm1 270 242 DO ji = 1, fs_jpim1 ! vector opt. … … 280 252 !!---------------------------------------------------------------------- 281 253 ! 282 !$OMP PARALLEL283 254 DO jk = 1, jpkm1 ! Horizontal slab 284 255 ! 285 256 ! !== Vertical tracer gradient 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 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) 307 261 ENDIF 308 !$OMP DO schedule(static) private(jj, ji, zmsku, zmskv, zabe1, zabe2, zcof1, zcof2)309 262 DO jj = 1 , jpjm1 !== Horizontal fluxes 310 263 DO ji = 1, fs_jpim1 ! vector opt. … … 330 283 END DO 331 284 ! 332 !$OMP DO schedule(static) private(jj, ji)333 285 DO jj = 2 , jpjm1 !== horizontal divergence and add to pta 334 286 DO ji = fs_2, fs_jpim1 ! vector opt. … … 344 296 !!---------------------------------------------------------------------- 345 297 ! 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 298 ztfw(1,:,:) = 0._wp ; ztfw(jpi,:,:) = 0._wp 352 299 ! 353 300 ! Vertical fluxes 354 301 ! --------------- 355 302 ! ! Surface and bottom vertical fluxes set to zero 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 303 ztfw(:,:, 1 ) = 0._wp ; ztfw(:,:,jpk) = 0._wp 362 304 363 !$OMP DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w, zcoef3, zcoef4)364 305 DO jk = 2, jpkm1 ! interior (2=<jk=<jpk-1) 365 306 DO jj = 2, jpjm1 … … 386 327 END DO 387 328 END DO 388 !$OMP END PARALLEL389 329 ! !== add the vertical 33 flux ==! 390 330 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 391 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)392 331 DO jk = 2, jpkm1 393 332 DO jj = 1, jpjm1 … … 403 342 SELECT CASE( kpass ) 404 343 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 405 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)406 344 DO jk = 2, jpkm1 407 345 DO jj = 1, jpjm1 … … 414 352 END DO 415 353 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)417 354 DO jk = 2, jpkm1 418 355 DO jj = 1, jpjm1 … … 427 364 ENDIF 428 365 ! 429 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)430 366 DO jk = 1, jpkm1 !== Divergence of vertical fluxes added to pta ==! 431 367 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r7698 r7753 121 121 IF( l_trdtra ) THEN 122 122 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 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 123 ztrdt(:,:,jk) = 0._wp 124 ztrds(:,:,jk) = 0._wp 132 125 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 133 126 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) … … 136 129 ! total trend for the non-time-filtered variables. 137 130 zfact = 1.0 / rdt 138 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)139 131 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 132 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 133 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact 146 134 END DO 147 135 CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) … … 149 137 ! Store now fields before applying the Asselin filter 150 138 ! in order to calculate Asselin filter trend later. 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 139 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 140 ztrds(:,:,:) = tsn(:,:,:,jp_sal) 160 141 ENDIF 161 142 162 143 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step (only swap) 163 144 DO jn = 1, jpts 164 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)165 145 DO jk = 1, jpkm1 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 146 tsn(:,:,jk,jn) = tsa(:,:,jk,jn) 171 147 END DO 172 148 END DO … … 187 163 ! 188 164 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 189 !$OMP PARALLEL DO schedule(static) private(jk, zfact)190 165 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 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 198 169 END DO 199 170 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) … … 243 214 DO jn = 1, kjpt 244 215 ! 245 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztn,ztd)246 216 DO jk = 1, jpkm1 247 217 DO jj = 2, jpjm1 … … 310 280 ! 311 281 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)313 282 DO jk = 1, jpkm1 314 283 zfact1 = atfp * p2dt -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r7698 r7753 128 128 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 129 129 CALL wrk_alloc( jpi,jpj,jpk, ztrdt ) 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 130 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 138 131 ENDIF 139 132 ! … … 149 142 ELSE ! No restart or restart not found: Euler forward time stepping 150 143 z1_2 = 1._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 144 qsr_hc_b(:,:,:) = 0._wp 159 145 ENDIF 160 146 ELSE !== Swap of qsr heat content ==! 161 147 z1_2 = 0.5_wp 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 148 qsr_hc_b(:,:,:) = qsr_hc(:,:,:) 170 149 ENDIF 171 150 ! … … 176 155 CASE( np_BIO ) !== bio-model fluxes ==! 177 156 ! 178 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)179 157 DO jk = 1, nksr 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 158 qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 185 159 END DO 186 160 ! … … 192 166 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll 193 167 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)195 168 DO jk = 1, nksr + 1 196 169 DO jj = 2, jpjm1 ! Separation in R-G-B depending of the surface Chl … … 217 190 END DO 218 191 ELSE !* constant chrlorophyll 219 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)220 192 DO jk = 1, nksr + 1 221 DO jj = 1, jpj 222 DO ji = 1, jpi 223 zchl3d(ji,jj,jk) = 0.05 224 ENDDO 225 ENDDO 193 zchl3d(:,:,jk) = 0.05 226 194 ENDDO 227 195 ENDIF 228 196 ! 229 197 zcoef = ( 1. - rn_abs ) / 3._wp !* surface equi-partition in R-G-B 230 !$OMP PARALLEL231 !$OMP DO schedule(static) private(jj,ji)232 198 DO jj = 2, jpjm1 233 199 DO ji = fs_2, fs_jpim1 … … 239 205 END DO 240 206 END DO 241 !$OMP END DO NOWAIT242 207 ! 243 208 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)245 209 DO jj = 2, jpjm1 246 210 DO ji = fs_2, fs_jpim1 … … 253 217 END DO 254 218 255 !$OMP DO schedule(static) private(jj,ji,zc0,zc1,zc2,zc3)256 219 DO jj = 2, jpjm1 257 220 DO ji = fs_2, fs_jpim1 … … 269 232 END DO 270 233 ! 271 !$OMP DO schedule(static) private(jk,jj,ji)272 234 DO jk = 1, nksr !* now qsr induced heat content 273 235 DO jj = 2, jpjm1 … … 277 239 END DO 278 240 END DO 279 !$OMP END PARALLEL280 241 ! 281 242 CALL wrk_dealloc( jpi,jpj, zekb, zekg, zekr ) … … 286 247 zz0 = rn_abs * r1_rau0_rcp ! surface equi-partition in 2-bands 287 248 zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 288 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zc0,zc1)289 249 DO jk = 1, nksr ! solar heat absorbed at T-point in the top 400m 290 250 DO jj = 2, jpjm1 … … 300 260 ! 301 261 ! !-----------------------------! 302 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)303 262 DO jk = 1, nksr ! update to the temp. trend ! 304 263 DO jj = 2, jpjm1 !-----------------------------! … … 311 270 ! 312 271 IF( ln_qsr_ice ) THEN ! sea-ice: store the 1st ocean level attenuation coefficient 313 !$OMP PARALLEL DO schedule(static) private(jj,ji)314 272 DO jj = 2, jpjm1 315 273 DO ji = fs_2, fs_jpim1 ! vector opt. … … 326 284 CALL wrk_alloc( jpi,jpj,jpk, zetot ) 327 285 ! 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 286 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 335 287 DO jk = nksr, 1, -1 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 288 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp 342 289 END DO 343 !$OMP END PARALLEL344 290 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 345 291 ! … … 353 299 ! 354 300 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 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 301 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 363 302 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 364 303 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt ) … … 487 426 END SELECT 488 427 ! 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 428 qsr_hc(:,:,:) = 0._wp ! now qsr heat content set to zero where it will not be computed 497 429 ! 498 430 ! 1st ocean level attenuation coefficient (used in sbcssm) … … 500 432 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 501 433 ELSE 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 434 fraqsr_1lev(:,:) = 1._wp ! default : no penetration 508 435 ENDIF 509 436 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r7710 r7753 88 88 IF( l_trdtra ) THEN !* Save ta and sa trends 89 89 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 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 90 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 91 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 99 92 ENDIF 100 93 ! 101 94 !!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 102 95 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 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 96 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 97 qsr(:,:) = 0._wp ! qsr set to zero 110 98 ENDIF 111 99 … … 119 107 IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file' 120 108 zfact = 0.5_wp 121 DO jn = 1, jpts 122 !$OMP PARALLEL DO schedule(static) private(jj, ji) 123 DO jj = 1, jpj 124 DO ji = 1, jpi 125 sbc_tsc(ji,jj,jn) = 0._wp ! needed just to ensure haloes are consistent across restarts 126 END DO 127 END DO 128 END DO 109 sbc_tsc(:,:,:) = 0._wp 129 110 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend 130 111 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend 131 112 ELSE ! No restart or restart not found: Euler forward time stepping 132 113 zfact = 1._wp 133 DO jn = 1, jpts 134 !$OMP PARALLEL DO schedule(static) private(jj, ji) 135 DO jj = 1, jpj 136 DO ji = 1, jpi 137 sbc_tsc(ji,jj,jn) = 0._wp 138 sbc_tsc_b(ji,jj,jn) = 0._wp 139 END DO 140 END DO 141 END DO 114 sbc_tsc(:,:,:) = 0._wp 115 sbc_tsc_b(:,:,:) = 0._wp 142 116 ENDIF 143 117 ELSE !* other time-steps: swap of forcing fields 144 118 zfact = 0.5_wp 145 DO jn = 1, jpts 146 !$OMP PARALLEL DO schedule(static) private(jj, ji) 147 DO jj = 1, jpj 148 DO ji = 1, jpi 149 sbc_tsc_b(ji,jj,jn) = sbc_tsc(ji,jj,jn) 150 END DO 151 END DO 152 END DO 119 sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 153 120 ENDIF 154 121 ! !== Now sbc tracer content fields ==! 155 !$OMP PARALLEL DO schedule(static) private(jj, ji)156 122 DO jj = 2, jpj 157 123 DO ji = fs_2, fs_jpim1 ! vector opt. … … 161 127 END DO 162 128 IF( ln_linssh ) THEN !* linear free surface 163 !$OMP PARALLEL DO schedule(static) private(jj, ji)164 129 DO jj = 2, jpj !==>> add concentration/dilution effect due to constant volume cell 165 130 DO ji = fs_2, fs_jpim1 ! vector opt. … … 173 138 ! 174 139 DO jn = 1, jpts !== update tracer trend ==! 175 !$OMP PARALLEL DO schedule(static) private(jj, ji)176 140 DO jj = 2, jpj 177 141 DO ji = fs_2, fs_jpim1 ! vector opt. … … 255 219 ! 256 220 IF( ln_iscpl .AND. ln_hsb) THEN ! input of heat and salt due to river runoff 257 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zdep)258 221 DO jk = 1,jpk 259 222 DO jj = 2, jpj … … 270 233 271 234 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics 272 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 273 DO jk = 1, jpk 274 DO jj = 1, jpj 275 DO ji = 1, jpi 276 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 277 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 278 END DO 279 END DO 280 END DO 235 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 236 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 281 237 CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 282 238 CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r7698 r7753 58 58 INTEGER, INTENT( in ) :: kt ! ocean time-step index 59 59 ! 60 INTEGER :: jk , jj, ji! Dummy loop indices60 INTEGER :: jk ! 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 !$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 74 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 75 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 83 76 ENDIF 84 77 ! … … 91 84 ! JMM avoid negative salinities near river outlet ! Ugly fix 92 85 ! JMM : restore negative salinities to small salinities: 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 86 WHERE( tsa(:,:,:,jp_sal) < 0._wp ) tsa(:,:,:,jp_sal) = 0.1_wp 101 87 !!gm 102 88 103 89 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 104 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)105 90 DO jk = 1, jpkm1 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 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) 112 93 END DO 113 94 !!gm this should be moved in trdtra.F90 and done on all trends -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r7698 r7753 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 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 108 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN ; zwt(:,:,2:jpk) = avt (:,:,2:jpk) 109 ELSE ; zwt(:,:,2:jpk) = fsavs(:,:,2:jpk) 122 110 ENDIF 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 111 zwt(:,:,1) = 0._wp 129 112 ! 130 113 IF( l_ldfslp ) THEN ! isoneutral diffusion: add the contribution 131 114 IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator 132 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)133 115 DO jk = 2, jpkm1 134 116 DO jj = 2, jpjm1 … … 139 121 END DO 140 122 ELSE ! standard or triad iso-neutral operator 141 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)142 123 DO jk = 2, jpkm1 143 124 DO jj = 2, jpjm1 … … 151 132 ! 152 133 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 153 !$OMP PARALLEL154 !$OMP DO schedule(static) private(jk, jj, ji)155 134 DO jk = 1, jpkm1 156 135 DO jj = 2, jpjm1 … … 183 162 ! used as a work space array: its value is modified. 184 163 ! 185 !$OMP DO schedule(static) private(jj, ji)186 164 DO jj = 2, jpjm1 !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) 187 165 DO ji = fs_2, fs_jpim1 ! done one for all passive tracers (so included in the IF instruction) … … 189 167 END DO 190 168 END DO 191 !$OMP END DO NOWAIT192 169 DO jk = 2, jpkm1 193 !$OMP DO schedule(static) private(jj, ji)194 170 DO jj = 2, jpjm1 195 171 DO ji = fs_2, fs_jpim1 … … 198 174 END DO 199 175 END DO 200 !$OMP END PARALLEL201 176 ! 202 177 ENDIF 203 178 ! 204 !$OMP PARALLEL205 !$OMP DO schedule(static) private(jj, ji)206 179 DO jj = 2, jpjm1 !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 207 180 DO ji = fs_2, fs_jpim1 … … 210 183 END DO 211 184 DO jk = 2, jpkm1 212 !$OMP DO schedule(static) private(jj, ji, zrhs)213 185 DO jj = 2, jpjm1 214 186 DO ji = fs_2, fs_jpim1 … … 219 191 END DO 220 192 ! 221 !$OMP DO schedule(static) private(jj, ji)222 193 DO jj = 2, jpjm1 !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk (result is the after tracer) 223 194 DO ji = fs_2, fs_jpim1 … … 226 197 END DO 227 198 DO jk = jpk-2, 1, -1 228 !$OMP DO schedule(static) private(jj, ji)229 199 DO jj = 2, jpjm1 230 200 DO ji = fs_2, fs_jpim1 … … 234 204 END DO 235 205 END DO 236 !$OMP END PARALLEL237 206 ! ! ================= ! 238 207 END DO ! end tracer loop ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r7698 r7753 101 101 IF( nn_timing == 1 ) CALL timing_start( 'zps_hde') 102 102 ! 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 103 pgtu(:,:,:)=0._wp ; zti (:,:,:)=0._wp ; zhi (:,: )=0._wp 104 pgtv(:,:,:)=0._wp ; ztj (:,:,:)=0._wp ; zhj (:,: )=0._wp 119 105 ! 120 106 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 121 107 ! 122 !$OMP PARALLEL DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv,zmaxu,zmaxv)123 108 DO jj = 1, jpjm1 124 109 DO ji = 1, jpim1 … … 165 150 ! 166 151 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 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) 152 pgru(:,:) = 0._wp 153 pgrv(:,:) = 0._wp ! depth of the partial step level 177 154 DO jj = 1, jpjm1 178 155 DO ji = 1, jpim1 … … 189 166 END DO 190 167 END DO 191 !$OMP END DO NOWAIT192 !$OMP END PARALLEL193 168 ! 194 169 CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj 195 170 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 196 171 ! 197 !$OMP PARALLEL DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv)198 172 DO jj = 1, jpjm1 ! Gradient of density at the last level 199 173 DO ji = 1, jpim1 -
trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_hgr.F90
r7715 r7753 7 7 !! User defined : mesh and Coriolis parameter of a user configuration 8 8 !!====================================================================== 9 !! History : 4.0! 2016-03 (S. Flavoni)9 !! History : 4.0 ! 2016-03 (S. Flavoni) 10 10 !!---------------------------------------------------------------------- 11 11 … … 103 103 ENDIF 104 104 ! 105 !$OMP PARALLEL106 !$OMP DO schedule(static) private(jj, ji, zim1, zjm1)107 105 DO jj = 1, jpj 108 106 DO ji = 1, jpi … … 131 129 END DO 132 130 END DO 133 !$OMP END DO NOWAIT134 131 ! 135 132 ! !== Horizontal scale factors ==! (in meters) 136 133 ! 137 134 ! ! constant grid spacing 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 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 152 141 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 that 143 pe1e2v(:,:) = 0._wp ! require an initialization of INTENT(out) arguments 153 144 ! 154 145 ! … … 162 153 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 163 154 ! 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 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) 171 157 ! 172 158 IF(lwp) WRITE(numout,*) ' beta-plane used. beta = ', zbeta, ' 1/(s.m)' -
trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_istate.F90
r7715 r7753 7 7 !! User defined : set the initial state of a user configuration 8 8 !!====================================================================== 9 !! History : 4.0 9 !! History : 4.0 ! 2016-03 (S. Flavoni) Original code 10 10 !!---------------------------------------------------------------------- 11 11 … … 55 55 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ Ocean at rest, with an horizontally uniform T and S profiles' 56 56 ! 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 57 pu (:,:,:) = 0._wp ! ocean at rest 58 pv (:,:,:) = 0._wp 59 pssh(:,:) = 0._wp 75 60 ! 76 !$OMP DO schedule(static) private(jk,jj,ji)77 61 DO jk = 1, jpk ! horizontally uniform T & S profiles 78 62 DO jj = 1, jpj … … 95 79 END DO 96 80 END DO 97 !$OMP END PARALLEL98 81 ! 99 82 END SUBROUTINE usr_def_istate -
trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90
r7698 r7753 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)112 111 DO jj = 1, jpj 113 112 DO ji = 1, jpi … … 138 137 139 138 ! freshwater (mass flux) and update of qns with heat content of emp 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 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 148 142 149 143 … … 172 166 ztau_sais = 0.015 173 167 ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi ) 174 !$OMP PARALLEL175 !$OMP DO schedule(static) private(jj, ji)176 168 DO jj = 1, jpj 177 169 DO ji = 1, jpi … … 185 177 ! module of wind stress and wind speed at T-point 186 178 zcoef = 1. / ( zrhoa * zcdrag ) 187 !$OMP DO schedule(static) private(jj, ji, ztx, zty, zmod)188 179 DO jj = 2, jpjm1 189 180 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 195 186 END DO 196 187 END DO 197 !$OMP END PARALLEL198 188 CALL lbc_lnk( taum(:,:), 'T', 1. ) ; CALL lbc_lnk( wndm(:,:), 'T', 1. ) 199 189 -
trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_zgr.F90
r7698 r7753 199 199 ! 200 200 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D local workspace 201 202 INTEGER :: ji, jj203 201 !!---------------------------------------------------------------------- 204 202 ! … … 208 206 IF(lwp) WRITE(numout,*) ' GYRE case : closed flat box ocean without ocean cavities' 209 207 ! 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 208 z2d(:,:) = REAL( jpkm1 , wp ) ! flat bottom 216 209 ! 217 210 CALL lbc_lnk( z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) 218 211 ! 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 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 227 215 ! 228 216 END SUBROUTINE zgr_msk_top_bot … … 246 234 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! - - - 247 235 ! 248 INTEGER :: j i, jj, jk236 INTEGER :: jk 249 237 !!---------------------------------------------------------------------- 250 238 ! 251 239 IF( nn_timing == 1 ) CALL timing_start('zgr_zco') 252 240 ! 253 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)254 241 DO jk = 1, jpk 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 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) 268 251 END DO 269 252 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r7698 r7753 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)109 108 DO jj = 1, jpj 110 109 DO ji = 1, jpi … … 118 117 ! (ISF) 119 118 IF ( ln_isfcav ) THEN 120 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp)121 119 DO jj = 1, jpj 122 120 DO ji = 1, jpi … … 131 129 ! 132 130 ELSE 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) 131 zbfrt(:,:) = bfrcoef2d(:,:) 132 ztfrt(:,:) = tfrcoef2d(:,:) 133 ENDIF 134 143 135 DO jj = 2, jpjm1 144 136 DO ji = 2, jpim1 … … 175 167 176 168 IF( ln_isfcav ) THEN 177 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv,zvu,zuv,zecu,zecv)178 169 DO jj = 2, jpjm1 179 170 DO ji = 2, jpim1 … … 269 260 CASE( 0 ) 270 261 IF(lwp) WRITE(numout,*) ' free-slip ' 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 262 bfrua(:,:) = 0._wp 263 bfrva(:,:) = 0._wp 264 tfrua(:,:) = 0._wp 265 tfrva(:,:) = 0._wp 280 266 ! 281 267 CASE( 1 ) … … 299 285 CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array 300 286 CALL iom_close(inum) 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 287 bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 307 288 ELSE 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 289 bfrcoef2d(:,:) = rn_bfri1 ! initialize bfrcoef2d to the namelist variable 290 ENDIF 291 ! 292 bfrua(:,:) = - bfrcoef2d(:,:) 293 bfrva(:,:) = - bfrcoef2d(:,:) 323 294 ! 324 295 IF ( ln_isfcav ) THEN … … 328 299 CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 329 300 CALL iom_close(inum) 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 301 tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 336 302 ELSE 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 303 tfrcoef2d(:,:) = rn_tfri1 ! initialize tfrcoef2d to the namelist variable 343 304 ENDIF 344 305 ! 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 306 tfrua(:,:) = - tfrcoef2d(:,:) 307 tfrva(:,:) = - tfrcoef2d(:,:) 352 308 END IF 353 309 ! … … 390 346 CALL iom_close(inum) 391 347 ! 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 348 bfrcoef2d(:,:) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 398 349 ELSE 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 350 bfrcoef2d(:,:) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable 405 351 ENDIF 406 352 … … 412 358 CALL iom_close(inum) 413 359 ! 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 360 tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 420 361 ELSE 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 362 tfrcoef2d(:,:) = rn_tfri2 ! initialize tfrcoef2d to the namelist variable 427 363 ENDIF 428 364 END IF 429 365 ! 430 366 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)432 367 DO jj = 1, jpj 433 368 DO ji = 1, jpi … … 439 374 END DO 440 375 IF ( ln_isfcav ) THEN 441 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp)442 376 DO jj = 1, jpj 443 377 DO ji = 1, jpi … … 479 413 zmaxtfr = -1.e10_wp ! initialise tracker for maximum of bottom friction coefficient 480 414 ! 481 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv,zfru,zfrv,ictu,ictv,zminbfr,zmaxbfr,zmintfr,zmaxtfr)482 415 DO jj = 2, jpjm1 483 416 DO ji = 2, jpim1 -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r7698 r7753 112 112 ! Define the mask 113 113 ! --------------- 114 !$OMP PARALLEL115 !$OMP DO schedule(static) private(jj,ji,zrw,zaw,zbw,zdt,zds)116 114 DO jj = 1, jpj ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 117 115 DO ji = 1, jpi … … 130 128 END DO 131 129 END DO 132 !$OMP END DO NOWAIT 133 134 !$OMP DO schedule(static) private(jj,ji) 130 135 131 DO jj = 1, jpj ! indicators: 136 132 DO ji = 1, jpi … … 159 155 END DO 160 156 ! mask zmsk in order to have avt and avs masked 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 157 zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk) 158 168 159 169 160 ! Update avt and avs 170 161 ! ------------------ 171 162 ! Constant eddy coefficient: reset to the background value 172 !$OMP DO schedule(static) private(jj,ji,zinr,zrr,zavfs,zavft,zavdt,zavds)173 163 DO jj = 1, jpj 174 164 DO ji = 1, jpi … … 199 189 ! -------------------------------- 200 190 !!gm to be changed following the definition of avm. 201 !$OMP DO schedule(static) private(jj,ji)202 191 DO jj = 1, jpjm1 203 192 DO ji = 1, fs_jpim1 ! vector opt. … … 210 199 END DO 211 200 END DO 212 !$OMP END DO NOWAIT213 !$OMP END PARALLEL214 201 ! ! =============== 215 202 END DO ! End of slab … … 245 232 !!---------------------------------------------------------------------- 246 233 INTEGER :: ios ! local integer 247 INTEGER :: ji, jj , jk ! dummy loop indices248 234 !! 249 235 NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr … … 271 257 IF( zdf_ddm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' ) 272 258 ! ! initialization to masked Kz 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 259 avs(:,:,:) = rn_avt0 * wmask(:,:,:) 281 260 ! 282 261 END SUBROUTINE zdf_ddm_init -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r7698 r7753 70 70 CALL wrk_alloc( jpi,jpj,jpk, zavt_evd, zavm_evd ) 71 71 ! 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 72 zavt_evd(:,:,:) = avt(:,:,:) ! set avt prior to evd application 80 73 ! 81 74 SELECT CASE ( nn_evdm ) … … 83 76 CASE ( 1 ) ! enhance vertical eddy viscosity and diffusivity (if rn2<-1.e-12) 84 77 ! 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 78 zavm_evd(:,:,:) = avm(:,:,:) ! set avm prior to evd application 94 79 ! 95 !$OMP DO schedule(static) private(jk, jj, ji)96 80 DO jk = 1, jpkm1 97 81 DO jj = 2, jpj ! no vector opt. … … 108 92 END DO 109 93 END DO 110 !$OMP END PARALLEL111 94 CALL lbc_lnk( avt , 'W', 1. ) ; CALL lbc_lnk( avm , 'W', 1. ) ! Lateral boundary conditions 112 95 CALL lbc_lnk( avmu, 'U', 1. ) ; CALL lbc_lnk( avmv, 'V', 1. ) 113 96 ! 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 97 zavm_evd(:,:,:) = avm(:,:,:) - zavm_evd(:,:,:) ! change in avm due to evd 122 98 CALL iom_put( "avm_evd", zavm_evd ) ! output this change 123 99 ! 124 100 CASE DEFAULT ! enhance vertical eddy diffusivity only (if rn2<-1.e-12) 125 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)126 101 DO jk = 1, jpkm1 127 102 !!! WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd ! agissant sur T SEUL! … … 136 111 END SELECT 137 112 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 113 zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:) ! change in avt due to evd 146 114 CALL iom_put( "avt_evd", zavt_evd ) ! output this change 147 115 IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r7698 r7753 96 96 97 97 ! w-level of the mixing and mixed layers 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 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 107 101 DO jk = nlb10, jpkm1 108 !$OMP DO schedule(static) private(jj, ji, ikt)109 102 DO jj = 1, jpj ! Mixed layer level: w-level 110 103 DO ji = 1, jpi … … 117 110 ! 118 111 ! w-level of the turbocline and mixing layer (iom_use) 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 112 imld(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point 125 113 DO jk = jpkm1, nlb10, -1 ! from the bottom to nlb10 126 !$OMP DO schedule(static) private(jj, ji)127 114 DO jj = 1, jpj 128 115 DO ji = 1, jpi … … 132 119 END DO 133 120 ! depth of the mixing and mixed layers 134 !$OMP DO schedule(static) private(jj, ji, iiki, iikn)135 121 DO jj = 1, jpj 136 122 DO ji = 1, jpi … … 142 128 END DO 143 129 END DO 144 !$OMP END PARALLEL145 130 ! 146 131 IF( .NOT.l_offline ) THEN -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r7698 r7753 171 171 !!---------------------------------------------------------------------- 172 172 INTEGER, INTENT(in) :: kt ! ocean time step 173 INTEGER :: jk, jj, ji174 173 !!---------------------------------------------------------------------- 175 174 ! … … 180 179 ! 181 180 IF( kt /= nit000 ) THEN ! restore before value to compute tke 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 181 avt (:,:,:) = avt_k (:,:,:) 182 avm (:,:,:) = avm_k (:,:,:) 183 avmu(:,:,:) = avmu_k(:,:,:) 184 avmv(:,:,:) = avmv_k(:,:,:) 193 185 ENDIF 194 186 ! … … 197 189 CALL tke_avn ! now avt, avm, avmu, avmv 198 190 ! 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 191 avt_k (:,:,:) = avt (:,:,:) 192 avm_k (:,:,:) = avm (:,:,:) 193 avmu_k(:,:,:) = avmu(:,:,:) 194 avmv_k(:,:,:) = avmv(:,:,:) 210 195 ! 211 196 #if defined key_agrif … … 268 253 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 269 254 IF ( ln_isfcav ) THEN 270 !$OMP PARALLEL DO schedule(static) private(jj, ji)271 255 DO jj = 2, jpjm1 ! en(mikt(ji,jj)) = rn_emin 272 256 DO ji = fs_2, fs_jpim1 ! vector opt. … … 275 259 END DO 276 260 END IF 277 !$OMP PARALLEL DO schedule(static) private(jj, ji)278 261 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 279 262 DO ji = fs_2, fs_jpim1 ! vector opt. … … 310 293 ! 311 294 ! !* total energy produce by LC : cumulative sum over jk 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 295 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * gdepw_n(:,:,1) * e3w_n(:,:,1) 319 296 DO jk = 2, jpk 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 297 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw_n(:,:,jk) * e3w_n(:,:,jk) 326 298 END DO 327 299 ! !* finite Langmuir Circulation depth 328 300 zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 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 301 imlc(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point (=2 over land) 335 302 DO jk = jpkm1, 2, -1 336 !$OMP DO schedule(static) private(jj, ji, zus)337 303 DO jj = 1, jpj ! Last w-level at which zpelc>=0.5*us*us 338 304 DO ji = 1, jpi ! with us=0.016*wind(starting from jpk-1) … … 343 309 END DO 344 310 ! ! finite LC depth 345 !$OMP DO schedule(static) private(jj, ji)346 311 DO jj = 1, jpj 347 312 DO ji = 1, jpi … … 350 315 END DO 351 316 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 352 !$OMP DO schedule(static) private(jk, jj, ji, zus, zind, zwlc)353 317 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 354 318 DO jj = 2, jpjm1 … … 364 328 END DO 365 329 END DO 366 !$OMP END PARALLEL367 330 ! 368 331 ENDIF … … 375 338 ! ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal 376 339 ! 377 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)378 340 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 379 341 DO jj = 1, jpjm1 … … 394 356 ! Note that zesh2 is also computed in the next loop. 395 357 ! 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)397 358 DO jk = 2, jpkm1 398 359 DO jj = 2, jpjm1 … … 411 372 ENDIF 412 373 ! 413 !$OMP PARALLEL414 !$OMP DO schedule(static) private(jk, jj, ji, zcof, zzd_up, zzd_lw, zesh2)415 374 DO jk = 2, jpkm1 !* Matrix and right hand side in en 416 375 DO jj = 2, jpjm1 … … 446 405 ! !* Matrix inversion from level 2 (tke prescribed at level 1) 447 406 DO jk = 3, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 448 !$OMP DO schedule(static) private(jj, ji)449 407 DO jj = 2, jpjm1 450 408 DO ji = fs_2, fs_jpim1 ! vector opt. … … 453 411 END DO 454 412 END DO 455 !$OMP DO schedule(static) private(jj, ji)456 413 DO jj = 2, jpjm1 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 457 414 DO ji = fs_2, fs_jpim1 ! vector opt. … … 460 417 END DO 461 418 DO jk = 3, jpkm1 462 !$OMP DO schedule(static) private(jj, ji)463 419 DO jj = 2, jpjm1 464 420 DO ji = fs_2, fs_jpim1 ! vector opt. … … 467 423 END DO 468 424 END DO 469 !$OMP DO schedule(static) private(jj, ji)470 425 DO jj = 2, jpjm1 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 471 426 DO ji = fs_2, fs_jpim1 ! vector opt. … … 474 429 END DO 475 430 DO jk = jpk-2, 2, -1 476 !$OMP DO schedule(static) private(jj, ji)477 431 DO jj = 2, jpjm1 478 432 DO ji = fs_2, fs_jpim1 ! vector opt. … … 481 435 END DO 482 436 END DO 483 !$OMP DO schedule(static) private(jk,jj, ji)484 437 DO jk = 2, jpkm1 ! set the minimum value of tke 485 438 DO jj = 2, jpjm1 … … 489 442 END DO 490 443 END DO 491 !$OMP END PARALLEL492 444 493 445 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 498 450 499 451 IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction) 500 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)501 452 DO jk = 2, jpkm1 502 453 DO jj = 2, jpjm1 … … 508 459 END DO 509 460 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)511 461 DO jj = 2, jpjm1 512 462 DO ji = fs_2, fs_jpim1 ! vector opt. … … 517 467 END DO 518 468 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)520 469 DO jk = 2, jpkm1 521 470 DO jj = 2, jpjm1 … … 596 545 ! 597 546 ! initialisation of interior minimum value (avoid a 2d loop with mikt) 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 547 zmxlm(:,:,:) = rmxl_min 548 zmxld(:,:,:) = rmxl_min 607 549 ! 608 550 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)610 551 DO jj = 2, jpjm1 611 552 DO ji = fs_2, fs_jpim1 … … 615 556 END DO 616 557 ELSE 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 558 zmxlm(:,:,1) = rn_mxl0 623 559 ENDIF 624 560 ! 625 !$OMP PARALLEL626 !$OMP DO schedule(static) private(jk, jj, ji, zrn2)627 561 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 628 562 DO jj = 2, jpjm1 … … 636 570 ! !* Physical limits for the mixing length 637 571 ! 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 572 zmxld(:,:, 1 ) = zmxlm(:,:,1) ! surface set to the minimum value 573 zmxld(:,:,jpk) = rmxl_min ! last level set to the minimum value 646 574 ! 647 575 SELECT CASE ( nn_mxl ) … … 650 578 ! where wmask = 0 set zmxlm == e3w_n 651 579 CASE ( 0 ) ! bounded by the distance to surface and bottom 652 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl)653 580 DO jk = 2, jpkm1 654 581 DO jj = 2, jpjm1 … … 664 591 ! 665 592 CASE ( 1 ) ! bounded by the vertical scale factor 666 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl)667 593 DO jk = 2, jpkm1 668 594 DO jj = 2, jpjm1 … … 676 602 ! 677 603 CASE ( 2 ) ! |dk[xml]| bounded by e3t : 678 !$OMP PARALLEL679 604 DO jk = 2, jpkm1 ! from the surface to the bottom : 680 !$OMP DO schedule(static) private(jj, ji)681 605 DO jj = 2, jpjm1 682 606 DO ji = fs_2, fs_jpim1 ! vector opt. … … 686 610 END DO 687 611 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : 688 !$OMP DO schedule(static) private(jj, ji, zemxl)689 612 DO jj = 2, jpjm1 690 613 DO ji = fs_2, fs_jpim1 ! vector opt. … … 695 618 END DO 696 619 END DO 697 !$OMP END PARALLEL698 620 ! 699 621 CASE ( 3 ) ! lup and ldown, |dk[xml]| bounded by e3t : 700 !$OMP PARALLEL701 622 DO jk = 2, jpkm1 ! from the surface to the bottom : lup 702 !$OMP DO schedule(static) private(jj, ji)703 623 DO jj = 2, jpjm1 704 624 DO ji = fs_2, fs_jpim1 ! vector opt. … … 708 628 END DO 709 629 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : ldown 710 !$OMP DO schedule(static) private(jj, ji)711 630 DO jj = 2, jpjm1 712 631 DO ji = fs_2, fs_jpim1 ! vector opt. … … 715 634 END DO 716 635 END DO 717 !$OMP DO schedule(static) private(jk, jj, ji, zemlm, zemlp)718 636 DO jk = 2, jpkm1 719 637 DO jj = 2, jpjm1 … … 726 644 END DO 727 645 END DO 728 !$OMP END PARALLEL729 646 ! 730 647 END SELECT 731 648 ! 732 649 # if defined key_c1d 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 650 e_dis(:,:,:) = zmxld(:,:,:) ! c1d configuration : save mixing and dissipation turbulent length scales 651 e_mix(:,:,:) = zmxlm(:,:,:) 742 652 # endif 743 653 … … 745 655 ! ! Vertical eddy viscosity and diffusivity (avmu, avmv, avt) 746 656 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 747 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zsqen, zav)748 657 DO jk = 1, jpkm1 !* vertical eddy viscosity & diffivity at w-points 749 658 DO jj = 2, jpjm1 … … 759 668 CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 760 669 ! 761 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)762 670 DO jk = 2, jpkm1 !* vertical eddy viscosity at wu- and wv-points 763 671 DO jj = 2, jpjm1 … … 771 679 ! 772 680 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt 773 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)774 681 DO jk = 2, jpkm1 775 682 DO jj = 2, jpjm1 … … 891 798 SELECT CASE( nn_htau ) ! Choice of the depth of penetration 892 799 CASE( 0 ) ! constant depth penetration (here 10 meters) 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 800 htau(:,:) = 10._wp 899 801 CASE( 1 ) ! F(latitude) : 0.5m to 30m poleward of 40 degrees 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 802 htau(:,:) = MAX( 0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(:,:) ) ) ) ) 906 803 END SELECT 907 804 ENDIF 908 805 ! !* set vertical eddy coef. to the background value 909 !$OMP PARALLEL910 !$OMP DO schedule(static) private(jk,jj,ji)911 806 DO jk = 1, jpk 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 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 931 813 ! 932 814 CALL tke_rst( nit000, 'READ' ) !* read or initialize all required files … … 948 830 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 949 831 ! 950 INTEGER :: jit, jk , jj, ji! dummy loop indices832 INTEGER :: jit, jk ! dummy loop indices 951 833 INTEGER :: id1, id2, id3, id4, id5, id6 ! local integers 952 834 !!---------------------------------------------------------------------- … … 975 857 ELSE ! No TKE array found: initialisation 976 858 IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without tke scheme, en computed by iterative loop' 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 859 en (:,:,:) = rn_emin * tmask(:,:,:) 985 860 CALL tke_avn ! recompute avt, avm, avmu, avmv and dissl (approximation) 986 861 ! 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 862 avt_k (:,:,:) = avt (:,:,:) 863 avm_k (:,:,:) = avm (:,:,:) 864 avmu_k(:,:,:) = avmu(:,:,:) 865 avmv_k(:,:,:) = avmv(:,:,:) 998 866 ! 999 867 DO jit = nit000 + 1, nit000 + 10 ; CALL zdf_tke( jit ) ; END DO 1000 868 ENDIF 1001 869 ELSE !* Start from rest 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 870 en(:,:,:) = rn_emin * tmask(:,:,:) 871 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) 1010 876 END DO 1011 !$OMP END DO NOWAIT1012 !$OMP DO schedule(static) private(jk)1013 DO jk = 1, jpk ! set the Kz to the background value1014 DO jj = 1, jpj1015 DO ji = 1, jpi1016 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 DO1021 END DO1022 END DO1023 !$OMP END PARALLEL1024 877 ENDIF 1025 878 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r7698 r7753 121 121 ! ! ----------------------- ! 122 122 ! !* First estimation (with n2 bound by rn_n2min) bounded by 60 cm2/s 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 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 140 126 DO jk = 2, jpkm1 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) 127 zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 128 END DO 129 150 130 DO jj = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 151 131 DO ji = 1, jpi … … 155 135 156 136 DO jk = 2, jpkm1 !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s 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 137 zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk) !kz max = 300 cm2/s 138 END DO 165 139 166 140 IF( kt == nit000 ) THEN !* check at first time-step: diagnose the energy consumed by zav_tide 167 141 ztpc = 0._wp 168 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc)169 142 DO jk= 1, jpk 170 143 DO jj= 1, jpj … … 189 162 ! ! Update mixing coefs ! 190 163 ! ! ----------------------- ! 191 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)192 164 DO jk = 2, jpkm1 !* update momentum & tracer diffusivity with tidal mixing 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 165 avt(:,:,jk) = avt(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 166 avm(:,:,jk) = avm(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 199 167 DO jj = 2, jpjm1 200 168 DO ji = fs_2, fs_jpim1 ! vector opt. … … 257 225 258 226 ! ! compute the form function using N2 at each time step 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) 227 zempba_3d_1(:,:,jpk) = 0.e0 228 zempba_3d_2(:,:,jpk) = 0.e0 268 229 DO jk = 1, jpkm1 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 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 287 238 DO jk= 2, jpk 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) 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 297 242 DO jj = 1, jpj 298 243 DO ji = 1, jpi … … 303 248 304 249 DO jk= 1, jpk 305 !$OMP DO schedule(static) private(jj,ji,zcoef,ztpc)306 250 DO jj = 1, jpj 307 251 DO ji = 1, jpi … … 315 259 END DO 316 260 END DO 317 !$OMP DO schedule(static) private(jj,ji)318 261 DO jj = 1, jpj 319 262 DO ji = 1, jpi … … 324 267 ! ! first estimation bounded by 10 cm2/s (with n2 bounded by rn_n2min) 325 268 zcoef = rn_tfe_itf / ( rn_tfe * rau0 ) 326 !$OMP DO schedule(static) private(jk,jj,ji)327 269 DO jk = 1, jpk 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 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 342 275 DO jk = 2, jpkm1 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) 276 zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk) 277 END DO 278 352 279 DO jj = 1, jpj ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 353 280 DO ji = 1, jpi … … 356 283 END DO 357 284 358 !$OMP DO schedule(static) private(jk,jj,ji)359 285 DO jk = 2, jpkm1 ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s 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 286 zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * wmask(:,:,jk) ! kz max = 120 cm2/s 287 END DO 367 288 368 289 IF( kt == nit000 ) THEN ! diagnose the nergy consumed by zavt_itf 369 290 ztpc = 0.e0 370 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc)371 291 DO jk= 1, jpk 372 292 DO jj= 1, jpj … … 383 303 384 304 ! ! Update pav with the ITF mixing coefficient 385 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)386 305 DO jk = 2, jpkm1 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 306 pav(:,:,jk) = pav (:,:,jk) * ( 1.e0 - mask_itf(:,:) ) & 307 & + zavt_itf(:,:,jk) * mask_itf(:,:) 393 308 END DO 394 309 ! … … 494 409 ! ! only the energy available for mixing is taken into account, 495 410 ! ! (mixing efficiency tidal dissipation efficiency) 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 411 en_tmx(:,:) = - rn_tfe * rn_me * ( zem2(:,:) * 1.25 + zek1(:,:) ) * ssmask(:,:) 504 412 505 413 !============ … … 508 416 !! the error is thus ~1% which I feel comfortable with, compared to uncertainties in tidal energy dissipation. 509 417 ! ! Vertical structure (az_tmx) 510 !$OMP DO schedule(static) private(jj, ji)511 418 DO jj = 1, jpj ! part independent of the level 512 419 DO ji = 1, jpi … … 516 423 END DO 517 424 END DO 518 !$OMP DO schedule(static) private(jk, jj, ji)519 425 DO jk= 1, jpk ! complete with the level-dependent part 520 426 DO jj = 1, jpj … … 524 430 END DO 525 431 END DO 526 !$OMP END PARALLEL527 432 !=========== 528 433 ! … … 531 436 ! Total power consumption due to vertical mixing 532 437 ! zpc = rau0 * 1/rn_me * rn2 * zav_tide 438 zav_tide(:,:,:) = 0.e0 439 DO jk = 2, jpkm1 440 zav_tide(:,:,jk) = az_tmx(:,:,jk) / MAX( rn_n2min, rn2(:,:,jk) ) 441 END DO 442 ! 533 443 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) 544 DO jk = 2, jpkm1 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 550 END DO 551 ! 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) 444 zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:) 561 445 DO jk= 2, jpkm1 562 446 DO jj = 1, jpj … … 566 450 END DO 567 451 END DO 568 !$OMP END PARALLEL569 452 IF( lk_mpp ) CALL mpp_sum( ztpc ) 570 453 ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc … … 574 457 ! 575 458 ! control print 2 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 459 zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 ) 460 zkz(:,:) = 0._wp 587 461 DO jk = 2, jpkm1 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 462 zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 594 463 END DO 595 464 ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz 596 !$OMP DO schedule(static) private(jj, ji)597 465 DO jj = 1, jpj 598 466 DO ji = 1, jpi … … 603 471 END DO 604 472 ztpc = 1.e50 605 !$OMP DO schedule(static) private(jj, ji, ztpc)606 473 DO jj = 1, jpj 607 474 DO ji = 1, jpi … … 611 478 END DO 612 479 END DO 613 !$OMP END PARALLEL614 480 WRITE(numout,*) ' Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) ) 615 !$OMP PARALLEL616 481 ! 617 !$OMP DO schedule(static) private(jk,jj,ji)618 482 DO jk = 2, jpkm1 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 483 zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk) !kz max = 300 cm2/s 624 484 END DO 625 485 ztpc = 0._wp 626 !$OMP DO schedule(static) private(jk, jj, ji) 627 DO jk= 1, jpk 628 DO jj = 1, jpj 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) 486 zpc(:,:,:) = Max(0.e0,rn2(:,:,:)) * zav_tide(:,:,:) 635 487 DO jk= 1, jpk 636 488 DO jj = 1, jpj … … 640 492 END DO 641 493 END DO 642 !$OMP END PARALLEL643 494 IF( lk_mpp ) CALL mpp_sum( ztpc ) 644 495 ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc … … 649 500 & / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) ) 650 501 ztpc = 1.e50 651 !$OMP PARALLEL DO schedule(static) private(ztpc, jj, ji)652 502 DO jj = 1, jpj 653 503 DO ji = 1, jpi … … 663 513 WRITE(numout,*) ' Initial profile of tidal vertical mixing' 664 514 DO jk = 1, jpk 665 !$OMP PARALLEL DO schedule(static) private(jj, ji)666 515 DO jj = 1,jpj 667 516 DO ji = 1,jpi … … 674 523 END DO 675 524 DO jk = 1, jpk 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 525 zkz(:,:) = az_tmx(:,:,jk) /rn_n2min 682 526 ze_z = SUM( e1e2t(:,:) * zkz (:,:) * tmask_i(:,:) ) & 683 527 & / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) ) … … 845 689 ! !* Critical slope mixing: distribute energy over the time-varying ocean depth, 846 690 ! using an exponential decay from the seafloor. 847 !$OMP PARALLEL848 !$OMP DO schedule(static) private(jj,ji)849 691 DO jj = 1, jpj ! part independent of the level 850 692 DO ji = 1, jpi … … 855 697 END DO 856 698 857 !$OMP DO schedule(static) private(jk,jj,ji)858 699 DO jk = 2, jpkm1 ! complete with the level-dependent part 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 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 868 704 869 705 ! !* Pycnocline-intensified mixing: distribute energy over the time-varying … … 874 710 CASE ( 1 ) ! Dissipation scales as N (recommended) 875 711 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 712 zfact(:,:) = 0._wp 883 713 DO jk = 2, jpkm1 ! part independent of the level 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) 714 zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 715 END DO 716 893 717 DO jj = 1, jpj 894 718 DO ji = 1, jpi … … 897 721 END DO 898 722 899 !$OMP DO schedule(static) private(jk,jj,ji)900 723 DO jk = 2, jpkm1 ! complete with the level-dependent part 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 724 emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 725 END DO 908 726 909 727 CASE ( 2 ) ! Dissipation scales as N^2 910 728 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) 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 929 734 DO jj= 1, jpj 930 735 DO ji = 1, jpi … … 933 738 END DO 934 739 935 !$OMP DO schedule(static) private(jk,jj,ji)936 740 DO jk = 2, jpkm1 ! complete with the level-dependent part 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 741 emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 742 END DO 944 743 945 744 END SELECT … … 948 747 ! !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 949 748 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 749 zwkb(:,:,:) = 0._wp 750 zfact(:,:) = 0._wp 965 751 DO jk = 2, jpkm1 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) 752 zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 753 zwkb(:,:,jk) = zfact(:,:) 754 END DO 755 976 756 DO jk = 2, jpkm1 977 757 DO jj = 1, jpj … … 982 762 END DO 983 763 END DO 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) 764 zwkb(:,:,1) = zhdep(:,:) * tmask(:,:,1) 765 766 zweight(:,:,:) = 0._wp 1002 767 DO jk = 2, jpkm1 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 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 1018 773 DO jk = 2, jpkm1 ! part independent of the level 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) 774 zfact(:,:) = zfact(:,:) + zweight(:,:,jk) 775 END DO 776 1028 777 DO jj = 1, jpj 1029 778 DO ji = 1, jpi … … 1032 781 END DO 1033 782 1034 !$OMP DO schedule(static) private(jk,jj,ji)1035 783 DO jk = 2, jpkm1 ! complete with the level-dependent part 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 784 emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk) & 785 & / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 786 END DO 1044 787 1045 788 1046 789 ! Calculate molecular kinematic viscosity 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) 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 1056 792 DO jk = 2, jpkm1 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 793 znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) 1062 794 END DO 1063 795 1064 796 ! Calculate turbulence intensity parameter Reb 1065 !$OMP DO schedule(static) private(jk,jj,ji)1066 797 DO jk = 2, jpkm1 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 798 zReb(:,:,jk) = emix_tmx(:,:,jk) / MAX( 1.e-20_wp, znu_w(:,:,jk) * rn2(:,:,jk) ) 1072 799 END DO 1073 800 1074 801 ! Define internal wave-induced diffusivity 1075 !$OMP DO schedule(static) private(jk,jj,ji)1076 802 DO jk = 2, jpkm1 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 803 zav_wave(:,:,jk) = znu_w(:,:,jk) * zReb(:,:,jk) * r1_6 ! This corresponds to a constant mixing efficiency of 1/6 804 END DO 1084 805 1085 806 IF( ln_mevar ) THEN ! Variable mixing efficiency case : modify zav_wave in the 1086 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)1087 807 DO jk = 2, jpkm1 ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 1088 808 DO jj = 1, jpj … … 1098 818 ENDIF 1099 819 1100 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)1101 820 DO jk = 2, jpkm1 ! Bound diffusivity by molecular value and 100 cm2/s 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 821 zav_wave(:,:,jk) = MIN( MAX( 1.4e-7_wp, zav_wave(:,:,jk) ), 1.e-2_wp ) * wmask(:,:,jk) 1107 822 END DO 1108 823 1109 824 IF( kt == nit000 ) THEN !* Control print at first time-step: diagnose the energy consumed by zav_wave 1110 825 ztpc = 0._wp 1111 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc)1112 826 DO jk = 2, jpkm1 1113 827 DO jj = 1, jpj … … 1135 849 ! 1136 850 IF( ln_tsdiff ) THEN !* Option for differential mixing of salinity and temperature 1137 !$OMP PARALLEL1138 !$OMP DO schedule(static) private(jk,jj,ji)1139 851 DO jk = 2, jpkm1 ! Calculate S/T diffusivity ratio as a function of Reb 1140 852 DO jj = 1, jpj … … 1146 858 END DO 1147 859 END DO 1148 !$OMP DO schedule(static) private(jk,jj,ji)860 CALL iom_put( "av_ratio", zav_ratio ) 1149 861 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 1159 CALL iom_put( "av_ratio", zav_ratio ) 862 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 DO 1160 866 ! 1161 867 ELSE !* update momentum & tracer diffusivity with wave-driven mixing 1162 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)1163 868 DO jk = 2, jpkm1 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 1171 END DO 1172 ENDIF 1173 1174 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 869 fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 870 avt (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 871 avm (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk) 872 END DO 873 ENDIF 874 1175 875 DO jk = 2, jpkm1 !* update momentum diffusivity at wu and wv points 1176 876 DO jj = 2, jpjm1 … … 1188 888 ! vertical integral of rau0 * Kz * N^2 (pcmap_tmx), energy density (emix_tmx) 1189 889 IF( iom_use("bflx_tmx") .OR. iom_use("pcmap_tmx") ) THEN 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 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(:,:) 1221 896 CALL iom_put( "bflx_tmx", bflx_tmx ) 1222 897 CALL iom_put( "pcmap_tmx", pcmap_tmx ) … … 1295 970 avmb(:) = 1.4e-6_wp ! viscous molecular value 1296 971 avtb(:) = 1.e-10_wp ! very small diffusive minimum (background avt is specified in zdf_tmx) 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 972 avtb_2d(:,:) = 1.e0_wp ! uniform 1303 973 IF(lwp) THEN ! Control print 1304 974 WRITE(numout,*) … … 1333 1003 CALL iom_close(inum) 1334 1004 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 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 1351 1016 1352 1017 zbot = glob_sum( e1e2t(:,:) * ebot_tmx(:,:) ) -
trunk/NEMOGCM/NEMO/OPA_SRC/step.F90
r7698 r7753 74 74 !! -8- Outputs and diagnostics 75 75 !!---------------------------------------------------------------------- 76 INTEGER :: ji,jj,jk ,jn! dummy loop indice76 INTEGER :: ji,jj,jk ! 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 !$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 137 avt (:,:,:) = rn_avt0 * wmask (:,:,:) 138 avmu(:,:,:) = rn_avm0 * wumask(:,:,:) 139 avmv(:,:,:) = rn_avm0 * wvmask(:,:,:) 147 140 ENDIF 148 141 149 142 IF( ln_rnf_mouth ) THEN ! increase diffusivity at rivers mouths 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 143 DO jk = 2, nkrnf ; avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk) ; END DO 158 144 ENDIF 159 145 IF( ln_zdfevd ) CALL zdf_evd( kstp ) ! enhanced vertical eddy diffusivity … … 211 197 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the first ocean level 212 198 !!jc: fs simplification 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 199 200 ua(:,:,:) = 0._wp ! set dynamics trends to zero 201 va(:,:,:) = 0._wp 222 202 223 203 IF( lk_asminc .AND. ln_asmiau .AND. ln_dyninc ) & … … 272 252 ! Active tracers 273 253 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 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 254 tsa(:,:,:,:) = 0._wp ! set tracer trends to zero 284 255 285 256 IF( lk_asminc .AND. ln_asmiau .AND. & -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zagg.F90
r7698 r7753 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)59 58 DO jk = 1, jpkm1 60 59 DO jj = 1, jpj … … 103 102 ELSE ! ln_p5z 104 103 ! 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)107 104 DO jk = 1, jpkm1 108 105 DO jj = 1, jpj -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r7698 r7753 66 66 ! OF PHYTOPLANKTON AND DETRITUS 67 67 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 68 xdiss(:,:,:) = 1. 77 69 !!gm the use of nmld should be better here? 78 !$OMP DO schedule(static) private(jk,jj,ji)79 70 DO jk = 2, jpkm1 80 71 DO jj = 1, jpj … … 85 76 END DO 86 77 END DO 87 !$OMP END PARALLEL88 78 89 79 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r7698 r7753 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 !$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 167 salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 175 168 ELSE 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 169 salinprac(:,:,:) = tsn(:,:,:,jp_sal) 184 170 ENDIF 185 171 … … 190 176 ! 0.04°C relative to an exact computation 191 177 ! --------------------------------------------------------------------- 192 !$OMP PARALLEL193 !$OMP DO schedule(static) private(jk,jj,ji,zpres,za1,za2)194 178 DO jk = 1, jpk 195 179 DO jj = 1, jpj … … 206 190 ! ---------------------------------- 207 191 !CDIR NOVERRCHK 208 !$OMP DO schedule(static) private(jj,ji,ztkel,zt,zsal,zcek1)209 192 DO jj = 1, jpj 210 193 !CDIR NOVERRCHK … … 228 211 ! ------------------------------- 229 212 !CDIR NOVERRCHK 230 !$OMP DO schedule(static) private(jk,jj,ji,ztkel,zsal,zsal2,ztgg,ztgg2,ztgg3,ztgg4,ztgg5,zoxy)231 213 DO jk = 1, jpk 232 214 !CDIR NOVERRCHK … … 257 239 ! ------------------------------- 258 240 !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)261 241 DO jk = 1, jpk 262 242 !CDIR NOVERRCHK … … 466 446 END DO 467 447 END DO 468 !$OMP END PARALLEL469 448 ! 470 449 IF( nn_timing == 1 ) CALL timing_stop('p4z_che') … … 494 473 IF( nn_timing == 1 ) CALL timing_start('ahini_for_at') 495 474 ! 496 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,p_alkcb,p_dictot,p_bortot,zca1,zba1,za2,za1,za0,zd,zsqrtd,zhmin)497 475 DO jk = 1, jpk 498 476 DO jj = 1, jpj … … 537 515 ! 538 516 END SUBROUTINE ahini_for_at 517 539 518 !=============================================================================== 540 519 SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) … … 547 526 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 548 527 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 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 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(:,:,:) 561 533 562 534 END SUBROUTINE anw_infsup … … 599 571 CALL anw_infsup( zalknw_inf, zalknw_sup ) 600 572 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 573 rmask(:,:,:) = tmask(:,:,:) 574 zhi(:,:,:) = 0. 611 575 612 576 ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 613 !$OMP DO schedule(static) private(jk,jj,ji,p_alktot,aphscale,zh_ini,zdelta)614 577 DO jk = 1, jpk 615 578 DO jj = 1, jpj … … 642 605 END DO 643 606 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 607 zeqn_absmin(:,:,:) = HUGE(1._wp) 652 608 653 609 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)659 610 DO jk = 1, jpk 660 611 DO jj = 1, jpj … … 845 796 END DO 846 797 END DO 847 !$OMP END PARALLEL848 798 ! 849 799 CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r7698 r7753 83 83 ! Allocate temporary workspace 84 84 CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 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 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 95 96 96 97 ! Total ligand concentration : Ligands can be chosen to be constant or variable … … 98 99 ! ------------------------------------------------- 99 100 IF( ln_ligvar ) THEN 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 101 ztotlig(:,:,:) = 0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9 102 ztotlig(:,:,:) = MIN( ztotlig(:,:,:), 10. ) 109 103 ELSE 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 104 IF( ln_ligand ) THEN ; ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9 105 ELSE ; ztotlig(:,:,:) = ligand * 1E9 128 106 ENDIF 129 107 ENDIF 130 108 131 109 IF( ln_fechem ) THEN 132 CALL wrk_alloc( jpi, jpj, zstrn, zstrn2 )133 CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP )134 110 ! compute the day length depending on latitude and the day 135 111 zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 136 112 zcodel = ASIN( SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp ) ) 137 113 138 !$OMP PARALLEL139 !$OMP DO schedule(static) private(jk,jj,ji)140 DO jk = 1, jpk141 DO jj = 1, jpj142 DO ji = 1, jpi143 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 DO148 END DO149 END DO150 114 ! day length in hours 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) 115 zstrn(:,:) = 0. 158 116 DO jj = 1, jpj 159 117 DO ji = 1, jpi … … 165 123 166 124 ! Maximum light intensity 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 125 zstrn2(:,:) = zstrn(:,:) / 24. 126 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 127 zstrn(:,:) = 24. / zstrn(:,:) 175 128 176 129 ! ------------------------------------------------------------ … … 180 133 ! ------------------------------------------------------------ 181 134 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)185 135 DO jk = 1, jpkm1 186 136 DO jj = 1, jpj … … 263 213 END DO 264 214 END DO 265 !$OMP END PARALLEL266 215 ELSE 267 216 ! ------------------------------------------------------------ … … 270 219 ! Chemistry is supposed to be fast enough to be at equilibrium 271 220 ! ------------------------------------------------------------ 272 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zkeq,zfesatur,ztfe)273 221 DO jk = 1, jpkm1 274 222 DO jj = 1, jpj … … 291 239 292 240 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)295 241 DO jk = 1, jpkm1 296 242 DO jj = 1, jpj … … 362 308 ! Define the bioavailable fraction of iron 363 309 ! ---------------------------------------- 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 310 IF( ln_fechem ) THEN ; biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 311 ELSE ; biron(:,:,:) = trb(:,:,:,jpfer) 382 312 ENDIF 383 313 ! 384 314 IF( ln_ligand ) THEN 385 315 ! 386 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zlam1a,zlam1b,zligco,zaggliga,zaggligb)387 316 DO jk = 1, jpkm1 388 317 DO jj = 1, jpj … … 402 331 ! 403 332 IF( .NOT.ln_fechem) THEN 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 333 plig(:,:,:) = MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 334 plig(:,:,:) = MAX( 0. , plig(:,:,:) ) 413 335 ENDIF 414 336 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r7698 r7753 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 !$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) 107 satmco2(:,:) = atcco2 108 ENDIF 109 110 IF( l_co2cpl ) satmco2(:,:) = atm_co2(:,:) 111 126 112 DO jj = 1, jpj 127 113 DO ji = 1, jpi … … 142 128 ! ------------------------------------------- 143 129 144 !$OMP DO schedule(static) private(jj,ji,ztc,ztc2,ztc3,ztc4,zsch_co2,zsch_o2,zws,zkgwan)145 130 DO jj = 1, jpj 146 131 DO ji = 1, jpi … … 164 149 165 150 166 !$OMP DO schedule(static) private(jj,ji,ztkel,zsal,zvapsw,zxc2,zfugcoeff,zfco2,zfld,zflu,zflu16)167 151 DO jj = 1, jpj 168 152 DO ji = 1, jpi … … 190 174 END DO 191 175 END DO 192 !$OMP END PARALLEL193 176 194 177 t_oce_co2_flx = glob_sum( oce_co2(:,:) ) ! Total Flux of Carbon … … 206 189 CALL wrk_alloc( jpi, jpj, zw2d ) 207 190 IF( iom_use( "Cflx" ) ) THEN 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 191 zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r 214 192 CALL iom_put( "Cflx" , zw2d ) 215 193 ENDIF 216 194 IF( iom_use( "Oflx" ) ) THEN 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 195 zw2d(:,:) = zoflx(:,:) * 1000 * tmask(:,:,1) 223 196 CALL iom_put( "Oflx" , zw2d ) 224 197 ENDIF 225 198 IF( iom_use( "Kg" ) ) THEN 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 199 zw2d(:,:) = zkgco2(:,:) * tmask(:,:,1) 232 200 CALL iom_put( "Kg" , zw2d ) 233 201 ENDIF 234 202 IF( iom_use( "Dpco2" ) ) THEN 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 203 zw2d(:,:) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 241 204 CALL iom_put( "Dpco2" , zw2d ) 242 205 ENDIF 243 206 IF( iom_use( "Dpo2" ) ) THEN 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 207 zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 250 208 CALL iom_put( "Dpo2" , zw2d ) 251 209 ENDIF … … 274 232 !!---------------------------------------------------------------------- 275 233 NAMELIST/nampisext/ln_co2int, atcco2, clname, nn_offset 276 INTEGER :: jm , jj, ji234 INTEGER :: jm 277 235 INTEGER :: ios ! Local integer output status for namelist read 278 236 !!---------------------------------------------------------------------- … … 300 258 WRITE(numout,*) ' ' 301 259 ENDIF 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 260 satmco2(:,:) = atcco2 ! Initialisation of atmospheric pco2 308 261 ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 309 262 IF(lwp) THEN … … 341 294 342 295 ! 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 296 oce_co2(:,:) = 0._wp ! Initialization of Flux of Carbon 349 297 t_oce_co2_flx = 0._wp 350 298 t_atm_co2_flx = 0._wp … … 365 313 !! * arguments 366 314 INTEGER, INTENT( in ) :: kt ! ocean time step 367 INTEGER :: jj, ji368 315 ! 369 316 INTEGER :: ierr … … 414 361 ENDIF 415 362 ! 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 363 IF( .NOT.ln_presatm ) patm(:,:) = 1.e0 ! Initialize patm if no reading from a file 424 364 ! 425 365 ENDIF … … 427 367 IF( ln_presatm ) THEN 428 368 CALL fld_read( kt, 1, sf_patm ) !* input Patm provided at kt + 1/2 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 369 patm(:,:) = sf_patm(1)%fnow(:,:,1) ! atmospheric pressure 435 370 ENDIF 436 371 ! 437 372 IF( ln_presatmco2 ) THEN 438 373 CALL fld_read( kt, 1, sf_atmco2 ) !* input atmco2 provided at kt + 1/2 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 374 satmco2(:,:) = sf_atmco2(1)%fnow(:,:,1) ! atmospheric pressure 445 375 ELSE 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 376 satmco2(:,:) = atcco2 ! Initialize atmco2 if no reading from a file 452 377 ENDIF 453 378 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
r7698 r7753 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 , jk! dummy loop indices38 INTEGER :: ji, jj ! dummy loop indices 39 39 REAL(wp) :: zvar ! local variable 40 40 !!--------------------------------------------------------------------- … … 44 44 ! Computation of phyto and zoo metabolic rate 45 45 ! ------------------------------------------- 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 46 tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 47 tgfunc2(:,:,:) = EXP( 0.07608 * tsn(:,:,:,jp_tem) ) 56 48 57 49 ! Computation of the silicon dependant half saturation constant for silica uptake 58 50 ! --------------------------------------------------- 59 !$OMP DO schedule(static) private(jj,ji,zvar)60 51 DO ji = 1, jpi 61 52 DO jj = 1, jpj … … 66 57 ! 67 58 IF( nday_year == nyear_len(1) ) THEN 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 59 xksi (:,:) = xksimax(:,:) 60 xksimax(:,:) = 0._wp 75 61 ENDIF 76 !$OMP END PARALLEL77 62 ! 78 63 IF( nn_timing == 1 ) CALL timing_stop('p4z_int') -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r7698 r7753 97 97 IF( nn_timing == 1 ) CALL timing_start('p4z_lim') 98 98 ! 99 !$OMP PARALLEL100 !$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)102 99 DO jk = 1, jpkm1 103 100 DO jj = 1, jpj … … 176 173 END DO 177 174 END DO 178 !$OMP END DO NOWAIT179 175 180 176 ! Compute the fraction of nanophytoplankton that is made of calcifiers 181 177 ! -------------------------------------------------------------------- 182 !$OMP DO schedule(static) private(jk,jj,ji,zlim1,zlim2,zlim3,ztem1,ztem2,zetot1,zetot2)183 178 DO jk = 1, jpkm1 184 179 DO jj = 1, jpj … … 204 199 END DO 205 200 END DO 206 !$OMP END DO NOWAIT 207 ! 208 !$OMP DO schedule(static) private(jk,jj,ji) 201 ! 209 202 DO jk = 1, jpkm1 210 203 DO jj = 1, jpj … … 217 210 END DO 218 211 END DO 219 !$OMP END PARALLEL220 212 ! 221 213 IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics … … 249 241 & xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r, oxymin 250 242 INTEGER :: ios ! Local integer output status for namelist read 251 INTEGER :: ji, jj, jk252 243 253 244 REWIND( numnatp_ref ) ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters … … 286 277 ENDIF 287 278 ! 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 279 nitrfac (:,:,:) = 0._wp 296 280 ! 297 281 END SUBROUTINE p4z_lim_init -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r7698 r7753 69 69 CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 70 70 ! 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 71 zco3 (:,:,:) = 0. 72 zcaldiss(:,:,:) = 0. 73 zhinit(:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 81 74 ! ------------------------------------------- 82 75 ! COMPUTE [CO3--] and [H+] CONCENTRATIONS … … 85 78 CALL solve_at_general(zhinit, zhi) 86 79 87 !$OMP PARALLEL88 !$OMP DO schedule(static) private(jk, jj, ji)89 80 DO jk = 1, jpkm1 90 81 DO jj = 1, jpj … … 103 94 ! --------------------------------------------------------- 104 95 105 !$OMP DO schedule(static) private(jk,jj,ji,zcalcon,zfact,zomegaca,zexcess0,zexcess,zdispot)106 96 DO jk = 1, jpkm1 107 97 DO jj = 1, jpj … … 134 124 END DO 135 125 END DO 136 !$OMP END PARALLEL137 126 ! 138 127 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r7698 r7753 79 79 ! 80 80 CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 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) 81 zgrazing(:,:,:) = 0._wp 82 94 83 DO jk = 1, jpkm1 95 84 DO jj = 1, jpj … … 231 220 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 232 221 IF( iom_use( "GRAZ2" ) ) THEN 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 222 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 241 223 CALL iom_put( "GRAZ2", zw3d ) 242 224 ENDIF 243 225 IF( iom_use( "PCAL" ) ) THEN 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 226 zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Calcite production 252 227 CALL iom_put( "PCAL", zw3d ) 253 228 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r7698 r7753 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)84 81 DO jk = 1, jpkm1 85 82 DO jj = 1, jpj … … 184 181 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 185 182 IF( iom_use( "GRAZ1" ) ) THEN 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 183 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 194 184 CALL iom_put( "GRAZ1", zw3d ) 195 185 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
r7698 r7753 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 !$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) 76 prodcal(:,:,:) = 0. !: calcite production variable set to zero 86 77 DO jk = 1, jpkm1 87 78 DO jj = 1, jpj … … 128 119 END DO 129 120 END DO 130 !$OMP END PARALLEL131 121 ! 132 122 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 163 153 ! ------------------------------------------------------------ 164 154 165 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zcompadi,zlim2,zlim1,zrespp2,ztortp2,zmortp2,zfactfe,zfactch,zfactsi)166 155 DO jk = 1, jpkm1 167 156 DO jj = 1, jpj -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r7698 r7753 84 84 ! Initialisation of variables used to compute PAR 85 85 ! ----------------------------------------------- 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 86 ze1(:,:,:) = 0._wp 87 ze2(:,:,:) = 0._wp 88 ze3(:,:,:) = 0._wp 98 89 ! 99 90 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 100 91 ! -------------------------------------------------------- 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) 92 zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 93 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 94 ! 122 95 DO jk = 1, jpkm1 123 96 DO jj = 1, jpj … … 137 110 IF( l_trcdm2dc ) THEN ! diurnal cycle 138 111 ! 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 112 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn ) 145 113 ! 146 114 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 147 115 ! 148 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)149 116 DO jk = 1, nksrp 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 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) 157 120 END DO 158 121 IF( ln_p5z ) THEN 159 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)160 122 DO jk = 1, nksrp 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 123 epico (:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 166 124 END DO 167 125 ENDIF 168 126 ! 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 127 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 175 128 ! 176 129 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) 177 130 ! 178 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)179 131 DO jk = 1, nksrp 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 132 etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 185 133 END DO 186 134 ! 187 135 ELSE 188 136 ! 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 137 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 195 138 ! 196 139 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 197 140 ! 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 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) 207 145 END DO 208 146 IF( ln_p5z ) THEN 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 147 DO jk = 1, nksrp 148 epico(:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 216 149 END DO 217 150 ENDIF 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 151 etot_ndcy(:,:,:) = etot(:,:,:) 226 152 ENDIF 227 153 … … 231 157 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 232 158 ! 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) 159 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) 241 160 DO jk = 2, nksrp + 1 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 161 etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 162 END DO 249 163 ! ! ------------------------ 250 164 ENDIF 251 165 ! !* Euphotic depth and level 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 166 neln (:,:) = 1 ! ------------------------ 167 heup (:,:) = gdepw_n(:,:,2) 168 heup_01(:,:) = gdepw_n(:,:,2) 262 169 263 170 DO jk = 2, nksrp 264 !$OMP DO schedule(static) private(jj,ji)265 171 DO jj = 1, jpj 266 172 DO ji = 1, jpi … … 277 183 END DO 278 184 ! 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 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 292 193 293 194 DO jk = 1, nksrp 294 !$OMP DO schedule(static) private(jj,ji)295 195 DO jj = 1, jpj 296 196 DO ji = 1, jpi … … 306 206 END DO 307 207 ! 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) 208 emoy(:,:,:) = etot(:,:,:) ! remineralisation 209 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 210 ! 319 211 DO jk = 1, nksrp 320 212 DO jj = 1, jpj … … 330 222 END DO 331 223 END DO 332 !$OMP END PARALLEL333 224 ! 334 225 IF( ln_p5z ) THEN 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 226 zetmp5 (:,:) = 0.e0 342 227 DO jk = 1, nksrp 343 !$OMP DO schedule(static) private(jj,ji,z1_dep)344 228 DO jj = 1, jpj 345 229 DO ji = 1, jpi … … 352 236 END DO 353 237 END DO 354 !$OMP END PARALLEL355 238 ENDIF 356 239 IF( lk_iomput ) THEN … … 391 274 392 275 ! Real shortwave 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 276 IF( ln_varpar ) THEN ; zqsr(:,:) = par_varsw(:,:) * pqsr(:,:) 277 ELSE ; zqsr(:,:) = xparsw * pqsr(:,:) 407 278 ENDIF 408 279 409 280 ! Light at the euphotic depth 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 281 IF( PRESENT( pqsr100 ) ) pqsr100(:,:) = 0.01 * 3. * zqsr(:,:) 418 282 419 283 IF( PRESENT( pe0 ) ) THEN ! W-level 420 284 ! 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 285 pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:) ! ( 1 - 3 * alpha ) * q 286 pe1(:,:,1) = zqsr(:,:) 287 pe2(:,:,1) = zqsr(:,:) 288 pe3(:,:,1) = zqsr(:,:) 431 289 ! 432 290 DO jk = 2, nksrp + 1 433 !$OMP DO schedule(static) private(jj,ji)434 291 DO jj = 1, jpj 435 292 DO ji = 1, jpi … … 443 300 ! 444 301 END DO 445 !$OMP END PARALLEL446 302 ! 447 303 ELSE ! T- level 448 304 ! 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 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) ) 458 308 ! 459 309 DO jk = 2, nksrp 460 !$OMP DO schedule(static) private(jj,ji)461 310 DO jj = 1, jpj 462 311 DO ji = 1, jpi … … 467 316 END DO 468 317 END DO 469 !$OMP END PARALLEL470 318 ! 471 319 ENDIF … … 521 369 INTEGER :: ierr 522 370 INTEGER :: ios ! Local integer output status for namelist read 523 INTEGER :: ji, jj, jk ! dummy loop indices524 371 REAL(wp), DIMENSION(nbtimes) :: zsteps ! times records 525 372 ! … … 577 424 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 578 425 ! 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 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 614 435 ! 615 436 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt_init') -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90
r7698 r7753 89 89 ! Initialisation of temprary arrys 90 90 IF( ln_p4z ) THEN 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 91 zremipoc(:,:,:) = xremip 92 zremigoc(:,:,:) = xremip 100 93 ELSE ! ln_p5z 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 94 zremipoc(:,:,:) = xremipc 95 zremigoc(:,:,:) = xremipc 110 96 ENDIF 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 97 zorem3(:,:,:) = 0. 98 orem (:,:,:) = 0. 99 ztremint(:,:,:) = 0. 100 101 DO jn = 1, jcpoc 102 alphag(:,:,:,jn) = alphan(jn) 103 alphap(:,:,:,jn) = alphan(jn) 121 104 END DO 122 !OMP END DO NOWAIT123 DO jn = 1, jcpoc124 !$OMP DO schedule(static) private(jk, jj, ji)125 DO jk = 1, jpk126 DO jj = 1, jpj127 DO ji = 1, jpi128 alphag(ji,jj,jk,jn) = alphan(jn)129 alphap(ji,jj,jk,jn) = alphan(jn)130 END DO131 END DO132 END DO133 END DO134 !$OMP END PARALLEL135 105 136 106 ! ----------------------------------------------------------------------- … … 140 110 ! ----------------------------------------------------------------------- 141 111 DO jk = 2, jpkm1 142 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,alphat,remint,zsizek1,zsizek,zpoc,jn)143 112 DO jj = 1, jpj 144 113 DO ji = 1, jpi … … 151 120 ! 152 121 IF( gdept_n(ji,jj,jk) > zdep ) THEN 122 alphat = 0. 123 remint = 0. 124 ! 153 125 zsizek1 = e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 154 126 zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) … … 183 155 & + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn) & 184 156 & * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2 185 157 alphat = alphat + alphag(ji,jj,jk,jn) 158 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 186 159 END DO 187 160 ELSE … … 201 174 & - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 202 175 & / 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) 203 178 END DO 204 179 ENDIF 205 !206 alphat = SUM(alphag(ji,jj,jk,:))207 remint = SUM(alphag(ji,jj,jk,:) * reminp(:))208 180 ! 209 181 DO jn = 1, jcpoc … … 221 193 END DO 222 194 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 195 IF( ln_p4z ) THEN ; zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 196 ELSE ; zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 241 197 ENDIF 242 198 243 199 IF( ln_p4z ) THEN 244 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremig,zorem2,zofer2,zofer3)245 200 DO jk = 1, jpkm1 246 201 DO jj = 1, jpj … … 266 221 END DO 267 222 ELSE 268 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremig,zopoc2,zofer2,zopon2,zopop2)269 223 DO jk = 1, jpkm1 270 224 DO jj = 1, jpj … … 312 266 ! ------------------------------------------------------------------- 313 267 ! 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 268 totprod(:,:) = 0. 269 totthick(:,:) = 0. 270 totcons(:,:) = 0. 323 271 ! intregrated production and consumption of POC in the mixed layer 324 272 ! ---------------------------------------------------------------- 325 273 ! 326 274 DO jk = 1, jpkm1 327 !$OMP DO schedule(static) private(jj,ji,zdep)328 275 DO jj = 1, jpj 329 276 DO ji = 1, jpi … … 339 286 END DO 340 287 END DO 341 !$OMP END PARALLEL342 288 343 289 ! Computation of the lability spectrum in the mixed layer. In the mixed 344 290 ! layer, this spectrum is supposed to be uniform. 345 291 ! --------------------------------------------------------------------- 346 !$OMP DO schedule(static) private(jk,jj,ji,zdep,alphat,remint,jn)347 292 DO jk = 1, jpkm1 348 293 DO jj = 1, jpj … … 350 295 IF (tmask(ji,jj,jk) == 1.) THEN 351 296 zdep = hmld(ji,jj) 297 alphat = 0.0 298 remint = 0.0 352 299 IF( gdept_n(ji,jj,jk) <= zdep ) THEN 353 300 DO jn = 1, jcpoc … … 356 303 alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn) & 357 304 & * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 305 alphat = alphat + alphap(ji,jj,jk,jn) 358 306 END DO 359 alphat = SUM(alphap(ji,jj,jk,:))360 307 DO jn = 1, jcpoc 361 308 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 309 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 362 310 END DO 363 remint = SUM(alphap(ji,jj,jk,:) * reminp(:))364 311 ! Mean remineralization rate in the mixed layer 365 312 ztremint(ji,jj,jk) = MAX( 0., remint ) … … 370 317 END DO 371 318 ! 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 319 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 320 ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 390 321 ENDIF 391 322 … … 399 330 ! 400 331 DO jk = 2, jpkm1 401 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,alphat,remint,zsizek1,zsizek,zpoc,jn)402 332 DO jj = 1, jpj 403 333 DO ji = 1, jpi … … 405 335 zdep = hmld(ji,jj) 406 336 IF( gdept_n(ji,jj,jk) > zdep ) THEN 337 alphat = 0. 338 remint = 0. 407 339 ! 408 340 ! the scale factors are corrected with temperature … … 430 362 & * zsizek ) ) 431 363 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 364 alphat = alphat + alphap(ji,jj,jk,jn) 432 365 END DO 433 366 ELSE … … 452 385 & - exp( -reminp(jn) * zsizek ) ) 453 386 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 387 alphat = alphat + alphap(ji,jj,jk,jn) 454 388 END DO 455 389 ENDIF 456 alphat = SUM(alphap(ji,jj,jk,:))457 390 ! Normalization of the lability spectrum so that the 458 391 ! integral is equal to 1 459 392 DO jn = 1, jcpoc 460 393 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 394 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 461 395 END DO 462 remint = SUM(alphap(ji,jj,jk,:) * reminp(:))463 396 ! Mean remineralization rate in the water column 464 397 ztremint(ji,jj,jk) = MAX( 0., remint ) … … 469 402 END DO 470 403 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 404 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 405 ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 489 406 ENDIF 490 407 491 408 IF( ln_p4z ) THEN 492 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremip,zorem,zofer)493 409 DO jk = 1, jpkm1 494 410 DO jj = 1, jpj … … 511 427 END DO 512 428 ELSE 513 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremip,zopoc,zopon,zopop,zofer)514 429 DO jk = 1, jpkm1 515 430 DO jj = 1, jpj … … 572 487 !! 573 488 !!---------------------------------------------------------------------- 574 INTEGER :: jn , jk, jj, ji489 INTEGER :: jn 575 490 REAL(wp) :: remindelta, reminup, remindown 576 491 INTEGER :: ifault … … 642 557 643 558 DO jn = 1, jcpoc 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 559 alphap(:,:,:,jn) = alphan(jn) 652 560 END DO 653 561 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r7698 r7753 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._wp 96 zprofen (:,:,:) = 0._wp ; zysopt (:,:,:) = 0._wp 97 zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia (:,:,:) = 0._wp 98 zprbio (:,:,:) = 0._wp ; zprdch (:,:,:) = 0._wp ; zprnch (:,:,:) = 0._wp 99 zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp 100 101 ! Computation of the optimal production 102 prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:) 103 95 104 ! compute the day length depending on latitude and the day 96 105 zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 97 106 zcodel = ASIN( SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp ) ) 98 107 99 !$OMP PARALLEL100 !$OMP DO schedule(static) private(jk,jj,ji)101 DO jk = 1, jpk102 DO jj = 1, jpj103 DO ji = 1, jpi104 zprorcan(ji,jj,jk) = 0._wp105 zprorcad(ji,jj,jk) = 0._wp106 zprofed (ji,jj,jk) = 0._wp107 zprofen (ji,jj,jk) = 0._wp108 zysopt (ji,jj,jk) = 0._wp109 zpronewn(ji,jj,jk) = 0._wp110 zpronewd(ji,jj,jk) = 0._wp111 zprdia (ji,jj,jk) = 0._wp112 zprbio (ji,jj,jk) = 0._wp113 zprdch (ji,jj,jk) = 0._wp114 zprnch (ji,jj,jk) = 0._wp115 zmxl_fac(ji,jj,jk) = 0._wp116 zmxl_chl(ji,jj,jk) = 0._wp117 118 ! Computation of the optimal production119 prmax(ji,jj,jk) = 0.8_wp * r1_rday * tgfunc(ji,jj,jk)120 END DO121 END DO122 END DO123 124 108 ! day length in hours 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) 109 zstrn(:,:) = 0. 132 110 DO jj = 1, jpj 133 111 DO ji = 1, jpi … … 139 117 140 118 ! Impact of the day duration and light intermittency on phytoplankton growth 141 !$OMP DO schedule(static) private(jk,jj,ji,zval)142 119 DO jk = 1, jpkm1 143 120 DO jj = 1 ,jpj … … 155 132 END DO 156 133 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 134 zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:) 135 zprdia(:,:,:) = zprbio(:,:,:) 166 136 167 137 ! Maximum light intensity 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 138 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 174 139 175 140 ! Computation of the P-I slope for nanos and diatoms 176 !$OMP DO schedule(static) private(jk,jj,ji,ztn,zadap,zconctemp,zconctemp2)177 141 DO jk = 1, jpkm1 178 142 DO jj = 1, jpj … … 195 159 196 160 IF( ln_newprod ) THEN 197 !$OMP DO schedule(static) private(jk,jj,ji,zpislopen,zpisloped)198 161 DO jk = 1, jpkm1 199 162 DO jj = 1, jpj … … 219 182 END DO 220 183 ELSE 221 !$OMP DO schedule(static) private(jk,jj,ji,zpislopen,zpisloped)222 184 DO jk = 1, jpkm1 223 185 DO jj = 1, jpj … … 244 206 ! Computation of a proxy of the N/C ratio 245 207 ! --------------------------------------- 246 !$OMP DO schedule(static) private(jk,jj,ji,zval)247 208 DO jk = 1, jpkm1 248 209 DO jj = 1, jpj … … 257 218 END DO 258 219 END DO 259 !$OMP END DO NOWAIT 260 261 262 !$OMP DO schedule(static) private(jk,jj,ji,zlim,zsilim,zsilfac,zsiborn,zsilfac2) 220 221 263 222 DO jk = 1, jpkm1 264 223 DO jj = 1, jpj … … 285 244 END DO 286 245 END DO 287 !$OMP END DO NOWAIT288 246 289 247 ! Mixed-layer effect on production 290 248 ! Sea-ice effect on production 291 249 292 !$OMP DO schedule(static) private(jk,jj,ji)293 250 DO jk = 1, jpkm1 294 251 DO jj = 1, jpj … … 303 260 304 261 ! Computation of the various production terms 305 !$OMP DO schedule(static) private(jk,jj,ji,zratio,zmax)306 262 DO jk = 1, jpkm1 307 263 DO jj = 1, jpj … … 334 290 335 291 ! Computation of the chlorophyll production terms 336 !$OMP DO schedule(static) private(jk,jj,ji,znanotot,zprod,zprochln,chlcnm_n,zprochld,zdiattot)337 292 DO jk = 1, jpkm1 338 293 DO jj = 1, jpj … … 362 317 363 318 ! Update the arrays TRA which contain the biological sources and sinks 364 !$OMP DO schedule(static) private(jk,jj,ji,zproreg,zproreg2,zdocprod,zfeup)365 319 DO jk = 1, jpkm1 366 320 DO jj = 1, jpj … … 394 348 ! 395 349 IF( ln_ligand ) THEN 396 !$OMP DO schedule(static) private(jk,jj,ji,zdocprod,zfeup)397 350 DO jk = 1, jpkm1 398 351 DO jj = 1, jpj … … 407 360 END DO 408 361 ENDIF 409 !$OMP END PARALLEL410 362 411 363 … … 421 373 ! 422 374 IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) ) THEN 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 ) 375 zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:) ! primary production by nanophyto 376 CALL iom_put( "PPPHYN" , zw3d ) 377 ! 378 zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) ! primary production by diatomes 379 CALL iom_put( "PPPHYD" , zw3d ) 442 380 ENDIF 443 381 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 ) 382 zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:) ! new primary production by nanophyto 383 CALL iom_put( "PPNEWN" , zw3d ) 453 384 ! 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 ) 385 zw3d(:,:,:) = zpronewd(:,:,:) * zfact * tmask(:,:,:) ! new primary production by diatomes 386 CALL iom_put( "PPNEWD" , zw3d ) 463 387 ENDIF 464 388 IF( iom_use( "PBSi" ) ) THEN 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 ) 389 zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ! biogenic silica production 390 CALL iom_put( "PBSi" , zw3d ) 474 391 ENDIF 475 392 IF( iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) ) THEN 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 ) 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 ) 495 398 ENDIF 496 399 IF( iom_use( "Mumax" ) ) THEN 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 ) 400 zw3d(:,:,:) = prmax(:,:,:) * tmask(:,:,:) ! Maximum growth rate 401 CALL iom_put( "Mumax" , zw3d ) 506 402 ENDIF 507 403 IF( iom_use( "MuN" ) .OR. iom_use( "MuD" ) ) THEN 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 ) 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 ) 527 409 ENDIF 528 410 IF( iom_use( "LNlight" ) .OR. iom_use( "LDlight" ) ) THEN 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 ) 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 ) 548 416 ENDIF 549 417 IF( iom_use( "TPP" ) ) THEN 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 ) 418 zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production 419 CALL iom_put( "TPP" , zw3d ) 559 420 ENDIF 560 421 IF( iom_use( "TPNEW" ) ) THEN 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 ) 422 zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production 423 CALL iom_put( "TPNEW" , zw3d ) 570 424 ENDIF 571 425 IF( iom_use( "TPBFE" ) ) THEN 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 ) 426 zw3d(:,:,:) = ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:) ! total biogenic iron production 427 CALL iom_put( "TPBFE" , zw3d ) 581 428 ENDIF 582 429 IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN 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 430 zw2d(:,:) = 0. 590 431 DO jk = 1, jpkm1 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 432 zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano 597 433 ENDDO 598 !$OMP END PARALLEL599 434 CALL iom_put( "INTPPPHYN" , zw2d ) 600 435 ! 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 436 zw2d(:,:) = 0. 608 437 DO jk = 1, jpkm1 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 438 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom 615 439 ENDDO 616 !$OMP END PARALLEL617 440 CALL iom_put( "INTPPPHYD" , zw2d ) 618 441 ENDIF 619 442 IF( iom_use( "INTPP" ) ) THEN 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 443 zw2d(:,:) = 0. 627 444 DO jk = 1, jpkm1 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 445 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 634 446 ENDDO 635 !$OMP END PARALLEL636 447 CALL iom_put( "INTPP" , zw2d ) 637 448 ENDIF 638 449 IF( iom_use( "INTPNEW" ) ) THEN 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 450 zw2d(:,:) = 0. 646 451 DO jk = 1, jpkm1 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 452 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod 653 453 ENDDO 654 !$OMP END PARALLEL655 454 CALL iom_put( "INTPNEW" , zw2d ) 656 455 ENDIF 657 456 IF( iom_use( "INTPBFE" ) ) THEN ! total biogenic iron production ( vertically integrated ) 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 457 zw2d(:,:) = 0. 665 458 DO jk = 1, jpkm1 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 459 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 672 460 ENDDO 673 !$OMP END PARALLEL674 461 CALL iom_put( "INTPBFE" , zw2d ) 675 462 ENDIF 676 463 IF( iom_use( "INTPBSI" ) ) THEN ! total biogenic silica production ( vertically integrated ) 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 464 zw2d(:,:) = 0. 684 465 DO jk = 1, jpkm1 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 466 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bsi prod 691 467 ENDDO 692 !$OMP END PARALLEL693 468 CALL iom_put( "INTPBSI" , zw2d ) 694 469 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r7698 r7753 78 78 79 79 ! Initialisation of temprary arrys 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 80 zdepprod(:,:,:) = 1._wp 81 ztempbac(:,:) = 0._wp 82 zfacsib(:,:,:) = xsilab / ( 1.0 - xsilab ) 83 zfacsi(:,:,:) = xsilab 97 84 98 85 ! Computation of the mean phytoplankton concentration as … … 102 89 ! ------------------------------------------------------- 103 90 DO jk = 1, jpkm1 104 !$OMP DO schedule(static) private(jj,ji,zdep,zdepmin)105 91 DO jj = 1, jpj 106 92 DO ji = 1, jpi … … 119 105 120 106 IF( ln_p4z ) THEN 121 !$OMP DO schedule(static) private(jk,jj,ji,zremik,zolimit)122 107 DO jk = 1, jpkm1 123 108 DO jj = 1, jpj … … 151 136 END DO 152 137 ELSE 153 !$OMP DO schedule(static) private(jk,jj,ji,zremik,zremikc,zremikn,zremikp,zolimit,zolimic,zolimin,zolimip,zdenitrn,zdenitrp)154 138 DO jk = 1, jpkm1 155 139 DO jj = 1, jpj … … 197 181 198 182 199 !$OMP DO schedule(static) private(jk,jj,ji,zonitr,zdenitnh4)200 183 DO jk = 1, jpkm1 201 184 DO jj = 1, jpj … … 216 199 END DO 217 200 END DO 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) 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 227 208 DO jk = 1, jpkm1 228 209 DO jj = 1, jpj … … 243 224 END DO 244 225 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 ENDIF226 IF(ln_ctl) THEN ! print mean trends (used for debugging) 227 WRITE(charout, FMT="('rem2')") 228 CALL prt_ctl_trc_info(charout) 229 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 230 ENDIF 250 231 251 232 ! Initialization of the array which contains the labile fraction … … 254 235 255 236 DO jk = 1, jpkm1 256 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,zsatur,zsatur2,znusil,zsiremin,zosil)257 237 DO jj = 1, jpj 258 238 DO ji = 1, jpi … … 284 264 CALL prt_ctl_trc_info(charout) 285 265 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 286 ENDIF266 ENDIF 287 267 288 268 IF( knt == nrdttrc ) THEN 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 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 317 283 ! 318 284 CALL wrk_dealloc( jpi, jpj, ztempbac ) … … 339 305 & xremikc, xremikn, xremikp 340 306 INTEGER :: ios ! Local integer output status for namelist read 341 INTEGER :: ji, jj, jk342 307 343 308 REWIND( numnatp_ref ) ! Namelist nampisrem in reference namelist : Pisces remineralization … … 369 334 ENDIF 370 335 ! 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 336 denitr (:,:,:) = 0._wp 379 337 ! 380 338 END SUBROUTINE p4z_rem_init -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r7698 r7753 116 116 CALL fld_read( kt, 1, sf_dust ) 117 117 IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN 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 118 dust(:,:) = sf_dust(1)%fnow(:,:,1) 124 119 ELSE 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 120 dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) ) 131 121 ENDIF 132 122 ENDIF … … 136 126 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_solub > 1 ) ) THEN 137 127 CALL fld_read( kt, 1, sf_solub ) 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 128 solub(:,:) = sf_solub(1)%fnow(:,:,1) 144 129 ENDIF 145 130 ENDIF … … 152 137 CALL fld_read( kt, 1, sf_river ) 153 138 IF( ln_p4z ) THEN 154 !$OMP PARALLEL DO schedule(static) private(jj, ji, zcoef)155 139 DO jj = 1, jpj 156 140 DO ji = 1, jpi … … 169 153 END DO 170 154 ELSE ! ln_p5z 171 !$OMP PARALLEL DO schedule(static) private(jj, ji, zcoef)172 155 DO jj = 1, jpj 173 156 DO ji = 1, jpi … … 196 179 IF( ln_ndepo ) THEN 197 180 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 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 181 zcoef = rno3 * 14E6 * ryyss 182 CALL fld_read( kt, 1, sf_ndepo ) 183 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) 206 184 ENDIF 207 185 IF( .NOT.ln_linssh ) THEN 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 186 zcoef = rno3 * 14E6 * ryyss 187 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) 215 188 ENDIF 216 189 ENDIF … … 319 292 ! online configuration : computed in sbcrnf 320 293 IF( l_offline ) THEN 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 294 nk_rnf(:,:) = 1 295 h_rnf (:,:) = gdept_n(:,:,1) 328 296 ENDIF 329 297 … … 498 466 IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1) 499 467 IF (lwp) WRITE(numout,*) 500 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmaskt)501 468 DO jk = 1, ik50 502 469 DO jj = 2, jpjm1 … … 513 480 CALL lbc_lnk( zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) 514 481 ! 515 !$OMP PARALLEL516 !$OMP DO schedule(static) private(jk, jj, ji, zexpide, zdenitide)517 482 DO jk = 1, jpk 518 483 DO jj = 1, jpj … … 524 489 END DO 525 490 END DO 526 !$OMP END DO NOWAIT527 491 ! Coastal supply of iron 528 492 ! ------------------------- 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 493 ironsed(:,:,jpk) = 0._wp 494 DO jk = 1, jpkm1 495 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday ) 534 496 END DO 535 !$OMP DO schedule(static) private(jk,jj,ji)536 DO jk = 1, jpkm1537 DO jj = 1, jpj538 DO ji = 1, jpi539 ironsed(ji,jj,jk) = sedfeinput * zcmask(ji,jj,jk) / ( e3t_0(ji,jj,jk) * rday )540 END DO541 END DO542 END DO543 !$OMP END PARALLEL544 497 DEALLOCATE( zcmask) 545 498 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r7698 r7753 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 !$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 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 99 95 100 96 ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. … … 104 100 CALL wrk_alloc( jpi, jpj, zironice ) 105 101 ! 106 !$OMP PARALLEL107 !$OMP DO schedule(static) private(jj,ji,zdep,zwflux,zfminus,zfplus)108 102 DO jj = 1, jpj 109 103 DO ji = 1, jpi … … 116 110 END DO 117 111 ! 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 112 tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:) 125 113 ! 126 114 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) ) & … … 139 127 ! ! Iron and Si deposition at the surface 140 128 IF( ln_solub ) THEN 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 129 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 147 130 ELSE 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 131 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 154 132 ENDIF 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 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 162 135 ! ! Iron solubilization of particles in the water column 163 136 ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j 164 137 zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 165 !$OMP PARALLEL166 !$OMP DO schedule(static) private(jk,jj,ji)167 138 DO jk = 2, jpkm1 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 139 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 140 zpdep (:,:,jk) = zirondep(:,:,jk) * 0.023 174 141 END DO 175 142 ! ! Iron solubilization of particles in the water column 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 143 tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep (:,:) 144 tra(:,:,:,jppo4) = tra(:,:,:,jppo4) + zpdep (:,:,:) 145 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:) 192 146 ! 193 147 IF( lk_iomput ) THEN … … 207 161 ! ---------------------------------------------------------- 208 162 IF( ln_river ) THEN 209 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk)210 163 DO jj = 1, jpj 211 164 DO ji = 1, jpi … … 221 174 ENDDO 222 175 IF( ln_p5z ) THEN 223 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk)224 176 DO jj = 1, jpj 225 177 DO ji = 1, jpi … … 237 189 ! ---------------------------------------------------------- 238 190 IF( ln_ndepo ) THEN 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 191 tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 192 tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 246 193 ENDIF 247 194 … … 249 196 ! ------------------------------------------------------ 250 197 IF( ln_ironsed ) THEN 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 198 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 199 IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2 270 200 ! 271 201 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) & … … 276 206 ! ------------------------------------------------------ 277 207 IF( ln_hydrofe ) THEN 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 208 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 286 209 IF( ln_ligand ) THEN 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 210 tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( hydrofe(:,:,:) * fep_rath ) * rfact2 211 tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 296 212 ENDIF 297 213 ! … … 302 218 ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 303 219 ! -------------------------------------------------------------------- 304 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep)305 220 DO jj = 1, jpj 306 221 DO ji = 1, jpi … … 314 229 ! 315 230 IF( ln_ligand ) THEN 316 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep)317 231 DO jj = 1, jpj 318 232 DO ji = 1, jpi … … 328 242 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 329 243 ! ------------------------------------------------------- 330 !$OMP PARALLEL331 !$OMP DO schedule(static) private(jj,ji,ikt,zflx,zo2,zno3,zdep)332 244 DO jj = 1, jpj 333 245 DO ji = 1, jpi … … 355 267 ! The factor for calcite comes from the alkalinity effect 356 268 ! ------------------------------------------------------------- 357 !$OMP DO schedule(static) private(jj,ji,ikt,zfactcal)358 269 DO jj = 1, jpj 359 270 DO ji = 1, jpi … … 369 280 END DO 370 281 END DO 371 !$OMP END PARALLEL372 282 zsumsedsi = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 373 283 zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday … … 381 291 IF( .NOT.lk_sed ) zrivsil = 1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn ) 382 292 383 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwsc,zsiloss,zcaloss)384 293 DO jj = 1, jpj 385 294 DO ji = 1, jpi … … 396 305 ! 397 306 IF( .NOT.lk_sed ) THEN 398 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwsc,zsiloss,zcaloss,zfactcal,zrivalk)399 307 DO jj = 1, jpj 400 308 DO ji = 1, jpi … … 417 325 ENDIF 418 326 ! 419 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4)420 327 DO jj = 1, jpj 421 328 DO ji = 1, jpi … … 432 339 ! 433 340 IF( ln_ligand ) THEN 434 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwssfep)435 341 DO jj = 1, jpj 436 342 DO ji = 1, jpi … … 444 350 ! 445 351 IF( ln_p5z ) THEN 446 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4)447 352 DO jj = 1, jpj 448 353 DO ji = 1, jpi … … 462 367 ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification 463 368 ! 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)465 369 DO jj = 1, jpj 466 370 DO ji = 1, jpi … … 498 402 ! Small source iron from particulate inorganic iron 499 403 !----------------------------------- 500 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)501 404 DO jk = 1, jpkm1 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 405 zlight (:,:,jk) = ( 1.- EXP( -etot_ndcy(:,:,jk) / diazolight ) ) * ( 1. - fr_i(:,:) ) 406 zsoufer(:,:,jk) = zlight(:,:,jk) * 2E-11 / ( 2E-11 + biron(:,:,jk) ) 508 407 ENDDO 509 408 IF( ln_p4z ) THEN 510 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zlim,zfact,ztrfer,ztrpo4s)511 409 DO jk = 1, jpkm1 512 410 DO jj = 1, jpj … … 525 423 END DO 526 424 ELSE ! p5z 527 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztemp,zmudia,xdianh4,xdiano3,zlim,zfact,ztrfer,ztrdp)528 425 DO jk = 1, jpkm1 529 426 DO jj = 1, jpj … … 551 448 ! ---------------------------------------- 552 449 IF( ln_p4z ) THEN 553 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact)554 450 DO jk = 1, jpkm1 555 451 DO jj = 1, jpj … … 566 462 END DO 567 463 ELSE ! p5z 568 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact)569 464 DO jk = 1, jpkm1 570 465 DO jj = 1, jpj … … 602 497 IF( iom_use("Nfix" ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) ) ! nitrogen fixation 603 498 IF( iom_use("INTNFIX") ) THEN ! nitrogen fixation rate in ocean ( vertically integrated ) 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 499 zwork1(:,:) = 0. 500 DO jk = 1, jpkm1 501 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 610 502 ENDDO 611 DO jk = 1, jpkm1612 !$OMP DO schedule(static) private(jj,ji)613 DO jj = 1, jpj614 DO ji = 1, jpi615 zwork1(ji,jj) = zwork1(ji,jj) + nitrpot(ji,jj,jk) * nitrfix * zfact * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)616 END DO617 END DO618 ENDDO619 !$OMP END PARALLEL620 503 CALL iom_put( "INTNFIX" , zwork1 ) 621 504 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r7698 r7753 74 74 ! Initialization of some global variables 75 75 ! --------------------------------------- 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 76 prodpoc(:,:,:) = 0. 77 conspoc(:,:,:) = 0. 78 prodgoc(:,:,:) = 0. 79 consgoc(:,:,:) = 0. 88 80 89 81 ! … … 91 83 ! by data and from the coagulation theory 92 84 ! ----------------------------------------------------------- 93 !$OMP DO schedule(static) private(jk, jj, ji, zmax, zfact)94 85 DO jk = 1, jpkm1 95 86 DO jj = 1, jpj … … 103 94 104 95 ! limit the values of the sinking speeds to avoid numerical instabilities 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 96 wsbio3(:,:,:) = wsbio 114 97 115 98 ! … … 129 112 iiter1 = 1 130 113 iiter2 = 1 131 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zwsmax) REDUCTION(MAX:iiter1, iiter2)132 114 DO jk = 1, jpkm1 133 115 DO jj = 1, jpj … … 149 131 ENDIF 150 132 151 !$OMP PARALLEL152 !$OMP DO schedule(static) private(jk, jj, ji, zwsmax)153 133 DO jk = 1,jpkm1 154 134 DO jj = 1, jpj … … 163 143 END DO 164 144 145 wscal (:,:,:) = wsbio4(:,:,:) 146 165 147 ! Initializa to zero all the sinking arrays 166 148 ! ----------------------------------------- 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 149 sinking (:,:,:) = 0.e0 150 sinking2(:,:,:) = 0.e0 151 sinkcal (:,:,:) = 0.e0 152 sinkfer (:,:,:) = 0.e0 153 sinksil (:,:,:) = 0.e0 154 sinkfer2(:,:,:) = 0.e0 182 155 183 156 ! Compute the sedimentation term using p4zsink2 for all the sinking particles … … 196 169 197 170 IF( ln_p5z ) THEN 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 171 sinkingn (:,:,:) = 0.e0 172 sinking2n(:,:,:) = 0.e0 173 sinkingp (:,:,:) = 0.e0 174 sinking2p(:,:,:) = 0.e0 209 175 210 176 ! Compute the sedimentation term using p4zsink2 for all the sinking particles … … 222 188 223 189 IF( ln_ligand ) THEN 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) 190 wsfep (:,:,:) = wfep 234 191 DO jk = 1,jpkm1 235 192 DO jj = 1, jpj … … 242 199 END DO 243 200 END DO 244 !$OMP END DO NOWAIT245 201 ! 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 202 sinkfep(:,:,:) = 0.e0 255 203 DO jit = 1, iiter1 256 204 CALL p4z_sink2( wsfep, sinkfep , jpfep, iiter1 ) … … 269 217 ! 270 218 IF( iom_use( "EPC100" ) ) THEN 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 ) 219 zw2d(:,:) = ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of carbon at 100m 220 CALL iom_put( "EPC100" , zw2d ) 278 221 ENDIF 279 222 IF( iom_use( "EPFE100" ) ) THEN 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 ) 223 zw2d(:,:) = ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of iron at 100m 224 CALL iom_put( "EPFE100" , zw2d ) 287 225 ENDIF 288 226 IF( iom_use( "EPCAL100" ) ) THEN 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 ) 227 zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m 228 CALL iom_put( "EPCAL100" , zw2d ) 296 229 ENDIF 297 230 IF( iom_use( "EPSI100" ) ) THEN 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 ) 231 zw2d(:,:) = sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m 232 CALL iom_put( "EPSI100" , zw2d ) 305 233 ENDIF 306 234 IF( iom_use( "EXPC" ) ) THEN 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 ) 235 zw3d(:,:,:) = ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of carbon in the water column 236 CALL iom_put( "EXPC" , zw3d ) 316 237 ENDIF 317 238 IF( iom_use( "EXPFE" ) ) THEN 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 ) 239 zw3d(:,:,:) = ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of iron 240 CALL iom_put( "EXPFE" , zw3d ) 327 241 ENDIF 328 242 IF( iom_use( "EXPCAL" ) ) THEN 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 ) 243 zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite 244 CALL iom_put( "EXPCAL" , zw3d ) 338 245 ENDIF 339 246 IF( iom_use( "EXPSI" ) ) THEN 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 ) 247 zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica 248 CALL iom_put( "EXPSI" , zw3d ) 349 249 ENDIF 350 250 IF( iom_use( "tcexp" ) ) CALL iom_put( "tcexp" , t_oce_co2_exp * zfact ) ! molC/s … … 412 312 zstep = rfact2 / REAL( kiter, wp ) / 2. 413 313 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) 314 ztraz(:,:,:) = 0.e0 315 zakz (:,:,:) = 0.e0 316 ztrb (:,:,:) = trb(:,:,:,jp_tra) 317 427 318 DO jk = 1, jpkm1 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 319 zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) 320 END DO 321 zwsink2(:,:,1) = 0.e0 322 442 323 443 324 ! Vertical advective flux 444 325 DO jn = 1, 2 445 326 ! first guess of the slopes interior values 446 !$OMP DO schedule(static) private(jk,jj,ji)447 327 DO jk = 2, jpkm1 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 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 462 332 463 333 ! slopes 464 !$OMP DO schedule(static) private(jk, jj, ji, zign)465 334 DO jk = 2, jpkm1 466 335 DO jj = 1,jpj … … 473 342 474 343 ! Slopes limitation 475 !$OMP DO schedule(static) private(jk, jj, ji)476 344 DO jk = 2, jpkm1 477 345 DO jj = 1, jpj … … 484 352 485 353 ! vertical advective flux 486 !$OMP DO schedule(static) private(jk, jj, ji, zigma, zew)487 354 DO jk = 1, jpkm1 488 355 DO jj = 1, jpj … … 496 363 ! 497 364 ! Boundary conditions 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 365 psinkflx(:,:,1 ) = 0.e0 366 psinkflx(:,:,jpk) = 0.e0 505 367 506 !$OMP DO schedule(static) private(jk, jj, ji, zflx)507 368 DO jk=1,jpkm1 508 369 DO jj = 1,jpj … … 516 377 ENDDO 517 378 518 !$OMP DO schedule(static) private(jk, jj, ji, zflx)519 379 DO jk = 1,jpkm1 520 380 DO jj = 1,jpj … … 526 386 END DO 527 387 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 388 trb(:,:,:,jp_tra) = ztrb(:,:,:) 389 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 538 390 ! 539 391 CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r7698 r7753 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 !$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 101 trb(:,:,:,jn) = trn(:,:,:,jn) 109 102 END DO 110 103 ENDIF … … 132 125 CALL p4z_flx( kt, jnt ) ! Compute surface fluxes 133 126 ! 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 127 xnegtr(:,:,:) = 1.e0 143 128 DO jn = jp_pcs0, jp_pcs1 144 !$OMP DO schedule(static) private(jk, jj, ji, ztra)145 129 DO jk = 1, jpk 146 130 DO jj = 1, jpj … … 157 141 ! ! 158 142 DO jn = jp_pcs0, jp_pcs1 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 143 trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 167 144 END DO 168 145 ! 169 146 DO jn = jp_pcs0, jp_pcs1 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 147 tra(:,:,:,jn) = 0._wp 178 148 END DO 179 !$OMP END PARALLEL180 149 ! 181 150 IF( ln_top_euler ) THEN 182 151 DO jn = jp_pcs0, jp_pcs1 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 152 trn(:,:,:,jn) = trb(:,:,:,jn) 191 153 END DO 192 154 ENDIF … … 387 349 ! 388 350 INTEGER, INTENT( in ) :: kt ! time step 389 INTEGER :: ji, jj, jk390 351 ! 391 352 REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) … … 396 357 REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn 397 358 REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb 398 REAL(wp), POINTER, DIMENSION(:,:,:) :: zctrn_jptal, zctrn_jppo4, zctrn_jppo3, zctrn_jpsil !workspace arrays399 REAL(wp), POINTER, DIMENSION(:,:,:) :: zctrb_jptal, zctrb_jppo4, zctrb_jppo3, zctrb_jpsil !workspace arrays400 359 !!--------------------------------------------------------------------- 401 360 … … 407 366 IF( cn_cfg == "orca" .AND. .NOT. lk_c1d ) THEN ! ORCA configuration (not 1D) ! 408 367 ! ! --------------------------- ! 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 412 368 ! set total alkalinity, phosphate, nitrate & silicate 413 369 zarea = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6 414 370 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 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 ) 450 387 ! 451 388 ! 452 389 IF( .NOT. ln_top_euler ) THEN 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 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 ) 489 407 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 )493 408 ! 494 409 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r7698 r7753 191 191 !-------------------------------------------------------------- 192 192 IF( .NOT.ln_rsttr ) THEN 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 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 246 238 ! initialize the half saturation constant for silicate 247 239 ! ---------------------------------------------------- 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 240 xksi(:,:) = 2.e-6 241 xksimax(:,:) = xksi(:,:) 256 242 END IF 257 243 -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r7698 r7753 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 , jj, ji! dummy loop index78 INTEGER :: jk ! 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 !$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 88 zun(:,:,:) = un(:,:,:) ! effective transport already in un/vn/wn 89 zvn(:,:,:) = vn(:,:,:) 90 zwn(:,:,:) = wn(:,:,:) 98 91 ELSE 99 92 ! 100 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)101 93 DO jk = 1, jpkm1 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 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) 109 97 END DO 110 98 ! 111 99 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 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 100 zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 101 zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 121 102 ENDIF 122 103 ! … … 126 107 IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport 127 108 ! 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 109 zun(:,:,jpk) = 0._wp ! no transport trough the bottom 110 zvn(:,:,jpk) = 0._wp 111 zwn(:,:,jpk) = 0._wp 136 112 ! 137 113 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r7698 r7753 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 !$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 63 ztrtrd(:,:,:,:) = tra(:,:,:,:) 73 64 ENDIF 74 65 … … 97 88 IF( l_trdtrc ) THEN ! save the horizontal diffusive trends for further diagnostics 98 89 DO jn = 1, jptra 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 90 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 107 91 CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 108 92 END DO -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r7698 r7753 76 76 IF( l_trdtrc ) THEN 77 77 CALL wrk_alloc( jpi,jpj,jpk,jptra, ztrtrd ) 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 78 ztrtrd(:,:,:,:) = tra(:,:,:,:) 88 79 ENDIF 89 80 ! !* set the lateral diffusivity coef. for passive tracer 90 81 CALL wrk_alloc( jpi,jpj,jpk, zahu, zahv ) 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 82 zahu(:,:,:) = rldf * ahtu(:,:,:) 83 zahv(:,:,:) = rldf * ahtv(:,:,:) 101 84 ! !* Enhanced zonal diffusivity coefficent in the equatorial domain 102 !$OMP DO schedule(static) private(jk,jj,ji,zdep)103 85 DO jk= 1, jpk 104 86 DO jj = 1, jpj … … 111 93 END DO 112 94 END DO 113 !$OMP END DO NOWAIT114 !$OMP END PARALLEL115 95 ! 116 96 SELECT CASE ( nldf ) !* compute lateral mixing trend and add it to the general trend … … 132 112 IF( l_trdtrc ) THEN ! send the trends for further diagnostics 133 113 DO jn = 1, jptra 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 114 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 142 115 CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 143 116 END DO -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r7698 r7753 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 , jj, ji! dummy loop indices79 INTEGER :: jk, jn ! 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 !$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 103 ztrdt(:,:,:,:) = trn(:,:,:,:) 113 104 ENDIF 114 105 ! ! Leap-Frog + Asselin filter time stepping 115 106 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)117 107 DO jn = 1, jptra 118 108 DO jk = 1, jpkm1 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 109 trn(:,:,jk,jn) = tra(:,:,jk,jn) 124 110 END DO 125 111 END DO … … 141 127 DO jk = 1, jpkm1 142 128 zfact = 1._wp / r2dttrc 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 129 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 149 130 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 150 131 END DO -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r7698 r7753 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 arrays143 142 REAL(wp) :: zs2rdt 144 143 LOGICAL :: lldebug = .FALSE. … … 148 147 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 149 148 150 CALL wrk_alloc( jpi, jpj, jpk, zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin )151 149 IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved 152 150 … … 157 155 158 156 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 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 157 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 158 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 168 159 ENDIF 169 160 ! ! sum over the global domain 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(:,:,:) ) 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(:,:,:) ) 185 166 186 167 IF( ztrcorb /= 0 ) THEN 187 168 zcoef = 1. + ztrcorb / ztrmasb 188 !$OMP PARALLEL DO schedule(static) private(jk)189 169 DO jk = 1, jpkm1 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 170 ptrb(:,:,jk,jn) = MAX( 0., ptrb(:,:,jk,jn) ) 171 ptrb(:,:,jk,jn) = ptrb(:,:,jk,jn) * zcoef * tmask(:,:,jk) 196 172 END DO 197 173 ENDIF … … 199 175 IF( ztrcorn /= 0 ) THEN 200 176 zcoef = 1. + ztrcorn / ztrmasn 201 !$OMP PARALLEL DO schedule(static) private(jk)202 177 DO jk = 1, jpkm1 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 178 ptrn(:,:,jk,jn) = MAX( 0., ptrn(:,:,jk,jn) ) 179 ptrn(:,:,jk,jn) = ptrn(:,:,jk,jn) * zcoef * tmask(:,:,jk) 209 180 END DO 210 181 ENDIF … … 213 184 ! 214 185 zs2rdt = 1. / ( 2. * rdt ) 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 186 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 187 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 225 188 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 226 189 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling … … 236 199 237 200 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 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 260 215 ! 261 216 zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 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 217 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 218 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 271 219 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 272 220 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling … … 279 227 280 228 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 281 CALL wrk_dealloc( jpi, jpj, jpk, zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin )282 229 283 230 END SUBROUTINE trc_rad_sms -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r7698 r7753 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 k, jn ! dummy loop indices63 INTEGER :: ji, jj, 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 86 85 87 86 IF( kt == nittrc000 ) THEN … … 99 98 ELSE ! No restart or restart not found: Euler forward time stepping 100 99 zfact = 1._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 100 sbc_trc_b(:,:,:) = 0._wp 109 101 ENDIF 110 102 ELSE ! Swap of forcing fields 111 103 IF( ln_top_euler ) THEN 112 104 zfact = 1._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 105 sbc_trc_b(:,:,:) = 0._wp 121 106 ELSE 122 107 zfact = 0.5_wp 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 108 sbc_trc_b(:,:,:) = sbc_trc(:,:,:) 131 109 ENDIF 132 110 ! … … 138 116 ! 139 117 IF( .NOT.ln_linssh ) THEN ! online coupling with vvl 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 118 zsfx(:,:) = 0._wp 146 119 ELSE ! online coupling free surface or offline with free surface 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 120 zsfx(:,:) = emp(:,:) 153 121 ENDIF 154 122 … … 156 124 DO jn = 1, jptra 157 125 ! 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 126 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 127 168 128 IF ( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice) 169 129 170 !$OMP PARALLEL DO schedule(static) private(jj, ji)171 130 DO jj = 2, jpj 172 131 DO ji = fs_2, fs_jpim1 ! vector opt. … … 177 136 ELSE 178 137 179 !$OMP PARALLEL DO schedule(static) private(jj,ji,zse3t,zftra,zcd,ztfx,zdtra,zratio)180 138 DO jj = 2, jpj 181 139 DO ji = fs_2, fs_jpim1 ! vector opt. … … 201 159 CALL lbc_lnk( sbc_trc(:,:,jn), 'T', 1. ) 202 160 ! Concentration dilution effect on tracers due to evaporation & precipitation 203 !$OMP PARALLEL DO schedule(static) private(jj,ji,zse3t)204 161 DO jj = 2, jpj 205 162 DO ji = fs_2, fs_jpim1 ! vector opt. … … 210 167 ! 211 168 IF( l_trdtrc ) THEN 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 169 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 220 170 CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 221 171 END IF -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r7698 r7753 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 , jj, ji55 INTEGER :: jk, jn 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 !$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 64 ztrtrd(:,:,:,:) = tra(:,:,:,:) 74 65 ENDIF 75 66 … … 81 72 IF( l_trdtrc ) THEN ! save the vertical diffusive trends for further diagnostics 82 73 DO jn = 1, jptra 83 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)84 74 DO jk = 1, jpkm1 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 75 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn) 90 76 END DO 91 77 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) -
trunk/NEMOGCM/NEMO/TOP_SRC/trcice.F90
r7698 r7753 38 38 !!--------------------------------------------------------------------- 39 39 ! --- Variable declarations --- ! 40 INTEGER :: jn, jj, ji ! dummy loop indices41 40 42 41 IF(lwp) THEN … … 50 49 CALL trc_nam_ice 51 50 ! 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 51 trc_i(:,:,:) = 0.0d0 ! by default 52 trc_o(:,:,:) = 0.0d0 ! by default 61 53 62 54 IF ( nn_ice_tr == 1 ) THEN -
trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r7698 r7753 105 105 !! ** Purpose : passive tracers inventories at initialsation phase 106 106 !!---------------------------------------------------------------------- 107 INTEGER :: jk, jn , jj, ji! dummy loop indices107 INTEGER :: jk, jn ! dummy loop indices 108 108 CHARACTER (len=25) :: charout 109 109 !!---------------------------------------------------------------------- 110 110 ! ! masked grid volume 111 !$OMP PARALLEL112 !$OMP DO schedule(static) private(jk,jj,ji)113 111 DO jk = 1, jpk 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 112 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 119 113 END DO 120 !121 !$OMP DO schedule(static) private(jn)122 DO jn = 1, jptra123 trai(jn) = 0._wp ! initial content of all tracers124 END DO125 !$OMP END PARALLEL126 114 ! ! total volume of the ocean 127 115 areatot = glob_sum( cvol(:,:,:) ) 128 116 ! 117 trai(:) = 0._wp ! initial content of all tracers 129 118 DO jn = 1, jptra 130 119 trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) … … 231 220 USE trcdta ! initialisation from files 232 221 ! 233 INTEGER :: jn, jl , jk, jj, ji! dummy loop indices222 INTEGER :: jn, jl ! dummy loop indices 234 223 !!---------------------------------------------------------------------- 235 224 ! … … 265 254 ENDIF 266 255 ! 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 256 trb(:,:,:,:) = trn(:,:,:,:) 277 257 ! 278 258 ENDIF 279 259 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 260 tra(:,:,:,:) = 0._wp 290 261 ! ! Partial top/bottom cell: GRADh(trn) 291 262 END SUBROUTINE trc_ini_state -
trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r7698 r7753 268 268 !! ** purpose : Compute tracers statistics 269 269 !!---------------------------------------------------------------------- 270 INTEGER :: jk, j j, ji, jn270 INTEGER :: jk, 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)282 281 DO jk = 1, jpk 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 282 zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 288 283 END DO 289 284 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r7698 r7753 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 , jj, ji! dummy loop indices55 INTEGER :: jk, jn ! 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)73 72 DO jk = 1, jpk 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 73 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 79 74 END DO 80 75 areatot = glob_sum( cvol(:,:,:) ) … … 92 87 ENDIF 93 88 ! 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 89 tra(:,:,:,:) = 0.e0 104 90 ! 105 91 CALL trc_rst_opn ( kt ) ! Open tracer restart file -
trunk/NEMOGCM/SETTE/prepare_job.sh
r7715 r7753 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 NUM_OMP_THREADS"70 usage=" Usage : ./prepare_job.sh INPUT_FILE_CONFIG_NAME NUMBER_PROC TEST_NAME MPI_FLAG JOB_FILE NUM_XIO_SERVERS" 71 71 usage=" example : ./prepare_job.sh input_ORCA2_LIM_PISCES.cfg 8 SHORT no/yes $JOB_FILE 0 2" 72 72 … … 94 94 JOB_FILE=$5 95 95 NXIO_PROC=$6 96 NOMP_THR=$797 96 98 97 # export EXE_DIR. This directory is used to execute model … … 294 293 echo NB_PROC_NODE ${NB_PROC_NODE} 295 294 ;; 296 ifort_athena_*)297 NB_PROC_NODE=$(( 16 / NOMP_THR ))298 ;;299 295 *) 300 296 NB_NODES=${NB_PROC} … … 309 305 -e"s/TOTAL_NPROCS/${TOTAL_NPROCS}/" \ 310 306 -e"s/NPROCS/${NB_PROC}/" \ 311 -e"s/OMP_NTHR/${NOMP_THR}/" \312 307 -e"s/NXIOPROCS/${NXIO_PROC}/" \ 313 308 -e"s:DEF_SETTE_DIR:${SETTE_DIR}:" -e"s:DEF_INPUT_DIR:${INPUT_DIR}:" \ … … 326 321 XC40_METO*) 327 322 cat run_sette_test.job | sed -e"s/SELECT/${SELECT}/" > run_sette_test1.job 328 mv run_sette_test1.job run_sette_test.job329 ;;330 ifort_athena_*)331 cat run_sette_test.job | sed -e"s/NPROC_NODE/${NB_PROC_NODE}/" > run_sette_test1.job332 323 mv run_sette_test1.job run_sette_test.job 333 324 ;; -
trunk/NEMOGCM/SETTE/sette.sh
r7744 r7753 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 parallelization39 38 # NUM_XIOSERVERS : number of stand-alone IO servers to employ 40 39 # set to zero if USING_MPMD="no" … … 91 90 COMPILER=X64_ADA 92 91 93 export USING_OMP="no"94 92 export BATCH_COMMAND_PAR="llsubmit" 95 93 export BATCH_COMMAND_SEQ=$BATCH_COMMAND_PAR … … 121 119 echo "Incompatible choices. MPMD mode requires the XIOS server" 122 120 exit 123 fi124 #125 # Settings which control the hybrid parallel execution126 #127 OMP_NTHR=1128 if [ ${USING_OMP} == "yes" ]129 then130 OMP_NTHR=8131 121 fi 132 122 … … 188 178 fi 189 179 cd ${SETTE_DIR} 190 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}180 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 191 181 192 182 cd ${SETTE_DIR} … … 228 218 fi 229 219 cd ${SETTE_DIR} 230 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}220 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 231 221 cd ${SETTE_DIR} 232 222 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 263 253 fi 264 254 cd ${SETTE_DIR} 265 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}255 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 266 256 cd ${SETTE_DIR} 267 257 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 291 281 fi 292 282 cd ${SETTE_DIR} 293 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}283 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 294 284 cd ${SETTE_DIR} 295 285 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 340 330 fi 341 331 cd ${SETTE_DIR} 342 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}332 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 343 333 344 334 cd ${SETTE_DIR} … … 392 382 fi 393 383 cd ${SETTE_DIR} 394 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}384 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 395 385 cd ${SETTE_DIR} 396 386 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 441 431 fi 442 432 cd ${SETTE_DIR} 443 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}433 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 444 434 cd ${SETTE_DIR} 445 435 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 482 472 fi 483 473 cd ${SETTE_DIR} 484 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}474 . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 485 475 cd ${SETTE_DIR} 486 476 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 531 521 fi 532 522 cd ${SETTE_DIR} 533 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}523 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 534 524 535 525 cd ${SETTE_DIR} … … 574 564 fi 575 565 cd ${SETTE_DIR} 576 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}566 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 577 567 cd ${SETTE_DIR} 578 568 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 621 611 fi 622 612 cd ${SETTE_DIR} 623 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}613 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 624 614 cd ${SETTE_DIR} 625 615 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 661 651 fi 662 652 cd ${SETTE_DIR} 663 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}653 . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 664 654 cd ${SETTE_DIR} 665 655 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 697 687 fi 698 688 cd ${SETTE_DIR} 699 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}689 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 700 690 701 691 cd ${SETTE_DIR} … … 728 718 fi 729 719 cd ${SETTE_DIR} 730 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}720 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 731 721 cd ${SETTE_DIR} 732 722 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 762 752 fi 763 753 cd ${SETTE_DIR} 764 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}754 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 765 755 cd ${SETTE_DIR} 766 756 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 788 778 fi 789 779 cd ${SETTE_DIR} 790 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}780 . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 791 781 cd ${SETTE_DIR} 792 782 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 826 816 fi 827 817 cd ${SETTE_DIR} 828 . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}818 . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 829 819 830 820 cd ${SETTE_DIR} … … 857 847 done 858 848 cd ${SETTE_DIR} 859 . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}849 . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 860 850 cd ${SETTE_DIR} 861 851 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 891 881 fi 892 882 cd ${SETTE_DIR} 893 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}883 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 894 884 895 885 cd ${SETTE_DIR} … … 925 915 fi 926 916 cd ${SETTE_DIR} 927 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}917 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 928 918 cd ${SETTE_DIR} 929 919 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 957 947 fi 958 948 cd ${SETTE_DIR} 959 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}949 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 960 950 cd ${SETTE_DIR} 961 951 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 983 973 fi 984 974 cd ${SETTE_DIR} 985 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}975 . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 986 976 cd ${SETTE_DIR} 987 977 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1046 1036 fi 1047 1037 cd ${SETTE_DIR} 1048 . ./prepare_job.sh input_ORCA2_LIM3_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}1038 . ./prepare_job.sh input_ORCA2_LIM3_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1049 1039 cd ${SETTE_DIR} 1050 1040 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1099 1089 fi 1100 1090 cd ${SETTE_DIR} 1101 . ./prepare_job.sh input_ORCA2_LIM3_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}1091 . ./prepare_job.sh input_ORCA2_LIM3_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1102 1092 cd ${SETTE_DIR} 1103 1093 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1143 1133 fi 1144 1134 cd ${SETTE_DIR} 1145 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}1135 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1146 1136 cd ${SETTE_DIR} 1147 1137 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1185 1175 fi 1186 1176 cd ${SETTE_DIR} 1187 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}1177 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1188 1178 cd ${SETTE_DIR} 1189 1179 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1219 1209 fi 1220 1210 cd ${SETTE_DIR} 1221 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}1211 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1222 1212 cd ${SETTE_DIR} 1223 1213 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1268 1258 fi 1269 1259 cd ${SETTE_DIR} 1270 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}1260 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1271 1261 1272 1262 cd ${SETTE_DIR} … … 1317 1307 fi 1318 1308 cd ${SETTE_DIR} 1319 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}1309 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1320 1310 cd ${SETTE_DIR} 1321 1311 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1362 1352 fi 1363 1353 cd ${SETTE_DIR} 1364 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}1354 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1365 1355 cd ${SETTE_DIR} 1366 1356 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} … … 1400 1390 fi 1401 1391 cd ${SETTE_DIR} 1402 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} ${OMP_NTHR}1392 . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 1403 1393 cd ${SETTE_DIR} 1404 1394 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
Note: See TracChangeset
for help on using the changeset viewer.
