pkg/bling/bling_main.F

95feb8c90d Jean*0001 #include "BLING_OPTIONS.h"
9f0da36f91 Jean*0002 #ifdef ALLOW_EXF
                0003 # include "EXF_OPTIONS.h"
                0004 #endif
a284455135 Matt*0005 #ifdef ALLOW_AUTODIFF
                0006 # include "AUTODIFF_OPTIONS.h"
                0007 #endif
95feb8c90d Jean*0008
                0009 CBOP
a284455135 Matt*0010       SUBROUTINE BLING_MAIN( PTR_DIC, PTR_ALK, PTR_O2,
e0f9a7ba0b Matt*0011 #ifndef USE_BLING_V1
                0012      U           PTR_NO3, PTR_PO4, PTR_FE,
                0013      U           PTR_DON, PTR_DOP,
                0014 #ifdef USE_SIBLING
                0015      U           PTR_SI,
                0016 #endif
95feb8c90d Jean*0017 #ifdef ADVECT_PHYTO
e0f9a7ba0b Matt*0018      U           PTR_PHY,
                0019 #endif
                0020 #else
                0021      U           PTR_PO4, PTR_DOP, PTR_FE,
95feb8c90d Jean*0022 #endif
e0f9a7ba0b Matt*0023      I           bi, bj, imin, imax, jmin, jmax,
                0024      I           myTime, myIter, myThid)
95feb8c90d Jean*0025
4ac06494d5 Matt*0026 C     ==================================================================
95feb8c90d Jean*0027 C     | subroutine bling_main
4ac06494d5 Matt*0028 C     | o Updates all the tracers for the effects of air-sea exchange,
95feb8c90d Jean*0029 C     |   biological production, and remineralization.
4ac06494d5 Matt*0030 C     | - The basic model includes 8 tracers
e0f9a7ba0b Matt*0031 C     | - There is an optional tracer for phytoplankton biomass
4ac06494d5 Matt*0032 C     | - River runoff is included here
                0033 C     ==================================================================
95feb8c90d Jean*0034
e0f9a7ba0b Matt*0035       IMPLICIT NONE
95feb8c90d Jean*0036
                0037 C     === Global variables ===
                0038 #include "SIZE.h"
                0039 #include "EEPARAMS.h"
                0040 #include "PARAMS.h"
                0041 #include "GRID.h"
                0042 #include "PTRACERS_SIZE.h"
                0043 #include "PTRACERS_PARAMS.h"
                0044 #ifdef ALLOW_EXF
9f0da36f91 Jean*0045 # include "EXF_INTERP_SIZE.h"
95feb8c90d Jean*0046 # include "EXF_FIELDS.h"
                0047 #endif
a284455135 Matt*0048 #include "BLING_VARS.h"
                0049 #ifdef ALLOW_AUTODIFF_TAMC
95feb8c90d Jean*0050 # include "tamc.h"
                0051 #endif
                0052
                0053 C     === Routine arguments ===
                0054 C     bi,bj         :: tile indices
                0055 C     iMin,iMax     :: computation domain: 1rst index range
                0056 C     jMin,jMax     :: computation domain: 2nd  index range
                0057 C     myTime        :: current time
                0058 C     myIter        :: current timestep
                0059 C     myThid        :: thread Id. number
                0060       INTEGER bi, bj, imin, imax, jmin, jmax
                0061       _RL     myTime
                0062       INTEGER myIter
                0063       INTEGER myThid
                0064 C     === Input ===
                0065 C     PTR_DIC       :: dissolved inorganic carbon
                0066 C     PTR_ALK       :: alkalinity
                0067 C     PTR_O2        :: oxygen concentration
                0068 C     PTR_FE        :: iron concentration
e0f9a7ba0b Matt*0069 C     PTR_PO4       :: phosphate concentration
                0070 C     PTR_NO3       :: nitrate concentration
                0071 C     PTR_DOP       :: dissolved organic phosphorus concentration
                0072 C     PTR_DON       :: dissolved organic nitrogen concentration
95feb8c90d Jean*0073 C     PTR_PHY       :: total phytoplankton biomass
                0074       _RL  PTR_DIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0075       _RL  PTR_ALK(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0076       _RL  PTR_O2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
e0f9a7ba0b Matt*0077       _RL  PTR_FE (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0078       _RL  PTR_PO4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
95feb8c90d Jean*0079       _RL  PTR_DOP(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
e0f9a7ba0b Matt*0080 #ifndef USE_BLING_V1
                0081       _RL  PTR_NO3(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0082       _RL  PTR_DON(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0083 #ifdef USE_SIBLING
                0084       _RL  PTR_SI (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0085 #endif
95feb8c90d Jean*0086 #ifdef ADVECT_PHYTO
                0087       _RL  PTR_PHY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0088 #endif
e0f9a7ba0b Matt*0089 #endif
95feb8c90d Jean*0090
                0091 C     === Local variables ===
                0092 C     i,j,k                :: loop indices
e0f9a7ba0b Matt*0093 C     G_xxx                :: tendency term for tracer xxx
95feb8c90d Jean*0094 C     surf_DIC             :: tendency of DIC due to air-sea exchange
e0f9a7ba0b Matt*0095 C     surf_Fe              :: tendency of Fe due to dust deposition
95feb8c90d Jean*0096 C     surf_O2              :: tendency of O2 due to air-sea exchange
e0f9a7ba0b Matt*0097 C     FluxO2               :: air-sea O2 flux
                0098 C     runoff_PO4           :: tendency due to river runoff
95feb8c90d Jean*0099
                0100        INTEGER i,j,k
                0101       _RL  G_DIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0102       _RL  G_ALK(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0103       _RL  G_O2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
e0f9a7ba0b Matt*0104       _RL  G_FE (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0105       _RL  G_PO4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
95feb8c90d Jean*0106       _RL  G_DOP(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0107       _RL  surf_DIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
cab777d667 Matt*0108       _RL  surf_Fe(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
e0f9a7ba0b Matt*0109       _RL  surf_O2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
cc42131cc8 Matt*0110       _RL  FluxO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
e0f9a7ba0b Matt*0111       _RL  runoff_PO4(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0112 #ifndef USE_BLING_V1
                0113       _RL  G_NO3(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0114       _RL  G_DON(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0115 #ifdef USE_SIBLING
                0116       _RL  G_SI (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0117 #endif
                0118 #endif
7c50f07931 Mart*0119 #ifdef ALLOW_AUTODIFF_TAMC
b26a461de7 Mart*0120 C     tkey :: tape key (tile dependent)
edb6656069 Mart*0121       INTEGER tkey
7c50f07931 Mart*0122 #endif
95feb8c90d Jean*0123 CEOP
                0124
                0125 c-----------------------------------------------------------
                0126 c  Initialize local variables
                0127
a284455135 Matt*0128 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0129       tkey = bi + (bj - 1)*nSx + (ikey_dynamics - 1)*nSx*nSy
a284455135 Matt*0130 #endif
e0f9a7ba0b Matt*0131       DO j=jmin,jmax
                0132        DO i=imin,imax
                0133         surf_DIC(i,j)        = 0. _d 0
                0134         surf_O2(i,j)         = 0. _d 0
                0135         surf_Fe(i,j)         = 0. _d 0
                0136         fluxO2(i,j)          = 0. _d 0
                0137         runoff_PO4(i,j)      = 0. _d 0
                0138        ENDDO
                0139       ENDDO
95feb8c90d Jean*0140       DO j=jmin,jmax
                0141        DO i=imin,imax
                0142         DO k=1,Nr
                0143          G_DIC(i,j,k)        = 0. _d 0
                0144          G_ALK(i,j,k)        = 0. _d 0
                0145          G_O2(i,j,k)         = 0. _d 0
e0f9a7ba0b Matt*0146          G_FE(i,j,k)         = 0. _d 0
                0147          G_PO4(i,j,k)        = 0. _d 0
95feb8c90d Jean*0148          G_DOP(i,j,k)        = 0. _d 0
e0f9a7ba0b Matt*0149 #ifndef USE_BLING_V1
                0150          G_NO3(i,j,k)        = 0. _d 0
                0151          G_DON(i,j,k)        = 0. _d 0
                0152 #ifdef USE_SIBLING
                0153          G_SI(i,j,k)         = 0. _d 0
                0154 #endif
                0155 #endif
95feb8c90d Jean*0156         ENDDO
                0157        ENDDO
                0158       ENDDO
e0f9a7ba0b Matt*0159
95feb8c90d Jean*0160 c-----------------------------------------------------------
                0161 c  carbon and oxygen air-sea interaction
                0162        CALL BLING_AIRSEAFLUX(
e0f9a7ba0b Matt*0163      I                       PTR_DIC, PTR_ALK, PTR_O2, PTR_PO4,
                0164 #ifdef USE_SIBLING
                0165      I                       PTR_SI,
                0166 #endif
cc42131cc8 Matt*0167      U                       surf_DIC, surf_O2, fluxO2,
95feb8c90d Jean*0168      I                       bi, bj, imin, imax, jmin, jmax,
e0f9a7ba0b Matt*0169      I                       myTime, myIter, myThid)
95feb8c90d Jean*0170
a284455135 Matt*0171 #ifdef ALLOW_AUTODIFF_TAMC
b26a461de7 Mart*0172 CADJ STORE ph(:,:,:,bi,bj), ak0(:,:,bi,bj), fugf(:,:,bi,bj)
                0173 CADJ &     = comlev1_bibj, key = tkey, kind = isbyte
a284455135 Matt*0174 #endif
95feb8c90d Jean*0175
                0176 c-----------------------------------------------------------
                0177 c  determine calcite saturation for remineralization
                0178        CALL BLING_CARBONATE_SYS(
                0179      I                         PTR_DIC, PTR_ALK, PTR_PO4,
e0f9a7ba0b Matt*0180 #ifdef USE_SIBLING
                0181      I                         PTR_SI,
                0182 #endif
95feb8c90d Jean*0183      I                         bi, bj, imin, imax, jmin, jmax,
e0f9a7ba0b Matt*0184      I                         myTime, myIter, myThid)
95feb8c90d Jean*0185
b26a461de7 Mart*0186 #ifdef ALLOW_AUTODIFF_TAMC
                0187 CADJ STORE omegaC(:,:,:,bi,bj) = comlev1_bibj, key=tkey, kind=isbyte
                0188 #endif
                0189
95feb8c90d Jean*0190 C-----------------------------------------------------------
                0191 C  biological activity
e0f9a7ba0b Matt*0192 C  call either "BLING" or "BLING + nitrogen"
                0193 #ifndef USE_BLING_V1
                0194        CALL BLING_BIO_NITROGEN(
                0195      I                 PTR_O2, PTR_FE, PTR_PO4, PTR_DOP,
                0196      I                 PTR_NO3, PTR_DON,
                0197 #ifdef USE_SIBLING
                0198      I                 PTR_SI,
                0199 #endif
95feb8c90d Jean*0200 #ifdef ADVECT_PHYTO
e0f9a7ba0b Matt*0201      I                 PTR_PHY,
95feb8c90d Jean*0202 #endif
e0f9a7ba0b Matt*0203      U                 G_DIC, G_ALK, G_O2, G_FE,
                0204      U                 G_PO4, G_DOP, G_NO3, G_DON,
12e63fa857 Jean*0205 #ifdef USE_SIBLING
                0206      U                 G_SI,
                0207 #endif
95feb8c90d Jean*0208      I                 bi, bj, imin, imax, jmin, jmax,
e0f9a7ba0b Matt*0209      I                 myTime, myIter, myThid)
                0210 #else
                0211        CALL BLING_BIO(
                0212      I                 PTR_O2, PTR_FE, PTR_PO4, PTR_DOP,
                0213      U                 G_DIC, G_ALK, G_O2, G_FE,
                0214      U                 G_PO4, G_DOP,
                0215      I                 bi, bj, imin, imax, jmin, jmax,
                0216      I                 myTime, myIter, myThid)
                0217 #endif
95feb8c90d Jean*0218
                0219 C-----------------------------------------------------------
                0220 C  Calculate river runoff source
                0221 C  Tracers are already diluted by freswater input, P-E+R
                0222 C  This accounts for tracer concentration in river runoff
7c50f07931 Mart*0223 C  no input south of 60S (it is ice melt)
95feb8c90d Jean*0224
9edc0e3a85 aver*0225 #if (defined ALLOW_EXF && defined ALLOW_RUNOFF)
e0f9a7ba0b Matt*0226        DO j=jmin,jmax
                0227         IF (YC(i,j,bi,bj).gt.-60.0) THEN
                0228          DO i=imin,imax
                0229           runoff_PO4(i,j) = river_conc_po4*runoff(i,j,bi,bj)
                0230      &                       *recip_drF(1)*recip_hFacC(i,j,1,bi,bj)
                0231          ENDDO
                0232         ENDIF
95feb8c90d Jean*0233        ENDDO
e0f9a7ba0b Matt*0234 #endif
95feb8c90d Jean*0235
                0236 C-----------------------------------------------------------
                0237 C   adding surface tendencies due to air-sea exchange
                0238 C   adding surface tendencies due to river runoff
e0f9a7ba0b Matt*0239 C   (assuming no dilution / runoff input for O2, Fe)
95feb8c90d Jean*0240 C   adding aeolian iron source
                0241
                0242          DO j=jmin,jmax
                0243           DO i=imin,imax
cab777d667 Matt*0244
e0f9a7ba0b Matt*0245                G_DIC(i,j,1) = G_DIC(i,j,1) + surf_DIC(i,j)
                0246      &                    + runoff_PO4(i,j)*CtoN*NtoP
                0247                G_ALK(i,j,1) = G_ALK(i,j,1)
                0248      &                    - runoff_PO4(i,j)*NtoP
                0249                G_O2(i,j,1)  = G_O2(i,j,1) + surf_O2(i,j)
                0250                surf_Fe(i,j) = alpfe*InputFe(i,j,bi,bj)
                0251                G_FE(i,j,1)  = G_FE(i,j,1) + surf_Fe(i,j)
                0252      &                    * recip_drF(1) * recip_hFacC(i,j,1,bi,bj)
                0253                G_PO4(i,j,1) = G_PO4(i,j,1) + runoff_PO4(i,j)
                0254                G_DOP(i,j,1) = G_DOP(i,j,1)
                0255      &                    + runoff_PO4(i,j)*river_dom_to_nut
                0256 #ifndef USE_BLING_V1
                0257                G_NO3(i,j,1) = G_NO3(i,j,1) + runoff_PO4(i,j)*NtoP
                0258                G_DON(i,j,1) = G_DON(i,j,1)
                0259      &                    + runoff_PO4(i,j)*NtoP*river_dom_to_nut
                0260
                0261 #endif
95feb8c90d Jean*0262           ENDDO
                0263          ENDDO
                0264
                0265 C-----------------------------------------------------------
                0266 C update
                0267        DO k=1,Nr
                0268          DO j=jmin,jmax
                0269           DO i=imin,imax
                0270            PTR_DIC(i,j,k)=PTR_DIC(i,j,k)+G_DIC(i,j,k)*PTRACERS_dTLev(k)
                0271            PTR_ALK(i,j,k)=PTR_ALK(i,j,k)+G_ALK(i,j,k)*PTRACERS_dTLev(k)
cab777d667 Matt*0272            PTR_O2 (i,j,k)=PTR_O2 (i,j,k)+G_O2 (i,j,k)*PTRACERS_dTLev(k)
95feb8c90d Jean*0273            PTR_FE (i,j,k)=PTR_FE (i,j,k)+G_FE (i,j,k)*PTRACERS_dTLev(k)
e0f9a7ba0b Matt*0274            PTR_PO4(i,j,k)=PTR_PO4(i,j,k)+G_PO4(i,j,k)*PTRACERS_dTLev(k)
95feb8c90d Jean*0275            PTR_DOP(i,j,k)=PTR_DOP(i,j,k)+G_DOP(i,j,k)*PTRACERS_dTLev(k)
e0f9a7ba0b Matt*0276 #ifndef USE_BLING_V1
                0277            PTR_NO3(i,j,k)=PTR_NO3(i,j,k)+G_NO3(i,j,k)*PTRACERS_dTLev(k)
                0278            PTR_DON(i,j,k)=PTR_DON(i,j,k)+G_DON(i,j,k)*PTRACERS_dTLev(k)
                0279 #ifdef USE_SIBLING
                0280            PTR_SI (i,j,k)=PTR_SI (i,j,k)+G_SI (i,j,k)*PTRACERS_dTLev(k)
                0281 #endif
                0282 #endif
95feb8c90d Jean*0283           ENDDO
                0284          ENDDO
                0285        ENDDO
                0286
                0287 C-----------------------------------------------------------
                0288 #ifdef ALLOW_DIAGNOSTICS
                0289       IF ( useDiagnostics ) THEN
                0290         CALL DIAGNOSTICS_FILL(pH      ,'BLGPH3D ',0,Nr,1,bi,bj,myThid)
                0291         CALL DIAGNOSTICS_FILL(OmegaAr ,'BLGOMAR ',0,Nr,1,bi,bj,myThid)
                0292         CALL DIAGNOSTICS_FILL(pCO2    ,'BLGPCO2 ',0,1 ,1,bi,bj,myThid)
                0293         CALL DIAGNOSTICS_FILL(fluxCO2 ,'BLGCFLX ',0,1 ,1,bi,bj,myThid)
cc42131cc8 Matt*0294         CALL DIAGNOSTICS_FILL(fluxO2  ,'BLGOFLX ',0,1 ,2,bi,bj,myThid)
e0f9a7ba0b Matt*0295         CALL DIAGNOSTICS_FILL(surf_Fe ,'BLGSURFE',0,1, 2,bi,bj,myThid)
a284455135 Matt*0296         CALL DIAGNOSTICS_FILL(apco2,'BLGapco2',0,1, 1,bi,bj,myThid)
95feb8c90d Jean*0297       ENDIF
                0298 #endif /* ALLOW_DIAGNOSTICS */
                0299
                0300        RETURN
                0301        END