#include "DIC_OPTIONS.h"
#include "GCHEM_OPTIONS.h"
CBOP
C !ROUTINE: PHOS_FLUX
C !INTERFACE: ==========================================================
SUBROUTINE PHOS_FLUX( bioac, pflux,
I bi,bj,imin,imax,jmin,jmax,
I myIter,myTime,myThid)
C !DESCRIPTION:
C Calculate the PO4 flux to depth from bio activity
C !USES: ===============================================================
IMPLICIT NONE
#include "SIZE.h"
#include "DYNVARS.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DIC_BIOTIC.h"
C !INPUT PARAMETERS: ===================================================
C myThid :: thread number
C myIter :: current timestep
C myTime :: current time
C bioac :: biological productivity
INTEGER myIter
_RL myTime
INTEGER myThid
_RL bioac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
C !OUTPUT PARAMETERS: ===================================================
C pflux :: changes to PO4 due to flux and reminerlization
_RL pflux(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
INTEGER imin, imax, jmin, jmax, bi, bj
#ifdef ALLOW_PTRACERS
#ifdef DIC_BIOTIC
C !LOCAL VARIABLES: ====================================================
C i,j,k :: loop indices
c ko :: loop-within-loop index
c bexport :: flux of phosphurous from base each "productive"
c layer
c depth_u, depth_l :: depths of upper and lower interfaces
c flux_u, flux_l :: flux through upper and lower interfaces
c zbase :: depth of bottom of current productive layer
_RL zbase
_RL bexport(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER I,J,k, ko
_RL depth_u, depth_l
_RL flux_u, flux_l
CEOP
c
c calculate PO4 flux from base of each layer
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
DO k=1,nlev
if (hFacC(i,j,k,bi,bj).gt.0.d0) then
c flux out of layer k
bexport(i,j)=bioac(i,j,k)*(1.0-DOPfraction)*
& drF(k)*hFacC(i,j,k,bi,bj)
c calculate flux to each layer from base of k
zbase=-rF(k+1)
Do ko=k+1,Nr
if (hFacC(i,j,ko,bi,bj).gt.0.d0) then
depth_u=-rF(ko)
depth_l=depth_u+
& drF(ko)*hFacC(i,j,ko,bi,bj)
c
flux_u=bexport(i,j)*((depth_u/zbase)**(-Kremin))
c no flux to ocean bottom
if (ko.eq.Nr) then
flux_l=0.d0
else
if (hFacC(i,j,ko+1,bi,bj).eq.0.d0) then
flux_l=0.d0
else
flux_l=bexport(i,j)*((depth_l/zbase)**(-Kremin))
endif
endif
pflux(i,j,ko)=pflux(i,j,ko) +
& ( (Flux_u-Flux_l)/(drF(ko)*hFacC(i,j,ko,bi,bj)) )
else
c if no layer below initial layer, remineralize in place
if (ko.eq.k+1) pflux(i,j,k)=pflux(i,j,k)
& +bioac(i,j,k)*(1.0-DOPfraction)
endif
ENDDO
endif
ENDDO
ENDDO
ENDDO
c
#endif
#endif
RETURN
END