Changeset 7753 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES
- Timestamp:
- 2017-03-03T12:46:59+01:00 (7 years ago)
- Location:
- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES
- Files:
-
- 20 edited
-
P4Z/p4zagg.F90 (modified) (2 diffs)
-
P4Z/p4zbio.F90 (modified) (2 diffs)
-
P4Z/p4zche.F90 (modified) (13 diffs)
-
P4Z/p4zfechem.F90 (modified) (9 diffs)
-
P4Z/p4zflx.F90 (modified) (12 diffs)
-
P4Z/p4zint.F90 (modified) (4 diffs)
-
P4Z/p4zlim.F90 (modified) (6 diffs)
-
P4Z/p4zlys.F90 (modified) (4 diffs)
-
P4Z/p4zmeso.F90 (modified) (2 diffs)
-
P4Z/p4zmicro.F90 (modified) (2 diffs)
-
P4Z/p4zmort.F90 (modified) (4 diffs)
-
P4Z/p4zopt.F90 (modified) (12 diffs)
-
P4Z/p4zpoc.F90 (modified) (20 diffs)
-
P4Z/p4zprod.F90 (modified) (14 diffs)
-
P4Z/p4zrem.F90 (modified) (11 diffs)
-
P4Z/p4zsbc.F90 (modified) (9 diffs)
-
P4Z/p4zsed.F90 (modified) (26 diffs)
-
P4Z/p4zsink.F90 (modified) (16 diffs)
-
P4Z/p4zsms.F90 (modified) (6 diffs)
-
trcini_pisces.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zagg.F90
r7698 r7753 56 56 IF( ln_p4z ) THEN 57 57 ! 58 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact,zagg1,zagg2,zagg3,zagg4,zagg,zaggfe,zaggdoc,zaggdoc2,zaggdoc3)59 58 DO jk = 1, jpkm1 60 59 DO jj = 1, jpj … … 103 102 ELSE ! ln_p5z 104 103 ! 105 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact,zaggtmp,zaggfe,zaggpoc,zaggpoc1,zaggpoc2,zaggpoc3,zaggpoc4) &106 !$OMP& private(zaggpon,zaggpop,zaggdoc,zaggdon,zaggdop,zaggdoc2,zaggdon2,zaggdop2,zaggdoc3,zaggdon3,zaggdop3)107 104 DO jk = 1, jpkm1 108 105 DO jj = 1, jpj -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r7698 r7753 66 66 ! OF PHYTOPLANKTON AND DETRITUS 67 67 68 !$OMP PARALLEL 69 !$OMP DO schedule(static) private(jk,jj,ji) 70 DO jk = 1, jpk 71 DO jj = 1, jpj 72 DO ji = 1, jpi 73 xdiss(ji,jj,jk) = 1. 74 END DO 75 END DO 76 END DO 68 xdiss(:,:,:) = 1. 77 69 !!gm the use of nmld should be better here? 78 !$OMP DO schedule(static) private(jk,jj,ji)79 70 DO jk = 2, jpkm1 80 71 DO jj = 1, jpj … … 85 76 END DO 86 77 END DO 87 !$OMP END PARALLEL88 78 89 79 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r7698 r7753 132 132 !!---------------------------------------------------------------------- 133 133 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 134 !! $Id$ 134 !! $Id$ 135 135 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 136 136 !!---------------------------------------------------------------------- … … 165 165 ! ------------------------------------------------------------- 166 166 IF (neos == -1) THEN 167 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 168 DO jk = 1, jpk 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 salinprac(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) * 35.0 / 35.16504 172 END DO 173 END DO 174 END DO 167 salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 175 168 ELSE 176 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 177 DO jk = 1, jpk 178 DO jj = 1, jpj 179 DO ji = 1, jpi 180 salinprac(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) 181 END DO 182 END DO 183 END DO 169 salinprac(:,:,:) = tsn(:,:,:,jp_sal) 184 170 ENDIF 185 171 … … 190 176 ! 0.04°C relative to an exact computation 191 177 ! --------------------------------------------------------------------- 192 !$OMP PARALLEL193 !$OMP DO schedule(static) private(jk,jj,ji,zpres,za1,za2)194 178 DO jk = 1, jpk 195 179 DO jj = 1, jpj … … 206 190 ! ---------------------------------- 207 191 !CDIR NOVERRCHK 208 !$OMP DO schedule(static) private(jj,ji,ztkel,zt,zsal,zcek1)209 192 DO jj = 1, jpj 210 193 !CDIR NOVERRCHK … … 228 211 ! ------------------------------- 229 212 !CDIR NOVERRCHK 230 !$OMP DO schedule(static) private(jk,jj,ji,ztkel,zsal,zsal2,ztgg,ztgg2,ztgg3,ztgg4,ztgg5,zoxy)231 213 DO jk = 1, jpk 232 214 !CDIR NOVERRCHK … … 257 239 ! ------------------------------- 258 240 !CDIR NOVERRCHK 259 !$OMP DO schedule(static) private(jk,jj,ji,zplat,zc1,zpres,ztkel,zsal,zsqrt,zsal15,zlogt,ztr,zis,zis2,zisqrt,ztc,zcl,zst) &260 !$OMP& private(zft,zcks,zckf,zckb,zck1,zck2,zckw,zck1p,zck2p,zck3p,zcksi,zaksp0,total2free,free2SWS,total2SWS,SWS2total,zak1,zak2,zakb,zakw,zaksp1,zak1p,zak2p,zak3p,zaksi,zcpexp,zcpexp2,zbuf1,zbuf2,ztkel1)261 241 DO jk = 1, jpk 262 242 !CDIR NOVERRCHK … … 466 446 END DO 467 447 END DO 468 !$OMP END PARALLEL469 448 ! 470 449 IF( nn_timing == 1 ) CALL timing_stop('p4z_che') … … 494 473 IF( nn_timing == 1 ) CALL timing_start('ahini_for_at') 495 474 ! 496 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,p_alkcb,p_dictot,p_bortot,zca1,zba1,za2,za1,za0,zd,zsqrtd,zhmin)497 475 DO jk = 1, jpk 498 476 DO jj = 1, jpj … … 537 515 ! 538 516 END SUBROUTINE ahini_for_at 517 539 518 !=============================================================================== 540 519 SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) … … 547 526 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 548 527 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 549 INTEGER :: ji, jj, jk 550 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 551 DO jk = 1, jpk 552 DO jj = 1, jpj 553 DO ji = 1, jpi 554 p_alknw_inf(ji,jj,jk) = -trb(ji,jj,jk,jppo4) * 1000. / (rhop(ji,jj,jk) + rtrn) - sulfat(ji,jj,jk) & 555 & - fluorid(ji,jj,jk) 556 p_alknw_sup(ji,jj,jk) = (2. * trb(ji,jj,jk,jpdic) + 2. * trb(ji,jj,jk,jppo4) + trb(ji,jj,jk,jpsil) ) & 557 & * 1000. / (rhop(ji,jj,jk) + rtrn) + borat(ji,jj,jk) 558 END DO 559 END DO 560 END DO 528 529 p_alknw_inf(:,:,:) = -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:) & 530 & - fluorid(:,:,:) 531 p_alknw_sup(:,:,:) = (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) ) & 532 & * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:) 561 533 562 534 END SUBROUTINE anw_infsup … … 599 571 CALL anw_infsup( zalknw_inf, zalknw_sup ) 600 572 601 !$OMP PARALLEL 602 !$OMP DO schedule(static) private(jk,jj,ji) 603 DO jk = 1, jpk 604 DO jj = 1, jpj 605 DO ji = 1, jpi 606 rmask(ji,jj,jk) = tmask(ji,jj,jk) 607 zhi(ji,jj,jk) = 0. 608 END DO 609 END DO 610 END DO 573 rmask(:,:,:) = tmask(:,:,:) 574 zhi(:,:,:) = 0. 611 575 612 576 ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 613 !$OMP DO schedule(static) private(jk,jj,ji,p_alktot,aphscale,zh_ini,zdelta)614 577 DO jk = 1, jpk 615 578 DO jj = 1, jpj … … 642 605 END DO 643 606 644 !$OMP DO schedule(static) private(jk,jj,ji) 645 DO jk = 1, jpk 646 DO jj = 1, jpj 647 DO ji = 1, jpi 648 zeqn_absmin(ji,jj,jk) = HUGE(1._wp) 649 END DO 650 END DO 651 END DO 607 zeqn_absmin(:,:,:) = HUGE(1._wp) 652 608 653 609 DO jn = 1, jp_maxniter_atgen 654 !$OMP DO schedule(static) private(jk,jj,ji,zfact,p_alktot,zdic,zbot,zpt,zsit,zst,zft,zh,zh_prev,znumer_dic) &655 !$OMP& private(zdenom_dic,zalk_dic,zdnumer_dic,zdalk_dic,znumer_bor,zdenom_bor,zalk_bor,zdnumer_bor,zdalk_bor) &656 !$OMP& private(znumer_po4,zdenom_po4,zalk_po4,zdnumer_po4,zdalk_po4,znumer_sil,zdenom_sil,zalk_sil,zdnumer_sil) &657 !$OMP& private(zdalk_sil,aphscale,znumer_so4,zdenom_so4,zalk_so4,zdnumer_so4,zdalk_so4,znumer_flu,zdenom_flu) &658 !$OMP& private(zalk_flu,zdnumer_flu,zdalk_flu,zalk_wat,zdalk_wat,zeqn,zalka,zdeqndh,zh_lnfactor,zh_delta,l_exitnow)659 610 DO jk = 1, jpk 660 611 DO jj = 1, jpj … … 845 796 END DO 846 797 END DO 847 !$OMP END PARALLEL848 798 ! 849 799 CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r7698 r7753 83 83 ! Allocate temporary workspace 84 84 CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 85 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 86 DO jk = 1, jpk 87 DO jj = 1, jpj 88 DO ji = 1, jpi 89 zFe3 (ji,jj,jk) = 0. 90 zFeL1(ji,jj,jk) = 0. 91 zTL1 (ji,jj,jk) = 0. 92 END DO 93 END DO 94 END DO 85 zFe3 (:,:,:) = 0. 86 zFeL1(:,:,:) = 0. 87 zTL1 (:,:,:) = 0. 88 IF( ln_fechem ) THEN 89 CALL wrk_alloc( jpi, jpj, zstrn, zstrn2 ) 90 CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 91 zFe2 (:,:,:) = 0. 92 zFeL2(:,:,:) = 0. 93 zTL2 (:,:,:) = 0. 94 zFeP (:,:,:) = 0. 95 ENDIF 95 96 96 97 ! Total ligand concentration : Ligands can be chosen to be constant or variable … … 98 99 ! ------------------------------------------------- 99 100 IF( ln_ligvar ) THEN 100 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 101 DO jk = 1, jpk 102 DO jj = 1, jpj 103 DO ji = 1, jpi 104 ztotlig(ji,jj,jk) = 0.09 * trb(ji,jj,jk,jpdoc) * 1E6 + ligand * 1E9 105 ztotlig(ji,jj,jk) = MIN( ztotlig(ji,jj,jk), 10. ) 106 END DO 107 END DO 108 END DO 101 ztotlig(:,:,:) = 0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9 102 ztotlig(:,:,:) = MIN( ztotlig(:,:,:), 10. ) 109 103 ELSE 110 IF( ln_ligand ) THEN 111 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 112 DO jk = 1, jpk 113 DO jj = 1, jpj 114 DO ji = 1, jpi 115 ztotlig(ji,jj,jk) = trb(ji,jj,jk,jplgw) * 1E9 116 END DO 117 END DO 118 END DO 119 ELSE 120 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 121 DO jk = 1, jpk 122 DO jj = 1, jpj 123 DO ji = 1, jpi 124 ztotlig(ji,jj,jk) = ligand * 1E9 125 END DO 126 END DO 127 END DO 104 IF( ln_ligand ) THEN ; ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9 105 ELSE ; ztotlig(:,:,:) = ligand * 1E9 128 106 ENDIF 129 107 ENDIF 130 108 131 109 IF( ln_fechem ) THEN 132 CALL wrk_alloc( jpi, jpj, zstrn, zstrn2 )133 CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP )134 110 ! compute the day length depending on latitude and the day 135 111 zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 136 112 zcodel = ASIN( SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp ) ) 137 113 138 !$OMP PARALLEL139 !$OMP DO schedule(static) private(jk,jj,ji)140 DO jk = 1, jpk141 DO jj = 1, jpj142 DO ji = 1, jpi143 zFe2 (ji,jj,jk) = 0.144 zFeL2(ji,jj,jk) = 0.145 zTL2 (ji,jj,jk) = 0.146 zFeP (ji,jj,jk) = 0.147 END DO148 END DO149 END DO150 114 ! day length in hours 151 !$OMP DO schedule(static) private(jj,ji) 152 DO jj = 1, jpj 153 DO ji = 1, jpi 154 zstrn(ji,jj) = 0. 155 END DO 156 END DO 157 !$OMP DO schedule(static) private(jj,ji,zargu) 115 zstrn(:,:) = 0. 158 116 DO jj = 1, jpj 159 117 DO ji = 1, jpi … … 165 123 166 124 ! Maximum light intensity 167 !$OMP DO schedule(static) private(jj,ji) 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 zstrn2(ji,jj) = zstrn(ji,jj) / 24. 171 IF( zstrn(ji,jj) < 1.e0 ) zstrn(ji,jj) = 24. 172 zstrn(ji,jj) = 24. / zstrn(ji,jj) 173 END DO 174 END DO 125 zstrn2(:,:) = zstrn(:,:) / 24. 126 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 127 zstrn(:,:) = 24. / zstrn(:,:) 175 128 176 129 ! ------------------------------------------------------------ … … 180 133 ! ------------------------------------------------------------ 181 134 DO jn = 1, 2 182 !$OMP DO schedule(static) private(jk,jj,ji,zzstrn2,ztligand,zph,zoxy,zkox,zkph2,zkph1,ztfe,za) &183 !$OMP& private(zb,zc,zkappa1,zkappa2,za2,za1,za0,zp,zq,zp3,zq2,zd,zr,zphi,zxs,zfff,jic,zfunc) &184 !$OMP& private(zlight,zzFe3,zzFep,zzFeL2,zzFeL1,zzFe2)185 135 DO jk = 1, jpkm1 186 136 DO jj = 1, jpj … … 263 213 END DO 264 214 END DO 265 !$OMP END PARALLEL266 215 ELSE 267 216 ! ------------------------------------------------------------ … … 270 219 ! Chemistry is supposed to be fast enough to be at equilibrium 271 220 ! ------------------------------------------------------------ 272 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zkeq,zfesatur,ztfe)273 221 DO jk = 1, jpkm1 274 222 DO jj = 1, jpj … … 291 239 292 240 zdust = 0. ! if no dust available 293 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfeequi,zfecoll,zhplus,fe3sol,ztrc,zdust) &294 !$OMP& private(zlam1b,zscave,zdenom1,zdenom2,zlamfac,zdep,zcoag,zlam1a,zaggdfea,zaggdfeb)295 241 DO jk = 1, jpkm1 296 242 DO jj = 1, jpj … … 362 308 ! Define the bioavailable fraction of iron 363 309 ! ---------------------------------------- 364 IF( ln_fechem ) THEN 365 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 366 DO jk = 1, jpk 367 DO jj = 1, jpj 368 DO ji = 1, jpi 369 biron(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) - zFeP(ji,jj,jk) * 1E-9 ) 370 END DO 371 END DO 372 END DO 373 ELSE 374 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 375 DO jk = 1, jpk 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 biron(ji,jj,jk) = trb(ji,jj,jk,jpfer) 379 END DO 380 END DO 381 END DO 310 IF( ln_fechem ) THEN ; biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 311 ELSE ; biron(:,:,:) = trb(:,:,:,jpfer) 382 312 ENDIF 383 313 ! 384 314 IF( ln_ligand ) THEN 385 315 ! 386 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zlam1a,zlam1b,zligco,zaggliga,zaggligb)387 316 DO jk = 1, jpkm1 388 317 DO jj = 1, jpj … … 402 331 ! 403 332 IF( .NOT.ln_fechem) THEN 404 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 405 DO jk = 1, jpk 406 DO jj = 1, jpj 407 DO ji = 1, jpi 408 plig(ji,jj,jk) = MAX( 0., ( ( zFeL1(ji,jj,jk) * 1E-9 ) / ( trb(ji,jj,jk,jpfer) +rtrn ) ) ) 409 plig(ji,jj,jk) = MAX( 0. , plig(ji,jj,jk) ) 410 END DO 411 END DO 412 END DO 333 plig(:,:,:) = MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 334 plig(:,:,:) = MAX( 0. , plig(:,:,:) ) 413 335 ENDIF 414 336 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r7698 r7753 54 54 !!---------------------------------------------------------------------- 55 55 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 56 !! $Id$ 56 !! $Id$ 57 57 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 58 58 !!---------------------------------------------------------------------- … … 105 105 zdco2dt = ( atcco2h(iind) - atcco2h(iindm1) ) / ( years(iind) - years(iindm1) + rtrn ) 106 106 atcco2 = zdco2dt * ( zyr_dec - years(iindm1) ) + atcco2h(iindm1) 107 !$OMP PARALLEL DO schedule(static) private(jj,ji) 108 DO jj = 1, jpj 109 DO ji = 1, jpi 110 satmco2(ji,jj) = atcco2 111 END DO 112 END DO 113 ENDIF 114 115 IF( l_co2cpl ) THEN 116 !$OMP PARALLEL DO schedule(static) private(jj,ji) 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 satmco2(ji,jj) = atm_co2(ji,jj) 120 END DO 121 END DO 122 END IF 123 124 !$OMP PARALLEL 125 !$OMP DO schedule(static) private(jj,ji,zfact,zdic,zph) 107 satmco2(:,:) = atcco2 108 ENDIF 109 110 IF( l_co2cpl ) satmco2(:,:) = atm_co2(:,:) 111 126 112 DO jj = 1, jpj 127 113 DO ji = 1, jpi … … 142 128 ! ------------------------------------------- 143 129 144 !$OMP DO schedule(static) private(jj,ji,ztc,ztc2,ztc3,ztc4,zsch_co2,zsch_o2,zws,zkgwan)145 130 DO jj = 1, jpj 146 131 DO ji = 1, jpi … … 164 149 165 150 166 !$OMP DO schedule(static) private(jj,ji,ztkel,zsal,zvapsw,zxc2,zfugcoeff,zfco2,zfld,zflu,zflu16)167 151 DO jj = 1, jpj 168 152 DO ji = 1, jpi … … 190 174 END DO 191 175 END DO 192 !$OMP END PARALLEL193 176 194 177 t_oce_co2_flx = glob_sum( oce_co2(:,:) ) ! Total Flux of Carbon … … 206 189 CALL wrk_alloc( jpi, jpj, zw2d ) 207 190 IF( iom_use( "Cflx" ) ) THEN 208 !$OMP PARALLEL DO schedule(static) private(jj,ji) 209 DO jj = 1, jpj 210 DO ji = 1, jpi 211 zw2d(ji,jj) = oce_co2(ji,jj) / e1e2t(ji,jj) * rfact2r 212 END DO 213 END DO 191 zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r 214 192 CALL iom_put( "Cflx" , zw2d ) 215 193 ENDIF 216 194 IF( iom_use( "Oflx" ) ) THEN 217 !$OMP PARALLEL DO schedule(static) private(jj,ji) 218 DO jj = 1, jpj 219 DO ji = 1, jpi 220 zw2d(ji,jj) = zoflx(ji,jj) * 1000 * tmask(ji,jj,1) 221 END DO 222 END DO 195 zw2d(:,:) = zoflx(:,:) * 1000 * tmask(:,:,1) 223 196 CALL iom_put( "Oflx" , zw2d ) 224 197 ENDIF 225 198 IF( iom_use( "Kg" ) ) THEN 226 !$OMP PARALLEL DO schedule(static) private(jj,ji) 227 DO jj = 1, jpj 228 DO ji = 1, jpi 229 zw2d(ji,jj) = zkgco2(ji,jj) * tmask(ji,jj,1) 230 END DO 231 END DO 199 zw2d(:,:) = zkgco2(:,:) * tmask(:,:,1) 232 200 CALL iom_put( "Kg" , zw2d ) 233 201 ENDIF 234 202 IF( iom_use( "Dpco2" ) ) THEN 235 !$OMP PARALLEL DO schedule(static) private(jj,ji) 236 DO jj = 1, jpj 237 DO ji = 1, jpi 238 zw2d(ji,jj) = ( zpco2atm(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 239 END DO 240 END DO 203 zw2d(:,:) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 241 204 CALL iom_put( "Dpco2" , zw2d ) 242 205 ENDIF 243 206 IF( iom_use( "Dpo2" ) ) THEN 244 !$OMP PARALLEL DO schedule(static) private(jj,ji) 245 DO jj = 1, jpj 246 DO ji = 1, jpi 247 zw2d(ji,jj) = ( atcox * patm(ji,jj) - atcox * trb(ji,jj,1,jpoxy) / ( chemo2(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 248 END DO 249 END DO 207 zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 250 208 CALL iom_put( "Dpo2" , zw2d ) 251 209 ENDIF … … 274 232 !!---------------------------------------------------------------------- 275 233 NAMELIST/nampisext/ln_co2int, atcco2, clname, nn_offset 276 INTEGER :: jm , jj, ji234 INTEGER :: jm 277 235 INTEGER :: ios ! Local integer output status for namelist read 278 236 !!---------------------------------------------------------------------- … … 300 258 WRITE(numout,*) ' ' 301 259 ENDIF 302 !$OMP PARALLEL DO schedule(static) private(jj,ji) 303 DO jj = 1, jpj 304 DO ji = 1, jpi 305 satmco2(ji,jj) = atcco2 ! Initialisation of atmospheric pco2 306 END DO 307 END DO 260 satmco2(:,:) = atcco2 ! Initialisation of atmospheric pco2 308 261 ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 309 262 IF(lwp) THEN … … 341 294 342 295 ! 343 !$OMP PARALLEL DO schedule(static) private(jj,ji) 344 DO jj = 1, jpj 345 DO ji = 1, jpi 346 oce_co2(ji,jj) = 0._wp ! Initialization of Flux of Carbon 347 END DO 348 END DO 296 oce_co2(:,:) = 0._wp ! Initialization of Flux of Carbon 349 297 t_oce_co2_flx = 0._wp 350 298 t_atm_co2_flx = 0._wp … … 365 313 !! * arguments 366 314 INTEGER, INTENT( in ) :: kt ! ocean time step 367 INTEGER :: jj, ji368 315 ! 369 316 INTEGER :: ierr … … 414 361 ENDIF 415 362 ! 416 IF( .NOT.ln_presatm ) THEN 417 !$OMP PARALLEL DO schedule(static) private(jj,ji) 418 DO jj = 1, jpj 419 DO ji = 1, jpi 420 patm(ji,jj) = 1.e0 ! Initialize patm if no reading from a file 421 END DO 422 END DO 423 ENDIF 363 IF( .NOT.ln_presatm ) patm(:,:) = 1.e0 ! Initialize patm if no reading from a file 424 364 ! 425 365 ENDIF … … 427 367 IF( ln_presatm ) THEN 428 368 CALL fld_read( kt, 1, sf_patm ) !* input Patm provided at kt + 1/2 429 !$OMP PARALLEL DO schedule(static) private(jj,ji) 430 DO jj = 1, jpj 431 DO ji = 1, jpi 432 patm(ji,jj) = sf_patm(1)%fnow(ji,jj,1) ! atmospheric pressure 433 END DO 434 END DO 369 patm(:,:) = sf_patm(1)%fnow(:,:,1) ! atmospheric pressure 435 370 ENDIF 436 371 ! 437 372 IF( ln_presatmco2 ) THEN 438 373 CALL fld_read( kt, 1, sf_atmco2 ) !* input atmco2 provided at kt + 1/2 439 !$OMP PARALLEL DO schedule(static) private(jj,ji) 440 DO jj = 1, jpj 441 DO ji = 1, jpi 442 satmco2(ji,jj) = sf_atmco2(1)%fnow(ji,jj,1) ! atmospheric pressure 443 END DO 444 END DO 374 satmco2(:,:) = sf_atmco2(1)%fnow(:,:,1) ! atmospheric pressure 445 375 ELSE 446 !$OMP PARALLEL DO schedule(static) private(jj,ji) 447 DO jj = 1, jpj 448 DO ji = 1, jpi 449 satmco2(ji,jj) = atcco2 ! Initialize atmco2 if no reading from a file 450 END DO 451 END DO 376 satmco2(:,:) = atcco2 ! Initialize atmco2 if no reading from a file 452 377 ENDIF 453 378 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
r7698 r7753 21 21 !!---------------------------------------------------------------------- 22 22 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 23 !! $Id$ 23 !! $Id$ 24 24 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 25 25 !!---------------------------------------------------------------------- … … 36 36 INTEGER, INTENT( in ) :: kt ! ocean time-step index 37 37 ! 38 INTEGER :: ji, jj , jk! dummy loop indices38 INTEGER :: ji, jj ! dummy loop indices 39 39 REAL(wp) :: zvar ! local variable 40 40 !!--------------------------------------------------------------------- … … 44 44 ! Computation of phyto and zoo metabolic rate 45 45 ! ------------------------------------------- 46 !$OMP PARALLEL 47 !$OMP DO schedule(static) private(jk,jj,ji) 48 DO jk = 1, jpk 49 DO jj = 1, jpj 50 DO ji = 1, jpi 51 tgfunc (ji,jj,jk) = EXP( 0.063913 * tsn(ji,jj,jk,jp_tem) ) 52 tgfunc2(ji,jj,jk) = EXP( 0.07608 * tsn(ji,jj,jk,jp_tem) ) 53 END DO 54 END DO 55 END DO 46 tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 47 tgfunc2(:,:,:) = EXP( 0.07608 * tsn(:,:,:,jp_tem) ) 56 48 57 49 ! Computation of the silicon dependant half saturation constant for silica uptake 58 50 ! --------------------------------------------------- 59 !$OMP DO schedule(static) private(jj,ji,zvar)60 51 DO ji = 1, jpi 61 52 DO jj = 1, jpj … … 66 57 ! 67 58 IF( nday_year == nyear_len(1) ) THEN 68 !$OMP DO schedule(static) private(jj,ji) 69 DO jj = 1, jpj 70 DO ji = 1, jpi 71 xksi (ji,jj) = xksimax(ji,jj) 72 xksimax(ji,jj) = 0._wp 73 END DO 74 END DO 59 xksi (:,:) = xksimax(:,:) 60 xksimax(:,:) = 0._wp 75 61 ENDIF 76 !$OMP END PARALLEL77 62 ! 78 63 IF( nn_timing == 1 ) CALL timing_stop('p4z_int') -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r7698 r7753 97 97 IF( nn_timing == 1 ) CALL timing_start('p4z_lim') 98 98 ! 99 !$OMP PARALLEL100 !$OMP DO schedule(static) private(jk,jj,ji,zno3,zferlim,zconcd,zconcd2,zconcn,zconcn2,z1_trbphy,z1_trbdia) &101 !$OMP& private(zconc1d,zconc1dnh4,zconc0n,zconc0nnh4,zdenom,zlim1,zlim2,zlim3,zlim4,zratio,zironmin)102 99 DO jk = 1, jpkm1 103 100 DO jj = 1, jpj … … 176 173 END DO 177 174 END DO 178 !$OMP END DO NOWAIT179 175 180 176 ! Compute the fraction of nanophytoplankton that is made of calcifiers 181 177 ! -------------------------------------------------------------------- 182 !$OMP DO schedule(static) private(jk,jj,ji,zlim1,zlim2,zlim3,ztem1,ztem2,zetot1,zetot2)183 178 DO jk = 1, jpkm1 184 179 DO jj = 1, jpj … … 204 199 END DO 205 200 END DO 206 !$OMP END DO NOWAIT 207 ! 208 !$OMP DO schedule(static) private(jk,jj,ji) 201 ! 209 202 DO jk = 1, jpkm1 210 203 DO jj = 1, jpj … … 217 210 END DO 218 211 END DO 219 !$OMP END PARALLEL220 212 ! 221 213 IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics … … 249 241 & xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r, oxymin 250 242 INTEGER :: ios ! Local integer output status for namelist read 251 INTEGER :: ji, jj, jk252 243 253 244 REWIND( numnatp_ref ) ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters … … 286 277 ENDIF 287 278 ! 288 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 289 DO jk = 1, jpkm1 290 DO jj = 1, jpj 291 DO ji = 1, jpi 292 nitrfac (ji,jj,jk) = 0._wp 293 END DO 294 END DO 295 END DO 279 nitrfac (:,:,:) = 0._wp 296 280 ! 297 281 END SUBROUTINE p4z_lim_init -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r7698 r7753 69 69 CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 70 70 ! 71 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 72 DO jk = 1, jpk 73 DO jj = 1, jpj 74 DO ji = 1, jpi 75 zco3 (ji,jj,jk) = 0. 76 zcaldiss(ji,jj,jk) = 0. 77 zhinit(ji,jj,jk) = hi(ji,jj,jk) * 1000. / ( rhop(ji,jj,jk) + rtrn ) 78 END DO 79 END DO 80 END DO 71 zco3 (:,:,:) = 0. 72 zcaldiss(:,:,:) = 0. 73 zhinit(:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 81 74 ! ------------------------------------------- 82 75 ! COMPUTE [CO3--] and [H+] CONCENTRATIONS … … 85 78 CALL solve_at_general(zhinit, zhi) 86 79 87 !$OMP PARALLEL88 !$OMP DO schedule(static) private(jk, jj, ji)89 80 DO jk = 1, jpkm1 90 81 DO jj = 1, jpj … … 103 94 ! --------------------------------------------------------- 104 95 105 !$OMP DO schedule(static) private(jk,jj,ji,zcalcon,zfact,zomegaca,zexcess0,zexcess,zdispot)106 96 DO jk = 1, jpkm1 107 97 DO jj = 1, jpj … … 134 124 END DO 135 125 END DO 136 !$OMP END PARALLEL137 126 ! 138 127 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r7698 r7753 79 79 ! 80 80 CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 81 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 82 DO jk = 1, jpk 83 DO jj = 1, jpj 84 DO ji = 1, jpi 85 zgrazing(ji,jj,jk) = 0._wp 86 END DO 87 END DO 88 END DO 89 90 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zcompam,zfact,zrespz2,ztortz2,zcompadi,zcompaz,zcompaph,zfracal) & 91 !$OMP& private(zcompapoc,zfood,zfoodlim,zdenom,zdenom2,zgraze2,zgrazd,zgrazz,zgrazn,zgrazpoc,zgraznf,zgrazf,zgrazpof) & 92 !$OMP& private(zgrazffeg,zgrazfffg,zgrazffep,zgrazfffp,zgraztot,zproport,zratio,zratio2,zfrac,zfracfe,zgraztotf,zgrasrat) & 93 !$OMP& private(zgraztotn,zgrasratn,zepshert,zepsherv,zgrarem2,zgrafer2,zgrapoc2,zgrarsig,zmortz2,zmortzgoc,zprcaca,zgrazcal) 81 zgrazing(:,:,:) = 0._wp 82 94 83 DO jk = 1, jpkm1 95 84 DO jj = 1, jpj … … 231 220 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 232 221 IF( iom_use( "GRAZ2" ) ) THEN 233 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 234 DO jk = 1, jpk 235 DO jj = 1, jpj 236 DO ji = 1, jpi 237 zw3d(ji,jj,jk) = zgrazing(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! Total grazing of phyto by zooplankton 238 END DO 239 END DO 240 END DO 222 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 241 223 CALL iom_put( "GRAZ2", zw3d ) 242 224 ENDIF 243 225 IF( iom_use( "PCAL" ) ) THEN 244 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 245 DO jk = 1, jpk 246 DO jj = 1, jpj 247 DO ji = 1, jpi 248 zw3d(ji,jj,jk) = prodcal(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! Calcite production 249 END DO 250 END DO 251 END DO 226 zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Calcite production 252 227 CALL iom_put( "PCAL", zw3d ) 253 228 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r7698 r7753 79 79 CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 80 80 ! 81 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zcompaz,zfact,zrespz,ztortz,zcompadi,zcompaph,zcompapoc,zfood) &82 !$OMP& private(zfoodlim,zdenom,zdenom2,zgraze,zgrazp,zgrazm,zgrazsd,zgrazpf,zgrazmf,zgrazsf,zgraztot,zgraztotf) &83 !$OMP& private(zgraztotn,zgrasrat,zgrasratn,zepshert,zepsherv,zgrafer,zgrarem,zgrapoc,zgrarsig,zmortz,zprcaca)84 81 DO jk = 1, jpkm1 85 82 DO jj = 1, jpj … … 184 181 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 185 182 IF( iom_use( "GRAZ1" ) ) THEN 186 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 187 DO jk = 1, jpk 188 DO jj = 1, jpj 189 DO ji = 1, jpi 190 zw3d(ji,jj,jk) = zgrazing(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! Total grazing of phyto by zooplankton 191 END DO 192 END DO 193 END DO 183 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 194 184 CALL iom_put( "GRAZ1", zw3d ) 195 185 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
r7698 r7753 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 34 !! $Id$ 34 !! $Id$ 35 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- … … 74 74 IF( nn_timing == 1 ) CALL timing_start('p4z_nano') 75 75 ! 76 !$OMP PARALLEL 77 !$OMP DO schedule(static) private(jk,jj,ji) 78 DO jk = 1, jpk 79 DO jj = 1, jpj 80 DO ji = 1, jpi 81 prodcal(ji,jj,jk) = 0. !: calcite production variable set to zero 82 END DO 83 END DO 84 END DO 85 !$OMP DO schedule(static) private(jk,jj,ji,zcompaph,zsizerat,zrespp,ztortp,zmortp,zfactfe,zfactch,zprcaca,zfracal) 76 prodcal(:,:,:) = 0. !: calcite production variable set to zero 86 77 DO jk = 1, jpkm1 87 78 DO jj = 1, jpj … … 128 119 END DO 129 120 END DO 130 !$OMP END PARALLEL131 121 ! 132 122 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 163 153 ! ------------------------------------------------------------ 164 154 165 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zcompadi,zlim2,zlim1,zrespp2,ztortp2,zmortp2,zfactfe,zfactch,zfactsi)166 155 DO jk = 1, jpkm1 167 156 DO jj = 1, jpj -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r7698 r7753 84 84 ! Initialisation of variables used to compute PAR 85 85 ! ----------------------------------------------- 86 !$OMP PARALLEL 87 !$OMP DO schedule(static) private(jk,jj,ji) 88 DO jk = 1, jpk 89 DO jj = 1, jpj 90 DO ji = 1, jpi 91 ze1(ji,jj,jk) = 0._wp 92 ze2(ji,jj,jk) = 0._wp 93 ze3(ji,jj,jk) = 0._wp 94 END DO 95 END DO 96 END DO 97 !$OMP END DO NOWAIT 86 ze1(:,:,:) = 0._wp 87 ze2(:,:,:) = 0._wp 88 ze3(:,:,:) = 0._wp 98 89 ! 99 90 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 100 91 ! -------------------------------------------------------- 101 !$OMP DO schedule(static) private(jk,jj,ji) 102 DO jk = 1, jpk 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 zchl3d(ji,jj,jk) = trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) 106 END DO 107 END DO 108 END DO 109 !$OMP END PARALLEL 110 IF( ln_p5z ) THEN 111 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 112 DO jk = 1, jpk 113 DO jj = 1, jpj 114 DO ji = 1, jpi 115 zchl3d(ji,jj,jk) = zchl3d(ji,jj,jk) + trb(ji,jj,jk,jppch) 116 END DO 117 END DO 118 END DO 119 END IF 120 ! 121 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zchl,irgb) 92 zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 93 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 94 ! 122 95 DO jk = 1, jpkm1 123 96 DO jj = 1, jpj … … 137 110 IF( l_trcdm2dc ) THEN ! diurnal cycle 138 111 ! 139 !$OMP PARALLEL DO schedule(static) private(jj,ji) 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 zqsr_corr(ji,jj) = qsr_mean(ji,jj) / ( 1. - fr_i(ji,jj) + rtrn ) 143 END DO 144 END DO 112 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn ) 145 113 ! 146 114 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 147 115 ! 148 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)149 116 DO jk = 1, nksrp 150 DO jj = 1, jpj 151 DO ji = 1, jpi 152 etot_ndcy(ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) 153 enano (ji,jj,jk) = 2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 154 ediat (ji,jj,jk) = 1.6 * ze1(ji,jj,jk) + 0.69 * ze2(ji,jj,jk) + 0.7 * ze3(ji,jj,jk) 155 END DO 156 END DO 117 etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 118 enano (:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 119 ediat (:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 157 120 END DO 158 121 IF( ln_p5z ) THEN 159 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)160 122 DO jk = 1, nksrp 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 epico (ji,jj,jk) = 2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 164 END DO 165 END DO 123 epico (:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 166 124 END DO 167 125 ENDIF 168 126 ! 169 !$OMP PARALLEL DO schedule(static) private(jj,ji) 170 DO jj = 1, jpj 171 DO ji = 1, jpi 172 zqsr_corr(ji,jj) = qsr(ji,jj) / ( 1. - fr_i(ji,jj) + rtrn ) 173 END DO 174 END DO 127 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 175 128 ! 176 129 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) 177 130 ! 178 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)179 131 DO jk = 1, nksrp 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 etot(ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) 183 END DO 184 END DO 132 etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 185 133 END DO 186 134 ! 187 135 ELSE 188 136 ! 189 !$OMP PARALLEL DO schedule(static) private(jj,ji) 190 DO jj = 1, jpj 191 DO ji = 1, jpi 192 zqsr_corr(ji,jj) = qsr(ji,jj) / ( 1. - fr_i(ji,jj) + rtrn ) 193 END DO 194 END DO 137 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 195 138 ! 196 139 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 197 140 ! 198 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 199 DO jk = 1, nksrp 200 DO jj = 1, jpj 201 DO ji = 1, jpi 202 etot (ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) 203 enano(ji,jj,jk) = 2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 204 ediat(ji,jj,jk) = 1.6 * ze1(ji,jj,jk) + 0.69 * ze2(ji,jj,jk) + 0.7 * ze3(ji,jj,jk) 205 END DO 206 END DO 141 DO jk = 1, nksrp 142 etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 143 enano(:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 144 ediat(:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 207 145 END DO 208 146 IF( ln_p5z ) THEN 209 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 210 DO jk = 1, nksrp 211 DO jj = 1, jpj 212 DO ji = 1, jpi 213 epico(ji,jj,jk) = 2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 214 END DO 215 END DO 147 DO jk = 1, nksrp 148 epico(:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 216 149 END DO 217 150 ENDIF 218 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 219 DO jk = 1, jpk 220 DO jj = 1, jpj 221 DO ji = 1, jpi 222 etot_ndcy(ji,jj,jk) = etot(ji,jj,jk) 223 END DO 224 END DO 225 END DO 151 etot_ndcy(:,:,:) = etot(:,:,:) 226 152 ENDIF 227 153 … … 231 157 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 232 158 ! 233 !$OMP PARALLEL 234 !$OMP DO schedule(static) private(jj,ji) 235 DO jj = 1, jpj 236 DO ji = 1, jpi 237 etot3(ji,jj,1) = qsr(ji,jj) * tmask(ji,jj,1) 238 END DO 239 END DO 240 !$OMP DO schedule(static) private(jk,jj,ji) 159 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) 241 160 DO jk = 2, nksrp + 1 242 DO jj = 1, jpj 243 DO ji = 1, jpi 244 etot3(ji,jj,jk) = ( ze0(ji,jj,jk) + ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) ) * tmask(ji,jj,jk) 245 END DO 246 END DO 247 END DO 248 !$OMP END PARALLEL 161 etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 162 END DO 249 163 ! ! ------------------------ 250 164 ENDIF 251 165 ! !* Euphotic depth and level 252 ! ------------------------ 253 !$OMP PARALLEL 254 !$OMP DO schedule(static) private(jj,ji) 255 DO jj = 1, jpj 256 DO ji = 1, jpi 257 neln(ji,jj) = 1 258 heup (ji,jj) = gdepw_n(ji,jj,2) 259 heup_01(ji,jj) = gdepw_n(ji,jj,2) 260 END DO 261 END DO 166 neln (:,:) = 1 ! ------------------------ 167 heup (:,:) = gdepw_n(:,:,2) 168 heup_01(:,:) = gdepw_n(:,:,2) 262 169 263 170 DO jk = 2, nksrp 264 !$OMP DO schedule(static) private(jj,ji)265 171 DO jj = 1, jpj 266 172 DO ji = 1, jpi … … 277 183 END DO 278 184 ! 279 !$OMP DO schedule(static) private(jj,ji) 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 heup (ji,jj) = MIN( 300., heup (ji,jj) ) 283 heup_01(ji,jj) = MIN( 300., heup_01(ji,jj) ) 284 ! !* mean light over the mixed layer 285 zdepmoy(ji,jj) = 0.e0 ! ------------------------------- 286 zetmp1 (ji,jj) = 0.e0 287 zetmp2 (ji,jj) = 0.e0 288 zetmp3 (ji,jj) = 0.e0 289 zetmp4 (ji,jj) = 0.e0 290 END DO 291 END DO 185 heup (:,:) = MIN( 300., heup (:,:) ) 186 heup_01(:,:) = MIN( 300., heup_01(:,:) ) 187 ! !* mean light over the mixed layer 188 zdepmoy(:,:) = 0.e0 ! ------------------------------- 189 zetmp1 (:,:) = 0.e0 190 zetmp2 (:,:) = 0.e0 191 zetmp3 (:,:) = 0.e0 192 zetmp4 (:,:) = 0.e0 292 193 293 194 DO jk = 1, nksrp 294 !$OMP DO schedule(static) private(jj,ji)295 195 DO jj = 1, jpj 296 196 DO ji = 1, jpi … … 306 206 END DO 307 207 ! 308 !$OMP DO schedule(static) private(jk,jj,ji) 309 DO jk = 1, jpk 310 DO jj = 1, jpj 311 DO ji = 1, jpi 312 emoy(ji,jj,jk) = etot(ji,jj,jk) ! remineralisation 313 zpar(ji,jj,jk) = etot_ndcy(ji,jj,jk) ! diagnostic : PAR with no diurnal cycle 314 END DO 315 END DO 316 END DO 317 ! 318 !$OMP DO schedule(static) private(jk,jj,ji,z1_dep) 208 emoy(:,:,:) = etot(:,:,:) ! remineralisation 209 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 210 ! 319 211 DO jk = 1, nksrp 320 212 DO jj = 1, jpj … … 330 222 END DO 331 223 END DO 332 !$OMP END PARALLEL333 224 ! 334 225 IF( ln_p5z ) THEN 335 !$OMP PARALLEL 336 !$OMP DO schedule(static) private(jj,ji) 337 DO jj = 1, jpj 338 DO ji = 1, jpi 339 zetmp5 (ji,jj) = 0.e0 340 END DO 341 END DO 226 zetmp5 (:,:) = 0.e0 342 227 DO jk = 1, nksrp 343 !$OMP DO schedule(static) private(jj,ji,z1_dep)344 228 DO jj = 1, jpj 345 229 DO ji = 1, jpi … … 352 236 END DO 353 237 END DO 354 !$OMP END PARALLEL355 238 ENDIF 356 239 IF( lk_iomput ) THEN … … 391 274 392 275 ! Real shortwave 393 IF( ln_varpar ) THEN 394 !$OMP PARALLEL DO schedule(static) private(jj,ji) 395 DO jj = 1, jpj 396 DO ji = 1, jpi 397 zqsr(ji,jj) = par_varsw(ji,jj) * pqsr(ji,jj) 398 END DO 399 END DO 400 ELSE 401 !$OMP PARALLEL DO schedule(static) private(jj,ji) 402 DO jj = 1, jpj 403 DO ji = 1, jpi 404 zqsr(ji,jj) = xparsw * pqsr(ji,jj) 405 END DO 406 END DO 276 IF( ln_varpar ) THEN ; zqsr(:,:) = par_varsw(:,:) * pqsr(:,:) 277 ELSE ; zqsr(:,:) = xparsw * pqsr(:,:) 407 278 ENDIF 408 279 409 280 ! Light at the euphotic depth 410 IF( PRESENT( pqsr100 ) ) THEN 411 !$OMP PARALLEL DO schedule(static) private(jj,ji) 412 DO jj = 1, jpj 413 DO ji = 1, jpi 414 pqsr100(ji,jj) = 0.01 * 3. * zqsr(ji,jj) 415 END DO 416 END DO 417 ENDIF 281 IF( PRESENT( pqsr100 ) ) pqsr100(:,:) = 0.01 * 3. * zqsr(:,:) 418 282 419 283 IF( PRESENT( pe0 ) ) THEN ! W-level 420 284 ! 421 !$OMP PARALLEL 422 !$OMP DO schedule(static) private(jj,ji) 423 DO jj = 1, jpj 424 DO ji = 1, jpi 425 pe0(ji,jj,1) = pqsr(ji,jj) - 3. * zqsr(ji,jj) ! ( 1 - 3 * alpha ) * q 426 pe1(ji,jj,1) = zqsr(ji,jj) 427 pe2(ji,jj,1) = zqsr(ji,jj) 428 pe3(ji,jj,1) = zqsr(ji,jj) 429 END DO 430 END DO 285 pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:) ! ( 1 - 3 * alpha ) * q 286 pe1(:,:,1) = zqsr(:,:) 287 pe2(:,:,1) = zqsr(:,:) 288 pe3(:,:,1) = zqsr(:,:) 431 289 ! 432 290 DO jk = 2, nksrp + 1 433 !$OMP DO schedule(static) private(jj,ji)434 291 DO jj = 1, jpj 435 292 DO ji = 1, jpi … … 443 300 ! 444 301 END DO 445 !$OMP END PARALLEL446 302 ! 447 303 ELSE ! T- level 448 304 ! 449 !$OMP PARALLEL 450 !$OMP DO schedule(static) private(jj,ji) 451 DO jj = 1, jpj 452 DO ji = 1, jpi 453 pe1(ji,jj,1) = zqsr(ji,jj) * EXP( -0.5 * ekb(ji,jj,1) ) 454 pe2(ji,jj,1) = zqsr(ji,jj) * EXP( -0.5 * ekg(ji,jj,1) ) 455 pe3(ji,jj,1) = zqsr(ji,jj) * EXP( -0.5 * ekr(ji,jj,1) ) 456 END DO 457 END DO 305 pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) ) 306 pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) ) 307 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 458 308 ! 459 309 DO jk = 2, nksrp 460 !$OMP DO schedule(static) private(jj,ji)461 310 DO jj = 1, jpj 462 311 DO ji = 1, jpi … … 467 316 END DO 468 317 END DO 469 !$OMP END PARALLEL470 318 ! 471 319 ENDIF … … 521 369 INTEGER :: ierr 522 370 INTEGER :: ios ! Local integer output status for namelist read 523 INTEGER :: ji, jj, jk ! dummy loop indices524 371 REAL(wp), DIMENSION(nbtimes) :: zsteps ! times records 525 372 ! … … 577 424 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 578 425 ! 579 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 580 DO jk = 1, jpk 581 DO jj = 1, jpj 582 DO ji = 1, jpi 583 ekr (ji,jj,jk) = 0._wp 584 ekb (ji,jj,jk) = 0._wp 585 ekg (ji,jj,jk) = 0._wp 586 etot (ji,jj,jk) = 0._wp 587 etot_ndcy(ji,jj,jk) = 0._wp 588 enano (ji,jj,jk) = 0._wp 589 ediat (ji,jj,jk) = 0._wp 590 END DO 591 END DO 592 END DO 593 IF( ln_qsr_bio ) THEN 594 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 595 DO jk = 1, jpk 596 DO jj = 1, jpj 597 DO ji = 1, jpi 598 etot3 (ji,jj,jk) = 0._wp 599 END DO 600 END DO 601 END DO 602 END IF 603 604 IF( ln_p5z ) THEN 605 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 606 DO jk = 1, jpk 607 DO jj = 1, jpj 608 DO ji = 1, jpi 609 epico (ji,jj,jk) = 0._wp 610 END DO 611 END DO 612 END DO 613 END IF 426 ekr (:,:,:) = 0._wp 427 ekb (:,:,:) = 0._wp 428 ekg (:,:,:) = 0._wp 429 etot (:,:,:) = 0._wp 430 etot_ndcy(:,:,:) = 0._wp 431 enano (:,:,:) = 0._wp 432 ediat (:,:,:) = 0._wp 433 IF( ln_p5z ) epico (:,:,:) = 0._wp 434 IF( ln_qsr_bio ) etot3 (:,:,:) = 0._wp 614 435 ! 615 436 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt_init') -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90
r7698 r7753 89 89 ! Initialisation of temprary arrys 90 90 IF( ln_p4z ) THEN 91 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 92 DO jk = 1, jpk 93 DO jj = 1, jpj 94 DO ji = 1, jpi 95 zremipoc(ji,jj,jk) = xremip 96 zremigoc(ji,jj,jk) = xremip 97 END DO 98 END DO 99 END DO 91 zremipoc(:,:,:) = xremip 92 zremigoc(:,:,:) = xremip 100 93 ELSE ! ln_p5z 101 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 102 DO jk = 1, jpk 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 zremipoc(ji,jj,jk) = xremipc 106 zremigoc(ji,jj,jk) = xremipc 107 END DO 108 END DO 109 END DO 94 zremipoc(:,:,:) = xremipc 95 zremigoc(:,:,:) = xremipc 110 96 ENDIF 111 !$OMP PARALLEL 112 !$OMP DO schedule(static) private(jk, jj, ji) 113 DO jk = 1, jpk 114 DO jj = 1, jpj 115 DO ji = 1, jpi 116 zorem3 (ji,jj,jk) = 0. 117 orem (ji,jj,jk) = 0. 118 ztremint(ji,jj,jk) = 0. 119 END DO 120 END DO 97 zorem3(:,:,:) = 0. 98 orem (:,:,:) = 0. 99 ztremint(:,:,:) = 0. 100 101 DO jn = 1, jcpoc 102 alphag(:,:,:,jn) = alphan(jn) 103 alphap(:,:,:,jn) = alphan(jn) 121 104 END DO 122 !OMP END DO NOWAIT123 DO jn = 1, jcpoc124 !$OMP DO schedule(static) private(jk, jj, ji)125 DO jk = 1, jpk126 DO jj = 1, jpj127 DO ji = 1, jpi128 alphag(ji,jj,jk,jn) = alphan(jn)129 alphap(ji,jj,jk,jn) = alphan(jn)130 END DO131 END DO132 END DO133 END DO134 !$OMP END PARALLEL135 105 136 106 ! ----------------------------------------------------------------------- … … 140 110 ! ----------------------------------------------------------------------- 141 111 DO jk = 2, jpkm1 142 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,alphat,remint,zsizek1,zsizek,zpoc,jn)143 112 DO jj = 1, jpj 144 113 DO ji = 1, jpi … … 151 120 ! 152 121 IF( gdept_n(ji,jj,jk) > zdep ) THEN 122 alphat = 0. 123 remint = 0. 124 ! 153 125 zsizek1 = e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 154 126 zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) … … 183 155 & + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn) & 184 156 & * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2 185 157 alphat = alphat + alphag(ji,jj,jk,jn) 158 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 186 159 END DO 187 160 ELSE … … 201 174 & - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 202 175 & / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) 176 alphat = alphat + alphag(ji,jj,jk,jn) 177 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 203 178 END DO 204 179 ENDIF 205 !206 alphat = SUM(alphag(ji,jj,jk,:))207 remint = SUM(alphag(ji,jj,jk,:) * reminp(:))208 180 ! 209 181 DO jn = 1, jcpoc … … 221 193 END DO 222 194 223 IF( ln_p4z ) THEN 224 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 225 DO jk = 1, jpk 226 DO jj = 1, jpj 227 DO ji = 1, jpi 228 zremigoc(ji,jj,jk) = MIN( xremip , ztremint(ji,jj,jk) ) 229 END DO 230 END DO 231 END DO 232 ELSE 233 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 234 DO jk = 1, jpk 235 DO jj = 1, jpj 236 DO ji = 1, jpi 237 zremigoc(ji,jj,jk) = MIN( xremipc, ztremint(ji,jj,jk) ) 238 END DO 239 END DO 240 END DO 195 IF( ln_p4z ) THEN ; zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 196 ELSE ; zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 241 197 ENDIF 242 198 243 199 IF( ln_p4z ) THEN 244 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremig,zorem2,zofer2,zofer3)245 200 DO jk = 1, jpkm1 246 201 DO jj = 1, jpj … … 266 221 END DO 267 222 ELSE 268 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremig,zopoc2,zofer2,zopon2,zopop2)269 223 DO jk = 1, jpkm1 270 224 DO jj = 1, jpj … … 312 266 ! ------------------------------------------------------------------- 313 267 ! 314 !$OMP PARALLEL 315 !$OMP DO schedule(static) private(jj,ji) 316 DO jj = 1, jpj 317 DO ji = 1, jpi 318 totprod(ji,jj) = 0. 319 totthick(ji,jj) = 0. 320 totcons(ji,jj) = 0. 321 END DO 322 END DO 268 totprod(:,:) = 0. 269 totthick(:,:) = 0. 270 totcons(:,:) = 0. 323 271 ! intregrated production and consumption of POC in the mixed layer 324 272 ! ---------------------------------------------------------------- 325 273 ! 326 274 DO jk = 1, jpkm1 327 !$OMP DO schedule(static) private(jj,ji,zdep)328 275 DO jj = 1, jpj 329 276 DO ji = 1, jpi … … 339 286 END DO 340 287 END DO 341 !$OMP END PARALLEL342 288 343 289 ! Computation of the lability spectrum in the mixed layer. In the mixed 344 290 ! layer, this spectrum is supposed to be uniform. 345 291 ! --------------------------------------------------------------------- 346 !$OMP DO schedule(static) private(jk,jj,ji,zdep,alphat,remint,jn)347 292 DO jk = 1, jpkm1 348 293 DO jj = 1, jpj … … 350 295 IF (tmask(ji,jj,jk) == 1.) THEN 351 296 zdep = hmld(ji,jj) 297 alphat = 0.0 298 remint = 0.0 352 299 IF( gdept_n(ji,jj,jk) <= zdep ) THEN 353 300 DO jn = 1, jcpoc … … 356 303 alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn) & 357 304 & * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 305 alphat = alphat + alphap(ji,jj,jk,jn) 358 306 END DO 359 alphat = SUM(alphap(ji,jj,jk,:))360 307 DO jn = 1, jcpoc 361 308 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 309 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 362 310 END DO 363 remint = SUM(alphap(ji,jj,jk,:) * reminp(:))364 311 ! Mean remineralization rate in the mixed layer 365 312 ztremint(ji,jj,jk) = MAX( 0., remint ) … … 370 317 END DO 371 318 ! 372 IF( ln_p4z ) THEN 373 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 374 DO jk = 1, jpk 375 DO jj = 1, jpj 376 DO ji = 1, jpi 377 zremipoc(ji,jj,jk) = MIN( xremip , ztremint(ji,jj,jk) ) 378 END DO 379 END DO 380 END DO 381 ELSE 382 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 383 DO jk = 1, jpk 384 DO jj = 1, jpj 385 DO ji = 1, jpi 386 zremipoc(ji,jj,jk) = MIN( xremipc , ztremint(ji,jj,jk) ) 387 END DO 388 END DO 389 END DO 319 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 320 ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 390 321 ENDIF 391 322 … … 399 330 ! 400 331 DO jk = 2, jpkm1 401 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,alphat,remint,zsizek1,zsizek,zpoc,jn)402 332 DO jj = 1, jpj 403 333 DO ji = 1, jpi … … 405 335 zdep = hmld(ji,jj) 406 336 IF( gdept_n(ji,jj,jk) > zdep ) THEN 337 alphat = 0. 338 remint = 0. 407 339 ! 408 340 ! the scale factors are corrected with temperature … … 430 362 & * zsizek ) ) 431 363 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 364 alphat = alphat + alphap(ji,jj,jk,jn) 432 365 END DO 433 366 ELSE … … 452 385 & - exp( -reminp(jn) * zsizek ) ) 453 386 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 387 alphat = alphat + alphap(ji,jj,jk,jn) 454 388 END DO 455 389 ENDIF 456 alphat = SUM(alphap(ji,jj,jk,:))457 390 ! Normalization of the lability spectrum so that the 458 391 ! integral is equal to 1 459 392 DO jn = 1, jcpoc 460 393 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 394 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 461 395 END DO 462 remint = SUM(alphap(ji,jj,jk,:) * reminp(:))463 396 ! Mean remineralization rate in the water column 464 397 ztremint(ji,jj,jk) = MAX( 0., remint ) … … 469 402 END DO 470 403 471 IF( ln_p4z ) THEN 472 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 473 DO jk = 1, jpk 474 DO jj = 1, jpj 475 DO ji = 1, jpi 476 zremipoc(ji,jj,jk) = MIN( xremip , ztremint(ji,jj,jk) ) 477 END DO 478 END DO 479 END DO 480 ELSE 481 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 482 DO jk = 1, jpk 483 DO jj = 1, jpj 484 DO ji = 1, jpi 485 zremipoc(ji,jj,jk) = MIN( xremipc , ztremint(ji,jj,jk) ) 486 END DO 487 END DO 488 END DO 404 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 405 ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 489 406 ENDIF 490 407 491 408 IF( ln_p4z ) THEN 492 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremip,zorem,zofer)493 409 DO jk = 1, jpkm1 494 410 DO jj = 1, jpj … … 511 427 END DO 512 428 ELSE 513 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremip,zopoc,zopon,zopop,zofer)514 429 DO jk = 1, jpkm1 515 430 DO jj = 1, jpj … … 572 487 !! 573 488 !!---------------------------------------------------------------------- 574 INTEGER :: jn , jk, jj, ji489 INTEGER :: jn 575 490 REAL(wp) :: remindelta, reminup, remindown 576 491 INTEGER :: ifault … … 642 557 643 558 DO jn = 1, jcpoc 644 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 645 DO jk = 1, jpk 646 DO jj = 1, jpj 647 DO ji = 1, jpi 648 alphap(ji,jj,jk,jn) = alphan(jn) 649 END DO 650 END DO 651 END DO 559 alphap(:,:,:,jn) = alphan(jn) 652 560 END DO 653 561 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r7698 r7753 93 93 CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 94 94 ! 95 zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 96 zprofen (:,:,:) = 0._wp ; zysopt (:,:,:) = 0._wp 97 zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia (:,:,:) = 0._wp 98 zprbio (:,:,:) = 0._wp ; zprdch (:,:,:) = 0._wp ; zprnch (:,:,:) = 0._wp 99 zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp 100 101 ! Computation of the optimal production 102 prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:) 103 95 104 ! compute the day length depending on latitude and the day 96 105 zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 97 106 zcodel = ASIN( SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp ) ) 98 107 99 !$OMP PARALLEL100 !$OMP DO schedule(static) private(jk,jj,ji)101 DO jk = 1, jpk102 DO jj = 1, jpj103 DO ji = 1, jpi104 zprorcan(ji,jj,jk) = 0._wp105 zprorcad(ji,jj,jk) = 0._wp106 zprofed (ji,jj,jk) = 0._wp107 zprofen (ji,jj,jk) = 0._wp108 zysopt (ji,jj,jk) = 0._wp109 zpronewn(ji,jj,jk) = 0._wp110 zpronewd(ji,jj,jk) = 0._wp111 zprdia (ji,jj,jk) = 0._wp112 zprbio (ji,jj,jk) = 0._wp113 zprdch (ji,jj,jk) = 0._wp114 zprnch (ji,jj,jk) = 0._wp115 zmxl_fac(ji,jj,jk) = 0._wp116 zmxl_chl(ji,jj,jk) = 0._wp117 118 ! Computation of the optimal production119 prmax(ji,jj,jk) = 0.8_wp * r1_rday * tgfunc(ji,jj,jk)120 END DO121 END DO122 END DO123 124 108 ! day length in hours 125 !$OMP DO schedule(static) private(jj,ji) 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 zstrn(ji,jj) = 0. 129 END DO 130 END DO 131 !$OMP DO schedule(static) private(jj,ji,zargu) 109 zstrn(:,:) = 0. 132 110 DO jj = 1, jpj 133 111 DO ji = 1, jpi … … 139 117 140 118 ! Impact of the day duration and light intermittency on phytoplankton growth 141 !$OMP DO schedule(static) private(jk,jj,ji,zval)142 119 DO jk = 1, jpkm1 143 120 DO jj = 1 ,jpj … … 155 132 END DO 156 133 157 !$OMP DO schedule(static) private(jk,jj,ji) 158 DO jk = 1, jpk 159 DO jj = 1 ,jpj 160 DO ji = 1, jpi 161 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zmxl_fac(ji,jj,jk) 162 zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 163 END DO 164 END DO 165 END DO 134 zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:) 135 zprdia(:,:,:) = zprbio(:,:,:) 166 136 167 137 ! Maximum light intensity 168 !$OMP DO schedule(static) private(jj,ji) 169 DO jj = 1 ,jpj 170 DO ji = 1, jpi 171 IF( zstrn(ji,jj) < 1.e0 ) zstrn(ji,jj) = 24. 172 END DO 173 END DO 138 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 174 139 175 140 ! Computation of the P-I slope for nanos and diatoms 176 !$OMP DO schedule(static) private(jk,jj,ji,ztn,zadap,zconctemp,zconctemp2)177 141 DO jk = 1, jpkm1 178 142 DO jj = 1, jpj … … 195 159 196 160 IF( ln_newprod ) THEN 197 !$OMP DO schedule(static) private(jk,jj,ji,zpislopen,zpisloped)198 161 DO jk = 1, jpkm1 199 162 DO jj = 1, jpj … … 219 182 END DO 220 183 ELSE 221 !$OMP DO schedule(static) private(jk,jj,ji,zpislopen,zpisloped)222 184 DO jk = 1, jpkm1 223 185 DO jj = 1, jpj … … 244 206 ! Computation of a proxy of the N/C ratio 245 207 ! --------------------------------------- 246 !$OMP DO schedule(static) private(jk,jj,ji,zval)247 208 DO jk = 1, jpkm1 248 209 DO jj = 1, jpj … … 257 218 END DO 258 219 END DO 259 !$OMP END DO NOWAIT 260 261 262 !$OMP DO schedule(static) private(jk,jj,ji,zlim,zsilim,zsilfac,zsiborn,zsilfac2) 220 221 263 222 DO jk = 1, jpkm1 264 223 DO jj = 1, jpj … … 285 244 END DO 286 245 END DO 287 !$OMP END DO NOWAIT288 246 289 247 ! Mixed-layer effect on production 290 248 ! Sea-ice effect on production 291 249 292 !$OMP DO schedule(static) private(jk,jj,ji)293 250 DO jk = 1, jpkm1 294 251 DO jj = 1, jpj … … 303 260 304 261 ! Computation of the various production terms 305 !$OMP DO schedule(static) private(jk,jj,ji,zratio,zmax)306 262 DO jk = 1, jpkm1 307 263 DO jj = 1, jpj … … 334 290 335 291 ! Computation of the chlorophyll production terms 336 !$OMP DO schedule(static) private(jk,jj,ji,znanotot,zprod,zprochln,chlcnm_n,zprochld,zdiattot)337 292 DO jk = 1, jpkm1 338 293 DO jj = 1, jpj … … 362 317 363 318 ! Update the arrays TRA which contain the biological sources and sinks 364 !$OMP DO schedule(static) private(jk,jj,ji,zproreg,zproreg2,zdocprod,zfeup)365 319 DO jk = 1, jpkm1 366 320 DO jj = 1, jpj … … 394 348 ! 395 349 IF( ln_ligand ) THEN 396 !$OMP DO schedule(static) private(jk,jj,ji,zdocprod,zfeup)397 350 DO jk = 1, jpkm1 398 351 DO jj = 1, jpj … … 407 360 END DO 408 361 ENDIF 409 !$OMP END PARALLEL410 362 411 363 … … 421 373 ! 422 374 IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) ) THEN 423 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 424 DO jk = 1, jpk 425 DO jj = 1, jpj 426 DO ji = 1, jpi 427 zw3d(ji,jj,jk) = zprorcan (ji,jj,jk) * zfact * tmask(ji,jj,jk) ! primary production by nanophyto 428 END DO 429 END DO 430 END DO 431 CALL iom_put( "PPPHYN" , zw3d ) 432 ! 433 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 434 DO jk = 1, jpk 435 DO jj = 1, jpj 436 DO ji = 1, jpi 437 zw3d(ji,jj,jk) = zprorcad (ji,jj,jk) * zfact * tmask(ji,jj,jk) ! primary production by nanophyto 438 END DO 439 END DO 440 END DO 441 CALL iom_put( "PPPHYD" , zw3d ) 375 zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:) ! primary production by nanophyto 376 CALL iom_put( "PPPHYN" , zw3d ) 377 ! 378 zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) ! primary production by diatomes 379 CALL iom_put( "PPPHYD" , zw3d ) 442 380 ENDIF 443 381 IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) ) THEN 444 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 445 DO jk = 1, jpk 446 DO jj = 1, jpj 447 DO ji = 1, jpi 448 zw3d(ji,jj,jk) = zpronewn (ji,jj,jk) * zfact * tmask(ji,jj,jk) ! new primary production by nanophyto 449 END DO 450 END DO 451 END DO 452 CALL iom_put( "PPNEWN" , zw3d ) 382 zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:) ! new primary production by nanophyto 383 CALL iom_put( "PPNEWN" , zw3d ) 453 384 ! 454 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 455 DO jk = 1, jpk 456 DO jj = 1, jpj 457 DO ji = 1, jpi 458 zw3d(ji,jj,jk) = zpronewd (ji,jj,jk) * zfact * tmask(ji,jj,jk) ! new primary production by nanophyto 459 END DO 460 END DO 461 END DO 462 CALL iom_put( "PPNEWD" , zw3d ) 385 zw3d(:,:,:) = zpronewd(:,:,:) * zfact * tmask(:,:,:) ! new primary production by diatomes 386 CALL iom_put( "PPNEWD" , zw3d ) 463 387 ENDIF 464 388 IF( iom_use( "PBSi" ) ) THEN 465 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 466 DO jk = 1, jpk 467 DO jj = 1, jpj 468 DO ji = 1, jpi 469 zw3d(ji,jj,jk) = zprorcad(ji,jj,jk) * zfact * tmask(ji,jj,jk) * zysopt(ji,jj,jk) ! biogenic silica production 470 END DO 471 END DO 472 END DO 473 CALL iom_put( "PBSi" , zw3d ) 389 zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ! biogenic silica production 390 CALL iom_put( "PBSi" , zw3d ) 474 391 ENDIF 475 392 IF( iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) ) THEN 476 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 477 DO jk = 1, jpk 478 DO jj = 1, jpj 479 DO ji = 1, jpi 480 zw3d(ji,jj,jk) = zprofen(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! biogenic iron production by nanophyto 481 END DO 482 END DO 483 END DO 484 CALL iom_put( "PFeN" , zw3d ) 485 ! 486 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 487 DO jk = 1, jpk 488 DO jj = 1, jpj 489 DO ji = 1, jpi 490 zw3d(ji,jj,jk) = zprofed(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! biogenic iron production by nanophyto 491 END DO 492 END DO 493 END DO 494 CALL iom_put( "PFeD" , zw3d ) 393 zw3d(:,:,:) = zprofen(:,:,:) * zfact * tmask(:,:,:) ! biogenic iron production by nanophyto 394 CALL iom_put( "PFeN" , zw3d ) 395 ! 396 zw3d(:,:,:) = zprofed(:,:,:) * zfact * tmask(:,:,:) ! biogenic iron production by diatomes 397 CALL iom_put( "PFeD" , zw3d ) 495 398 ENDIF 496 399 IF( iom_use( "Mumax" ) ) THEN 497 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 498 DO jk = 1, jpk 499 DO jj = 1, jpj 500 DO ji = 1, jpi 501 zw3d(ji,jj,jk) = prmax(ji,jj,jk) * tmask(ji,jj,jk) ! Maximum growth rate 502 END DO 503 END DO 504 END DO 505 CALL iom_put( "Mumax" , zw3d ) 400 zw3d(:,:,:) = prmax(:,:,:) * tmask(:,:,:) ! Maximum growth rate 401 CALL iom_put( "Mumax" , zw3d ) 506 402 ENDIF 507 403 IF( iom_use( "MuN" ) .OR. iom_use( "MuD" ) ) THEN 508 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 509 DO jk = 1, jpk 510 DO jj = 1, jpj 511 DO ji = 1, jpi 512 zw3d(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tmask(ji,jj,jk) ! Realized growth rate for nanophyto 513 END DO 514 END DO 515 END DO 516 CALL iom_put( "MuN" , zw3d ) 517 ! 518 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 519 DO jk = 1, jpk 520 DO jj = 1, jpj 521 DO ji = 1, jpi 522 zw3d(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tmask(ji,jj,jk) ! Realized growth rate for diatoms 523 END DO 524 END DO 525 END DO 526 CALL iom_put( "MuD" , zw3d ) 404 zw3d(:,:,:) = zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ! Realized growth rate for nanophyto 405 CALL iom_put( "MuN" , zw3d ) 406 ! 407 zw3d(:,:,:) = zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ! Realized growth rate for diatoms 408 CALL iom_put( "MuD" , zw3d ) 527 409 ENDIF 528 410 IF( iom_use( "LNlight" ) .OR. iom_use( "LDlight" ) ) THEN 529 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 530 DO jk = 1, jpk 531 DO jj = 1, jpj 532 DO ji = 1, jpi 533 zw3d(ji,jj,jk) = zprbio (ji,jj,jk) / (prmax(ji,jj,jk) + rtrn) * tmask(ji,jj,jk) ! light limitation term 534 END DO 535 END DO 536 END DO 537 CALL iom_put( "LNlight" , zw3d ) 538 ! 539 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 540 DO jk = 1, jpk 541 DO jj = 1, jpj 542 DO ji = 1, jpi 543 zw3d(ji,jj,jk) = zprdia (ji,jj,jk) / (prmax(ji,jj,jk) + rtrn) * tmask(ji,jj,jk) ! light limitation term 544 END DO 545 END DO 546 END DO 547 CALL iom_put( "LDlight" , zw3d ) 411 zw3d(:,:,:) = zprbio (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term 412 CALL iom_put( "LNlight" , zw3d ) 413 ! 414 zw3d(:,:,:) = zprdia (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term 415 CALL iom_put( "LDlight" , zw3d ) 548 416 ENDIF 549 417 IF( iom_use( "TPP" ) ) THEN 550 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 551 DO jk = 1, jpk 552 DO jj = 1, jpj 553 DO ji = 1, jpi 554 zw3d(ji,jj,jk) = ( zprorcan(ji,jj,jk) + zprorcad(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! total primary production 555 END DO 556 END DO 557 END DO 558 CALL iom_put( "TPP" , zw3d ) 418 zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production 419 CALL iom_put( "TPP" , zw3d ) 559 420 ENDIF 560 421 IF( iom_use( "TPNEW" ) ) THEN 561 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 562 DO jk = 1, jpk 563 DO jj = 1, jpj 564 DO ji = 1, jpi 565 zw3d(ji,jj,jk) = ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! total new production 566 END DO 567 END DO 568 END DO 569 CALL iom_put( "TPNEW" , zw3d ) 422 zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production 423 CALL iom_put( "TPNEW" , zw3d ) 570 424 ENDIF 571 425 IF( iom_use( "TPBFE" ) ) THEN 572 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 573 DO jk = 1, jpk 574 DO jj = 1, jpj 575 DO ji = 1, jpi 576 zw3d(ji,jj,jk) = ( zprofen(ji,jj,jk) + zprofed(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! total biogenic iron production 577 END DO 578 END DO 579 END DO 580 CALL iom_put( "TPBFE" , zw3d ) 426 zw3d(:,:,:) = ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:) ! total biogenic iron production 427 CALL iom_put( "TPBFE" , zw3d ) 581 428 ENDIF 582 429 IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN 583 !$OMP PARALLEL 584 !$OMP DO schedule(static) private(jj,ji) 585 DO jj = 1, jpj 586 DO ji =1 ,jpi 587 zw2d(ji,jj) = 0. 588 END DO 589 END DO 430 zw2d(:,:) = 0. 590 431 DO jk = 1, jpkm1 591 !$OMP DO schedule(static) private(jj,ji) 592 DO jj = 1, jpj 593 DO ji =1 ,jpi 594 zw2d(ji,jj) = zw2d(ji,jj) + zprorcan (ji,jj,jk) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert. integrated primary produc. by nano 595 END DO 596 END DO 432 zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano 597 433 ENDDO 598 !$OMP END PARALLEL599 434 CALL iom_put( "INTPPPHYN" , zw2d ) 600 435 ! 601 !$OMP PARALLEL 602 !$OMP DO schedule(static) private(jj,ji) 603 DO jj = 1, jpj 604 DO ji =1 ,jpi 605 zw2d(ji,jj) = 0. 606 END DO 607 END DO 436 zw2d(:,:) = 0. 608 437 DO jk = 1, jpkm1 609 !$OMP DO schedule(static) private(jj,ji) 610 DO jj = 1, jpj 611 DO ji =1 ,jpi 612 zw2d(ji,jj) = zw2d(ji,jj) + zprorcad(ji,jj,jk) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert. integrated primary produc. by diatom 613 END DO 614 END DO 438 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom 615 439 ENDDO 616 !$OMP END PARALLEL617 440 CALL iom_put( "INTPPPHYD" , zw2d ) 618 441 ENDIF 619 442 IF( iom_use( "INTPP" ) ) THEN 620 !$OMP PARALLEL 621 !$OMP DO schedule(static) private(jj,ji) 622 DO jj = 1, jpj 623 DO ji =1 ,jpi 624 zw2d(ji,jj) = 0. 625 END DO 626 END DO 443 zw2d(:,:) = 0. 627 444 DO jk = 1, jpkm1 628 !$OMP DO schedule(static) private(jj,ji) 629 DO jj = 1, jpj 630 DO ji =1 ,jpi 631 zw2d(ji,jj) = zw2d(ji,jj) + ( zprorcan(ji,jj,jk) + zprorcad(ji,jj,jk) ) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert. integrated pp 632 END DO 633 END DO 445 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 634 446 ENDDO 635 !$OMP END PARALLEL636 447 CALL iom_put( "INTPP" , zw2d ) 637 448 ENDIF 638 449 IF( iom_use( "INTPNEW" ) ) THEN 639 !$OMP PARALLEL 640 !$OMP DO schedule(static) private(jj,ji) 641 DO jj = 1, jpj 642 DO ji =1 ,jpi 643 zw2d(ji,jj) = 0. 644 END DO 645 END DO 450 zw2d(:,:) = 0. 646 451 DO jk = 1, jpkm1 647 !$OMP DO schedule(static) private(jj,ji) 648 DO jj = 1, jpj 649 DO ji =1 ,jpi 650 zw2d(ji,jj) = zw2d(ji,jj) + ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert. integrated new prod 651 END DO 652 END DO 452 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod 653 453 ENDDO 654 !$OMP END PARALLEL655 454 CALL iom_put( "INTPNEW" , zw2d ) 656 455 ENDIF 657 456 IF( iom_use( "INTPBFE" ) ) THEN ! total biogenic iron production ( vertically integrated ) 658 !$OMP PARALLEL 659 !$OMP DO schedule(static) private(jj,ji) 660 DO jj = 1, jpj 661 DO ji =1 ,jpi 662 zw2d(ji,jj) = 0. 663 END DO 664 END DO 457 zw2d(:,:) = 0. 665 458 DO jk = 1, jpkm1 666 !$OMP DO schedule(static) private(jj,ji) 667 DO jj = 1, jpj 668 DO ji =1 ,jpi 669 zw2d(ji,jj) = zw2d(ji,jj) + ( zprofen(ji,jj,jk) + zprofed(ji,jj,jk) ) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert integr. bfe prod 670 END DO 671 END DO 459 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 672 460 ENDDO 673 !$OMP END PARALLEL674 461 CALL iom_put( "INTPBFE" , zw2d ) 675 462 ENDIF 676 463 IF( iom_use( "INTPBSI" ) ) THEN ! total biogenic silica production ( vertically integrated ) 677 !$OMP PARALLEL 678 !$OMP DO schedule(static) private(jj,ji) 679 DO jj = 1, jpj 680 DO ji =1 ,jpi 681 zw2d(ji,jj) = 0. 682 END DO 683 END DO 464 zw2d(:,:) = 0. 684 465 DO jk = 1, jpkm1 685 !$OMP DO schedule(static) private(jj,ji) 686 DO jj = 1, jpj 687 DO ji =1 ,jpi 688 zw2d(ji,jj) = zw2d(ji,jj) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert integr. bsi prod 689 END DO 690 END DO 466 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bsi prod 691 467 ENDDO 692 !$OMP END PARALLEL693 468 CALL iom_put( "INTPBSI" , zw2d ) 694 469 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r7698 r7753 78 78 79 79 ! Initialisation of temprary arrys 80 !$OMP PARALLEL 81 !$OMP DO schedule(static) private(jk,jj,ji) 82 DO jk = 1, jpk 83 DO jj = 1, jpj 84 DO ji = 1, jpi 85 zdepprod(ji,jj,jk) = 1._wp 86 zfacsib(ji,jj,jk) = xsilab / ( 1.0 - xsilab ) 87 zfacsi(ji,jj,jk) = xsilab 88 END DO 89 END DO 90 END DO 91 !$OMP DO schedule(static) private(jj,ji) 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 ztempbac(ji,jj) = 0._wp 95 END DO 96 END DO 80 zdepprod(:,:,:) = 1._wp 81 ztempbac(:,:) = 0._wp 82 zfacsib(:,:,:) = xsilab / ( 1.0 - xsilab ) 83 zfacsi(:,:,:) = xsilab 97 84 98 85 ! Computation of the mean phytoplankton concentration as … … 102 89 ! ------------------------------------------------------- 103 90 DO jk = 1, jpkm1 104 !$OMP DO schedule(static) private(jj,ji,zdep,zdepmin)105 91 DO jj = 1, jpj 106 92 DO ji = 1, jpi … … 119 105 120 106 IF( ln_p4z ) THEN 121 !$OMP DO schedule(static) private(jk,jj,ji,zremik,zolimit)122 107 DO jk = 1, jpkm1 123 108 DO jj = 1, jpj … … 151 136 END DO 152 137 ELSE 153 !$OMP DO schedule(static) private(jk,jj,ji,zremik,zremikc,zremikn,zremikp,zolimit,zolimic,zolimin,zolimip,zdenitrn,zdenitrp)154 138 DO jk = 1, jpkm1 155 139 DO jj = 1, jpj … … 197 181 198 182 199 !$OMP DO schedule(static) private(jk,jj,ji,zonitr,zdenitnh4)200 183 DO jk = 1, jpkm1 201 184 DO jj = 1, jpj … … 216 199 END DO 217 200 END DO 218 !$OMP END PARALLEL 219 220 IF(ln_ctl) THEN ! print mean trends (used for debugging) 221 WRITE(charout, FMT="('rem1')") 222 CALL prt_ctl_trc_info(charout) 223 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 224 ENDIF 225 226 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zbactfer) 201 202 IF(ln_ctl) THEN ! print mean trends (used for debugging) 203 WRITE(charout, FMT="('rem1')") 204 CALL prt_ctl_trc_info(charout) 205 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 206 ENDIF 207 227 208 DO jk = 1, jpkm1 228 209 DO jj = 1, jpj … … 243 224 END DO 244 225 245 IF(ln_ctl) THEN ! print mean trends (used for debugging)246 WRITE(charout, FMT="('rem2')")247 CALL prt_ctl_trc_info(charout)248 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)249 ENDIF226 IF(ln_ctl) THEN ! print mean trends (used for debugging) 227 WRITE(charout, FMT="('rem2')") 228 CALL prt_ctl_trc_info(charout) 229 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 230 ENDIF 250 231 251 232 ! Initialization of the array which contains the labile fraction … … 254 235 255 236 DO jk = 1, jpkm1 256 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,zsatur,zsatur2,znusil,zsiremin,zosil)257 237 DO jj = 1, jpj 258 238 DO ji = 1, jpi … … 284 264 CALL prt_ctl_trc_info(charout) 285 265 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 286 ENDIF266 ENDIF 287 267 288 268 IF( knt == nrdttrc ) THEN 289 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 290 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 291 ! 292 IF( iom_use( "REMIN" ) ) THEN 293 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 294 DO jk = 1, jpk 295 DO jj = 1, jpj 296 DO ji = 1, jpi 297 zw3d(ji,jj,jk) = zolimi(ji,jj,jk) * tmask(ji,jj,jk) * zfact ! Remineralisation rate 298 END DO 299 END DO 300 END DO 301 CALL iom_put( "REMIN" , zw3d ) 302 ENDIF 303 IF( iom_use( "DENIT" ) ) THEN 304 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 305 DO jk = 1, jpk 306 DO jj = 1, jpj 307 DO ji = 1, jpi 308 zw3d(ji,jj,jk) = denitr(ji,jj,jk) * rdenit * rno3 * tmask(ji,jj,jk) * zfact ! Denitrification 309 END DO 310 END DO 311 END DO 312 CALL iom_put( "DENIT" , zw3d ) 313 ENDIF 314 ! 315 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 316 ENDIF 269 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 270 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 271 ! 272 IF( iom_use( "REMIN" ) ) THEN 273 zw3d(:,:,:) = zolimi(:,:,:) * tmask(:,:,:) * zfact ! Remineralisation rate 274 CALL iom_put( "REMIN" , zw3d ) 275 ENDIF 276 IF( iom_use( "DENIT" ) ) THEN 277 zw3d(:,:,:) = denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zfact ! Denitrification 278 CALL iom_put( "DENIT" , zw3d ) 279 ENDIF 280 ! 281 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 282 ENDIF 317 283 ! 318 284 CALL wrk_dealloc( jpi, jpj, ztempbac ) … … 339 305 & xremikc, xremikn, xremikp 340 306 INTEGER :: ios ! Local integer output status for namelist read 341 INTEGER :: ji, jj, jk342 307 343 308 REWIND( numnatp_ref ) ! Namelist nampisrem in reference namelist : Pisces remineralization … … 369 334 ENDIF 370 335 ! 371 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 372 DO jk = 1, jpk 373 DO jj = 1, jpj 374 DO ji = 1, jpi 375 denitr (ji,jj,jk) = 0._wp 376 END DO 377 END DO 378 END DO 336 denitr (:,:,:) = 0._wp 379 337 ! 380 338 END SUBROUTINE p4z_rem_init -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r7698 r7753 116 116 CALL fld_read( kt, 1, sf_dust ) 117 117 IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN 118 !$OMP PARALLEL DO schedule(static) private(jj, ji) 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 dust(ji,jj) = sf_dust(1)%fnow(ji,jj,1) 122 END DO 123 END DO 118 dust(:,:) = sf_dust(1)%fnow(:,:,1) 124 119 ELSE 125 !$OMP PARALLEL DO schedule(static) private(jj, ji) 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 dust(ji,jj) = sf_dust(1)%fnow(ji,jj,1) * ( 1.0 - fr_i(ji,jj) ) 129 END DO 130 END DO 120 dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) ) 131 121 ENDIF 132 122 ENDIF … … 136 126 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_solub > 1 ) ) THEN 137 127 CALL fld_read( kt, 1, sf_solub ) 138 !$OMP PARALLEL DO schedule(static) private(jj, ji) 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 solub(ji,jj) = sf_solub(1)%fnow(ji,jj,1) 142 END DO 143 END DO 128 solub(:,:) = sf_solub(1)%fnow(:,:,1) 144 129 ENDIF 145 130 ENDIF … … 152 137 CALL fld_read( kt, 1, sf_river ) 153 138 IF( ln_p4z ) THEN 154 !$OMP PARALLEL DO schedule(static) private(jj, ji, zcoef)155 139 DO jj = 1, jpj 156 140 DO ji = 1, jpi … … 169 153 END DO 170 154 ELSE ! ln_p5z 171 !$OMP PARALLEL DO schedule(static) private(jj, ji, zcoef)172 155 DO jj = 1, jpj 173 156 DO ji = 1, jpi … … 196 179 IF( ln_ndepo ) THEN 197 180 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 198 zcoef = rno3 * 14E6 * ryyss 199 CALL fld_read( kt, 1, sf_ndepo ) 200 !$OMP PARALLEL DO schedule(static) private(jj, ji) 201 DO jj = 1, jpj 202 DO ji = 1, jpi 203 nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / zcoef / e3t_n(ji,jj,1) 204 END DO 205 END DO 181 zcoef = rno3 * 14E6 * ryyss 182 CALL fld_read( kt, 1, sf_ndepo ) 183 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) 206 184 ENDIF 207 185 IF( .NOT.ln_linssh ) THEN 208 zcoef = rno3 * 14E6 * ryyss 209 !$OMP PARALLEL DO schedule(static) private(jj, ji) 210 DO jj = 1, jpj 211 DO ji = 1, jpi 212 nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / zcoef / e3t_n(ji,jj,1) 213 END DO 214 END DO 186 zcoef = rno3 * 14E6 * ryyss 187 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) 215 188 ENDIF 216 189 ENDIF … … 319 292 ! online configuration : computed in sbcrnf 320 293 IF( l_offline ) THEN 321 !$OMP PARALLEL DO schedule(static) private(jj, ji) 322 DO jj = 1, jpj 323 DO ji = 1, jpi 324 nk_rnf(ji,jj) = 1 325 h_rnf (ji,jj) = gdept_n(ji,jj,1) 326 END DO 327 END DO 294 nk_rnf(:,:) = 1 295 h_rnf (:,:) = gdept_n(:,:,1) 328 296 ENDIF 329 297 … … 498 466 IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1) 499 467 IF (lwp) WRITE(numout,*) 500 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmaskt)501 468 DO jk = 1, ik50 502 469 DO jj = 2, jpjm1 … … 513 480 CALL lbc_lnk( zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) 514 481 ! 515 !$OMP PARALLEL516 !$OMP DO schedule(static) private(jk, jj, ji, zexpide, zdenitide)517 482 DO jk = 1, jpk 518 483 DO jj = 1, jpj … … 524 489 END DO 525 490 END DO 526 !$OMP END DO NOWAIT527 491 ! Coastal supply of iron 528 492 ! ------------------------- 529 !$OMP DO schedule(static) private(jj,ji) 530 DO jj = 1, jpj 531 DO ji = 1, jpi 532 ironsed(ji,jj,jpk) = 0._wp 533 END DO 493 ironsed(:,:,jpk) = 0._wp 494 DO jk = 1, jpkm1 495 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday ) 534 496 END DO 535 !$OMP DO schedule(static) private(jk,jj,ji)536 DO jk = 1, jpkm1537 DO jj = 1, jpj538 DO ji = 1, jpi539 ironsed(ji,jj,jk) = sedfeinput * zcmask(ji,jj,jk) / ( e3t_0(ji,jj,jk) * rday )540 END DO541 END DO542 END DO543 !$OMP END PARALLEL544 497 DEALLOCATE( zcmask) 545 498 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r7698 r7753 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 34 !! $Id$ 34 !! $Id$ 35 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- … … 84 84 85 85 86 !$OMP PARALLEL DO schedule(static) private(jj,ji) 87 DO jj = 1, jpj 88 DO ji = 1, jpi 89 zdenit2d(ji,jj) = 0.e0 90 zbureff (ji,jj) = 0.e0 91 zwork1 (ji,jj) = 0.e0 92 zwork2 (ji,jj) = 0.e0 93 zwork3 (ji,jj) = 0.e0 94 zsedsi (ji,jj) = 0.e0 95 zsedcal (ji,jj) = 0.e0 96 zsedc (ji,jj) = 0.e0 97 END DO 98 END DO 86 zdenit2d(:,:) = 0.e0 87 zbureff (:,:) = 0.e0 88 zwork1 (:,:) = 0.e0 89 zwork2 (:,:) = 0.e0 90 zwork3 (:,:) = 0.e0 91 zsedsi (:,:) = 0.e0 92 zsedcal (:,:) = 0.e0 93 zsedc (:,:) = 0.e0 94 99 95 100 96 ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. … … 104 100 CALL wrk_alloc( jpi, jpj, zironice ) 105 101 ! 106 !$OMP PARALLEL107 !$OMP DO schedule(static) private(jj,ji,zdep,zwflux,zfminus,zfplus)108 102 DO jj = 1, jpj 109 103 DO ji = 1, jpi … … 116 110 END DO 117 111 ! 118 !$OMP DO schedule(static) private(jj,ji) 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 tra(ji,jj,1,jpfer) = tra(ji,jj,1,jpfer) + zironice(ji,jj) 122 END DO 123 END DO 124 !$OMP END PARALLEL 112 tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:) 125 113 ! 126 114 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) ) & … … 139 127 ! ! Iron and Si deposition at the surface 140 128 IF( ln_solub ) THEN 141 !$OMP PARALLEL DO schedule(static) private(jj,ji) 142 DO jj = 1, jpj 143 DO ji = 1, jpi 144 zirondep(ji,jj,1) = solub(ji,jj) * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 55.85 + 3.e-10 * r1_ryyss 145 END DO 146 END DO 129 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 147 130 ELSE 148 !$OMP PARALLEL DO schedule(static) private(jj,ji) 149 DO jj = 1, jpj 150 DO ji = 1, jpi 151 zirondep(ji,jj,1) = dustsolub * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 55.85 + 3.e-10 * r1_ryyss 152 END DO 153 END DO 131 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 154 132 ENDIF 155 !$OMP PARALLEL DO schedule(static) private(jj,ji) 156 DO jj = 1, jpj 157 DO ji = 1, jpi 158 zsidep(ji,jj) = 8.8 * 0.075 * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 28.1 159 zpdep (ji,jj,1) = 0.1 * 0.021 * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 31. / po4r 160 END DO 161 END DO 133 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 134 zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 162 135 ! ! Iron solubilization of particles in the water column 163 136 ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j 164 137 zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 165 !$OMP PARALLEL166 !$OMP DO schedule(static) private(jk,jj,ji)167 138 DO jk = 2, jpkm1 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 zirondep(ji,jj,jk) = dust(ji,jj) * mfrac * zwdust * rfact2 * EXP( -gdept_n(ji,jj,jk) / 540. ) 171 zpdep (ji,jj,jk) = zirondep(ji,jj,jk) * 0.023 172 END DO 173 END DO 139 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 140 zpdep (:,:,jk) = zirondep(:,:,jk) * 0.023 174 141 END DO 175 142 ! ! Iron solubilization of particles in the water column 176 !$OMP DO schedule(static) private(jj,ji) 177 DO jj = 1, jpj 178 DO ji = 1, jpi 179 tra(ji,jj,1,jpsil) = tra(ji,jj,1,jpsil) + zsidep (ji,jj) 180 END DO 181 END DO 182 !$OMP DO schedule(static) private(jk,jj,ji) 183 DO jk = 1, jpk 184 DO jj = 1, jpj 185 DO ji = 1, jpi 186 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zpdep (ji,jj,jk) 187 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zirondep(ji,jj,jk) 188 END DO 189 END DO 190 END DO 191 !$OMP END PARALLEL 143 tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep (:,:) 144 tra(:,:,:,jppo4) = tra(:,:,:,jppo4) + zpdep (:,:,:) 145 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:) 192 146 ! 193 147 IF( lk_iomput ) THEN … … 207 161 ! ---------------------------------------------------------- 208 162 IF( ln_river ) THEN 209 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk)210 163 DO jj = 1, jpj 211 164 DO ji = 1, jpi … … 221 174 ENDDO 222 175 IF( ln_p5z ) THEN 223 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk)224 176 DO jj = 1, jpj 225 177 DO ji = 1, jpi … … 237 189 ! ---------------------------------------------------------- 238 190 IF( ln_ndepo ) THEN 239 !$OMP PARALLEL DO schedule(static) private(jj,ji) 240 DO jj = 1, jpj 241 DO ji = 1, jpi 242 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + nitdep(ji,jj) * rfact2 243 tra(ji,jj,1,jptal) = tra(ji,jj,1,jptal) - rno3 * nitdep(ji,jj) * rfact2 244 ENDDO 245 ENDDO 191 tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 192 tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 246 193 ENDIF 247 194 … … 249 196 ! ------------------------------------------------------ 250 197 IF( ln_ironsed ) THEN 251 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 252 DO jk = 1, jpk 253 DO jj = 1, jpj 254 DO ji = 1, jpi 255 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + ironsed(ji,jj,jk) * rfact2 256 END DO 257 END DO 258 END DO 259 260 IF( ln_ligand ) THEN 261 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 262 DO jk = 1, jpk 263 DO jj = 1, jpj 264 DO ji = 1, jpi 265 tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) + ( ironsed(ji,jj,jk) * fep_rats ) * rfact2 266 END DO 267 END DO 268 END DO 269 END IF 198 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 199 IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2 270 200 ! 271 201 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) & … … 276 206 ! ------------------------------------------------------ 277 207 IF( ln_hydrofe ) THEN 278 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 279 DO jk = 1, jpk 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + hydrofe(ji,jj,jk) * rfact2 283 END DO 284 END DO 285 END DO 208 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 286 209 IF( ln_ligand ) THEN 287 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 288 DO jk = 1, jpk 289 DO jj = 1, jpj 290 DO ji = 1, jpi 291 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + ( hydrofe(ji,jj,jk) * fep_rath ) * rfact2 292 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + ( hydrofe(ji,jj,jk) * lgw_rath ) * rfact2 293 END DO 294 END DO 295 END DO 210 tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( hydrofe(:,:,:) * fep_rath ) * rfact2 211 tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 296 212 ENDIF 297 213 ! … … 302 218 ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 303 219 ! -------------------------------------------------------------------- 304 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep)305 220 DO jj = 1, jpj 306 221 DO ji = 1, jpi … … 314 229 ! 315 230 IF( ln_ligand ) THEN 316 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep)317 231 DO jj = 1, jpj 318 232 DO ji = 1, jpi … … 328 242 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 329 243 ! ------------------------------------------------------- 330 !$OMP PARALLEL331 !$OMP DO schedule(static) private(jj,ji,ikt,zflx,zo2,zno3,zdep)332 244 DO jj = 1, jpj 333 245 DO ji = 1, jpi … … 355 267 ! The factor for calcite comes from the alkalinity effect 356 268 ! ------------------------------------------------------------- 357 !$OMP DO schedule(static) private(jj,ji,ikt,zfactcal)358 269 DO jj = 1, jpj 359 270 DO ji = 1, jpi … … 369 280 END DO 370 281 END DO 371 !$OMP END PARALLEL372 282 zsumsedsi = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 373 283 zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday … … 381 291 IF( .NOT.lk_sed ) zrivsil = 1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn ) 382 292 383 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwsc,zsiloss,zcaloss)384 293 DO jj = 1, jpj 385 294 DO ji = 1, jpi … … 396 305 ! 397 306 IF( .NOT.lk_sed ) THEN 398 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwsc,zsiloss,zcaloss,zfactcal,zrivalk)399 307 DO jj = 1, jpj 400 308 DO ji = 1, jpi … … 417 325 ENDIF 418 326 ! 419 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4)420 327 DO jj = 1, jpj 421 328 DO ji = 1, jpi … … 432 339 ! 433 340 IF( ln_ligand ) THEN 434 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwssfep)435 341 DO jj = 1, jpj 436 342 DO ji = 1, jpi … … 444 350 ! 445 351 IF( ln_p5z ) THEN 446 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4)447 352 DO jj = 1, jpj 448 353 DO ji = 1, jpi … … 462 367 ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification 463 368 ! in the sediments and just above the sediments. Not very clever, but simpliest option. 464 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4,zrivno3,zwstpoc,zpdenit,z1pdenit,zolimit,zdenitt,zwstpop,zwstpon)465 369 DO jj = 1, jpj 466 370 DO ji = 1, jpi … … 498 402 ! Small source iron from particulate inorganic iron 499 403 !----------------------------------- 500 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)501 404 DO jk = 1, jpkm1 502 DO jj = 1, jpj 503 DO ji = 1, jpi 504 zlight (ji,jj,jk) = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) * ( 1. - fr_i(ji,jj) ) 505 zsoufer(ji,jj,jk) = zlight(ji,jj,jk) * 2E-11 / ( 2E-11 + biron(ji,jj,jk) ) 506 END DO 507 END DO 405 zlight (:,:,jk) = ( 1.- EXP( -etot_ndcy(:,:,jk) / diazolight ) ) * ( 1. - fr_i(:,:) ) 406 zsoufer(:,:,jk) = zlight(:,:,jk) * 2E-11 / ( 2E-11 + biron(:,:,jk) ) 508 407 ENDDO 509 408 IF( ln_p4z ) THEN 510 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zlim,zfact,ztrfer,ztrpo4s)511 409 DO jk = 1, jpkm1 512 410 DO jj = 1, jpj … … 525 423 END DO 526 424 ELSE ! p5z 527 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztemp,zmudia,xdianh4,xdiano3,zlim,zfact,ztrfer,ztrdp)528 425 DO jk = 1, jpkm1 529 426 DO jj = 1, jpj … … 551 448 ! ---------------------------------------- 552 449 IF( ln_p4z ) THEN 553 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact)554 450 DO jk = 1, jpkm1 555 451 DO jj = 1, jpj … … 566 462 END DO 567 463 ELSE ! p5z 568 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact)569 464 DO jk = 1, jpkm1 570 465 DO jj = 1, jpj … … 602 497 IF( iom_use("Nfix" ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) ) ! nitrogen fixation 603 498 IF( iom_use("INTNFIX") ) THEN ! nitrogen fixation rate in ocean ( vertically integrated ) 604 !$OMP PARALLEL 605 !$OMP DO schedule(static) private(jj,ji) 606 DO jj = 1, jpj 607 DO ji = 1, jpi 608 zwork1(ji,jj) = 0. 609 END DO 499 zwork1(:,:) = 0. 500 DO jk = 1, jpkm1 501 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 610 502 ENDDO 611 DO jk = 1, jpkm1612 !$OMP DO schedule(static) private(jj,ji)613 DO jj = 1, jpj614 DO ji = 1, jpi615 zwork1(ji,jj) = zwork1(ji,jj) + nitrpot(ji,jj,jk) * nitrfix * zfact * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)616 END DO617 END DO618 ENDDO619 !$OMP END PARALLEL620 503 CALL iom_put( "INTNFIX" , zwork1 ) 621 504 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r7698 r7753 74 74 ! Initialization of some global variables 75 75 ! --------------------------------------- 76 !$OMP PARALLEL 77 !$OMP DO schedule(static) private(jk, jj, ji) 78 DO jk = 1, jpk 79 DO jj = 1, jpj 80 DO ji = 1,jpi 81 prodpoc(ji,jj,jk) = 0. 82 conspoc(ji,jj,jk) = 0. 83 prodgoc(ji,jj,jk) = 0. 84 consgoc(ji,jj,jk) = 0. 85 END DO 86 END DO 87 END DO 76 prodpoc(:,:,:) = 0. 77 conspoc(:,:,:) = 0. 78 prodgoc(:,:,:) = 0. 79 consgoc(:,:,:) = 0. 88 80 89 81 ! … … 91 83 ! by data and from the coagulation theory 92 84 ! ----------------------------------------------------------- 93 !$OMP DO schedule(static) private(jk, jj, ji, zmax, zfact)94 85 DO jk = 1, jpkm1 95 86 DO jj = 1, jpj … … 103 94 104 95 ! limit the values of the sinking speeds to avoid numerical instabilities 105 !$OMP DO schedule(static) private(jk, jj, ji) 106 DO jk = 1, jpk 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 wsbio3(ji,jj,jk) = wsbio 110 END DO 111 END DO 112 END DO 113 !$OMP END PARALLEL 96 wsbio3(:,:,:) = wsbio 114 97 115 98 ! … … 129 112 iiter1 = 1 130 113 iiter2 = 1 131 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zwsmax) REDUCTION(MAX:iiter1, iiter2)132 114 DO jk = 1, jpkm1 133 115 DO jj = 1, jpj … … 149 131 ENDIF 150 132 151 !$OMP PARALLEL152 !$OMP DO schedule(static) private(jk, jj, ji, zwsmax)153 133 DO jk = 1,jpkm1 154 134 DO jj = 1, jpj … … 163 143 END DO 164 144 145 wscal (:,:,:) = wsbio4(:,:,:) 146 165 147 ! Initializa to zero all the sinking arrays 166 148 ! ----------------------------------------- 167 !$OMP DO schedule(static) private(jk, jj, ji) 168 DO jk = 1, jpk 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 sinking (ji,jj,jk) = 0.e0 172 sinking2(ji,jj,jk) = 0.e0 173 sinkcal (ji,jj,jk) = 0.e0 174 sinkfer (ji,jj,jk) = 0.e0 175 sinksil (ji,jj,jk) = 0.e0 176 sinkfer2(ji,jj,jk) = 0.e0 177 wscal (ji,jj,jk) = wsbio4(ji,jj,jk) 178 END DO 179 END DO 180 END DO 181 !$OMP END PARALLEL 149 sinking (:,:,:) = 0.e0 150 sinking2(:,:,:) = 0.e0 151 sinkcal (:,:,:) = 0.e0 152 sinkfer (:,:,:) = 0.e0 153 sinksil (:,:,:) = 0.e0 154 sinkfer2(:,:,:) = 0.e0 182 155 183 156 ! Compute the sedimentation term using p4zsink2 for all the sinking particles … … 196 169 197 170 IF( ln_p5z ) THEN 198 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 199 DO jk = 1, jpk 200 DO jj = 1, jpj 201 DO ji = 1, jpi 202 sinkingn (ji,jj,jk) = 0.e0 203 sinking2n(ji,jj,jk) = 0.e0 204 sinkingp (ji,jj,jk) = 0.e0 205 sinking2p(ji,jj,jk) = 0.e0 206 END DO 207 END DO 208 END DO 171 sinkingn (:,:,:) = 0.e0 172 sinking2n(:,:,:) = 0.e0 173 sinkingp (:,:,:) = 0.e0 174 sinking2p(:,:,:) = 0.e0 209 175 210 176 ! Compute the sedimentation term using p4zsink2 for all the sinking particles … … 222 188 223 189 IF( ln_ligand ) THEN 224 !$OMP PARALLEL 225 !$OMP DO schedule(static) private(jk, jj, ji) 226 DO jk = 1, jpk 227 DO jj = 1, jpj 228 DO ji = 1, jpi 229 wsfep (ji,jj,jk) = wfep 230 END DO 231 END DO 232 END DO 233 !$OMP DO schedule(static) private(jk, jj, ji, zwsmax) 190 wsfep (:,:,:) = wfep 234 191 DO jk = 1,jpkm1 235 192 DO jj = 1, jpj … … 242 199 END DO 243 200 END DO 244 !$OMP END DO NOWAIT245 201 ! 246 !$OMP DO schedule(static) private(jk, jj, ji) 247 DO jk = 1, jpk 248 DO jj = 1, jpj 249 DO ji = 1, jpi 250 sinkfep(ji,jj,jk) = 0.e0 251 END DO 252 END DO 253 END DO 254 !$OMP END PARALLEL 202 sinkfep(:,:,:) = 0.e0 255 203 DO jit = 1, iiter1 256 204 CALL p4z_sink2( wsfep, sinkfep , jpfep, iiter1 ) … … 269 217 ! 270 218 IF( iom_use( "EPC100" ) ) THEN 271 !$OMP PARALLEL DO schedule(static) private(jj, ji) 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 zw2d(ji,jj) = ( sinking(ji,jj,ik100) + sinking2(ji,jj,ik100) ) * zfact * tmask(ji,jj,1) ! Export of carbon at 100m 275 END DO 276 END DO 277 CALL iom_put( "EPC100" , zw2d ) 219 zw2d(:,:) = ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of carbon at 100m 220 CALL iom_put( "EPC100" , zw2d ) 278 221 ENDIF 279 222 IF( iom_use( "EPFE100" ) ) THEN 280 !$OMP PARALLEL DO schedule(static) private(jj, ji) 281 DO jj = 1, jpj 282 DO ji = 1, jpi 283 zw2d(ji,jj) = ( sinkfer(ji,jj,ik100) + sinkfer2(ji,jj,ik100) ) * zfact * tmask(ji,jj,1) ! Export of iron at 100m 284 END DO 285 END DO 286 CALL iom_put( "EPFE100" , zw2d ) 223 zw2d(:,:) = ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of iron at 100m 224 CALL iom_put( "EPFE100" , zw2d ) 287 225 ENDIF 288 226 IF( iom_use( "EPCAL100" ) ) THEN 289 !$OMP PARALLEL DO schedule(static) private(jj, ji) 290 DO jj = 1, jpj 291 DO ji = 1, jpi 292 zw2d(ji,jj) = sinkcal(ji,jj,ik100) * zfact * tmask(ji,jj,1) ! Export of calcite at 100m 293 END DO 294 END DO 295 CALL iom_put( "EPCAL100" , zw2d ) 227 zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m 228 CALL iom_put( "EPCAL100" , zw2d ) 296 229 ENDIF 297 230 IF( iom_use( "EPSI100" ) ) THEN 298 !$OMP PARALLEL DO schedule(static) private(jj, ji) 299 DO jj = 1, jpj 300 DO ji = 1, jpi 301 zw2d(ji,jj) = sinksil(ji,jj,ik100) * zfact * tmask(ji,jj,1) ! Export of bigenic silica at 100m 302 END DO 303 END DO 304 CALL iom_put( "EPSI100" , zw2d ) 231 zw2d(:,:) = sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m 232 CALL iom_put( "EPSI100" , zw2d ) 305 233 ENDIF 306 234 IF( iom_use( "EXPC" ) ) THEN 307 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 308 DO jk = 1, jpk 309 DO jj = 1, jpj 310 DO ji = 1, jpi 311 zw3d(ji,jj,jk) = ( sinking(ji,jj,jk) + sinking2(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! Export of carbon in the water column 312 END DO 313 END DO 314 END DO 315 CALL iom_put( "EXPC" , zw3d ) 235 zw3d(:,:,:) = ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of carbon in the water column 236 CALL iom_put( "EXPC" , zw3d ) 316 237 ENDIF 317 238 IF( iom_use( "EXPFE" ) ) THEN 318 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 319 DO jk = 1, jpk 320 DO jj = 1, jpj 321 DO ji = 1, jpi 322 zw3d(ji,jj,jk) = ( sinkfer(ji,jj,jk) + sinkfer2(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! Export of iron 323 END DO 324 END DO 325 END DO 326 CALL iom_put( "EXPFE" , zw3d ) 239 zw3d(:,:,:) = ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of iron 240 CALL iom_put( "EXPFE" , zw3d ) 327 241 ENDIF 328 242 IF( iom_use( "EXPCAL" ) ) THEN 329 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 330 DO jk = 1, jpk 331 DO jj = 1, jpj 332 DO ji = 1, jpi 333 zw3d(ji,jj,jk) = sinkcal(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! Export of calcite 334 END DO 335 END DO 336 END DO 337 CALL iom_put( "EXPCAL" , zw3d ) 243 zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite 244 CALL iom_put( "EXPCAL" , zw3d ) 338 245 ENDIF 339 246 IF( iom_use( "EXPSI" ) ) THEN 340 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 341 DO jk = 1, jpk 342 DO jj = 1, jpj 343 DO ji = 1, jpi 344 zw3d(ji,jj,jk) = sinksil(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! Export of bigenic silica 345 END DO 346 END DO 347 END DO 348 CALL iom_put( "EXPSI" , zw3d ) 247 zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica 248 CALL iom_put( "EXPSI" , zw3d ) 349 249 ENDIF 350 250 IF( iom_use( "tcexp" ) ) CALL iom_put( "tcexp" , t_oce_co2_exp * zfact ) ! molC/s … … 412 312 zstep = rfact2 / REAL( kiter, wp ) / 2. 413 313 414 !$OMP PARALLEL 415 !$OMP DO schedule(static) private(jk, jj, ji) 416 DO jk = 1, jpk 417 DO jj = 1, jpj 418 DO ji = 1, jpi 419 ztraz(ji,jj,jk) = 0.e0 420 zakz (ji,jj,jk) = 0.e0 421 ztrb (ji,jj,jk) = trb(ji,jj,jk,jp_tra) 422 END DO 423 END DO 424 END DO 425 !$OMP END DO NOWAIT 426 !$OMP DO schedule(static) private(jk, jj, ji) 314 ztraz(:,:,:) = 0.e0 315 zakz (:,:,:) = 0.e0 316 ztrb (:,:,:) = trb(:,:,:,jp_tra) 317 427 318 DO jk = 1, jpkm1 428 DO jj = 1, jpj 429 DO ji = 1, jpi 430 zwsink2(ji,jj,jk+1) = -pwsink(ji,jj,jk) / rday * tmask(ji,jj,jk+1) 431 END DO 432 END DO 433 END DO 434 435 !$OMP DO schedule(static) private(jj, ji) 436 DO jj = 1, jpj 437 DO ji = 1, jpi 438 zwsink2(ji,jj,1) = 0.e0 439 END DO 440 END DO 441 !$OMP END DO NOWAIT 319 zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) 320 END DO 321 zwsink2(:,:,1) = 0.e0 322 442 323 443 324 ! Vertical advective flux 444 325 DO jn = 1, 2 445 326 ! first guess of the slopes interior values 446 !$OMP DO schedule(static) private(jk,jj,ji)447 327 DO jk = 2, jpkm1 448 DO jj = 1, jpj 449 DO ji = 1, jpi 450 ztraz(ji,jj,jk) = ( trb(ji,jj,jk-1,jp_tra) - trb(ji,jj,jk,jp_tra) ) * tmask(ji,jj,jk) 451 END DO 452 END DO 453 END DO 454 !$OMP END DO NOWAIT 455 !$OMP DO schedule(static) private(jj, ji) 456 DO jj = 1, jpj 457 DO ji = 1, jpi 458 ztraz(ji,jj,1 ) = 0.0 459 ztraz(ji,jj,jpk) = 0.0 460 END DO 461 END DO 328 ztraz(:,:,jk) = ( trb(:,:,jk-1,jp_tra) - trb(:,:,jk,jp_tra) ) * tmask(:,:,jk) 329 END DO 330 ztraz(:,:,1 ) = 0.0 331 ztraz(:,:,jpk) = 0.0 462 332 463 333 ! slopes 464 !$OMP DO schedule(static) private(jk, jj, ji, zign)465 334 DO jk = 2, jpkm1 466 335 DO jj = 1,jpj … … 473 342 474 343 ! Slopes limitation 475 !$OMP DO schedule(static) private(jk, jj, ji)476 344 DO jk = 2, jpkm1 477 345 DO jj = 1, jpj … … 484 352 485 353 ! vertical advective flux 486 !$OMP DO schedule(static) private(jk, jj, ji, zigma, zew)487 354 DO jk = 1, jpkm1 488 355 DO jj = 1, jpj … … 496 363 ! 497 364 ! Boundary conditions 498 !$OMP DO schedule(static) private(jj, ji) 499 DO jj = 1, jpj 500 DO ji = 1, jpi 501 psinkflx(ji,jj,1 ) = 0.e0 502 psinkflx(ji,jj,jpk) = 0.e0 503 END DO 504 END DO 365 psinkflx(:,:,1 ) = 0.e0 366 psinkflx(:,:,jpk) = 0.e0 505 367 506 !$OMP DO schedule(static) private(jk, jj, ji, zflx)507 368 DO jk=1,jpkm1 508 369 DO jj = 1,jpj … … 516 377 ENDDO 517 378 518 !$OMP DO schedule(static) private(jk, jj, ji, zflx)519 379 DO jk = 1,jpkm1 520 380 DO jj = 1,jpj … … 526 386 END DO 527 387 528 !$OMP DO schedule(static) private(jk, jj, ji) 529 DO jk = 1, jpk 530 DO jj = 1, jpj 531 DO ji = 1, jpi 532 trb(ji,jj,jk,jp_tra) = ztrb(ji,jj,jk) 533 psinkflx(ji,jj,jk) = 2. * psinkflx(ji,jj,jk) 534 END DO 535 END DO 536 END DO 537 !$OMP END PARALLEL 388 trb(:,:,:,jp_tra) = ztrb(:,:,:) 389 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 538 390 ! 539 391 CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r7698 r7753 99 99 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 100 100 DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter 101 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 102 DO jk = 1, jpk 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 106 END DO 107 END DO 108 END DO 101 trb(:,:,:,jn) = trn(:,:,:,jn) 109 102 END DO 110 103 ENDIF … … 132 125 CALL p4z_flx( kt, jnt ) ! Compute surface fluxes 133 126 ! 134 !$OMP PARALLEL 135 !$OMP DO schedule(static) private(jk, jj, ji) 136 DO jk = 1, jpk 137 DO jj = 1, jpj 138 DO ji = 1, jpi 139 xnegtr(ji,jj,jk) = 1.e0 140 END DO 141 END DO 142 END DO 127 xnegtr(:,:,:) = 1.e0 143 128 DO jn = jp_pcs0, jp_pcs1 144 !$OMP DO schedule(static) private(jk, jj, ji, ztra)145 129 DO jk = 1, jpk 146 130 DO jj = 1, jpj … … 157 141 ! ! 158 142 DO jn = jp_pcs0, jp_pcs1 159 !$OMP DO schedule(static) private(jk, jj, ji) 160 DO jk = 1, jpk 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) + xnegtr(ji,jj,jk) * tra(ji,jj,jk,jn) 164 END DO 165 END DO 166 END DO 143 trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 167 144 END DO 168 145 ! 169 146 DO jn = jp_pcs0, jp_pcs1 170 !$OMP DO schedule(static) private(jk, jj, ji) 171 DO jk = 1, jpk 172 DO jj = 1, jpj 173 DO ji = 1, jpi 174 tra(ji,jj,jk,jn) = 0._wp 175 END DO 176 END DO 177 END DO 147 tra(:,:,:,jn) = 0._wp 178 148 END DO 179 !$OMP END PARALLEL180 149 ! 181 150 IF( ln_top_euler ) THEN 182 151 DO jn = jp_pcs0, jp_pcs1 183 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 184 DO jk = 1, jpk 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 trn(ji,jj,jk,jn) = trb(ji,jj,jk,jn) 188 END DO 189 END DO 190 END DO 152 trn(:,:,:,jn) = trb(:,:,:,jn) 191 153 END DO 192 154 ENDIF … … 387 349 ! 388 350 INTEGER, INTENT( in ) :: kt ! time step 389 INTEGER :: ji, jj, jk390 351 ! 391 352 REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) … … 396 357 REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn 397 358 REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb 398 REAL(wp), POINTER, DIMENSION(:,:,:) :: zctrn_jptal, zctrn_jppo4, zctrn_jppo3, zctrn_jpsil !workspace arrays399 REAL(wp), POINTER, DIMENSION(:,:,:) :: zctrb_jptal, zctrb_jppo4, zctrb_jppo3, zctrb_jpsil !workspace arrays400 359 !!--------------------------------------------------------------------- 401 360 … … 407 366 IF( cn_cfg == "orca" .AND. .NOT. lk_c1d ) THEN ! ORCA configuration (not 1D) ! 408 367 ! ! --------------------------- ! 409 CALL wrk_alloc( jpi, jpj, jpk, zctrn_jptal, zctrn_jppo4, zctrn_jppo3, zctrn_jpsil )410 CALL wrk_alloc( jpi, jpj, jpk, zctrb_jptal, zctrb_jppo4, zctrb_jppo3, zctrb_jpsil )411 412 368 ! set total alkalinity, phosphate, nitrate & silicate 413 369 zarea = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6 414 370 415 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 416 DO jk = 1, jpk 417 DO jj = 1, jpj 418 DO ji = 1, jpi 419 zctrn_jptal(ji,jj,jk) = trn(ji,jj,jk,jptal) * cvol(ji,jj,jk) 420 zctrn_jppo4(ji,jj,jk) = trn(ji,jj,jk,jppo4) * cvol(ji,jj,jk) 421 zctrn_jppo3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * cvol(ji,jj,jk) 422 zctrn_jpsil(ji,jj,jk) = trn(ji,jj,jk,jpsil) * cvol(ji,jj,jk) 423 END DO 424 END DO 425 END DO 426 427 zalksumn = glob_sum( zctrn_jptal(:,:,:) ) * zarea 428 zpo4sumn = glob_sum( zctrn_jppo4(:,:,:) ) * zarea * po4r 429 zno3sumn = glob_sum( zctrn_jppo3(:,:,:) ) * zarea * rno3 430 zsilsumn = glob_sum( zctrn_jpsil(:,:,:) ) * zarea 431 432 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 433 DO jk = 1, jpk 434 DO jj = 1, jpj 435 DO ji = 1, jpi 436 trn(ji,jj,jk,jpsil) = MIN( 400.e-6,trn(ji,jj,jk,jpsil) * silmean / zsilsumn ) 437 trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) * alkmean / zalksumn 438 trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) * po4mean / zpo4sumn 439 trn(ji,jj,jk,jpno3) = trn(ji,jj,jk,jpno3) * no3mean / zno3sumn 440 END DO 441 END DO 442 END DO 443 444 IF(lwp) THEN 445 WRITE(numout,*) ' TALKN mean : ', zalksumn 446 WRITE(numout,*) ' PO4N mean : ', zpo4sumn 447 WRITE(numout,*) ' NO3N mean : ', zno3sumn 448 WRITE(numout,*) ' SiO3N mean : ', zsilsumn 449 END IF 371 zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea 372 zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 373 zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 374 zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 375 376 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn 377 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn 378 379 IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn 380 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn 381 382 IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn 383 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn 384 385 IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn 386 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn ) 450 387 ! 451 388 ! 452 389 IF( .NOT. ln_top_euler ) THEN 453 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 454 DO jk = 1, jpk 455 DO jj = 1, jpj 456 DO ji = 1, jpi 457 zctrb_jptal(ji,jj,jk) = trb(ji,jj,jk,jptal) * cvol(ji,jj,jk) 458 zctrb_jppo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) * cvol(ji,jj,jk) 459 zctrb_jppo3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * cvol(ji,jj,jk) 460 zctrb_jpsil(ji,jj,jk) = trb(ji,jj,jk,jpsil) * cvol(ji,jj,jk) 461 END DO 462 END DO 463 END DO 464 465 zalksumb = glob_sum( zctrb_jptal(:,:,:) ) * zarea 466 zpo4sumb = glob_sum( zctrb_jppo4(:,:,:) ) * zarea * po4r 467 zno3sumb = glob_sum( zctrb_jppo3(:,:,:) ) * zarea * rno3 468 zsilsumb = glob_sum( zctrb_jpsil(:,:,:) ) * zarea 469 470 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 471 DO jk = 1, jpk 472 DO jj = 1, jpj 473 DO ji = 1, jpi 474 trb(ji,jj,jk,jpsil) = MIN( 400.e-6,trb(ji,jj,jk,jpsil) * silmean / zsilsumb ) 475 trb(ji,jj,jk,jptal) = trb(ji,jj,jk,jptal) * alkmean / zalksumb 476 trb(ji,jj,jk,jppo4) = trb(ji,jj,jk,jppo4) * po4mean / zpo4sumb 477 trb(ji,jj,jk,jpno3) = trb(ji,jj,jk,jpno3) * no3mean / zno3sumb 478 END DO 479 END DO 480 END DO 481 482 IF(lwp) THEN 483 WRITE(numout,*) ' ' 484 WRITE(numout,*) ' TALKB mean : ', zalksumb 485 WRITE(numout,*) ' PO4B mean : ', zpo4sumb 486 WRITE(numout,*) ' NO3B mean : ', zno3sumb 487 WRITE(numout,*) ' SiO3B mean : ', zsilsumb 488 END IF 390 zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea 391 zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 392 zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 393 zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 394 395 IF(lwp) WRITE(numout,*) ' ' 396 IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb 397 trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 398 399 IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb 400 trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 401 402 IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb 403 trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 404 405 IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb 406 trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 489 407 ENDIF 490 !491 CALL wrk_dealloc( jpi, jpj, jpk, zctrb_jptal, zctrb_jppo4, zctrb_jppo3, zctrb_jpsil )492 CALL wrk_dealloc( jpi, jpj, jpk, zctrn_jptal, zctrn_jppo4, zctrn_jppo3, zctrn_jpsil )493 408 ! 494 409 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r7698 r7753 191 191 !-------------------------------------------------------------- 192 192 IF( .NOT.ln_rsttr ) THEN 193 !$OMP PARALLEL 194 !$OMP DO schedule(static) private(jk,jj,ji) 195 DO jk = 1, jpk 196 DO jj = 1, jpj 197 DO ji = 1, jpi 198 trn(ji,jj,jk,jpdic) = sco2 199 trn(ji,jj,jk,jpdoc) = bioma0 200 trn(ji,jj,jk,jptal) = alka0 201 trn(ji,jj,jk,jpoxy) = oxyg0 202 trn(ji,jj,jk,jpcal) = bioma0 203 trn(ji,jj,jk,jppo4) = po4 / po4r 204 trn(ji,jj,jk,jppoc) = bioma0 205 trn(ji,jj,jk,jpgoc) = bioma0 206 trn(ji,jj,jk,jpbfe) = bioma0 * 5.e-6 207 trn(ji,jj,jk,jpsil) = silic1 208 trn(ji,jj,jk,jpdsi) = bioma0 * 0.15 209 trn(ji,jj,jk,jpgsi) = bioma0 * 5.e-6 210 trn(ji,jj,jk,jpphy) = bioma0 211 trn(ji,jj,jk,jpdia) = bioma0 212 trn(ji,jj,jk,jpzoo) = bioma0 213 trn(ji,jj,jk,jpmes) = bioma0 214 trn(ji,jj,jk,jpfer) = 0.6E-9 215 trn(ji,jj,jk,jpsfe) = bioma0 * 5.e-6 216 trn(ji,jj,jk,jpdfe) = bioma0 * 5.e-6 217 trn(ji,jj,jk,jpnfe) = bioma0 * 5.e-6 218 trn(ji,jj,jk,jpnch) = bioma0 * 12. / 55. 219 trn(ji,jj,jk,jpdch) = bioma0 * 12. / 55. 220 trn(ji,jj,jk,jpno3) = no3 221 trn(ji,jj,jk,jpnh4) = bioma0 222 IF( ln_ligand) THEN 223 trn(ji,jj,jk,jplgw) = 0.6E-9 224 trn(ji,jj,jk,jpfep) = 0. * 5.e-6 225 ENDIF 226 IF( ln_p5z ) THEN 227 trn(ji,jj,jk,jpdon) = bioma0 228 trn(ji,jj,jk,jpdop) = bioma0 229 trn(ji,jj,jk,jppon) = bioma0 230 trn(ji,jj,jk,jppop) = bioma0 231 trn(ji,jj,jk,jpgon) = bioma0 232 trn(ji,jj,jk,jpgop) = bioma0 233 trn(ji,jj,jk,jpnph) = bioma0 234 trn(ji,jj,jk,jppph) = bioma0 235 trn(ji,jj,jk,jppic) = bioma0 236 trn(ji,jj,jk,jpnpi) = bioma0 237 trn(ji,jj,jk,jpppi) = bioma0 238 trn(ji,jj,jk,jpndi) = bioma0 239 trn(ji,jj,jk,jppdi) = bioma0 240 trn(ji,jj,jk,jppfe) = bioma0 * 5.e-6 241 trn(ji,jj,jk,jppch) = bioma0 * 12. / 55. 242 ENDIF 243 END DO 244 END DO 245 END DO 193 trn(:,:,:,jpdic) = sco2 194 trn(:,:,:,jpdoc) = bioma0 195 trn(:,:,:,jptal) = alka0 196 trn(:,:,:,jpoxy) = oxyg0 197 trn(:,:,:,jpcal) = bioma0 198 trn(:,:,:,jppo4) = po4 / po4r 199 trn(:,:,:,jppoc) = bioma0 200 trn(:,:,:,jpgoc) = bioma0 201 trn(:,:,:,jpbfe) = bioma0 * 5.e-6 202 trn(:,:,:,jpsil) = silic1 203 trn(:,:,:,jpdsi) = bioma0 * 0.15 204 trn(:,:,:,jpgsi) = bioma0 * 5.e-6 205 trn(:,:,:,jpphy) = bioma0 206 trn(:,:,:,jpdia) = bioma0 207 trn(:,:,:,jpzoo) = bioma0 208 trn(:,:,:,jpmes) = bioma0 209 trn(:,:,:,jpfer) = 0.6E-9 210 trn(:,:,:,jpsfe) = bioma0 * 5.e-6 211 trn(:,:,:,jpdfe) = bioma0 * 5.e-6 212 trn(:,:,:,jpnfe) = bioma0 * 5.e-6 213 trn(:,:,:,jpnch) = bioma0 * 12. / 55. 214 trn(:,:,:,jpdch) = bioma0 * 12. / 55. 215 trn(:,:,:,jpno3) = no3 216 trn(:,:,:,jpnh4) = bioma0 217 IF( ln_ligand) THEN 218 trn(:,:,:,jplgw) = 0.6E-9 219 trn(:,:,:,jpfep) = 0. * 5.e-6 220 ENDIF 221 IF( ln_p5z ) THEN 222 trn(:,:,:,jpdon) = bioma0 223 trn(:,:,:,jpdop) = bioma0 224 trn(:,:,:,jppon) = bioma0 225 trn(:,:,:,jppop) = bioma0 226 trn(:,:,:,jpgon) = bioma0 227 trn(:,:,:,jpgop) = bioma0 228 trn(:,:,:,jpnph) = bioma0 229 trn(:,:,:,jppph) = bioma0 230 trn(:,:,:,jppic) = bioma0 231 trn(:,:,:,jpnpi) = bioma0 232 trn(:,:,:,jpppi) = bioma0 233 trn(:,:,:,jpndi) = bioma0 234 trn(:,:,:,jppdi) = bioma0 235 trn(:,:,:,jppfe) = bioma0 * 5.e-6 236 trn(:,:,:,jppch) = bioma0 * 12. / 55. 237 ENDIF 246 238 ! initialize the half saturation constant for silicate 247 239 ! ---------------------------------------------------- 248 !$OMP DO schedule(static) private(jj,ji) 249 DO jj = 1, jpj 250 DO ji = 1, jpi 251 xksi(ji,jj) = 2.e-6 252 xksimax(ji,jj) = xksi(ji,jj) 253 END DO 254 END DO 255 !$OMP END PARALLEL 240 xksi(:,:) = 2.e-6 241 xksimax(:,:) = xksi(:,:) 256 242 END IF 257 243
Note: See TracChangeset
for help on using the changeset viewer.
