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

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

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

revision 1.3 by jahn, Fri Dec 27 17:29:00 2013 UTC revision 1.4 by benw, Tue May 19 14:32:43 2015 UTC
# Line 51  c iron partitioning Line 51  c iron partitioning
51        _RL freefu        _RL freefu
52        _RL inputFel        _RL inputFel
53  #endif  #endif
54  c upstream arrays for sinking/swimming  c upstream arrays for sinking
55        _RL bioabove(iomax,npmax)        _RL bioabove(iomax,npmax)
       _RL biobelow(iomax,npmax)  
56        _RL orgabove(iomax-iChl,komax)        _RL orgabove(iomax-iChl,komax)
57  c some working variables  c some working variables
58        _RL sumpy        _RL sumpy
# Line 71  COJ for diagnostics Line 70  COJ for diagnostics
70  #endif  #endif
71  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
72  #ifdef QUOTA_DIAG_LIMIT  #ifdef QUOTA_DIAG_LIMIT
73        _RL Nlim(npmax)        _RL Rlim(iomax-iChl-1,npmax)
       _RL Flim(npmax)  
74        _RL Ilim(npmax)        _RL Ilim(npmax)
75        _RL Tlim        _RL Tlim
76          _RL AP(iomax,npmax)
77          _RL HP(iomax,npmax)
78  #endif  #endif
79  #endif  #endif
80  c  c
# Line 94  c local tendencies Line 94  c local tendencies
94    
95        INTEGER bottom        INTEGER bottom
96        INTEGER surface        INTEGER surface
97        INTEGER i,j,k,it,itmp,ktmp        INTEGER i,j,k,it,ktmp
98        INTEGER ii,io,jp,ko, jp2, jpsave        INTEGER ii,io,jp,ko
99        INTEGER place        INTEGER place
100        INTEGER debug        INTEGER debug
101    #ifdef ALLOW_DIAGNOSTICS
102        CHARACTER*8 diagname        CHARACTER*8 diagname
103    #endif
104    
105  c  c
106  c--------------------------------------------------  c--------------------------------------------------
# Line 209  c ************************************** Line 211  c **************************************
211  c Unicellular biomass (including chlorophyll biomass - for non-grazers)  c Unicellular biomass (including chlorophyll biomass - for non-grazers)
212              do io=1,iomax              do io=1,iomax
213                do jp=1,npmax                do jp=1,npmax
214                  if (io.ne.iChlo.or.pft(jp).ne.6) then ! no grazer chlorophyll                  if (io.ne.iChlo.or.autotrophy(jp).gt.0. _d 0) then ! no grazer chlorophyll
215                    place = place + 1                    place = place + 1
216                    biomass(io,jp)  = max(Ptr(i,j,k,bi,bj,place),0. _d 0)                    biomass(io,jp)  = max(Ptr(i,j,k,bi,bj,place),0. _d 0)
217  ! biomasses above current layer for sinking  ! biomasses above current layer for sinking
218                    if (k.eq.1) then                    if (k.eq.1) then
219                      bioabove(io,jp)=0. _d 0                      bioabove(io,jp)=0. _d 0
220                    endif                    endif
 ! biomasses below current layer for swimming  
                   if (k.eq.Nr) then  
                    biobelow(io,jp)=0. _d 0  
                   elseif (hFacC(i,j,k+1,bi,bj).eq.0. _d 0) then  
                    biobelow(io,jp)=0. _d 0  
                   else  
                    biobelow(io,jp)=max(Ptr(i,j,k+1,bi,bj,place),0. _d 0)  
                   endif  
221  ! initialise biomass rate of change  ! initialise biomass rate of change
222                    dbiomass(io,jp) = 0. _d 0                    dbiomass(io,jp) = 0. _d 0
223                  else ! if grazer, fill chl biomass with zeros                  else ! if grazer, fill chl biomass with zeros
# Line 317  c -------------------------------------- Line 311  c --------------------------------------
311              CALL QUOTA_PLANKTON(              CALL QUOTA_PLANKTON(
312       I                       biomass, orgmat, nutrient,       I                       biomass, orgmat, nutrient,
313       O                       PP,       O                       PP,
314       I                       bioabove, biobelow,       I                       bioabove,
315       I                       orgabove,       I                       orgabove,
316  #ifdef FQUOTA  #ifdef FQUOTA
317       I                       freefu, inputFel,       I                       freefu, inputFel,
318  #endif  #endif
319  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
320  #ifdef QUOTA_DIAG_LIMIT  #ifdef QUOTA_DIAG_LIMIT
321       O                       Nlim, Flim, Ilim, Tlim,       O                       AP, HP,
322         O                       Rlim, Ilim, Tlim,
323  #endif  #endif
324  #endif  #endif
325       I                       PARlocal, Tlocal, Slocal,       I                       PARlocal, Tlocal, Slocal,
# Line 334  c -------------------------------------- Line 329  c --------------------------------------
329       I                       runtim,       I                       runtim,
330       I                       MyThid)       I                       MyThid)
331  c ---------------------------------------------------------------------  c ---------------------------------------------------------------------
332    c
333    #ifdef RELAX_NUTS
334                if (darwin_relaxscale.gt.0. _d 0) then
335    !
336                 IF ( darwin_NO3_relaxFile .NE. ' '  ) THEN
337                  tmp=(Ptr(i,j,k,bi,bj,iNO3 )-no3_obs(i,j,k,bi,bj))
338                  if (tmp.lt.0. _d 0) then
339                    dnutrient(iNO3)=dnutrient(iNO3)
340         &                      -(tmp/darwin_relaxscale)
341                  endif
342                 ENDIF
343    #ifdef PQUOTA
344                 IF ( darwin_PO4_relaxFile .NE. ' '  ) THEN
345                  tmp=(Ptr(i,j,k,bi,bj,iPO4 )-po4_obs(i,j,k,bi,bj))
346                  if (tmp.lt.0. _d 0) then
347                    dnutrient(iPO4)=dnutrient(iPO4)
348         &                      -(tmp/darwin_relaxscale)
349                  endif
350                 ENDIF
351    #endif
352    #ifdef FQOUTA
353                 IF ( darwin_Fet_relaxFile .NE. ' '  ) THEN
354                  tmp=(Ptr(i,j,k,bi,bj,iFeT )-fet_obs(i,j,k,bi,bj))
355                  if (tmp.lt.0. _d 0) then
356                    dnutrient(iFeT)=dnutrient(iFeT)
357         &                      -(tmp/darwin_relaxscale)
358                  endif
359                 ENDIF
360    #endif
361    #ifdef SQUOTA
362                 IF ( darwin_Si_relaxFile .NE. ' '  ) THEN
363                  tmp=( Ptr(i,j,k,bi,bj,iSi  )-si_obs(i,j,k,bi,bj))
364                  if (tmp.lt.0. _d 0) then
365                    dnutrient(iSi)=dnutrient(iSi)
366         &                    -(tmp/darwin_relaxscale)
367                  endif
368                 ENDIF
369    #endif
370                endif
371    #endif
372    c
373  #ifdef FQUOTA  #ifdef FQUOTA
374  #ifdef IRON_SED_SOURCE  #ifdef IRON_SED_SOURCE
375  c only above minimum depth (continental shelf)  c only above minimum depth (continental shelf)
# Line 383  cccccccccccccccccccccccccccccccccccccccc Line 419  cccccccccccccccccccccccccccccccccccccccc
419  c Biomass  c Biomass
420              do io=1,iomax              do io=1,iomax
421                do jp=1,npmax                do jp=1,npmax
422                  if (io.ne.iChlo.or.pft(jp).ne.6) then ! if not a grazer                  if (io.ne.iChlo.or.autotrophy(jp).gt.0. _d 0) then ! if not a grazer
423                    place = place + 1                    place = place + 1
424                    Ptr(i,j,k,bi,bj,place) = Ptr(i,j,k,bi,bj,place)                    Ptr(i,j,k,bi,bj,place) = Ptr(i,j,k,bi,bj,place)
425       &                                   + dtplankton*dbiomass(io,jp)       &                                   + dtplankton*dbiomass(io,jp)
                   if (pft(jp).eq.6.and.io.eq.iChlo) then  
                     Ptr(i,j,k,bi,bj,place) = 0. _d 0  
                   endif  
426                  endif                  endif
427                enddo ! jp                enddo ! jp
428              enddo ! io              enddo ! io
# Line 419  COJ for diagnostics Line 452  COJ for diagnostics
452  c  c
453  #ifdef QUOTA_DIAG_LIMIT  #ifdef QUOTA_DIAG_LIMIT
454              do jp=1,npmax              do jp=1,npmax
455    ! carbon
456                  AP_C_ave(i,j,k,bi,bj,jp) = AP_C_ave(i,j,k,bi,bj,jp)
457         &                                 + AP(iCarb,jp) * dtplankton
458                  HP_C_ave(i,j,k,bi,bj,jp) = HP_C_ave(i,j,k,bi,bj,jp)
459         &                                 + HP(iCarb,jp) * dtplankton
460    ! nitrogen
461                  AP_N_ave(i,j,k,bi,bj,jp) = AP_N_ave(i,j,k,bi,bj,jp)
462         &                                 + AP(iNitr,jp) * dtplankton
463                  HP_N_ave(i,j,k,bi,bj,jp) = HP_N_ave(i,j,k,bi,bj,jp)
464         &                                 + HP(iNitr,jp) * dtplankton
465                Nlimave(i,j,k,bi,bj,jp) = Nlimave(i,j,k,bi,bj,jp)                Nlimave(i,j,k,bi,bj,jp) = Nlimave(i,j,k,bi,bj,jp)
466       &                                + Nlim(jp) * dtplankton       &                                + Rlim(iNitr-1,jp) * dtplankton
467    ! phosphorus
468    #ifdef PQUOTA
469                  AP_P_ave(i,j,k,bi,bj,jp) = AP_P_ave(i,j,k,bi,bj,jp)
470         &                                 + AP(iPhos,jp) * dtplankton
471                  HP_P_ave(i,j,k,bi,bj,jp) = HP_P_ave(i,j,k,bi,bj,jp)
472         &                                 + HP(iPhos,jp) * dtplankton
473                  Plimave(i,j,k,bi,bj,jp) = Plimave(i,j,k,bi,bj,jp)
474         &                                + Rlim(iPhos-1,jp) * dtplankton
475    #endif
476    ! iron
477    #ifdef FQUOTA
478                  AP_F_ave(i,j,k,bi,bj,jp) = AP_F_ave(i,j,k,bi,bj,jp)
479         &                                 + AP(iIron,jp) * dtplankton
480                  HP_F_ave(i,j,k,bi,bj,jp) = HP_F_ave(i,j,k,bi,bj,jp)
481         &                                 + HP(iIron,jp) * dtplankton
482                Flimave(i,j,k,bi,bj,jp) = Flimave(i,j,k,bi,bj,jp)                Flimave(i,j,k,bi,bj,jp) = Flimave(i,j,k,bi,bj,jp)
483       &                                + Flim(jp) * dtplankton       &                                + Rlim(iIron-1,jp) * dtplankton
484    #endif
485    ! light
486                Ilimave(i,j,k,bi,bj,jp) = Ilimave(i,j,k,bi,bj,jp)                Ilimave(i,j,k,bi,bj,jp) = Ilimave(i,j,k,bi,bj,jp)
487       &                                + Ilim(jp) * dtplankton       &                                + Ilim(jp) * dtplankton
488              enddo              enddo
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22