pkg/dic/car_flux.F

6d54cf9ca1 Ed H*0001 #include "DIC_OPTIONS.h"
daab022f42 Step*0002
08536d17ba Step*0003 CBOP
                0004 C !ROUTINE: CAR_FLUX
                0005
                0006 C !INTERFACE: ==========================================================
e18333c42b Davi*0007       SUBROUTINE CAR_FLUX( CAR_S, cflux,
daab022f42 Step*0008      I           bi,bj,imin,imax,jmin,jmax,
2e3e8c330d Jona*0009      I           myTime, myIter, myThid )
daab022f42 Step*0010
08536d17ba Step*0011 C !DESCRIPTION:
ac331e4517 Davi*0012 C Calculate carbonate fluxes
daab022f42 Step*0013
08536d17ba Step*0014 C !USES: ===============================================================
                0015       IMPLICIT NONE
daab022f42 Step*0016 #include "SIZE.h"
                0017 #include "DYNVARS.h"
                0018 #include "EEPARAMS.h"
                0019 #include "PARAMS.h"
                0020 #include "GRID.h"
2ef8966791 Davi*0021 #include "DIC_VARS.h"
daab022f42 Step*0022
08536d17ba Step*0023 C !INPUT PARAMETERS: ===================================================
e18333c42b Davi*0024 C  CAR_S                :: carbonate source
2e3e8c330d Jona*0025 C  myTime               :: current time
                0026 C  myIter               :: current timestep
                0027 C  myThid               :: thread number
e18333c42b Davi*0028       _RL  CAR_S(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
ac331e4517 Davi*0029       INTEGER imin, imax, jmin, jmax, bi, bj
2e3e8c330d Jona*0030       _RL myTime
                0031       INTEGER myIter
                0032       INTEGER myThid
daab022f42 Step*0033
08536d17ba Step*0034 C !OUTPUT PARAMETERS: ===================================================
ac331e4517 Davi*0035 C  cflux                :: carbonate flux
                0036       _RL cflux(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
08536d17ba Step*0037
c2a4adfccc Mart*0038 #if (defined ALLOW_PTRACERS && defined DIC_BIOTIC)
08536d17ba Step*0039
                0040 C !LOCAL VARIABLES: ====================================================
                0041 C  i,j,k                  :: loop indices
                0042 c  ko                     :: loop-within-loop index
ac331e4517 Davi*0043 c  caexport               :: flux of carbonate from base each "productive"
08536d17ba Step*0044 c                            layer
c2a4adfccc Mart*0045 c  depth_l                :: depth and lower interface
ac331e4517 Davi*0046 c  flux_u, flux_l         :: flux through upper and lower interfaces
2c1f2f5f32 Mart*0047 c  reminFac               :: abbreviation
ac331e4517 Davi*0048 c  zbase                  :: depth of bottom of current productive layer
2e3e8c330d Jona*0049       INTEGER i,j,k, ko, kop1
c2a4adfccc Mart*0050       _RL zbase
                0051       _RL caexport(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
2c1f2f5f32 Mart*0052       _RL reminFac
c2a4adfccc Mart*0053       _RL depth_l
                0054       _RL flux_u  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0055       _RL flux_l
08536d17ba Step*0056 CEOP
                0057
ac331e4517 Davi*0058 C- Calculate carbonate flux from base of each layer
c2a4adfccc Mart*0059       DO k=1,nlev
51c3bf0077 Step*0060        DO j=jmin,jmax
                0061         DO i=imin,imax
c2a4adfccc Mart*0062          caexport(i,j) = 0. _d 0
                0063          IF (hFacC(i,j,k,bi,bj).GT.0. _d 0) THEN
                0064 C--   If no layer below initial layer (because of bottom or
                0065 C--   topography), then remineralize in here
                0066           IF (k.EQ.Nr) THEN
2e3e8c330d Jona*0067            cflux(i,j,k)=cflux(i,j,k) + CAR_S(i,j,k)
22bb60bade Mart*0068           ELSEIF ( _hFacC(i,j,k+1,bi,bj).EQ.0. _d 0 ) THEN
2e3e8c330d Jona*0069            cflux(i,j,k)=cflux(i,j,k) + CAR_S(i,j,k)
c2a4adfccc Mart*0070           ELSE
ac331e4517 Davi*0071 C- flux out of layer k
2e3e8c330d Jona*0072            caexport(i,j) = CAR_S(i,j,k)*drF(k) * _hFacC(i,j,k,bi,bj)
c2a4adfccc Mart*0073           ENDIF
                0074          ENDIF
                0075         ENDDO
                0076        ENDDO
                0077 C--   If availabe, flux carbon export downward;
                0078 C--   calculate flux to each layer from base of k
                0079        zbase=-rF(k+1)
                0080 C--   Upper flux
                0081        DO j=jmin,jmax
                0082         DO i=imin,imax
                0083          flux_u(i,j)  = caexport(i,j)
                0084         ENDDO
                0085        ENDDO
22bb60bade Mart*0086 C     Instead of running the loop to ko=Nr and masking the last
                0087 C     flux_l, let ko reach only Nr-1 and do a special loop for ko=Nr,
                0088 C     in order to save a few expensive exp-function calls
                0089        DO ko=k+1,Nr-1
c2a4adfccc Mart*0090         kop1   = MIN(Nr,ko+1)
05f9b34a51 Mart*0091 #ifndef NONLIN_FRSURF
2c1f2f5f32 Mart*0092 C     For the linear free surface, hFacC can be omitted, buying another
                0093 C     performance increase of a factor of six on a vector computer.
2e3e8c330d Jona*0094 C     For now this is not implemented via run time flags, in order to
2c1f2f5f32 Mart*0095 C     avoid making this code too complicated.
                0096         depth_l  = -rF(ko) + drF(ko)
                0097         reminFac = exp(-(depth_l-zbase)/zca)
05f9b34a51 Mart*0098 #endif /* NONLIN_FRSURF */
c2a4adfccc Mart*0099         DO j=jmin,jmax
                0100          DO i=imin,imax
                0101           IF ( caexport(i,j) .NE. 0. _d 0 ) THEN
                0102 C--   Lower flux (no flux to ocean bottom)
05f9b34a51 Mart*0103 #ifdef NONLIN_FRSURF
2c1f2f5f32 Mart*0104            depth_l  = -rF(ko) + drF(ko) * _hFacC(i,j,ko,bi,bj)
                0105            reminFac = exp(-(depth_l-zbase)/zca)
05f9b34a51 Mart*0106 #endif /* NONLIN_FRSURF */
2c1f2f5f32 Mart*0107            flux_l   = caexport(i,j)*reminFac
22bb60bade Mart*0108      &          *maskC(i,j,kop1,bi,bj)
2e3e8c330d Jona*0109 C
c2a4adfccc Mart*0110            cflux(i,j,ko)=cflux(i,j,ko) + (flux_u(i,j)-flux_l)
22bb60bade Mart*0111      &          *recip_drF(ko) * _recip_hFacC(i,j,ko,bi,bj)
c2a4adfccc Mart*0112 C--   Store flux through upper layer for the next k-level
                0113            flux_u(i,j)  = flux_l
                0114 C     endif carexport .ne. 0
ac331e4517 Davi*0115           ENDIF
c2a4adfccc Mart*0116 C     i,j-loops
daab022f42 Step*0117          ENDDO
951926fb9b Jean*0118         ENDDO
c2a4adfccc Mart*0119 C     ko-loop
daab022f42 Step*0120        ENDDO
22bb60bade Mart*0121 C     now do ko = Nr
                0122        ko = Nr
                0123        flux_l = 0. _d 0
                0124        DO j=jmin,jmax
                0125         DO i=imin,imax
                0126          cflux(i,j,ko)=cflux(i,j,ko) + (flux_u(i,j)-flux_l)
                0127      &        *recip_drF(ko) * _recip_hFacC(i,j,ko,bi,bj)
                0128         ENDDO
                0129        ENDDO
c2a4adfccc Mart*0130 C     k-loop
                0131       ENDDO
daab022f42 Step*0132 c
c2a4adfccc Mart*0133 #endif /* defined ALLOW_PTRACERS && defined DIC_BIOTIC */
                0134       RETURN
                0135       END