Changeset 7753
- Timestamp:
- 2017-03-03T12:46:59+01:00 (8 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 )