/[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.1 by jahn, Wed Apr 13 18:56:26 2011 UTC revision 1.2 by benw, Mon Jul 2 09:47:43 2012 UTC
# Line 64  c light variables Line 64  c light variables
64        _RL atten,lite        _RL atten,lite
65        _RL newtime     ! for sub-timestepping        _RL newtime     ! for sub-timestepping
66        _RL runtim      ! time from tracer initialization        _RL runtim      ! time from tracer initialization
67    c
68  #ifdef DAR_DIAG_DIVER  #ifdef ALLOW_DIAGNOSTICS
69        _RL Diver1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  COJ for diagnostics
70        _RL Diver2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL  PParr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
71        _RL Diver3(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  #endif
72        _RL Diver4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  #ifdef ALLOW_TIMEAVE
73    #ifdef QUOTA_DIAG_LIMIT
74          _RL Nlim(npmax)
75          _RL Flim(npmax)
76          _RL Ilim(npmax)
77          _RL Tlim
78    #endif
79  #endif  #endif
80  c  c
81    
# Line 88  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, ktmp        INTEGER i,j,k,it,itmp,ktmp
98        INTEGER ii,io,jp,ko, jp2, jpsave        INTEGER ii,io,jp,ko, jp2, jpsave
99        INTEGER place        INTEGER place
100        INTEGER debug        INTEGER debug
# Line 96  c local tendencies Line 102  c local tendencies
102    
103  c  c
104  c--------------------------------------------------  c--------------------------------------------------
105  c initialise vatriables  c initialise variables
106        DO j=1-OLy,sNy+OLy        DO j=1-OLy,sNy+OLy
107        DO i=1-OLx,sNx+OLx        DO i=1-OLx,sNx+OLx
108         do k=1,Nr         do k=1,Nr
# Line 104  c initialise vatriables Line 110  c initialise vatriables
110             freefe(i,j,k) = 0.0 _d 0             freefe(i,j,k) = 0.0 _d 0
111  # endif  # endif
112             PAR(i,j,k)    = 0.0 _d 0             PAR(i,j,k)    = 0.0 _d 0
113  #ifdef DAR_DIAG_DIVER  #ifdef ALLOW_DIAGNOSTICS
114             Diver1(i,j,k) = 0.0 _d 0  COJ for diagnostics
115             Diver2(i,j,k) = 0.0 _d 0             PParr(i,j,k) = 0. _d 0
            Diver3(i,j,k) = 0.0 _d 0  
            Diver4(i,j,k) = 0.0 _d 0  
116  #endif  #endif
 c  
117          enddo !k          enddo !k
118         ENDDO !i         ENDDO !i
119         ENDDO !j         ENDDO !j
# Line 203  c             ambient nutrients for each Line 206  c             ambient nutrients for each
206                dnutrient(ii) = 0. _d 0                dnutrient(ii) = 0. _d 0
207              enddo ! ii              enddo ! ii
208  c *********************************************************************  c *********************************************************************
209  c Unicellular biomass (including chlorophyll biomass)  c Unicellular biomass (including chlorophyll biomass - for non-grazers)
210              do io=1,iomax              do io=1,iomax
211                do jp=1,npmax                do jp=1,npmax
212                  place = place + 1                  if (io.ne.iChlo.or.pft(jp).ne.6) then ! no grazer chlorophyll
213                  biomass(io,jp)  = max(Ptr(i,j,k,bi,bj,place),0. _d 0)                    place = place + 1
214                      biomass(io,jp)  = max(Ptr(i,j,k,bi,bj,place),0. _d 0)
215  ! biomasses above current layer for sinking  ! biomasses above current layer for sinking
216                  if (k.eq.1) then                    if (k.eq.1) then
217                    bioabove(io,jp)=0. _d 0                      bioabove(io,jp)=0. _d 0
218                  endif                    endif
219  ! biomasses below current layer for swimming  ! biomasses below current layer for swimming
220                  if (k.eq.Nr) then                    if (k.eq.Nr) then
221                    biobelow(io,jp)=0. _d 0                     biobelow(io,jp)=0. _d 0
222                  elseif (hFacC(i,j,k+1,bi,bj).eq.0. _d 0) then                    elseif (hFacC(i,j,k+1,bi,bj).eq.0. _d 0) then
223                    biobelow(io,jp)=0. _d 0                     biobelow(io,jp)=0. _d 0
224                  else                    else
225                    biobelow(io,jp)=max(Ptr(i,j,k+1,bi,bj,place),0. _d 0)                     biobelow(io,jp)=max(Ptr(i,j,k+1,bi,bj,place),0. _d 0)
226                  endif                    endif
227  ! initialise biomass rate of change  ! initialise biomass rate of change
228                  dbiomass(io,jp) = 0. _d 0                    dbiomass(io,jp) = 0. _d 0
229                    else ! if grazer, fill chl biomass with zeros
230                      biomass(io,jp)  = 0. _d 0
231                    endif
232                enddo ! jp                enddo ! jp
233              enddo              enddo
234  c *********************************************************************  c *********************************************************************
# Line 315  c -------------------------------------- Line 322  c --------------------------------------
322  #ifdef FQUOTA  #ifdef FQUOTA
323       I                       freefu, inputFel,       I                       freefu, inputFel,
324  #endif  #endif
325    #ifdef ALLOW_TIMEAVE
326    #ifdef QUOTA_DIAG_LIMIT
327         O                       Nlim, Flim, Ilim, Tlim,
328    #endif
329    #endif
330       I                       PARlocal, Tlocal, Slocal,       I                       PARlocal, Tlocal, Slocal,
331       I                       bottom, surface, dzlocal,       I                       bottom, surface, dzlocal,
332       O                       dbiomass, dorgmat, dnutrient,       O                       dbiomass, dorgmat, dnutrient,
# Line 322  c -------------------------------------- Line 334  c --------------------------------------
334       I                       runtim,       I                       runtim,
335       I                       MyThid)       I                       MyThid)
336  c ---------------------------------------------------------------------  c ---------------------------------------------------------------------
337    #ifdef FQUOTA
338    #ifdef IRON_SED_SOURCE
339    c only above minimum depth (continental shelf)
340                 if (rF(k).lt.depthfesed) then
341    c only if bottom layer
342                   if (HFacC(i,j,k+1,bi,bj).eq.0. _d 0) then
343    #ifdef IRON_SED_SOURCE_VARIABLE
344    c calculate sink of POC into bottom layer
345                    tmp=orgsink(2)*orgabove(iCarb,2)/dzlocal
346    c convert to dPOCl
347                    dnutrient(iFeT) = dnutrient(iFeT)
348         &                          + fesedflux_pcm*tmp
349    #else
350                    dnutrient(iFeT) = dnutrient(iFeT)
351         &                          + fesedflux/(drF(k)*hFacC(i,j,k,bi,bj))
352    #endif
353                   endif
354                 endif
355    #endif
356    #endif
357    c ---------------------------------------------------------------------
358  c save un-updated biomass as layer above  c save un-updated biomass as layer above
359              do io=1,iomax              do io=1,iomax
360                do jp=1,npmax                do jp=1,npmax
# Line 350  cccccccccccccccccccccccccccccccccccccccc Line 383  cccccccccccccccccccccccccccccccccccccccc
383  c Biomass  c Biomass
384              do io=1,iomax              do io=1,iomax
385                do jp=1,npmax                do jp=1,npmax
386                  place = place + 1                  if (io.ne.iChlo.or.pft(jp).ne.6) then ! if not a grazer
387                  Ptr(i,j,k,bi,bj,place) = Ptr(i,j,k,bi,bj,place)                    place = place + 1
388       &                                 + dtplankton*dbiomass(io,jp)                    Ptr(i,j,k,bi,bj,place) = Ptr(i,j,k,bi,bj,place)
389                  if (pft(jp).eq.6.and.io.eq.iChlo) then       &                                   + dtplankton*dbiomass(io,jp)
390                    Ptr(i,j,k,bi,bj,place) = 0. _d 0                    if (pft(jp).eq.6.and.io.eq.iChlo) then
391                        Ptr(i,j,k,bi,bj,place) = 0. _d 0
392                      endif
393                  endif                  endif
394                enddo ! jp                enddo ! jp
395              enddo ! io              enddo ! io
# Line 371  c Organic matter Line 406  c Organic matter
406              enddo ! io              enddo ! io
407  ccccccccccccccccccccccccccccccccccccccccccccccccccccccc  ccccccccccccccccccccccccccccccccccccccccccccccccccccccc
408  c  c
409              PPave(i,j,k,bi,bj) = PPave(i,j,k,bi,bj)+  #ifdef ALLOW_DIAGNOSTICS
410       &                           PP*dtplankton  COJ for diagnostics
411              PARave(i,j,k,bi,bj) = PARave(i,j,k,bi,bj)+              PParr(i,j,k) = PP
412       &                            PARlocal * dtplankton  #endif /* ALLOW_DIAGNOSTICS */
413  c  
414  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
415                 PPave(i,j,k,bi,bj) = PPave(i,j,k,bi,bj)
416         &                          + PP * dtplankton
417                PARave(i,j,k,bi,bj) = PARave(i,j,k,bi,bj)
418         &                          + PARlocal * dtplankton
419  c  c
420  #ifdef DAR_DIAG_DIVER  #ifdef QUOTA_DIAG_LIMIT
421               Diver1ave(i,j,k,bi,bj)=Diver1ave(i,j,k,bi,bj)+              do jp=1,npmax
422       &                           Diver1(i,j,k)*dtplankton                Nlimave(i,j,k,bi,bj,jp) = Nlimave(i,j,k,bi,bj,jp)
423               Diver2ave(i,j,k,bi,bj)=Diver2ave(i,j,k,bi,bj)+       &                                + Nlim(jp) * dtplankton
424       &                           Diver2(i,j,k)*dtplankton                Flimave(i,j,k,bi,bj,jp) = Flimave(i,j,k,bi,bj,jp)
425               Diver3ave(i,j,k,bi,bj)=Diver3ave(i,j,k,bi,bj)+       &                                + Flim(jp) * dtplankton
426       &                           Diver3(i,j,k)*dtplankton                Ilimave(i,j,k,bi,bj,jp) = Ilimave(i,j,k,bi,bj,jp)
427               Diver4ave(i,j,k,bi,bj)=Diver4ave(i,j,k,bi,bj)+       &                                + Ilim(jp) * dtplankton
428       &                           Diver4(i,j,k)*dtplankton              enddo
429                Tlimave(i,j,k,bi,bj) = Tlimave(i,j,k,bi,bj)
430         &                           + Tlim * dtplankton
431  #endif  #endif
432  #endif  #endif
433            endif            endif
# Line 401  c Line 442  c
442  COJ fill diagnostics  COJ fill diagnostics
443  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
444         IF ( useDiagnostics ) THEN         IF ( useDiagnostics ) THEN
445          diagname = '        '          diagname = 'PP      '
446          do jp=1,npmax          CALL DIAGNOSTICS_FILL( PParr(1-Olx,1-Oly,1), diagname,
             WRITE(diagname,'(A8)') 'dCHL',jp,' '  
             CALL DIAGNOSTICS_FILL  
      &      (dCHLarr(1-Olx,1-Oly,1,jp),diagname,0,Nr,2,bi,bj,myThid)  
           do ii=1,iimax  
             WRITE(diagname,'(A8)') 'PP',ii,jp,' '  
             CALL DIAGNOSTICS_FILL  
      &      (PParr(1-Olx,1-Oly,1,ii,jp),diagname,0,Nr,2,bi,bj,myThid)  
           enddo  
         enddo  
 c  
         WRITE(diagname,'(A8)') 'PAR     '  
         CALL DIAGNOSTICS_FILL( PAR(1-Olx,1-Oly,1), diagname,  
      &                         0,Nr,2,bi,bj,myThid )  
 #ifdef DAR_DIAG_DIVER  
         WRITE(diagname,'(A8)') 'Diver1  '  
         CALL DIAGNOSTICS_FILL( Diver1(1-Olx,1-Oly,1), diagname,  
447       &                         0,Nr,2,bi,bj,myThid )       &                         0,Nr,2,bi,bj,myThid )
         WRITE(diagname,'(A8)') 'Diver2  '  
         CALL DIAGNOSTICS_FILL( Diver2(1-Olx,1-Oly,1), diagname,  
      &                         0,Nr,2,bi,bj,myThid )  
         WRITE(diagname,'(A8)') 'Diver3  '  
         CALL DIAGNOSTICS_FILL( Diver3(1-Olx,1-Oly,1), diagname,  
      &                         0,Nr,2,bi,bj,myThid )  
         WRITE(diagname,'(A8)') 'Diver4  '  
         CALL DIAGNOSTICS_FILL( Diver4(1-Olx,1-Oly,1), diagname,  
      &                         0,Nr,2,bi,bj,myThid )  
 #endif  
448         ENDIF         ENDIF
449  #endif  #endif
450  COJ  COJ
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22