Changeset 7698 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
- Timestamp:
- 2017-02-18T10:02:03+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90 (modified) (26 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r7646 r7698 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 34 !! $Id$ 34 !! $Id$ 35 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- … … 84 84 85 85 86 zdenit2d(:,:) = 0.e0 87 zbureff (:,:) = 0.e0 88 zwork1 (:,:) = 0.e0 89 zwork2 (:,:) = 0.e0 90 zwork3 (:,:) = 0.e0 91 zsedsi (:,:) = 0.e0 92 zsedcal (:,:) = 0.e0 93 zsedc (:,:) = 0.e0 94 86 !$OMP PARALLEL DO schedule(static) private(jj,ji) 87 DO jj = 1, jpj 88 DO ji = 1, jpi 89 zdenit2d(ji,jj) = 0.e0 90 zbureff (ji,jj) = 0.e0 91 zwork1 (ji,jj) = 0.e0 92 zwork2 (ji,jj) = 0.e0 93 zwork3 (ji,jj) = 0.e0 94 zsedsi (ji,jj) = 0.e0 95 zsedcal (ji,jj) = 0.e0 96 zsedc (ji,jj) = 0.e0 97 END DO 98 END DO 95 99 96 100 ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. … … 100 104 CALL wrk_alloc( jpi, jpj, zironice ) 101 105 ! 106 !$OMP PARALLEL 107 !$OMP DO schedule(static) private(jj,ji,zdep,zwflux,zfminus,zfplus) 102 108 DO jj = 1, jpj 103 109 DO ji = 1, jpi … … 110 116 END DO 111 117 ! 112 tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:) 118 !$OMP DO schedule(static) private(jj,ji) 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 tra(ji,jj,1,jpfer) = tra(ji,jj,1,jpfer) + zironice(ji,jj) 122 END DO 123 END DO 124 !$OMP END PARALLEL 113 125 ! 114 126 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) ) & … … 127 139 ! ! Iron and Si deposition at the surface 128 140 IF( ln_solub ) THEN 129 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 141 !$OMP PARALLEL DO schedule(static) private(jj,ji) 142 DO jj = 1, jpj 143 DO ji = 1, jpi 144 zirondep(ji,jj,1) = solub(ji,jj) * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 55.85 + 3.e-10 * r1_ryyss 145 END DO 146 END DO 130 147 ELSE 131 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 148 !$OMP PARALLEL DO schedule(static) private(jj,ji) 149 DO jj = 1, jpj 150 DO ji = 1, jpi 151 zirondep(ji,jj,1) = dustsolub * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 55.85 + 3.e-10 * r1_ryyss 152 END DO 153 END DO 132 154 ENDIF 133 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 134 zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 155 !$OMP PARALLEL DO schedule(static) private(jj,ji) 156 DO jj = 1, jpj 157 DO ji = 1, jpi 158 zsidep(ji,jj) = 8.8 * 0.075 * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 28.1 159 zpdep (ji,jj,1) = 0.1 * 0.021 * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 31. / po4r 160 END DO 161 END DO 135 162 ! ! Iron solubilization of particles in the water column 136 163 ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j 137 164 zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 165 !$OMP PARALLEL 166 !$OMP DO schedule(static) private(jk,jj,ji) 138 167 DO jk = 2, jpkm1 139 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 140 zpdep (:,:,jk) = zirondep(:,:,jk) * 0.023 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 zirondep(ji,jj,jk) = dust(ji,jj) * mfrac * zwdust * rfact2 * EXP( -gdept_n(ji,jj,jk) / 540. ) 171 zpdep (ji,jj,jk) = zirondep(ji,jj,jk) * 0.023 172 END DO 173 END DO 141 174 END DO 142 175 ! ! Iron solubilization of particles in the water column 143 tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep (:,:) 144 tra(:,:,:,jppo4) = tra(:,:,:,jppo4) + zpdep (:,:,:) 145 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:) 176 !$OMP DO schedule(static) private(jj,ji) 177 DO jj = 1, jpj 178 DO ji = 1, jpi 179 tra(ji,jj,1,jpsil) = tra(ji,jj,1,jpsil) + zsidep (ji,jj) 180 END DO 181 END DO 182 !$OMP DO schedule(static) private(jk,jj,ji) 183 DO jk = 1, jpk 184 DO jj = 1, jpj 185 DO ji = 1, jpi 186 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zpdep (ji,jj,jk) 187 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zirondep(ji,jj,jk) 188 END DO 189 END DO 190 END DO 191 !$OMP END PARALLEL 146 192 ! 147 193 IF( lk_iomput ) THEN … … 161 207 ! ---------------------------------------------------------- 162 208 IF( ln_river ) THEN 209 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 163 210 DO jj = 1, jpj 164 211 DO ji = 1, jpi … … 174 221 ENDDO 175 222 IF( ln_p5z ) THEN 223 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 176 224 DO jj = 1, jpj 177 225 DO ji = 1, jpi … … 189 237 ! ---------------------------------------------------------- 190 238 IF( ln_ndepo ) THEN 191 tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 192 tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 239 !$OMP PARALLEL DO schedule(static) private(jj,ji) 240 DO jj = 1, jpj 241 DO ji = 1, jpi 242 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + nitdep(ji,jj) * rfact2 243 tra(ji,jj,1,jptal) = tra(ji,jj,1,jptal) - rno3 * nitdep(ji,jj) * rfact2 244 ENDDO 245 ENDDO 193 246 ENDIF 194 247 … … 196 249 ! ------------------------------------------------------ 197 250 IF( ln_ironsed ) THEN 198 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 199 IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2 251 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 252 DO jk = 1, jpk 253 DO jj = 1, jpj 254 DO ji = 1, jpi 255 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + ironsed(ji,jj,jk) * rfact2 256 END DO 257 END DO 258 END DO 259 260 IF( ln_ligand ) THEN 261 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 262 DO jk = 1, jpk 263 DO jj = 1, jpj 264 DO ji = 1, jpi 265 tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) + ( ironsed(ji,jj,jk) * fep_rats ) * rfact2 266 END DO 267 END DO 268 END DO 269 END IF 200 270 ! 201 271 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) & … … 206 276 ! ------------------------------------------------------ 207 277 IF( ln_hydrofe ) THEN 208 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 278 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 279 DO jk = 1, jpk 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + hydrofe(ji,jj,jk) * rfact2 283 END DO 284 END DO 285 END DO 209 286 IF( ln_ligand ) THEN 210 tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( hydrofe(:,:,:) * fep_rath ) * rfact2 211 tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 287 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 288 DO jk = 1, jpk 289 DO jj = 1, jpj 290 DO ji = 1, jpi 291 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + ( hydrofe(ji,jj,jk) * fep_rath ) * rfact2 292 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + ( hydrofe(ji,jj,jk) * lgw_rath ) * rfact2 293 END DO 294 END DO 295 END DO 212 296 ENDIF 213 297 ! … … 218 302 ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 219 303 ! -------------------------------------------------------------------- 304 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep) 220 305 DO jj = 1, jpj 221 306 DO ji = 1, jpi … … 229 314 ! 230 315 IF( ln_ligand ) THEN 316 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep) 231 317 DO jj = 1, jpj 232 318 DO ji = 1, jpi … … 242 328 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 243 329 ! ------------------------------------------------------- 330 !$OMP PARALLEL 331 !$OMP DO schedule(static) private(jj,ji,ikt,zflx,zo2,zno3,zdep) 244 332 DO jj = 1, jpj 245 333 DO ji = 1, jpi … … 267 355 ! The factor for calcite comes from the alkalinity effect 268 356 ! ------------------------------------------------------------- 357 !$OMP DO schedule(static) private(jj,ji,ikt,zfactcal) 269 358 DO jj = 1, jpj 270 359 DO ji = 1, jpi … … 280 369 END DO 281 370 END DO 371 !$OMP END PARALLEL 282 372 zsumsedsi = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 283 373 zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday … … 291 381 IF( .NOT.lk_sed ) zrivsil = 1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn ) 292 382 383 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwsc,zsiloss,zcaloss) 293 384 DO jj = 1, jpj 294 385 DO ji = 1, jpi … … 305 396 ! 306 397 IF( .NOT.lk_sed ) THEN 398 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwsc,zsiloss,zcaloss,zfactcal,zrivalk) 307 399 DO jj = 1, jpj 308 400 DO ji = 1, jpi … … 325 417 ENDIF 326 418 ! 419 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4) 327 420 DO jj = 1, jpj 328 421 DO ji = 1, jpi … … 339 432 ! 340 433 IF( ln_ligand ) THEN 434 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwssfep) 341 435 DO jj = 1, jpj 342 436 DO ji = 1, jpi … … 350 444 ! 351 445 IF( ln_p5z ) THEN 446 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4) 352 447 DO jj = 1, jpj 353 448 DO ji = 1, jpi … … 367 462 ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification 368 463 ! in the sediments and just above the sediments. Not very clever, but simpliest option. 464 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4,zrivno3,zwstpoc,zpdenit,z1pdenit,zolimit,zdenitt,zwstpop,zwstpon) 369 465 DO jj = 1, jpj 370 466 DO ji = 1, jpi … … 402 498 ! Small source iron from particulate inorganic iron 403 499 !----------------------------------- 500 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 404 501 DO jk = 1, jpkm1 405 zlight (:,:,jk) = ( 1.- EXP( -etot_ndcy(:,:,jk) / diazolight ) ) * ( 1. - fr_i(:,:) ) 406 zsoufer(:,:,jk) = zlight(:,:,jk) * 2E-11 / ( 2E-11 + biron(:,:,jk) ) 502 DO jj = 1, jpj 503 DO ji = 1, jpi 504 zlight (ji,jj,jk) = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) * ( 1. - fr_i(ji,jj) ) 505 zsoufer(ji,jj,jk) = zlight(ji,jj,jk) * 2E-11 / ( 2E-11 + biron(ji,jj,jk) ) 506 END DO 507 END DO 407 508 ENDDO 408 509 IF( ln_p4z ) THEN 510 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zlim,zfact,ztrfer,ztrpo4s) 409 511 DO jk = 1, jpkm1 410 512 DO jj = 1, jpj … … 423 525 END DO 424 526 ELSE ! p5z 527 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztemp,zmudia,xdianh4,xdiano3,zlim,zfact,ztrfer,ztrdp) 425 528 DO jk = 1, jpkm1 426 529 DO jj = 1, jpj … … 448 551 ! ---------------------------------------- 449 552 IF( ln_p4z ) THEN 553 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact) 450 554 DO jk = 1, jpkm1 451 555 DO jj = 1, jpj … … 462 566 END DO 463 567 ELSE ! p5z 568 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact) 464 569 DO jk = 1, jpkm1 465 570 DO jj = 1, jpj … … 497 602 IF( iom_use("Nfix" ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) ) ! nitrogen fixation 498 603 IF( iom_use("INTNFIX") ) THEN ! nitrogen fixation rate in ocean ( vertically integrated ) 499 zwork1(:,:) = 0. 604 !$OMP PARALLEL 605 !$OMP DO schedule(static) private(jj,ji) 606 DO jj = 1, jpj 607 DO ji = 1, jpi 608 zwork1(ji,jj) = 0. 609 END DO 610 ENDDO 500 611 DO jk = 1, jpkm1 501 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 612 !$OMP DO schedule(static) private(jj,ji) 613 DO jj = 1, jpj 614 DO ji = 1, jpi 615 zwork1(ji,jj) = zwork1(ji,jj) + nitrpot(ji,jj,jk) * nitrfix * zfact * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 616 END DO 617 END DO 502 618 ENDDO 619 !$OMP END PARALLEL 503 620 CALL iom_put( "INTNFIX" , zwork1 ) 504 621 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
