/[MITgcm]/MITgcm_contrib/dcarroll/highres_darwin/code/darwin_plankton.F
ViewVC logotype

Contents of /MITgcm_contrib/dcarroll/highres_darwin/code/darwin_plankton.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (show annotations) (download)
Sun Sep 22 21:23:46 2019 UTC (5 years, 10 months ago) by dcarroll
Branch: MAIN
CVS Tags: HEAD
Initial check in of high resolution Darwin simulation code

1 C $Header: /u/gcmpack/MITgcm_contrib/ecco_darwin/v4_llc270/code_darwin/darwin_plankton.F,v 1.7 2019/09/16 15:25:49 dcarroll Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5 #include "PTRACERS_OPTIONS.h"
6 #include "DARWIN_OPTIONS.h"
7
8 #ifdef ALLOW_PTRACERS
9 #ifdef ALLOW_DARWIN
10
11 c ====================================================================
12 c SUBROUTINE DARWIN_PLANKTON
13 c 1. Local ecological interactions for models with many phytoplankton
14 c "functional groups"
15 c 2. Timestep plankton and nutrients locally
16 c 3. Includes explicit DOM and POM
17 c 4. Remineralization of detritus also determined in routine
18 c 5. Sinking particles and phytoplankton
19 c 6. NOT in this routine: iron chemistry
20 c
21 c Mick Follows, Scott Grant, Fall/Winter 2005
22 c Stephanie Dutkiewicz Spring/Summer 2006
23 c
24 c - add extra diagnostics, including R* (#define DAR_DIAG_RSTAR) - Stephanie, Spring 2007
25 c - add check for conservation (#define CHECK_CONS) - Stephanie, Spring 2007
26 c - improve grazing (#undef OLD_GRAZING) - Stephanie, Spring 2007
27 c - add diazotrophy (#define ALLOW_DIAZ) - Stephanie, Spring 2007
28 c - add mutation code (#define ALLOW_MUTANTS) - Jason Bragg, Spring/Summer 2007
29 c - new nitrogen limiting scheme (#undef OLD_NSCHEME) - Jason Bragg, Summer 2007
30 c - fix bug in diazotroph code - Stephanie, Fall 2007
31 c - add additional r* diagnostic for (no3+no2) - Stephanie, Winter 2007
32 c - add diversity diagnostics - Stephanie, Winter 2007
33 c - add geider chl:c ratio and growth rate dependence,
34 c though has no photo-inhibtion at this point - Stephanie, Spring 2008
35 c - add waveband dependence of light attenuation and absorption,
36 c NOTE: need to have geider turned on too - Anna Hickman, Summer 2008
37 c ====================================================================
38
39 c ANNA pass extra variables if WAVEBANDS
40 SUBROUTINE DARWIN_PLANKTON(
41 U phyto,
42 I zooP, zooN, zooFe, zooSi,
43 O PP, Chl, Nfix, denit,
44 I PO4local, NO3local, FeTlocal, Silocal,
45 I NO2local, NH4local,
46 I DOPlocal, DONlocal, DOFelocal,
47 I POPlocal, PONlocal, POFelocal, PSilocal,
48 I phytoup, popuplocal, ponuplocal,
49 I pofeuplocal, psiuplocal,
50 I PARlocal,Tlocal, Slocal,
51 I freefelocal, inputFelocal,
52 I bottom, dzlocal,
53 O Rstarlocal, RNstarlocal,
54 #ifdef DAR_DIAG_GROW
55 O Growlocal, Growsqlocal,
56 #endif
57 #ifdef ALLOW_DIAZ
58 #ifdef DAR_DIAG_NFIXP
59 O NfixPlocal,
60 #endif
61 #endif
62 O dphytodt, dzooPdt, dzooNdt, dzooFedt,
63 O dzooSidt,
64 O dPO4dt, dNO3dt, dFeTdt, dSidt,
65 O dNH4dt, dNO2dt,
66 O dDOPdt, dDONdt, dDOFedt,
67 O dPOPdt, dPONdt, dPOFedt, dPSidt,
68 #ifdef ALLOW_CARBON
69 I DIClocal, DOClocal, POClocal, PIClocal,
70 I ALKlocal, O2local, ZooClocal,
71 I POCuplocal, PICuplocal, KspTPLocal,
72 I CO3Local,calciumLocal,
73 O dDICdt, dDOCdt, dPOCdt, dPICdt,
74 O dALKdt, dO2dt, dZOOCdt,omegaCLocal,
75 O disscPIC,
76 #endif
77 #ifdef CO2_FLUX_BUDGET
78 O consumpDIC, consumpDIC_PIC,
79 O preminC, DOCremin,
80 #endif
81 #ifdef GEIDER
82 I phychl,
83 #ifdef DYNAMIC_CHL
84 O dphychl, Chlup,
85 #endif
86 #ifdef WAVEBANDS
87 I PARwlocal,
88 #endif
89 #endif
90 #ifdef ALLOW_PAR_DAY
91 I PARdaylocal,
92 #endif
93 #ifdef DAR_DIAG_CHL
94 O ChlGeiderlocal, ChlDoneylocal,
95 O ChlCloernlocal,
96 #endif
97 I debug,
98 I runtim,
99 I MyThid)
100
101
102 implicit none
103 #include "DARWIN_SIZE.h"
104 #include "SPECTRAL_SIZE.h"
105 #include "DARWIN.h"
106 #include "DARWIN_PARAMS.h"
107
108 c ANNA set wavebands params
109 #ifdef WAVEBANDS
110 #include "WAVEBANDS_PARAMS.h"
111 #endif
112
113
114 C !INPUT PARAMETERS: ===================================================
115 C myThid :: thread number
116 INTEGER myThid
117 CEOP
118 c === GLOBAL VARIABLES =====================
119 c npmax = no of phyto functional groups
120 c nzmax = no of grazer species
121 c phyto = phytoplankton
122 c zoo = zooplankton
123 _RL phyto(npmax)
124 _RL zooP(nzmax)
125 _RL zooN(nzmax)
126 _RL zooFe(nzmax)
127 _RL zooSi(nzmax)
128 _RL PP
129 _RL Nfix
130 _RL denit
131 _RL Chl
132 _RL PO4local
133 _RL NO3local
134 _RL FeTlocal
135 _RL Silocal
136 _RL NO2local
137 _RL NH4local
138 _RL DOPlocal
139 _RL DONlocal
140 _RL DOFelocal
141 _RL POPlocal
142 _RL PONlocal
143 _RL POFelocal
144 _RL PSilocal
145 _RL phytoup(npmax)
146 _RL POPuplocal
147 _RL PONuplocal
148 _RL POFeuplocal
149 _RL PSiuplocal
150 _RL PARlocal
151 _RL Tlocal
152 _RL Slocal
153 _RL freefelocal
154 _RL inputFelocal
155 _RL bottom
156 _RL dzlocal
157 _RL Rstarlocal(npmax)
158 _RL RNstarlocal(npmax)
159 #ifdef DAR_DIAG_GROW
160 _RL Growlocal(npmax)
161 _RL Growsqlocal(npmax)
162 #endif
163 #ifdef ALLOW_DIAZ
164 #ifdef DAR_DIAG_NFIXP
165 _RL NfixPlocal(npmax)
166 #endif
167 #endif
168 INTEGER debug
169 _RL dphytodt(npmax)
170 _RL dzooPdt(nzmax)
171 _RL dzooNdt(nzmax)
172 _RL dzooFedt(nzmax)
173 _RL dzooSidt(nzmax)
174 _RL dPO4dt
175 _RL dNO3dt
176 _RL dNO2dt
177 _RL dNH4dt
178 _RL dFeTdt
179 _RL dSidt
180 _RL dDOPdt
181 _RL dDONdt
182 _RL dDOFedt
183 _RL dPOPdt
184 _RL dPONdt
185 _RL dPOFedt
186 _RL dPSidt
187 #ifdef ALLOW_CARBON
188 _RL DIClocal
189 _RL DOClocal
190 _RL POClocal
191 _RL PIClocal
192 _RL ALKlocal
193 _RL O2local
194 _RL ZooClocal(nzmax)
195 _RL POCuplocal
196 _RL PICuplocal
197 _RL KspTPLocal
198 _RL CO3Local
199 _RL calciumLocal
200 _RL omegaCLocal
201 _RL dDICdt
202 _RL dDOCdt
203 _RL dPOCdt
204 _RL dPICdt
205 _RL dALKdt
206 _RL dO2dt
207 _RL dZOOCdt(nzmax)
208 #endif
209 #ifdef GEIDER
210 _RL phychl(npmax)
211 #ifdef DYNAMIC_CHL
212 _RL dphychl(npmax)
213 _RL Chlup(npmax)
214 #endif
215 #endif
216 #ifdef ALLOW_PAR_DAY
217 _RL PARdaylocal
218 #endif
219 #ifdef DAR_DIAG_CHL
220 _RL ChlGeiderlocal, ChlDoneylocal, ChlCloernlocal
221 #endif
222 _RL runtim
223
224 c ANNA Global variables for WAVEBANDS
225 c ANNA these variables are passed in/out of darwin_forcing.F
226 #ifdef WAVEBANDS
227 _RL PARwlocal(tlam) !PAR at midpoint of previous(in) and local(out) gridcell
228 #endif
229 c ANNA endif
230
231
232
233
234
235 c LOCAL VARIABLES
236 c -------------------------------------------------------------
237
238 c WORKING VARIABLES
239 c np = phytoplankton index
240 integer np
241 c nz = zooplankton index
242 integer nz
243
244 c variables for phytoplankton growth rate/nutrient limitation
245 c phytoplankton specific nutrient limitation term
246 _RL limit(npmax)
247 c phytoplankton light limitation term
248 _RL ilimit(npmax)
249 _RL ngrow(npmax)
250 _RL grow(npmax)
251 _RL PspecificPO4(npmax)
252 _RL phytoTempFunction(npmax)
253 _RL mortPTempFunction
254 _RL dummy
255 _RL Ndummy
256 _RL Nsourcelimit(npmax)
257 _RL Nlimit(npmax)
258 _RL NO3limit(npmax)
259 _RL NO2limit(npmax)
260 _RL NH4limit(npmax)
261
262 c for check N limit scheme
263 _RL Ndiff
264 _RL NO3limcheck
265 _RL NO2limcheck
266 _RL Ndummy1
267 LOGICAL check_nlim
268
269 #ifndef OLD_NSCHEME
270 c [jbmodif] some new N terms
271 integer N2only
272 integer noNOdadv
273 integer NOreducost
274 _RL NO2zoNH4
275 _RL NOXzoNH4
276 #endif
277
278 c varible for mimumum phyto
279 _RL phytomin(npmax)
280
281 #ifdef OLD_GRAZE
282 c variables for zooplankton grazing rates
283 _RL zooTempFunction(nzmax)
284 _RL mortZTempFunction
285 _RL mortZ2TempFunction
286 _RL grazing_phyto(npmax)
287 _RL grazingP(nzmax)
288 _RL grazingN(nzmax)
289 _RL grazingFe(nzmax)
290 _RL grazingSi(nzmax)
291 #else
292 c variables for zooplankton grazing rates
293 _RL zooTempFunction(nzmax)
294 _RL mortZTempFunction
295 _RL mortZ2TempFunction
296 _RL allphyto(nzmax)
297 _RL grazphy(npmax,nzmax)
298 _RL sumgrazphy(npmax)
299 _RL sumgrazzoo(nzmax)
300 _RL sumgrazzooN(nzmax)
301 _RL sumgrazzooFe(nzmax)
302 _RL sumgrazzooSi(nzmax)
303 _RL sumgrazloss(nzmax)
304 _RL sumgrazlossN(nzmax)
305 _RL sumgrazlossFe(nzmax)
306 _RL sumgrazlossSi(nzmax)
307 #endif
308
309 #ifdef GEIDER
310 _RL alpha_I(npmax)
311 _RL pcarbon(npmax)
312 _RL pcm(npmax)
313 _RL chl2c(npmax)
314 #ifdef DYNAMIC_CHL
315 _RL acclim(npmax)
316 _RL psinkchl(npmax)
317 _RL rhochl(npmax)
318 #endif
319 #endif
320
321 #ifdef DAR_DIAG_CHL
322 _RL tmppcm
323 _RL tmpchl2c
324 #endif
325 c variables for nutrient uptake
326 _RL consumpPO4
327 _RL consumpNO3
328 _RL consumpNO2
329 _RL consumpNH4
330 _RL consumpFeT
331 _RL consumpSi
332
333 c variables for reminerlaization of DOM and POM
334 _RL reminTempFunction
335 _RL DOPremin
336 _RL DONremin
337 _RL DOFeremin
338 _RL preminP
339 _RL preminN
340 _RL preminFe
341 _RL preminSi
342
343 c for sinking matter
344 _RL psinkP
345 _RL psinkN
346 _RL psinkFe
347 _RL psinkSi
348 _RL psinkphy(npmax)
349
350 #ifdef ALLOW_CARBON
351 _RL consumpDIC
352 _RL consumpDIC_PIC
353 _RL preminC
354 _RL DOCremin
355 _RL totphy_doc
356 _RL totzoo_doc
357 _RL totphy_poc
358 _RL totzoo_poc
359 _RL totphy_pic
360 _RL totzoo_pic
361 _RL psinkC
362 _RL psinkPIC
363 _RL disscPIC
364 #ifdef OLD_GRAZE
365 _RL grazingC(nzmax)
366 #else
367 c variables for zooplankton grazing rates
368 _RL sumgrazzooC(nzmax)
369 _RL sumgrazlossC(nzmax)
370 _RL sumgrazlossPIC(nzmax)
371 #endif
372
373 #endif
374
375 c variables for conversions from phyto and zoo to DOM and POM
376 _RL totphy_dop
377 _RL totphy_pop
378 _RL totphy_don
379 _RL totphy_pon
380 _RL totphy_dofe
381 _RL totphy_pofe
382 _RL totphy_dosi
383 _RL totphy_posi
384
385 _RL totzoo_dop
386 _RL totzoo_pop
387 _RL totzoo_don
388 _RL totzoo_pon
389 _RL totzoo_dofe
390 _RL totzoo_pofe
391 _RL totzoo_posi
392
393 _RL NO2prod
394 _RL NO3prod
395
396 _RL facpz
397
398 _RL kpar, kinh
399
400 _RL tmpr,tmpz, tmpgrow, tmp1, tmp2
401
402 integer ITEST
403
404 #ifdef PART_SCAV
405 _RL scav_part
406 _RL scav_poc
407 #endif
408
409
410 c ANNA local variables for WAVEBANDS
411 #ifdef WAVEBANDS
412 integer i,ilam
413 integer nl
414
415 c ANNA for interpolation
416 _RL cu_area
417 C _RL waves_diff
418 C _RL light_diff
419 C _RL alphaI_diff
420 C _RL squ_part
421 C _RL tri_part
422 C _RL seg_area
423
424 c ANNA inportant but local variables that can be fogotten
425 _RL PARwdn(tlam) !light at bottom of local gridcell
426 _RL attenwl(tlam) !attenuation (m-1)
427 _RL sumaphy_nl(tlam) !total phyto absorption at each wavelength
428 #endif
429 c ANNA endif
430
431 c ANNA - for inhib
432 _RL Ek
433 _RL EkoverE
434
435 c.................................................................
436
437 #ifdef ALLOW_MUTANTS
438 c -m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-
439 c mutation variables [jbmodif]
440 INTEGER nsisone
441 INTEGER nsistwo
442 INTEGER nsisthree
443 INTEGER nsisfour
444 INTEGER npro
445 INTEGER taxind
446 _RL mutfor, mutback
447 _RL grow1
448 _RL grow2
449 _RL grow3
450 _RL grow4
451 #endif
452
453 INTEGER numtax
454 _RL oneyr,threeyr
455
456 #ifdef ALLOW_MUTANTS
457 c compile time options -- could maybe be moved to
458 c run time and set in data.gchem???
459 c QQQQQQQ
460 c Initialize sister taxon mutation scheme
461 c if numtax = 1, mutation is off
462 numtax = 4
463 c number of plankton types to assign for
464 c wild and mutants types
465 npro = 60
466 #else
467 numtax=1
468 #endif
469
470 oneyr = 86400.0 _d 0*360.0 _d 0
471 threeyr = oneyr*3. _d 0
472
473 c end mutation variables [jbmodif]
474 c -m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-
475
476 #ifndef OLD_NSCHEME
477 c [jbmodif] init new N terms
478 c if those not using NO3 has
479 c N limit with denominator with NO3 or not: 0=NO3 in denom; 1=NO2 only
480 N2only = 1
481 c ??
482 noNOdadv = 1
483 c energetic disadvantage of using NO2/No3: off=0, on=1
484 NOreducost =0
485 #endif
486
487 #ifdef GEIDER
488 do np=1,npmax
489 pcarbon(np) = 0. _d 0
490 pcm(np)=0. _d 0
491 chl2c(np)=0. _d 0
492 #ifdef DYNAMIC_CHL
493 acclim(np)=0. _d 0
494 psinkChl(np)=0. _d 0
495 #endif
496 enddo
497 #endif
498
499
500 c set sum totals to zero
501 totphy_pop = 0. _d 0
502 totphy_dop = 0. _d 0
503 totphy_don = 0. _d 0
504 totphy_pon = 0. _d 0
505 totphy_dofe = 0. _d 0
506 totphy_pofe = 0. _d 0
507 totphy_posi = 0. _d 0
508
509 totzoo_dop = 0. _d 0
510 totzoo_pop = 0. _d 0
511 totzoo_don = 0. _d 0
512 totzoo_pon = 0. _d 0
513 totzoo_dofe = 0. _d 0
514 totzoo_pofe = 0. _d 0
515 totzoo_posi = 0. _d 0
516
517 consumpPO4 = 0.0 _d 0
518 consumpNO3 = 0.0 _d 0
519 consumpNO2 = 0.0 _d 0
520 consumpNH4 = 0.0 _d 0
521 consumpFeT = 0.0 _d 0
522 consumpSi = 0.0 _d 0
523
524 #ifdef ALLOW_CARBON
525 totphy_doc = 0. _d 0
526 totphy_poc = 0. _d 0
527 totphy_pic = 0. _d 0
528 totzoo_doc = 0. _d 0
529 totzoo_poc = 0. _d 0
530 totzoo_pic = 0. _d 0
531 consumpDIC = 0.0 _d 0
532 consumpDIC_PIC = 0.0 _d 0
533 #endif
534
535 c zeros for diagnostics
536 PP=0. _d 0
537 Nfix=0. _d 0
538 denit=0. _d 0
539 Chl=0. _d 0
540
541 c set up phtyoplankton array to be used for grazing and mortality
542 c set up other variable used more than once to zero
543 do np = 1, npmax
544 dummy = phyto(np)-phymin
545 phytomin(np)=max(dummy,0. _d 0)
546 NH4limit(np)=0. _d 0
547 NO2limit(np)=0. _d 0
548 NO3limit(np)=0. _d 0
549 #ifdef ALLOW_DIAZ
550 #ifdef DAR_DIAG_NFIXP
551 NfixPlocal(np)=0. _d 0
552 #endif
553 #endif
554 enddo
555
556
557 #ifdef ALLOW_MUTANTS
558 c SWD if parent population is zero (ie. negative) treat all mutants
559 c as zeros too
560 if(runtim .gt. threeyr) then
561 if(numtax .gt. 1)then
562 do np=1,npro
563 if(mod(np,numtax).eq. 1. _d 0)then
564 nsisone = np
565 nsistwo = np+1
566 nsisthree = np+2
567 nsisfour = np+3
568
569 if (phyto(nsisone).le.0. _d 0) then
570 if (numtax.gt.1) phyto(nsistwo)=0. _d 0
571 if (numtax.gt.2) phyto(nsisthree)=0. _d 0
572 if (numtax.gt.3) phyto(nsisfour)=0. _d 0
573 endif
574 endif
575 enddo
576 endif
577 endif
578 ccccccccccccccccccccccccccccccc
579 #endif
580
581
582 c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
583 call DARWIN_TEMPFUNC(Tlocal,phytoTempFunction,
584 & zooTempFunction, reminTempFunction,
585 & mortPTempFunction, mortZTempFunction,
586 & mortZ2TempFunction, myThid)
587 if (debug.eq.1) print*,'phytoTempFunction',
588 & phytoTempFunction, Tlocal
589 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
590
591 c ******************** GROWTH OF PHYTO ****************************
592 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
593 #ifndef GEIDER
594 c ANNA also if not wavebands
595 #ifndef WAVEBANDS
596 c Determine phytoplantkon light limitation: will affect growth rate
597 c using Platt-like equations with inhibition
598 do np = 1, npmax
599 if (PARlocal.gt.1. _d 0) then
600 kpar=ksatPAR(np)/10. _d 0;
601 kinh=kinhib(np)/1000. _d 0;
602 ilimit(np)=(1.0 _d 0 - EXP(-PARlocal*kpar))
603 & *(EXP(-PARlocal*kinh)) /
604 & ( kpar/(kpar+kinh)*EXP(kinh/kpar*LOG(kinh/(kpar+kinh))) )
605 ilimit(np)=min(ilimit(np),1. _d 0)
606 else
607 ilimit(np)=0. _d 0
608 endif
609 enddo
610 if (debug.eq.1) print*,'ilimit',ilimit, PARlocal
611 #endif
612 #endif
613 c ANNA endif
614
615 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
616 c Determine phytoplankton nutrient limitation as mimimum of
617 c P,N,Si,Fe. However N can be utilized in several forms, so
618 c also determine which is used
619 do np=1, npmax
620 limit(np) = 1.0 _d 0
621 c P limitation
622 if (ksatPO4(np).gt.0. _d 0) then
623 dummy = PO4local/(PO4local+ksatPO4(np))
624 if (dummy .lt. limit(np)) limit(np) = dummy
625 endif
626 c Fe limitation
627 if (ksatFeT(np).gt.0. _d 0) then
628 dummy = FeTlocal/(FeTlocal+ksatFeT(np))
629 if (dummy .lt. limit(np))limit(np) = dummy
630 endif
631 c Si limiation
632 if (R_SiP(np) .ne. 0. _d 0.and.ksatSi(np).gt.0. _d 0) then
633 dummy = Silocal/(Silocal+ksatSi(np))
634 if (dummy .lt. limit(np))limit(np) = dummy
635 endif
636
637 c N limitation [jbmodif]
638 c nsource: genetic preference for {1:NH4&NO2 2:NH4 3:ALL Sources}
639 c Nsourcelimit marker for which nsource will be consumed {1:NO3 2:NO2 3:NH4}
640 c (Note: very different to way 1-D model does this)
641 if(diazotroph(np) .ne. 1.0 _d 0)then
642
643 c NH4, all nsource
644 if (ksatNH4(np).gt.0. _d 0) then
645 NH4limit(np) = NH4local/(NH4local+ksatNH4(np))
646 endif
647
648 #ifdef OLD_NSCHEME
649 if (ksatNO2(np).gt.0. _d 0) then
650 c NO2, if nsource is 1 or 3
651 NO2limit(np) = NO2local/(NO2local+ksatNO2(np))*
652 & EXP(-sig1*NH4local)
653 NO2limcheck = NO2local/(NO2local+ksatNO2(np))
654 endif
655 c NO3, if nsource is 3
656 if (ksatNO3(np).gt.0. _d 0) then
657 NO3limit(np) = NO3local/(NO3local+ksatNO3(np))*
658 & EXP(-sig2*NH4local - sig3*NO2local)
659 NO3limcheck = NO3local/(NO3local+ksatNO3(np))
660 endif
661 #else
662 c [jbmodif]
663 c NO2, if nsource is 1 or 3
664 if (ksatNO2(np).gt.0. _d 0 .and. nsource(np).ne.2) then
665 if (N2only.eq.1 .and. nsource(np).eq.1) then
666 c if (nsource(np).eq.1) then
667 NO2limit(np) = NO2local/(NO2local+ksatNO2(np))
668 & *EXP(-sig1*NH4local)
669 NO2limcheck = NO2local/(NO2local+ksatNO2(np))
670 else
671 if (ksatNO3(np).gt.0. _d 0) then
672 NO2limit(np)=NO2local/(NO3local+NO2local+ksatNO3(np))
673 & *EXP(-sig1*NH4local)
674 NO2limcheck=NO2local/(NO3local+NO2local+ksatNO3(np))
675 endif
676 endif
677 endif
678 c NO3, if nsource is 3
679 if (ksatNO3(np).gt.0. _d 0 .and. nsource(np).eq.3) then
680 NO3limit(np)=NO3local/(NO3local+NO2local+ksatNO3(np))
681 & *EXP(-sig1*NH4local)
682 NO3limcheck=NO3local/(NO3local+NO2local+ksatNO3(np))
683 endif
684
685 #endif
686
687 if (nsource(np).eq.2) then
688 NO2limit(np) = 0. _d 0
689 NO3limit(np) = 0. _d 0
690 NO2limcheck = 0. _d 0
691 NO3limcheck = 0. _d 0
692 endif
693 if (nsource(np).eq.1) then
694 NO3limit(np) = 0. _d 0
695 NO3limcheck = 0. _d 0
696 endif
697 if (nsource(np).eq.3) then
698 c don't do anything
699 endif
700
701 Ndummy = NO3limit(np)+NO2limit(np)+NH4limit(np)
702 c
703 c make sure no Nlim disadvantage;
704 c check that limit doesn't decrease at high NH4 levels
705 check_nlim=.FALSE.
706 if (check_nlim) then
707 Ndummy1=NO3limcheck+NO2limcheck
708 if (Ndummy.gt.0. _d 0.and.Ndummy.lt.Ndummy1) then
709 c print*,'QQ N limit WARNING',Ndummy, Ndummy1,
710 c & NO3local,NO2local,NH4local
711 Ndiff=Ndummy1-NH4limit(np)
712 NO2limit(np)=Ndiff *
713 & NO2limit(np)/(NO2limit(np)+NO3limit(np))
714 NO3limit(np)=Ndiff *
715 & NO3limit(np)/(NO2limit(np)+NO3limit(np))
716 Ndummy = NO3limit(np)+NO2limit(np)+NH4limit(np)
717 endif
718 endif
719
720 if (Ndummy.gt.1. _d 0) then
721 NO3limit(np) = NO3limit(np)/Ndummy
722 NO2limit(np) = NO2limit(np)/Ndummy
723 NH4limit(np) = NH4limit(np)/Ndummy
724 endif
725 Nlimit(np)=NO3limit(np)+NO2limit(np)+NH4limit(np)
726 if (Nlimit(np).gt.1.01 _d 0) then
727 c print*,'QQ Nlimit', Nlimit(np), NO3limit(np),
728 c & NO2limit(np), NH4limit(np)
729 endif
730 if (Nlimit(np).le.0. _d 0) then
731 c if (np.eq.1) then
732 c print*,'QQ Nlimit', Nlimit(np), NO3limit(np),
733 c & NO2limit(np), NH4limit(np)
734 c print*,'QQ limit',limit(np), np
735 c endif
736 Nlimit(np)=0. _d 0 !1 _d -10
737 endif
738
739 #ifdef OLD_NSCHEME
740 c lower growth for higher NO3 consumption at higher light
741 if (Nlimit(np).le.0. _d 0) then
742 ngrow(np)=1. _d 0
743 else
744 if (parlocal.gt.ilight) then
745 ngrow(np)=ngrowfac+(1. _d 0-ngrowfac)*
746 & (NH4limit(np)+NO2limit(np))/Nlimit(np)
747 else
748 ngrow(np)=1. _d 0
749 endif
750 ngrow(np)=min(ngrow(np),1. _d 0)
751 endif
752 #else
753 c disadvantage of oxidized inorganic N
754 c for now, ignore - a first attempt is included below
755 ngrow(np) = 1.0 _d 0
756
757 cc lower growth for higher NO3 consumption at higher light
758 c one possible way of counting cost of reducing NOX
759 if (NOreducost .eq. 1)then
760 if (Nlimit(np).le.0. _d 0) then
761 ngrow(np)=1. _d 0
762 else
763 ngrow(np)= (10. _d 0*4. _d 0 +2. _d 0) /
764 & (10. _d 0*4. _d 0 +2. _d 0*NH4limit(np)/Nlimit(np)
765 & +8. _d 0*NO2limit(np)/Nlimit(np)
766 & +10. _d 0*NO3limit(np)/Nlimit(np))
767 ngrow(np)=min(ngrow(np),1. _d 0)
768 endif
769 endif
770 c
771 c might consider other costs, too
772 c if (NOironcost .eq. 1)then
773 c
774 c endif
775 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
776 #endif
777
778 c Now Check Against General Nutrient Limiting Tendency
779 if (ksatNH4(np).gt.0. _d 0.or.ksatNO2(np).gt.0. _d 0
780 & .or.ksatNO3(np).gt.0. _d 0) then
781 if(Nlimit(np) .lt. limit(np)) limit(np) = Nlimit(np)
782 endif
783 else
784 ngrow(np)=1. _d 0
785 Nlimit(np)=1. _d 0
786 NO3limit(np)=0. _d 0
787 NO2limit(np)=0. _d 0
788 NH4limit(np)=0. _d 0
789 endif ! diaz
790 limit(np)=min(limit(np),1. _d 0)
791 enddo !np
792 if (debug.eq.1) print*,'nut limit',
793 & limit, PO4local, FeTlocal, Silocal
794 if (debug.eq.1) print*,'Nlimit',
795 & Nlimit
796 if (debug.eq.1) print*,'NH4limit',
797 & NH4limit, NH4local
798 if (debug.eq.1) print*,'NO2limit',
799 & NO2limit, NO2local
800 if (debug.eq.1) print*,'NO3limit',
801 & NO3limit, NO3local
802 if (debug.eq.1) print*,'ngrow',
803 & ngrow
804
805
806 #ifdef GEIDER
807
808 #ifdef WAVEBANDS
809 c ANNA if wavebands then uses spectral alphachl derived from spectral alpha * I
810 c so first get value for alphachl_nl * PARwlocal
811 c value will depend on matchup between spectra of alphachl_nl (ie. aphy_chl) and PARwlocal
812 c integrate alpha*PAR over wavebands
813 do np = 1,npmax
814 alpha_I(np) = 0 _d 0
815 do nl = 1,tlam
816 alpha_I(np) = alpha_I(np) + alphachl_nl(np,nl)*PARwlocal(nl)
817 end do
818 end do
819 c Geider growth (and chl2c) now depends on this (sinlge) value of alpha_chl * I
820
821 c alpha_mean now precomputed in darwin_init_vari
822 #else
823 c ANNA if not wavebands uses alphachl derived from mQyield * aphy_chl_ave
824 c for use with generic geider equation need to use alpha_I (ie. alphachl*PARlocal)
825 do np = 1, npmax
826 alpha_I(np)=alphachl(np)*PARlocal
827 enddo
828 c ANNA endif
829 #endif
830
831 do np = 1, npmax
832 pcm(np)=pcmax(np)*limit(np)*phytoTempFunction(np)
833 #ifdef DYNAMIC_CHL
834 if (phyto(np).gt. 0. _d 0) then
835 chl2c(np)=phychl(np)/(phyto(np)*R_PC(np))
836 else
837 chl2c(np)= 0. _d 0
838 endif
839 #endif
840 if (pcm(np).gt.0.d0) then
841 #ifndef DYNAMIC_CHL
842 c assumes balanced growth, eq A14 in Geider et al 1997
843 chl2c(np)=chl2cmax(np)/
844 & (1+(chl2cmax(np)*alpha_I(np))/
845 & (2*pcm(np)))
846 chl2c(np)=min(chl2c(np),chl2cmax(np))
847 chl2c(np)=max(chl2c(np),chl2cmin(np))
848 #endif
849 if (PARlocal.gt.1. _d -1) then
850 c Eq A1 in Geider et al 1997
851 pcarbon(np)=pcm(np)*( 1 -
852 & exp((-alpha_I(np)*chl2c(np))/(pcm(np))) )
853 c for inhibition
854 if (inhibcoef_geid(np).gt.0. _d 0) then
855 #ifdef WAVEBANDS
856 Ek = pcm(np)/(chl2c(np)*alpha_mean(np))
857 #else
858 Ek = pcm(np)/(chl2c(np)*alphachl(np))
859 #endif
860 EkoverE = Ek / PARlocal
861 if (PARlocal .ge. Ek) then !photoinhibition begins
862 pcarbon(np) = pcarbon(np)*(EkoverE*inhibcoef_geid(np))
863 endif
864 endif
865 c end inhib
866 if (pcarbon(np).lt. 0. _d 0)
867 & print*,'QQ ERROR pc=',np,pcarbon(np)
868 if (pcm(np).gt.0. _d 0) then
869 ilimit(np)=pcarbon(np)/pcm(np)
870 else
871 ilimit(np)= 0. _d 0
872 endif
873 else
874 ilimit(np)=0. _d 0
875 pcarbon(np)=0. _d 0
876 endif
877 #ifdef DYNAMIC_CHL
878 c Chl:C acclimated to current conditions
879 c (eq A14 in Geider et al 1997)
880 acclim(np)=chl2cmax(np)/
881 & (1+(chl2cmax(np)*alpha_I(np))/
882 & (2*pcm(np)))
883 acclim(np)=min(acclim(np),chl2cmax(np))
884 c acclim(np)=max(acclim(np),chl2cmin(np))
885 #endif
886 else ! if pcm 0
887 pcm(np)=0. _d 0
888 #ifdef DYNAMIC_CHL
889 acclim(np)=0. _d 0
890 c acclim(np)=max(acclim(np),chl2cmin(np))
891 #else
892 chl2c(np)=chl2cmin(np)
893 #endif
894 pcarbon(np)=0. _d 0
895 ilimit(np)=0. _d 0
896 endif
897 #ifndef DYNAMIC_CHL
898 phychl(np)=phyto(np)*R_PC(np)*chl2c(np)
899 #endif
900 enddo
901 if (debug.eq.14) print*,'ilimit',ilimit, PARlocal
902 if (debug.eq.14) print*,'chl:c',chl2c
903 if (debug.eq.14) print*,'chl',phychl
904 #ifdef DYNAMIC_CHL
905 if (debug.eq.14) print*,'acclim',acclim
906 #endif
907 #endif /* GEIDER */
908
909 #ifdef DAR_DIAG_CHL
910 c diagnostic version of the above that does not feed back to growth
911 ChlGeiderlocal = 0. _d 0
912 do np = 1, npmax
913 tmppcm = mu(np)*limit(np)*phytoTempFunction(np)
914 if (tmppcm.gt.0.d0) then
915 tmpchl2c = Geider_chl2cmax(np)/
916 & (1+(Geider_chl2cmax(np)*Geider_alphachl(np)*PARdaylocal)/
917 & (2*tmppcm))
918 tmpchl2c = min(tmpchl2c, Geider_chl2cmax(np))
919 tmpchl2c = max(tmpchl2c, Geider_chl2cmin(np))
920 else
921 tmpchl2c = Geider_chl2cmin(np)
922 endif
923 ChlGeiderlocal = ChlGeiderlocal + phyto(np)*R_PC(np)*tmpchl2c
924 enddo
925 C Chl a la Doney
926 ChlDoneylocal = 0. _d 0
927 do np = 1, npmax
928 tmpchl2c = (Doney_Bmax - (Doney_Bmax-Doney_Bmin)*
929 & MIN(1. _d 0,PARdaylocal/Doney_PARstar))
930 & *limit(np)
931 ChlDoneylocal = ChlDoneylocal +
932 & tmpchl2c*R_PC(np)*phyto(np)
933 enddo
934 C Chl a la Cloern
935 ChlCloernlocal = 0. _d 0
936 do np = 1, npmax
937 tmpchl2c = Cloern_chl2cmin +
938 & Cloern_A*exp(Cloern_B*Tlocal)
939 & *exp(-Cloern_C*PARdaylocal)
940 & *limit(np)
941 ChlCloernlocal = ChlCloernlocal +
942 & tmpchl2c*R_PC(np)*phyto(np)
943 enddo
944 #endif /* DAR_DIAG_CHL */
945
946
947 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
948 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
949 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
950 c ******************* END GROWTH PHYTO *******************************
951
952
953 #ifdef OLD_GRAZE
954 c------------------------------------------------------------------------
955 c GRAZING sum contributions of all zooplankton
956 do np=1,npmax
957 grazing_phyto(np) = 0.0 _d 0
958 do nz = 1, nzmax
959 grazing_phyto(np) = grazing_phyto(np)
960 & + graze(np,nz)*zooP(nz)*zooTempFunction(nz)
961 enddo
962 enddo
963 if (debug.eq.2) print*,'grazing_phyto',grazing_phyto
964 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
965 #else
966 c------------------------------------------------------------------------
967 c sum all palatability*phyto and find phyto specific grazing rate
968 do nz=1,nzmax
969 allphyto(nz)=0. _d 0
970 do np=1,npmax
971 allphyto(nz)=allphyto(nz)+palat(np,nz)*phyto(np)
972 enddo
973 if (allphyto(nz).le.0. _d 0) allphyto(nz)=phygrazmin
974 do np=1,npmax
975 tmpz=max(0. _d 0,(allphyto(nz)-phygrazmin) )
976 grazphy(np,nz)=grazemax(nz)*zooTempFunction(nz)*
977 & (palat(np,nz)*phyto(np)/allphyto(nz))*
978 & ( tmpz/
979 & (tmpz+kgrazesat) )
980 enddo
981 enddo
982 if (debug.eq.2) print*,'allphyto',allphyto
983 c if (debug.eq.2) print*,'grazephy',grazphy
984 c sum over zoo for impact on phyto
985 do np=1,npmax
986 sumgrazphy(np)=0. _d 0
987 do nz=1,nzmax
988 sumgrazphy(np)=sumgrazphy(np)+
989 & grazphy(np,nz)*zooP(nz)
990 enddo
991 enddo
992 if (debug.eq.2) print*,'sumgrazephy',sumgrazphy
993 c sum over phy for impact on zoo, and all remainder to go to POM
994 do nz=1,nzmax
995 sumgrazzoo(nz)=0. _d 0
996 sumgrazzooN(nz)=0. _d 0
997 sumgrazzooFe(nz)=0. _d 0
998 sumgrazzooSi(nz)=0. _d 0
999 sumgrazloss(nz)=0. _d 0
1000 sumgrazlossN(nz)=0. _d 0
1001 sumgrazlossFe(nz)=0. _d 0
1002 sumgrazlossSi(nz)=0. _d 0
1003 #ifdef ALLOW_CARBON
1004 sumgrazzooC(nz)=0. _d 0
1005 sumgrazlossC(nz)=0. _d 0
1006 sumgrazlossPIC(nz)=0. _d 0
1007 #endif
1008 do np=1,npmax
1009 sumgrazzoo(nz)=sumgrazzoo(nz)+
1010 & asseff(np,nz)*grazphy(np,nz)*zooP(nz)
1011 sumgrazloss(nz)=sumgrazloss(nz)+
1012 & (1. _d 0-asseff(np,nz))*grazphy(np,nz)*zooP(nz)
1013 sumgrazzooN(nz)=sumgrazzooN(nz)+
1014 & asseff(np,nz)*grazphy(np,nz)*zooP(nz)*R_NP(np)
1015 sumgrazlossN(nz)=sumgrazlossN(nz)+
1016 & (1. _d 0-asseff(np,nz))*grazphy(np,nz)*
1017 & zooP(nz)*R_NP(np)
1018 sumgrazzooFe(nz)=sumgrazzooFe(nz)+
1019 & asseff(np,nz)*grazphy(np,nz)*
1020 & zooP(nz)*R_FeP(np)
1021 sumgrazlossFe(nz)=sumgrazlossFe(nz)+
1022 & (1. _d 0-asseff(np,nz))*grazphy(np,nz)*
1023 & zooP(nz)*R_FeP(np)
1024 sumgrazzooSi(nz)=sumgrazzooSi(nz)+
1025 & asseff(np,nz)*grazphy(np,nz)*
1026 & zooP(nz)*R_SiP(np)
1027 sumgrazlossSi(nz)=sumgrazlossSi(nz)+
1028 & (1. _d 0-asseff(np,nz))*grazphy(np,nz)*
1029 & zooP(nz)*R_SiP(np)
1030 #ifdef ALLOW_CARBON
1031 sumgrazzooC(nz)=sumgrazzooC(nz)+
1032 & asseff(np,nz)*grazphy(np,nz)*zooP(nz)*R_PC(np)
1033 sumgrazlossC(nz)=sumgrazlossC(nz)+
1034 & (1. _d 0-asseff(np,nz))*grazphy(np,nz)*
1035 & zooP(nz)*R_PC(np)
1036 sumgrazlossPIC(nz)=sumgrazlossPIC(nz)+
1037 & (1. _d 0)*grazphy(np,nz)*
1038 & zooP(nz)*R_PC(np)*R_PICPOC(np)
1039 #endif
1040 enddo
1041 enddo
1042 if (debug.eq.2) print*,'sumgrazzoo',sumgrazzoo
1043 if (debug.eq.2) print*,'sumgrazloss',sumgrazloss
1044 if (debug.eq.2) print*,'sumgrazzooN',sumgrazzooN
1045 if (debug.eq.2) print*,'sumgrazlossN',sumgrazlossN
1046 if (debug.eq.2) print*,'sumgrazzooFe',sumgrazzooFe
1047 if (debug.eq.2) print*,'sumgrazlossFe',sumgrazlossFe
1048 if (debug.eq.2) print*,'sumgrazzooSi',sumgrazzooSi
1049 if (debug.eq.2) print*,'sumgrazlossSi',sumgrazlossSi
1050 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1051 #endif
1052
1053 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1054 c accumulate particulate and dissolved detritus
1055 do np=1, npmax
1056 totphy_pop=totphy_pop+
1057 & ExportFracP(np)*mortphy(np)*
1058 & mortPTempFunction*phytomin(np)
1059 totphy_dop=totphy_dop+
1060 & (1. _d 0-ExportFracP(np))*mortphy(np)*
1061 & mortPTempFunction*phytomin(np)
1062 totphy_pon=totphy_pon+ R_NP(np)*
1063 & ExportFracP(np)*mortphy(np)*
1064 & mortPTempFunction*phytomin(np)
1065 totphy_don=totphy_don+ R_NP(np)*
1066 & (1. _d 0-ExportFracP(np))*mortphy(np)*
1067 & mortPTempFunction*phytomin(np)
1068 totphy_pofe=totphy_pofe+ R_FeP(np)*
1069 & ExportFracP(np)*mortphy(np)*
1070 & mortPTempFunction*phytomin(np)
1071 totphy_dofe=totphy_dofe+ R_FeP(np)*
1072 & (1. _d 0-ExportFracP(np))*mortphy(np)*
1073 & mortPTempFunction*phytomin(np)
1074 totphy_posi=totphy_posi+ R_SiP(np)*
1075 & mortphy(np)*
1076 & mortPTempFunction*phytomin(np)
1077 #ifdef ALLOW_CARBON
1078 totphy_poc=totphy_poc+ R_PC(np)*
1079 & ExportFracP(np)*mortphy(np)*
1080 & mortPTempFunction*phytomin(np)
1081 totphy_doc=totphy_doc+ R_PC(np)*
1082 & (1. _d 0-ExportFracP(np))*mortphy(np)*
1083 & mortPTempFunction*phytomin(np)
1084 totphy_pic=totphy_pic+ R_PC(np)*R_PICPOC(np)*
1085 & mortphy(np)*
1086 & mortPTempFunction*phytomin(np)
1087 #endif
1088 enddo
1089 if (debug.eq.3) print*,'tot_phy_pop',totphy_pop
1090 if (debug.eq.3) print*,'tot_phy_dop',totphy_dop
1091 if (debug.eq.3) print*,'tot_phy_pon',totphy_pon
1092 if (debug.eq.3) print*,'tot_phy_don',totphy_don
1093 if (debug.eq.3) print*,'tot_phy_pofe',totphy_pofe
1094 if (debug.eq.3) print*,'tot_phy_dofe',totphy_dofe
1095 if (debug.eq.3) print*,'tot_phy_posi',totphy_posi
1096
1097
1098 c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1099
1100
1101 #ifdef OLD_GRAZE
1102 c ****************** ZOO GRAZING RATE ****************************
1103 c determine zooplankton grazing rates
1104 do nz = 1, nzmax
1105 c grazing: sum contribution from all phytoplankton
1106 grazingP(nz) = 0.0 _d 0
1107 grazingN(nz) = 0.0 _d 0
1108 grazingFe(nz) = 0.0 _d 0
1109 grazingSi(nz) = 0.0 _d 0
1110 #ifdef ALLOW_CARBON
1111 grazingC(nz) = 0.0 _d 0
1112 #endif
1113 do np = 1, npmax
1114 facpz = (phytomin(np)/(phytomin(np) + kgrazesat))
1115 & *zooTempFunction(nz)
1116 grazingP(nz) = grazingP(nz) +
1117 & graze(np,nz)*facpz
1118 grazingN(nz) = grazingN(nz) +
1119 & graze(np,nz)*R_NP(np)*facpz
1120 grazingFe(nz) = grazingFe(nz) +
1121 & graze(np,nz)*R_FeP(np)*facpz
1122 grazingSi(nz) = grazingSi(nz) +
1123 & graze(np,nz)*R_SiP(np)*facpz
1124 #ifdef ALLOW_CARBON
1125 grazingC(nz) = grazingC(nz) +
1126 & graze(np,nz)*R_PC(np)*facpz
1127 #endif
1128 enddo
1129 enddo
1130 if (debug.eq.4) print*,'grazingP', grazingP
1131 if (debug.eq.4) print*,'grazingN', grazingN
1132 if (debug.eq.4) print*,'grazingFe', grazingFe
1133 if (debug.eq.4) print*,'grazingSi', grazingSi
1134 c ************* END ZOO GRAZING *********************************
1135 #endif
1136 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1137 c accumulate particulate and dissolved detritus
1138 do nz=1, nzmax
1139 totzoo_pop=totzoo_pop+
1140 & ExportFracZ(nz)*( mortzoo(nz)*
1141 & mortZTempFunction*zooP(nz)
1142 & + mortzoo2(nz)*
1143 & mortZ2TempFunction*zooP(nz)**2 )
1144 totzoo_dop=totzoo_dop+
1145 & (1. _d 0-ExportFracZ(nz))*(
1146 & mortzoo(nz)*
1147 & mortZTempFunction*zooP(nz)+
1148 & mortzoo2(nz)*
1149 & mortZ2TempFunction*zooP(nz)**2 )
1150 totzoo_pon=totzoo_pon+
1151 & ExportFracZ(nz)*( mortzoo(nz)*
1152 & mortZTempFunction*zooN(nz)
1153 & + mortzoo2(nz)*
1154 & mortZ2TempFunction*zooN(nz)*zooP(nz) )
1155 totzoo_don=totzoo_don+
1156 & (1. _d 0-ExportFracZ(nz))*(
1157 & mortzoo(nz)*
1158 & mortZTempFunction*zooN(nz)+
1159 & mortzoo2(nz)*
1160 & mortZ2TempFunction*zooN(nz)*zooP(nz) )
1161 totzoo_pofe=totzoo_pofe+
1162 & ExportFracZ(nz)*( mortzoo(nz)*
1163 & mortZTempFunction*zooFe(nz)
1164 & + mortzoo2(nz)*
1165 & mortZ2TempFunction*zooFe(nz)*zooP(nz) )
1166 totzoo_dofe=totzoo_dofe+
1167 & (1. _d 0-ExportFracZ(nz))*(
1168 & mortzoo(nz)*
1169 & mortZTempFunction*zooFe(nz) +
1170 & mortzoo2(nz)*
1171 & mortZ2TempFunction*zooFe(nz)*zooP(nz) )
1172 totzoo_posi=totzoo_posi+
1173 & ( mortzoo(nz)*
1174 & mortZTempFunction*zooSi(nz)+
1175 & mortzoo2(nz)*
1176 & mortZ2TempFunction*zooSi(nz)*zooP(nz) )
1177 #ifdef ALLOW_CARBON
1178 totzoo_poc=totzoo_poc+
1179 & ExportFracZ(nz)*( mortzoo(nz)*
1180 & mortZTempFunction*zooClocal(nz)
1181 & + mortzoo2(nz)*
1182 & mortZ2TempFunction*zooClocal(nz)*zooP(nz) )
1183 totzoo_doc=totzoo_doc+
1184 & (1. _d 0-ExportFracZ(nz))*( mortzoo(nz)*
1185 & mortZTempFunction*zooClocal(nz)
1186 & + mortzoo2(nz)*
1187 & mortZ2TempFunction*zooClocal(nz)*zooP(nz) )
1188 #endif
1189 enddo
1190
1191 #ifndef OLD_GRAZE
1192 do nz=1, nzmax
1193 totzoo_pop=totzoo_pop+
1194 & ExportFracGraz(nz)*sumgrazloss(nz)
1195 totzoo_dop=totzoo_dop+
1196 & (1. _d 0-ExportFracGraz(nz))*sumgrazloss(nz)
1197 totzoo_pon=totzoo_pon+
1198 & ExportFracGraz(nz)*sumgrazlossN(nz)
1199 totzoo_don=totzoo_don+
1200 & (1. _d 0-ExportFracGraz(nz))*sumgrazlossN(nz)
1201 totzoo_pofe=totzoo_pofe+
1202 & ExportFracGraz(nz)*sumgrazlossFe(nz)
1203 totzoo_dofe=totzoo_dofe+
1204 & (1. _d 0-ExportFracGraz(nz))*sumgrazlossFe(nz)
1205 totzoo_posi=totzoo_posi+
1206 & sumgrazlossSi(nz)
1207 #ifdef ALLOW_CARBON
1208 totzoo_poc=totzoo_poc+
1209 & ExportFracGraz(nz)*sumgrazlossC(nz)
1210 totzoo_doc=totzoo_doc+
1211 & (1. _d 0-ExportFracGraz(nz))*sumgrazlossC(nz)
1212 totzoo_pic=totzoo_pic+
1213 & sumgrazlossPIC(nz)
1214 #endif
1215 enddo
1216 #endif
1217 if (debug.eq.5) print*,'totzoo_pop',totzoo_pop
1218 if (debug.eq.5) print*,'totzoo_dop',totzoo_dop
1219 if (debug.eq.5) print*,'totzoo_pon',totzoo_pon
1220 if (debug.eq.5) print*,'totzoo_don',totzoo_don
1221 if (debug.eq.5) print*,'totzoo_pofe',totzoo_pofe
1222 if (debug.eq.5) print*,'totzoo_dofe',totzoo_dofe
1223 if (debug.eq.5) print*,'totzoo_posi',totzoo_posi
1224 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1225
1226 c ********************* NUTRIENT UPTAKE *******************************
1227 c determine nutrient uptake
1228 c consumption - sum of phytoplankton contributions
1229 do np = 1, npmax
1230 c phospate uptake by each phytoplankton
1231 #ifndef GEIDER
1232 grow(np)=ngrow(np)*mu(np)*limit(np)*ilimit(np)*
1233 & phytoTempFunction(np)
1234 #endif
1235 #ifdef GEIDER
1236 grow(np)=ngrow(np)*pcarbon(np)
1237 if (debug.eq.1) print*,'grow', grow(np), pcarbon(np)
1238 if (debug.eq.14) print*,'grow', grow(np), pcarbon(np)
1239 #ifdef DYNAMIC_CHL
1240 c geider 97 for dChl/dt (source part) Eq. 3
1241 if (acclim(np).gt. 0. _d 0.and.
1242 & alpha_I(np).gt. 0. _d 0) then
1243 rhochl(np)=chl2cmax(np) *
1244 & (grow(np)/(alpha_I(np)*acclim(np)) )
1245 else
1246 rhochl(np)= 0. _d 0
1247 endif
1248 if (debug.eq.14) print*,'rhochl',rhochl(np)
1249 #endif
1250 #endif
1251 PspecificPO4(np) = grow(np)*phyto(np)
1252 c write(6,*)'np =',np, ' PspecificPO4 ='
1253 c & ,PspecificPO4(np)
1254 consumpPO4 = consumpPO4 + PspecificPO4(np)
1255 consumpFeT = consumpFeT + PspecificPO4(np)*R_FeP(np)
1256 consumpSi = consumpSi + PspecificPO4(np)*R_SiP(np)
1257 cswd should have O2prod as function of np?
1258 c New Way of doing Nitrogen Consumption .......................
1259 if(diazotroph(np) .ne. 1.0 _d 0)then
1260 if (Nlimit(np).le.0. _d 0) then
1261 consumpNO3 = consumpNO3
1262 consumpNO2 = consumpNO2
1263 consumpNH4 = consumpNH4
1264 else
1265 consumpNO3 = consumpNO3 +
1266 & NO3limit(np)/Nlimit(np)*PspecificPO4(np)*R_NP(np)
1267 consumpNO2 = consumpNO2 +
1268 & NO2limit(np)/Nlimit(np)* PspecificPO4(np)*R_NP(np)
1269 consumpNH4 = consumpNH4 +
1270 & NH4limit(np)/Nlimit(np)*PspecificPO4(np)*R_NP(np)
1271 endif
1272 else
1273 consumpNO3 = consumpNO3
1274 consumpNO2 = consumpNO2
1275 consumpNH4 = consumpNH4
1276 Nfix=Nfix+PspecificPO4(np)*R_NP(np)
1277 #ifdef ALLOW_DIAZ
1278 #ifdef DAR_DIAG_NFIXP
1279 NfixPlocal(np)=PspecificPO4(np)*R_NP(np)
1280 #endif
1281 #endif
1282 endif
1283 #ifdef ALLOW_CARBON
1284 consumpDIC = consumpDIC + PspecificPO4(np)*R_PC(np)
1285 consumpDIC_PIC = consumpDIC_PIC +
1286 & PspecificPO4(np)*R_PC(np)*R_PICPOC(np)
1287 #endif
1288 enddo
1289 if (debug.eq.7) print*,'local', parlocal,tlocal,po4local,
1290 & no3local, no2local,nh4local,fetlocal,silocal
1291 if (debug.eq.7) print*,'grow',grow
1292 if (debug.eq.6) print*,'pspecificpo4', PspecificPO4
1293 if (debug.eq.6) print*,'consumpPO4', consumpPO4
1294 if (debug.eq.6) print*,'consumpFeT', consumpFeT
1295 if (debug.eq.6) print*,'consumpSi ', consumpsi
1296 if (debug.eq.6) print*,'consumpNO3', consumpNO3
1297 if (debug.eq.6) print*,'consumpNO2', consumpNO2
1298 if (debug.eq.6) print*,'consumpNH4', consumpNH4
1299 c ****************** END NUTRIENT UPTAKE ****************************
1300
1301 c sinking phytoplankton and POM
1302
1303 c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1304 c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1305 c MONICA: MODIFICATION 2: Change bottom boundary condition
1306 c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1307 c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1308 c THe if loop was not commented in original version:
1309 c if(bottom .eq. 1.0 _d 0)then
1310 c psinkP = (wp_sink*POPuplocal)/(dzlocal)
1311 c psinkN = (wn_sink*PONuplocal)/(dzlocal)
1312 c psinkFe = (wfe_sink*POFeuplocal)/(dzlocal)
1313 c psinkSi = (wsi_sink*PSiuplocal)/(dzlocal)
1314 c do np=1,npmax
1315 c psinkPhy(np) =
1316 c & (wsink(np)*Phytoup(np))/(dzlocal)
1317 c enddo
1318 c#ifdef DYNAMIC_CHL
1319 c do np=1,npmax
1320 c psinkChl(np) =
1321 c & (wsink(np)*Chlup(np))/(dzlocal)
1322 c enddo
1323 c#endif
1324 c#ifdef ALLOW_CARBON
1325 c psinkC = (wc_sink*POCuplocal)/(dzlocal)
1326 c psinkPIC = (wpic_sink*PICuplocal)/(dzlocal)
1327 c#endif
1328 c else
1329 psinkP = (wp_sink*(POPuplocal-POPlocal))/(dzlocal)
1330 psinkN = (wn_sink*(PONuplocal-PONlocal))/(dzlocal)
1331 psinkFe = (wfe_sink*(POFeuplocal-POFelocal))/(dzlocal)
1332 psinkSi = (wsi_sink*(PSiuplocal-PSilocal))/(dzlocal)
1333 do np=1,npmax
1334 psinkPhy(np) =
1335 & (wsink(np))*(Phytoup(np)-Phyto(np))/(dzlocal)
1336 enddo
1337 #ifdef DYNAMIC_CHL
1338 do np=1,npmax
1339 psinkChl(np) =
1340 & (wsink(np))*(Chlup(np)-phychl(np))/(dzlocal)
1341 enddo
1342 #endif
1343 #ifdef ALLOW_CARBON
1344 psinkC = (wc_sink*(POCuplocal-POClocal))/(dzlocal)
1345 psinkPIC = (wpic_sink*(PICuplocal-PIClocal))/(dzlocal)
1346 #endif
1347 c endif
1348
1349 c DOM remineralization rates
1350 DOPremin = reminTempFunction * Kdop * DOPlocal
1351 DONremin = reminTempFunction * Kdon * DONlocal
1352 DOFeremin = reminTempFunction * KdoFe * DOFelocal
1353
1354 c remineralization of sinking particulate
1355 preminP = reminTempFunction * Kpremin_P*POPlocal
1356 preminN = reminTempFunction * Kpremin_N*PONlocal
1357 preminFe = reminTempFunction * Kpremin_Fe*POFelocal
1358 preminSi = reminTempFunction * Kpremin_Si*PSilocal
1359
1360 #ifdef ALLOW_CARBON
1361 DOCremin = reminTempFunction * Kdoc * DOClocal
1362 preminC = reminTempFunction * Kpremin_C*POClocal
1363
1364 omegaCLocal = calciumLocal * CO3Local / KspTPLocal
1365
1366 c water column dissolution
1367 #ifdef NAVIAUX_DISSOLUTION
1368
1369 c Naviaux et al. 2019, Marine Chemistry dissolution rate law
1370 if (omegaCLocal .LT. 1.0 _d 0) then
1371 if (omegaCLocal .LT. 0.8272 _d 0) then
1372 disscPIC = PIClocal*5.22 _d -9 *
1373 & (1-omegaCLocal)**0.11 _d 0
1374 else
1375 disscPIC = PIClocal*1.65 _d -5 *
1376 & (1-omegaCLocal)**4.7 _d 0
1377 endif
1378 else
1379 disscPIC = 0.0 _d 0
1380 endif
1381
1382 #else /* NAVIAUX_DISSOLUTION */
1383 disscPIC = Kdissc*PIClocal
1384 #endif /* NAVIAUX_DISSOLUTION */
1385
1386 #endif /* ALLOW_CARBON */
1387
1388 c chemistry
1389 c NH4 -> NO2 -> NO3 by bacterial action
1390 NO2prod = knita*( 1. _d 0-min(PARlocal/PAR0,1. _d 0) )
1391 & *NH4local
1392 NO3prod = knitb*( 1. _d 0-min(PARlocal/PAR0,1. _d 0) )
1393 & *NO2local
1394 c NO2prod = knita*NH4local
1395 c NO3prod = knitb*NO2local
1396 c
1397 #ifdef PART_SCAV
1398 scav_poc=POPlocal/1.1321 _d -4
1399 c scav rate
1400 scav_part=scav_rat*scav_inter*(scav_poc**scav_exp)
1401 #endif
1402 c -------------------------------------------------------------------
1403 c calculate tendency terms (and some diagnostics)
1404 c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1405 c phytoplankton
1406 do np=1,npmax
1407 dphytodt(np) = PspecificPO4(np)
1408 #ifdef OLD_GRAZE
1409 & - grazing_phyto(np)*
1410 & (phytomin(np)/(phytomin(np) + kgrazesat))
1411 #else
1412 & - sumgrazphy(np)
1413 #endif
1414 & - mortphy(np)*
1415 & mortPTempFunction*phytomin(np)
1416 & + psinkphy(np)
1417 #ifdef GEIDER
1418 #ifdef DYNAMIC_CHL
1419 dphychl(np) = acclim(np)*PspecificPO4(np)*R_PC(np)
1420 c dphychl(np) = rhochl(np)*PspecificPO4(np)*R_PC(np)
1421 & + acclimtimescl *
1422 & (acclim(np)-chl2c(np))*phyto(np)*R_PC(np)
1423 & +(
1424 #ifdef OLD_GRAZE
1425 & - grazing_phyto(np)*
1426 & (phytomin(np)/(phytomin(np) + kgrazesat))
1427 #else
1428 & - sumgrazphy(np)
1429 #endif
1430 & - mortphy(np)*
1431 & mortPTempFunction*phytomin(np))
1432 & *chl2c(np)*R_PC(np)
1433 & + psinkChl(np)
1434 #endif
1435 Chl=Chl + phychl(np)
1436 #endif
1437 c %% diagnostics
1438 PP = PP + PspecificPO4(np)
1439 c%%%
1440 #ifdef OLD_GRAZE
1441 tmpr=grazing_phyto(np)*
1442 & (phytomin(np)/(phytomin(np) + kgrazesat))
1443 & + mortphy(np)*
1444 & mortPTempFunction*phytomin(np)
1445 & - psinkphy(np)
1446 #else
1447 tmpr=sumgrazphy(np)
1448 & + mortphy(np)*
1449 & mortPTempFunction*phytomin(np)
1450 & - psinkphy(np)
1451 #endif
1452 #ifdef DAR_DIAG_RSTAR
1453 #ifndef GEIDER
1454 tmpgrow=ngrow(np)*mu(np)*ilimit(np)*
1455 & phytoTempFunction(np)
1456 #endif
1457 #ifdef GEIDER
1458 tmpgrow=grow(np)/limit(np)
1459 #endif
1460 tmp1=tmpgrow*phyto(np)-tmpr
1461 tmp2=tmpgrow*phyto(np)*(exp(-sig1*nh4local)+NH4limit(np))
1462 & -tmpr
1463 if (tmp1.ne.0. _d 0) then
1464 Rstarlocal(np)=ksatPO4(np)*tmpr/tmp1
1465 else
1466 Rstarlocal(np)=-9999. _d 0
1467 endif
1468 if (tmp2.ne.0. _d 0) then
1469 RNstarlocal(np)=ksatNO3(np)*
1470 & (tmpr-tmpgrow*NH4limit(np)*phyto(np))/tmp2
1471 else
1472 RNstarlocal(np)=-9999. _d 0
1473 endif
1474 #endif
1475 #ifdef DAR_DIAG_GROW
1476 c include temp, light, nutrients
1477 c Growlocal(np)=grow(np)
1478 c include temp and light, but not nutrients
1479 Growlocal(np)=ngrow(np)*mu(np)*ilimit(np)*
1480 & phytoTempFunction(np)
1481 c include temp, but not nutrients or light
1482 c Growlocal(np)=ngrow(np)*mu(np)*
1483 c & phytoTempFunction(np)
1484 Growsqlocal(np)=Growlocal(np)**2
1485 #endif
1486 enddo
1487 c end np loop
1488 if (debug.eq.10) print*,'dphytodt',dphytodt
1489 c
1490 #ifdef OLD_GRAZE
1491 c zooplankton growth by grazing
1492 do nz=1,nzmax
1493 c zoo in P currency
1494 dzooPdt(nz) = grazingP(nz)*zooP(nz)
1495 C zooplankton stoichiometry varies according to food source
1496 dzooNdt(nz) = grazingN(nz)*zooP(nz)
1497 dzooFedt(nz) = grazingFe(nz)*zooP(nz)
1498 dzooSidt(nz) = grazingSi(nz)*zooP(nz)
1499 enddo
1500 #else
1501 do nz=1,nzmax
1502 c zoo in P currency
1503 dzooPdt(nz) = sumgrazzoo(nz)
1504 C zooplankton stoichiometry varies according to food source
1505 dzooNdt(nz) = sumgrazzooN(nz)
1506 dzooFedt(nz) = sumgrazzooFe(nz)
1507 dzooSidt(nz) = sumgrazzooSi(nz)
1508 enddo
1509 #endif
1510 if (debug.eq.10) print*,'dZooPdt',dZooPdt
1511
1512 c zooplankton mortality
1513 do nz=1,nzmax
1514 c zoo in P currency
1515 dzooPdt(nz) = dzooPdt(nz)
1516 & - mortzoo(nz)*
1517 & mortZTempFunction*zooP(nz)
1518 & - mortzoo2(nz)*
1519 & mortZ2TempFunction*zooP(nz)**2
1520 c zooplankton in other currencies
1521 C zooplankton stoichiometry varies according to food source
1522 dzooNdt(nz) = dzooNdt(nz)
1523 & - mortzoo(nz)*
1524 & mortZTempFunction*zooN(nz)
1525 & - mortzoo2(nz)*
1526 & mortZ2TempFunction*zooN(nz)*zooP(nz)
1527 dzooFedt(nz) = dzooFedt(nz)
1528 & - mortzoo(nz)*
1529 & mortZTempFunction*zooFe(nz)
1530 & - mortzoo2(nz)*
1531 & mortZ2TempFunction*zooFe(nz)*zooP(nz)
1532 dzooSidt(nz) = dzooSidt(nz)
1533 & - mortzoo(nz)*
1534 & mortZTempFunction*zooSi(nz)
1535 & - mortzoo2(nz)*
1536 & mortZ2TempFunction*zooSi(nz)*zooP(nz)
1537 enddo
1538
1539
1540 c sum contributions to inorganic nutrient tendencies
1541 dPO4dt = - consumpPO4 + preminP + DOPremin
1542 dNH4dt = - consumpNH4 + preminN + DONremin
1543 & - NO2prod
1544 dNO2dt = - consumpNO2
1545 & + NO2prod - NO3prod
1546 dNO3dt = - consumpNO3
1547 & + NO3prod
1548 c-ONLYNO3 dNO3dt = C consumpNO3 + preminN + DONremin
1549 #ifdef ALLOW_DENIT
1550 if (O2local.le.O2crit) then
1551 if (NO3local.gt.1. _d -2) then
1552 denit = denit_np*(preminP + DOPremin)
1553 dNO3dt = dNO3dt -
1554 & (104. _d 0/denit_np)*denit
1555 dNH4dt = dNH4dt - (preminN + DONremin)
1556 else
1557 denit = 0. _d 0
1558 dPO4dt = dPO4dt - (preminP + DOPremin)
1559 dNH4dt = dNH4dt - (preminN + DONremin)
1560 DOPremin = 0. _d 0
1561 preminP = 0. _d 0
1562 DONremin = 0. _d 0
1563 preminN = 0. _d 0
1564 DOFeremin = 0. _d 0
1565 preminFe = 0. _d 0
1566 #ifdef ALLOW_CARBON
1567 DOCremin = 0. _d 0
1568 preminC = 0. _d 0
1569 #endif
1570 endif
1571 endif
1572 #endif
1573 dFeTdt = - consumpFeT + preminFe + DOFeremin
1574 #ifdef PART_SCAV
1575 & - scav_part*freefelocal +
1576 #else
1577 & - scav*freefelocal +
1578 #endif
1579 & alpfe*inputFelocal/dzlocal
1580 dSidt = - consumpSi + preminSi
1581
1582 c tendency of dissolved organic pool
1583 dDOPdt = totphy_dop + totzoo_dop - DOPremin
1584 dDONdt = totphy_don + totzoo_don - DONremin
1585 dDOFedt = totphy_dofe + totzoo_dofe - DOFeremin
1586 c tendency of particulate detritus pools
1587 dpopdt = totphy_pop + totzoo_pop - preminP + psinkP
1588 dpondt = totphy_pon + totzoo_pon - preminN + psinkN
1589 dpofedt = totphy_pofe + totzoo_pofe - preminFe + psinkFe
1590 dpSidt = totphy_posi + totzoo_posi - preminSi + psinkSi
1591 #ifdef ALLOW_CARBON
1592 dDICdt = - consumpDIC - consumpDIC_PIC
1593 & + preminC + DOCremin
1594 & + disscPIC
1595 dDOCdt = totphy_doc + totzoo_doc - DOCremin
1596 dPOCdt = totphy_poc + totzoo_poc - preminC + psinkC
1597 dPICdt = totphy_pic + totzoo_pic - disscPIC + psinkPIC
1598 dALKdt = - dNO3dt - 2.d0 * (consumpDIC_PIC - disscPIC)
1599 c should be = O2prod - preminP - DOPremin?
1600 c OLD WAY
1601 c dO2dt = - R_OP*dPO4dt
1602 c production of O2 by photosynthesis
1603 dO2dt = R_OP*consumpPO4
1604 c loss of O2 by remineralization
1605 if (O2local.gt.O2crit) then
1606 dO2dt = dO2dt - R_OP*(preminP + DOPremin)
1607 endif
1608 #ifdef OLD_GRAZE
1609 do nz=1,nzmax
1610 dzooCdt(nz) = grazingC(nz)*zooClocal(nz)
1611 & - mortzoo(nz)*
1612 & mortZTempFunction*zooClocal(nz)
1613 & - mortzoo2(nz)*
1614 & mortZ2TempFunction*zooClocal(nz)*zooP(nz)
1615 enddo
1616 #else
1617 do nz=1,nzmax
1618 dzooCdt(nz) = sumgrazzooc(nz)
1619 & - mortzoo(nz)*
1620 & mortZTempFunction*zooClocal(nz)
1621 & - mortzoo2(nz)*
1622 & mortZ2TempFunction*zooClocal(nz)*zooP(nz)
1623 enddo
1624 #endif
1625
1626 #endif
1627
1628 if (debug.eq.10) print*,'dDOPdt', dDOPdt
1629 if (debug.eq.10) print*,'dpopdt',dpopdt
1630 if (debug.eq.10) print*,'dDONdt',dDONdt
1631 if (debug.eq.10) print*,'dpondt',dpondt
1632 c
1633 c -------------------------------------------------------------------
1634 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1635 c --------------------------------------------------------------------------
1636
1637 c -m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-
1638 c Mutation - apply mutation to tendencies [jbmodif]
1639
1640 #ifdef ALLOW_MUTANTS
1641 c apply to all sisters when first sister is encountered
1642 if(runtim .gt. threeyr) then
1643 mutfor=1 _d -8
1644 mutback=1 _d -12
1645 if(numtax .gt. 1)then
1646 do np=1,npro
1647 if(mod(np,numtax).eq. 1. _d 0)then
1648 nsisone = np
1649 nsistwo = np+1
1650 nsisthree = np+2
1651 nsisfour = np+3
1652
1653 grow1 = PspecificPO4(nsisone)
1654 grow2 = PspecificPO4(nsistwo)
1655
1656 if(numtax.eq.2)grow3 = 0.0 _d 0
1657 if(numtax.eq.2)grow4 = 0.0 _d 0
1658
1659 if(numtax.eq.3)grow4 = 0.0 _d 0
1660 if(numtax.ge.3)grow3 = PspecificPO4(nsisthree)
1661
1662 if(numtax.eq.4)grow4 = PspecificPO4(nsisfour)
1663
1664
1665
1666 dphytodt(nsisone) = dphytodt(nsisone)
1667 & - grow1 *1.4427 _d 0*mutfor
1668 & - grow1 *1.4427 _d 0*mutfor
1669 & - grow1 *1.4427 _d 0*mutfor
1670 & + grow2 *1.4427 _d 0*mutback
1671 & + grow3 *1.4427 _d 0*mutback
1672 & + grow4 *1.4427 _d 0*mutback
1673
1674 dphytodt(nsistwo) = dphytodt(nsistwo)
1675 & - grow2 *1.4427 _d 0*mutback
1676 & + grow1 *1.4427 _d 0*mutfor
1677
1678 if(numtax .ge. 3)then
1679 dphytodt(nsisthree) = dphytodt(nsisthree)
1680 & - grow3 *1.4427 _d 0*mutback
1681 & + grow1 *1.4427 _d 0*mutfor
1682 endif
1683
1684 if(numtax .eq. 4)then
1685 dphytodt(nsisfour) = dphytodt(nsisfour)
1686 & - grow4 *1.4427 _d 0*mutback
1687 & + grow1 *1.4427 _d 0*mutfor
1688 c QQQQQQQQQQ FIX FOR NIT RUNS ONLY!!!
1689 if (phyto(nsisfour).eq.0. _d 0) then
1690 if (phyto(nsistwo).eq.0. _d 0) then
1691 if (dphytodt(nsistwo).gt.dphytodt(nsisfour)) then
1692 dphytodt(nsisfour)=dphytodt(nsistwo)
1693 endif
1694 endif
1695 if (phyto(nsisthree).eq.0. _d 0) then
1696 if (dphytodt(nsisthree).gt.dphytodt(nsisfour)) then
1697 dphytodt(nsisfour)=dphytodt(nsisthree)
1698 endif
1699 endif
1700 endif
1701 c QQQQQQQQQQQQQ
1702 endif
1703
1704 c QQQQQQQQQQQQTEST
1705 if (debug.eq.11) then
1706 if (PARlocal.gt.1. _d 0) then
1707 if (dphytodt(nsistwo).gt.dphytodt(nsisfour).and.
1708 & dphytodt(nsisfour).gt.0. _d 0) then
1709 print*,'QQQQ nsistwo>nsisfour',nsistwo,nsisfour,
1710 & dphytodt(nsistwo), dphytodt(nsisfour),
1711 & phyto(nsistwo), phyto(nsisfour),
1712 & phyto(nsisone)
1713 endif
1714 if (dphytodt(nsisthree).gt.dphytodt(nsisfour).and.
1715 & dphytodt(nsisfour).gt.0. _d 0) then
1716 print*,'QQQQ nsisthree>nsisfour',nsisthree,nsisfour,
1717 & dphytodt(nsisthree), dphytodt(nsisfour),
1718 & phyto(nsisthree), phyto(nsisfour),
1719 & phyto(nsisone)
1720 endif
1721 if (dphytodt(nsisfour).gt.dphytodt(nsisone).and.
1722 & dphytodt(nsisone).gt.0. _d 0) then
1723 print*,' BIG QQQQ nsisfour>nsisone',nsisone,nsisfour,
1724 & dphytodt(nsisfour), dphytodt(nsisone),
1725 & phyto(nsisfour), phyto(nsisone)
1726 endif
1727 endif
1728 endif
1729 c QQQQQQQQQTEST
1730 endif
1731 enddo
1732 endif
1733 endif
1734
1735 c mutation is finished
1736 c -m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-m-
1737 #endif
1738
1739
1740
1741 RETURN
1742 END
1743 #endif /*DARWIN*/
1744 #endif /*ALLOW_PTRACERS*/
1745 c ==================================================================

  ViewVC Help
Powered by ViewVC 1.1.22