/[MITgcm]/MITgcm_contrib/darwin2/pkg/quota/quota_plankton.F
ViewVC logotype

Diff of /MITgcm_contrib/darwin2/pkg/quota/quota_plankton.F

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

revision 1.2 by benw, Mon Jul 2 09:55:36 2012 UTC revision 1.3 by benw, Tue May 19 14:32:43 2015 UTC
# Line 36  c ====================================== Line 36  c ======================================
36           SUBROUTINE QUOTA_PLANKTON(           SUBROUTINE QUOTA_PLANKTON(
37       I                       biomass, orgmat, nutrient,       I                       biomass, orgmat, nutrient,
38       O                       PP,       O                       PP,
39       I                       bioabove, biobelow,       I                       bioabove,
40       I                       orgabove,       I                       orgabove,
41  #ifdef FQUOTA  #ifdef FQUOTA
42       I                       freefelocal, inputFelocal,       I                       freefelocal, inputFelocal,
43  #endif  #endif
44  #ifdef QUOTA_DIAG_LIMIT  #ifdef QUOTA_DIAG_LIMIT
45       O                       Nlim, Flim, Ilim, photo_Tempfunction,       O                       AP, HP,
46         O                       Rlim, Ilim, photo_Tempfunction,
47  #endif  #endif
48       I                       PARlocal, Tlocal, Slocal,       I                       PARlocal, Tlocal, Slocal,
49       I                       bottom, surface, dzlocal,       I                       bottom, surface, dzlocal,
# Line 78  c orgmat   = organic matter biomass (dis Line 79  c orgmat   = organic matter biomass (dis
79           _RL quota(iomax-iChl,npmax)           _RL quota(iomax-iChl,npmax)
80           _RL PP           _RL PP
81           _RL bioabove(iomax,npmax)           _RL bioabove(iomax,npmax)
          _RL biobelow(iomax,npmax)  
82           _RL orgabove(iomax-iChl,komax)           _RL orgabove(iomax-iChl,komax)
83  #ifdef FQUOTA  #ifdef FQUOTA
84           _RL freefelocal           _RL freefelocal
85           _RL inputFelocal           _RL inputFelocal
86  #endif  #endif
87  #ifdef QUOTA_DIAG_LIMIT  #ifdef QUOTA_DIAG_LIMIT
88           _RL Nlim(npmax),Flim(npmax),Ilim(npmax),Tlim           _RL Rlim(iomax-iChl-1,npmax),Ilim(npmax),Tlim
89             _RL AP(iomax,npmax),HP(iomax,npmax)
90  #endif  #endif
91           _RL m_ref(npmax)           _RL m_ref(npmax)
92           _RL PARlocal           _RL PARlocal
# Line 126  c variables for plankton growth rate lim Line 127  c variables for plankton growth rate lim
127  #endif  #endif
128  c plankton specific nutrient limitation terms  c plankton specific nutrient limitation terms
129           _RL qreg(iomax,npmax)           _RL qreg(iomax,npmax)
130           _RL qregmax           _RL q_reg(iomax,npmax)
131  c photosynthesis light limitation term  c photosynthesis light limitation term
132           _RL ilimit(npmax)           _RL ilimit(npmax)
133  c temperature limitation terms  c temperature limitation terms
# Line 136  c uptake of inorganic nutrients Line 137  c uptake of inorganic nutrients
137           _RL up_inorg(iimax,npmax)           _RL up_inorg(iimax,npmax)
138  c plankton grazing rates  c plankton grazing rates
139           _RL grazing(iomax,npmax,npmax)           _RL grazing(iomax,npmax,npmax)
140           _RL food1,food2           _RL food1,food2,refuge(npmax)
          _RL Psum,Zsum,Jsum  
141           _RL biomass2(npmax)           _RL biomass2(npmax)
142  c plankton respiration rates (carbon only)  c plankton respiration rates (carbon only)
143           _RL C_resp(npmax)           _RL C_resp(npmax)
# Line 145  c varible for mimumum phyto Line 145  c varible for mimumum phyto
145           _RL biomassmin(npmax)           _RL biomassmin(npmax)
146  c variables for remineralization of organic matter  c variables for remineralization of organic matter
147  c  c
148  c variables for sinking/swimming  c variables for sinking
149          _RL bvert(iomax,npmax)          _RL bvert(iomax,npmax)
150          _RL pomsink(iomax-iChl)          _RL pomsink(iomax-iChl)
151            _RL fSurf,fBott
152  c variables for sums of plankton and organic matter  c variables for sums of plankton and organic matter
153           _RL totplankton(iomax)           _RL totplankton(iomax)
154           _RL totorgmat(iomax-iChl)           _RL totorgmat(iomax-iChl)
155  c ?  c ?
156           _RL facpz           _RL facpz
157           _RL kpar, kinh           _RL kpar, kinh
158           _RL tmpr,tmpz, tmpgrow, tmp1, tmp2           _RL tmp, tmpr,tmpz, tmpgrow, tmp1, tmp2
159           integer ITEST           integer ITEST
160  c  c
161  c *****************************************************************  c *****************************************************************
# Line 168  c Line 169  c
169  c qreg   --> individual nutrient status for uptake regualtion  c qreg   --> individual nutrient status for uptake regualtion
170  c            0 = quota full, 1 = quota empty  c            0 = quota full, 1 = quota empty
171  c            linear for all elements (not needed for Si)  c            linear for all elements (not needed for Si)
172  c            qreg(C) = inverse of qreg for most limiting element  c            qreg(C,jp) = inverse of qreg for most limiting element
173  c  c
174        do jp = 1,npmax        do jp = 1,npmax
175  c       set diagnostic to zero  c       set diagnostic to zero
# Line 180  c quota = nutrient biomass to carbon bio Line 181  c quota = nutrient biomass to carbon bio
181            if (biomass(iCarb,jp).gt.0. _d 0) then            if (biomass(iCarb,jp).gt.0. _d 0) then
182              quota(io,jp) = biomass(io,jp) / biomass(iCarb,jp)              quota(io,jp) = biomass(io,jp) / biomass(iCarb,jp)
183            else            else
184              quota(io,jp) = 0. _d 0              quota(io,jp) = qmin(io,jp)
185            endif            endif
186  c limit ranges from 1 to 0 between qmin and qmax  c limit ranges from 1 to 0 between qmin and qmax
187            if (quota(io,jp).le.qmin(io,jp)) then ! if quota empty...            if (quota(io,jp).le.qmin(io,jp)) then ! if quota empty...
# Line 201  c limit ranges from 1 to 0 between qmin Line 202  c limit ranges from 1 to 0 between qmin
202              qreg(io,jp) = (qmax(io,jp) - quota(io,jp))              qreg(io,jp) = (qmax(io,jp) - quota(io,jp))
203       &                  / (qmax(io,jp) - qmin(io,jp) )       &                  / (qmax(io,jp) - qmin(io,jp) )
204            endif            endif
205              
206  #ifdef QUOTA_DIAG_LIMIT  #ifdef QUOTA_DIAG_LIMIT
207            if (io.eq.iNitr) Nlim(jp) = limit            if (io.eq.iNitr) Rlim(iNitr-1,jp) = limit
208            if (io.eq.iIron) Flim(jp) = limit  #ifdef PQUOTA
209              if (io.eq.iPhos) Rlim(iPhos-1,jp) = limit
210    #endif
211    #ifdef FQUOTA
212              if (io.eq.iIron) Rlim(iIron-1,jp) = limit
213    #endif
214  #endif  #endif
215  #ifdef FQUOTA  #ifdef FQUOTA
216            if (io.eq.iIron) then            if (io.eq.iIron) then
# Line 218  c limit ranges from 1 to 0 between qmin Line 225  c limit ranges from 1 to 0 between qmin
225              qreg(iSili,jp)    = 0. _d 0              qreg(iSili,jp)    = 0. _d 0
226              biomass(iSili,jp) = 0. _d 0              biomass(iSili,jp) = 0. _d 0
227              bioabove(iSili,jp)= 0. _d 0              bioabove(iSili,jp)= 0. _d 0
             biobelow(iSili,jp)= 0. _d 0  
228              quota(iSili,jp)   = 0. _d 0              quota(iSili,jp)   = 0. _d 0
229            endif            endif
230  #endif  #endif
231            qlimit(jp)     = min(qlimit(jp),limit)            qlimit(jp)     = min(qlimit(jp),limit)
232            qreg(iCarb,jp) = min(qreg(iCarb,jp),1. _d 0 - qreg(io,jp))            qreg(iCarb,jp) = min(qreg(iCarb,jp),1. _d 0 - qreg(io,jp))
233  c  c
234              q_reg(io,jp) = qreg(io,jp) ** hill
235          enddo ! io          enddo ! io
236            q_reg(iCarb,jp) = qreg(iCarb,jp) ** hill
237    #ifdef QUOTA_DIAG_LIMIT
238            ! use monod limitation diagnostic where types are extinct
239            if (biomass(iCarb,jp).le.0. _d 0) then
240              Rlim(iNitr-1,jp) = nutrient(iNO3)/(nutrient(iNO3)+kn(iNO3,jp))
241    #ifdef PQUOTA
242              Rlim(iPhos-1,jp) = nutrient(iPO4)/(nutrient(iPO4)+kn(iPO4,jp))
243    #endif
244    #ifdef FQUOTA
245              Rlim(iIron-1,jp) = nutrient(iFeT)/(nutrient(iFeT)+kn(iFeT,jp))
246    #endif
247            endif
248    #endif
249          if (autotrophy(jp).eq. 0. _d 0) then          if (autotrophy(jp).eq. 0. _d 0) then
250            biomass(iChlo,jp)  = 0. _d 0 ! pure heterotroph, so chl is zero            biomass(iChlo,jp)  = 0. _d 0 ! pure heterotroph, so chl is zero
251            bioabove(iChlo,jp) = 0. _d 0            bioabove(iChlo,jp) = 0. _d 0
           biobelow(iChlo,jp) = 0. _d 0  
252          endif          endif
253        enddo ! jp        enddo ! jp
254  c  c
# Line 256  c C-specific nutrient uptake, modulated Line 275  c C-specific nutrient uptake, modulated
275              if (nutrient(ii).gt.0. _d 0) then              if (nutrient(ii).gt.0. _d 0) then
276                up_inorg(ii,jp) = vmaxi(ii,jp)                          ! maximum uptake rate                up_inorg(ii,jp) = vmaxi(ii,jp)                          ! maximum uptake rate
277       &                        * nutrient(ii)/(nutrient(ii)+kn(ii,jp)) ! ambient nutrients       &                        * nutrient(ii)/(nutrient(ii)+kn(ii,jp)) ! ambient nutrients
278       &                        * qreg(io,jp)                           ! quota satiation       &                        * q_reg(io,jp)                          ! quota satiation
279       &                        * activ_Tempfunction                    ! temperature effects       &                        * activ_Tempfunction                    ! temperature effects
280  #ifdef AMMON  #ifdef AMMON
281  c             apply ammonium inhibition to NO3 and NO2  c             apply ammonium inhibition to NO3 and NO2
# Line 305  c ************************************** Line 324  c **************************************
324  c PRE-ASSIMILATION grazing of type jpredator by type jprey  c PRE-ASSIMILATION grazing of type jpredator by type jprey
325        do jpred=1,npmax ! loop predators        do jpred=1,npmax ! loop predators
326          if (autotrophy(jpred).lt.1. _d 0) then ! not for pure autotrophs          if (autotrophy(jpred).lt.1. _d 0) then ! not for pure autotrophs
327            food1 = 0. _d 0            food1 = 0.0 _d 0
328  #ifdef SWITCH3            food2 = 0.0 _d 0
329            food2 = 0. _d 0            do jprey=1,npmax ! sum all the prey carbon of predator, weighted by availability (preference)
330  #else              if (graz_pref(jpred,jprey).gt.0.0 _d 0) then
331            Psum  = 0. _d 0                food1 = food1
332            Zsum  = 0. _d 0       &              + graz_pref(jpred,jprey)*biomass(iCarb,jprey)
333    #ifdef SWITCHING
334                  food2 = food2
335         &              + (graz_pref(jpred,jprey)*biomass(iCarb,jprey))**ns
336  #endif  #endif
           do jprey=1,npmax ! sum all the prey carbon of predator, weighted by preference  
             food1 = food1  
      &            + graz_pref(jpred,jprey) * biomass(iCarb,jprey)  
 #ifdef SWITCH3  
             food2 = food2  
      &            + graz_pref(jpred,jprey) * biomass(iCarb,jprey)  
      &            * graz_pref(jpred,jprey) * biomass(iCarb,jprey)  
 #else  
             if (pft(jprey).ne.6) then  
               Psum  = Psum  
      &              + graz_pref(jpred,jprey)  
      &              * biomass(iCarb,jprey) * biomass(iCarb,jprey)  
             else  
               Zsum  = Zsum  
      &              + graz_pref(jpred,jprey)  
      &              * biomass(iCarb,jprey) * biomass(iCarb,jprey)  
337              endif              endif
 #endif  
338            enddo            enddo
339            ! calculate grazing effort            ! calculate grazing effort
340            if (food1.gt.0. _d 0) then            if (food1.gt.0. _d 0) then
341              tmp1  = graz(jpred) * activ_Tempfunction ! saturated grazing              refuge(jpred) = (1.0 _d 0 - exp(Lambda * food1))
342       &            * food1 / (food1+kg(jpred))    ! grazing effort              tmp1  = activ_Tempfunction ! saturated grazing
343       &            * (1.0 _d 0 - exp(-1. _d 0 * food1))       &            * food1 / (food1 + kg(jpred))      ! grazing effort
344         &            * refuge(jpred)                    ! grazing refuge
345            else            else
346              tmp1  = 0. _d 0              tmp1  = 0. _d 0
347            endif            endif
348            do jprey=1,npmax ! loop prey carbon consumption            do jprey=1,npmax ! loop prey carbon consumption
 #ifdef SWITCH3  
349              if (food1.gt.0. _d 0) then              if (food1.gt.0. _d 0) then
               tmp2=food2  
 #else  
             if (food1.gt.0. _d 0 .and.(Psum+Zsum).gt.0) then  
               tmp2=food1  
               if (pft(jprey).ne.6) then  
                 Jsum  = Psum  
               else  
                 Jsum  = Zsum  
               endif  
 #endif  
350                grazing(iCarb,jpred,jprey)                 ! d^-1                grazing(iCarb,jpred,jprey)                 ! d^-1
351  #ifndef SWITCH3       &          = tmp1 ! grazing effort
352       &               = Jsum / (Psum+Zsum)  !#ifdef ONEGRAZER
353    !     &          * graz(jprey) ! prey dependent maximum rate
354    !#else
355         &          * graz(jpred) ! predator dependent maximum rate
356    !#endif
357    #ifdef SWITCHING
358         &          *(graz_pref(jpred,jprey)*biomass(iCarb,jprey))**ns/food2
359  #else  #else
360       &               = graz_pref(jpred,jprey) * biomass(iCarb,jprey)       &          * graz_pref(jpred,jprey)*biomass(iCarb,jprey)     /food1
361  #endif  #endif
      &               * graz_pref(jpred,jprey) * biomass(iCarb,jprey)  
      &               / tmp2  
      &               * tmp1  
362              else              else
363                grazing(iCarb,jpred,jprey) = 0. _d 0                grazing(iCarb,jpred,jprey) = 0. _d 0
364              endif              endif
# Line 392  c end evaluate biological process terms Line 390  c end evaluate biological process terms
390  c -----------------------------------------------------------------  c -----------------------------------------------------------------
391  c  c
392  c -----------------------------------------------------------------  c -----------------------------------------------------------------
393  c evaluate vertical sink and swim terms  c evaluate vertical sink terms
394  c ************************************************************  c ************************************************************
395  c     biosink is +ve downwards  c     biosink is +ve downwards
 c     bioswim is -ve upwards  
396  c     (upstream - downstream) * vertical velocity  c     (upstream - downstream) * vertical velocity
397  c     bvert is a gain term  c     bvert is a gain term
398    
399    !     factors to avoid sinking into surface layer, or out of bottom
400          fSurf=float(1-surface)
401          fBott=float(1-bottom)
402    !
403        do io=1,iomax        do io=1,iomax
404    !       plankton sinking
405          do jp=1,npmax          do jp=1,npmax
406            if (surface.eq.1) then ! surface              bvert(io,jp) = (fSurf*bioabove(io,jp)-fBott*biomass(io,jp))
             bvert(io,jp) =(-biomass(io,jp))  
      &                   *  biosink(jp) / dzlocal           ! - sinking out  
      &                   +(-biobelow(io,jp))  
      &                   *  bioswim(jp) / dzlocal           ! - swimming in (-ve)  
           elseif (bottom.eq.1) then ! bottom  
             bvert(io,jp) =  bioabove(io,jp)  
      &                   *  biosink(jp) / dzlocal           ! + sinking in  
      &                   +  biomass(io,jp)  
      &                   *  bioswim(jp) / dzlocal           ! + swimming out (-ve)  
           else ! in between  
             bvert(io,jp) = (bioabove(io,jp)-biomass(io,jp))  
407       &                   *  biosink(jp) / dzlocal           ! + sinking in - sinking out       &                   *  biosink(jp) / dzlocal           ! + sinking in - sinking out
      &                   + (biomass(io,jp)-biobelow(io,jp))  
      &                   *  bioswim(jp) / dzlocal           ! + swimming out (-ve) - swimming in (-ve)  
           endif  
408          enddo          enddo
409    !       organic matter sinking
410          if (io.ne.iChlo) then          if (io.ne.iChlo) then
411            if (surface.eq.1) then ! surface            pomsink(io) = (fSurf*orgabove(io,2)-fBott*orgmat(io,2))
412              pomsink(io) =(-orgmat(io,2))       &                *  orgsink(2) / dzlocal
      &                  *  orgsink(2) / dzlocal  
           elseif (bottom.eq.1) then ! bottom  
             pomsink(io) =  orgabove(io,2)  
      &                  *  orgsink(2) / dzlocal  
           else ! in between  
             pomsink(io) = (orgabove(io,2)-orgmat(io,2))  
      &                  *  orgsink(2) / dzlocal  
           endif  
413          endif          endif
414        enddo        enddo
415  c ************************************************************  c ************************************************************
# Line 457  c inorganic uptake Line 439  c inorganic uptake
439  #ifdef FQUOTA  #ifdef FQUOTA
440          dbiomassdt(iIron,jp) = biomass(iCarb,jp)*up_inorg(iFeT,jp)          dbiomassdt(iIron,jp) = biomass(iCarb,jp)*up_inorg(iFeT,jp)
441  #endif  #endif
442    #ifdef QUOTA_DIAG_LIMIT
443            do io=1,iomax
444              AP(io,jp) = dbiomassdt(io,jp)
445            enddo
446    #endif
447  c  c
448          dbiomassdt(iChlo,jp) = dchloro(jp)          dbiomassdt(iChlo,jp) = dchloro(jp)
449  c  c
# Line 467  c Line 454  c
454  c  c
455  c grazing uptake  c grazing uptake
456          do io=1,iomax          do io=1,iomax
457    #ifdef QUOTA_DIAG_LIMIT
458              HP(io,jp) = 0.0 _d 0
459    #endif
460            if (io.ne.iSili.and.io.ne.iChlo) then ! don't take up silicate or chlorophyll            if (io.ne.iSili.and.io.ne.iChlo) then ! don't take up silicate or chlorophyll
461  c           Grazing uptake of everything but silicate and chlorophyll  c           Grazing uptake of everything but silicate and chlorophyll
462              do jprey=1,npmax              do jprey=1,npmax
463                dbiomassdt(io,jp) = dbiomassdt(io,jp)                dbiomassdt(io,jp) = dbiomassdt(io,jp)
464       &                          + biomass(iCarb,jp)   ! carbon biomass of predator       &                          + biomass(iCarb,jp)   ! carbon biomass of predator
465       &                          * grazing(io,jp,jprey)! * carbon specific rate       &                          * grazing(io,jp,jprey)! * carbon specific rate
466       &                          * assim_graz(jp,jprey) * qreg(io,jp)       &                          * assim_graz(jp,jprey) * q_reg(io,jp)
467    #ifdef QUOTA_DIAG_LIMIT
468                  HP(io,jp)         = HP(io,jp)
469         &                          + biomass(iCarb,jp)   ! carbon biomass of predator
470         &                          * grazing(io,jp,jprey)! * carbon specific rate
471         &                          * assim_graz(jp,jprey) * q_reg(io,jp)
472    #endif
473              enddo ! jprey              enddo ! jprey
474  c           Exudation of elemental reservoirs  c           Exudation of elemental reservoirs
475              if (io.eq.iCarb.or.io.eq.iNitr.or.io.eq.iPhos) then              if (io.ne.iChl.or.io.ne.iSili) then
476                dbiomassdt(io,jp) = dbiomassdt(io,jp)                dbiomassdt(io,jp) = dbiomassdt(io,jp)
477       &                          - kexc(io,jp) * biomass(io,jp)       &                          - kexc(io,jp) * biomass(io,jp)
478              endif              endif
# Line 484  c           Exudation of elemental reser Line 480  c           Exudation of elemental reser
480  !  !
481  ! calculate temperature adjusted mortality rates  ! calculate temperature adjusted mortality rates
482            m_ref(jp) = kmort(jp) !* activ_Tempfunction            m_ref(jp) = kmort(jp) !* activ_Tempfunction
483    #ifdef ALLOWPFT
484            ! Z mortality is t dependent - a la Moore 2002            ! Z mortality is t dependent - a la Moore 2002
485            if (pft(jp).eq.6) then            if (pft(jp).eq.6) then
486              m_ref(jp) = kmort(jp) * activ_Tempfunction              m_ref(jp) = kmort(jp) * activ_Tempfunction
487            endif            endif
488    #endif
489  !  !
490  ! Loss and sinking terms - include silicate and chlorophyll  ! Loss and sinking terms - include silicate and chlorophyll
491              dbiomassdt(io,jp) = dbiomassdt(io,jp)              dbiomassdt(io,jp) = dbiomassdt(io,jp)
# Line 590  c organic matter Line 588  c organic matter
588            dorgmatdt(io,2) = dorgmatdt(io,2)            dorgmatdt(io,2) = dorgmatdt(io,2)
589       &                    + biomass(io,jp)       &                    + biomass(io,jp)
590       &                    * m_ref(jp)       &                    * m_ref(jp)
591       &                    * (1. _d 0 - beta_mort(io,jp))       &                    *(1. _d 0-beta_mort(io,jp))
592            do jprey=1,npmax            do jprey=1,npmax
593  !           unassimilated grazing  !           unassimilated grazing
594              dorgmatdt(io,1) = dorgmatdt(io,1)              dorgmatdt(io,1) = dorgmatdt(io,1)
595       &                      + biomass(iCarb,jp)       &                      + biomass(iCarb,jp)
596       &                      * grazing(io,jp,jprey)       &                      * grazing(io,jp,jprey)
597       &                      * (1. _d 0-assim_graz(jp,jprey)*qreg(io,jp))       &                      *(1. _d 0-assim_graz(jp,jprey)*q_reg(io,jp))
598       &                      * beta_graz(io,jprey)       &                      * beta_graz(io,jprey)
599              dorgmatdt(io,2) = dorgmatdt(io,2)              dorgmatdt(io,2) = dorgmatdt(io,2)
600       &                      + biomass(iCarb,jp)       &                      + biomass(iCarb,jp)
601       &                      * grazing(io,jp,jprey)       &                      * grazing(io,jp,jprey)
602       &                      * (1. _d 0-assim_graz(jp,jprey)*qreg(io,jp))       &                      *(1. _d 0-assim_graz(jp,jprey)*q_reg(io,jp))
603       &                      * (1. _d 0 - beta_graz(io,jprey))       &                      *(1. _d 0-beta_graz(io,jprey))
604            enddo ! jprey            enddo ! jprey
605          enddo ! jp          enddo ! jp
606  !       remineralisation of organic matter  !       remineralisation of organic matter

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.22