| 1 | 
C $Header:  $ | 
| 2 | 
C $Name:  $ | 
| 3 | 
 | 
| 4 | 
#include "BLING_OPTIONS.h" | 
| 5 | 
#include "PTRACERS_OPTIONS.h" | 
| 6 | 
 | 
| 7 | 
CBOP | 
| 8 | 
      subroutine BLING_AIRSEAFLUX(  | 
| 9 | 
     I           PTR_DIC, PTR_ALK, PTR_NUT, PTR_O2,  | 
| 10 | 
     O           SGDIC, SGO2,  | 
| 11 | 
     I           bi, bj, imin, imax, jmin, jmax, | 
| 12 | 
     I           myIter, myTime, myThid) | 
| 13 | 
 | 
| 14 | 
C     ================================================================= | 
| 15 | 
C     | subroutine bling_airseaflux | 
| 16 | 
C     | o Calculate the carbon and oxygen air-sea flux terms | 
| 17 | 
C     |   Adapted from pkg/dic/ | 
| 18 | 
C     | - Get atmospheric pCO2 value | 
| 19 | 
C     |   Option 1: constant value, default 268.d-6, can be changed in  | 
| 20 | 
C     |             data.bling | 
| 21 | 
C     |   Option 2: read 2D field using EXF pkg | 
| 22 | 
C     ================================================================= | 
| 23 | 
 | 
| 24 | 
      implicit none | 
| 25 | 
       | 
| 26 | 
C     === Global variables === | 
| 27 | 
#include "SIZE.h" | 
| 28 | 
#include "DYNVARS.h" | 
| 29 | 
#include "EEPARAMS.h" | 
| 30 | 
#include "PARAMS.h" | 
| 31 | 
#include "GRID.h" | 
| 32 | 
#include "FFIELDS.h" | 
| 33 | 
#include "BLING_VARS.h" | 
| 34 | 
#ifdef ALLOW_EXF | 
| 35 | 
# include "EXF_FIELDS.h" | 
| 36 | 
#endif | 
| 37 | 
#ifdef ALLOW_AUTODIFF_TAMC | 
| 38 | 
# include "tamc.h" | 
| 39 | 
#endif | 
| 40 | 
 | 
| 41 | 
C     === Routine arguments === | 
| 42 | 
C     myTime           :: current time | 
| 43 | 
C     myIter           :: current timestep | 
| 44 | 
C     myThid           :: thread Id. number | 
| 45 | 
      _RL myTime | 
| 46 | 
      INTEGER myIter | 
| 47 | 
      INTEGER myThid | 
| 48 | 
      INTEGER iMin, iMax, jMin, jMax, bi, bj | 
| 49 | 
C     === Input === | 
| 50 | 
C     PTR_DIC          :: DIC tracer field | 
| 51 | 
C     PTR_ALK          :: alkalinity tracer field | 
| 52 | 
C     PTR_NUT          :: macro-nutrient tracer field | 
| 53 | 
C     PTR_O2           :: oxygen tracer field | 
| 54 | 
      _RL  PTR_DIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) | 
| 55 | 
      _RL  PTR_ALK(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) | 
| 56 | 
      _RL  PTR_NUT(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) | 
| 57 | 
      _RL  PTR_O2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) | 
| 58 | 
C     === Output === | 
| 59 | 
C     SGDIC            :: tendency of DIC due to air-sea exchange  | 
| 60 | 
C     SGO2             :: tendency od O2 due to air-sea exchange  | 
| 61 | 
      _RL  SGDIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 62 | 
      _RL  SGO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 63 | 
 | 
| 64 | 
 | 
| 65 | 
#ifdef ALLOW_PTRACERS | 
| 66 | 
 | 
| 67 | 
C     === Local variables === | 
| 68 | 
C     i,j              :: Loop counters | 
| 69 | 
      INTEGER i,j,klev | 
| 70 | 
C Number of iterations for pCO2 solvers | 
| 71 | 
      _RL co3dummy | 
| 72 | 
      _RL Kwexch_Pre  (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 73 | 
C Solubility relation coefficients | 
| 74 | 
      _RL SchmidtNoDIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 75 | 
      _RL pCO2sat     (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 76 | 
      _RL Kwexch      (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 77 | 
      _RL pisvel      (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 78 | 
C local variables for carbon chem | 
| 79 | 
      _RL surfalk     (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 80 | 
      _RL surfphos    (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 81 | 
      _RL surfsi      (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 82 | 
      _RL surftemp    (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 83 | 
      _RL surfsalt    (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 84 | 
      _RL surfdic     (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 85 | 
C o2 solubility relation coefficients | 
| 86 | 
      _RL SchmidtNoO2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 87 | 
      _RL O2sat       (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 88 | 
      _RL Kwexch_o2   (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 89 | 
      _RL FluxO2      (1-OLx:sNx+OLx,1-OLy:sNy+OLy) | 
| 90 | 
      _RL aTT | 
| 91 | 
      _RL aTK | 
| 92 | 
      _RL aTS | 
| 93 | 
      _RL aTS2 | 
| 94 | 
      _RL aTS3 | 
| 95 | 
      _RL aTS4 | 
| 96 | 
      _RL aTS5 | 
| 97 | 
      _RL o2s | 
| 98 | 
      _RL ttemp | 
| 99 | 
      _RL stemp | 
| 100 | 
      _RL oCnew | 
| 101 | 
CEOP | 
| 102 | 
 | 
| 103 | 
C---------------------------------------------------------------------- | 
| 104 | 
C First, carbon | 
| 105 | 
C---------------------------------------------------------------------- | 
| 106 | 
        klev=1 | 
| 107 | 
C determine inorganic carbon chem coefficients | 
| 108 | 
        DO j=jmin,jmax | 
| 109 | 
         DO i=imin,imax | 
| 110 | 
 | 
| 111 | 
             surfalk(i,j)  = PTR_ALK(i,j,1) | 
| 112 | 
     &                          * maskC(i,j,1,bi,bj) | 
| 113 | 
             surfphos(i,j) = PTR_NUT(i,j,1)/NUTfac | 
| 114 | 
     &                          * maskC(i,j,1,bi,bj) | 
| 115 | 
 | 
| 116 | 
C FOR NON-INTERACTIVE Si | 
| 117 | 
             surfsi(i,j)   = SILICA(i,j,bi,bj) * maskC(i,j,1,bi,bj) | 
| 118 | 
             surftemp(i,j) = theta(i,j,1,bi,bj) | 
| 119 | 
             surfsalt(i,j) = salt(i,j,1,bi,bj) | 
| 120 | 
             surfdic(i,j)  = PTR_DIC(i,j,1) | 
| 121 | 
 | 
| 122 | 
          ENDDO | 
| 123 | 
         ENDDO | 
| 124 | 
 | 
| 125 | 
         CALL CARBON_COEFFS( | 
| 126 | 
     I                       surftemp,surfsalt, | 
| 127 | 
     I                       bi,bj,iMin,iMax,jMin,jMax,myThid) | 
| 128 | 
 | 
| 129 | 
       DO j=jmin,jmax | 
| 130 | 
        DO i=imin,imax | 
| 131 | 
C Compute Kwexch_Pre which is re-used for flux of O2 | 
| 132 | 
caxx Atmos pressure is assumed to be 1 atm | 
| 133 | 
 | 
| 134 | 
c   Read EXF winds instead of value from file: | 
| 135 | 
#ifdef ALLOW_EXF | 
| 136 | 
              wind(i,j,bi,bj) = wspeed(i,j,bi,bj) | 
| 137 | 
#endif | 
| 138 | 
 | 
| 139 | 
C Pre-compute part of exchange coefficient: pisvel*(1-fice) | 
| 140 | 
C Schmidt number is accounted for later | 
| 141 | 
              pisvel(i,j) = 0.337 _d 0 *wind(i,j,bi,bj)**2/3.6 _d 5 | 
| 142 | 
              Kwexch_Pre(i,j) = pisvel(i,j) | 
| 143 | 
     &                              * (1. _d 0 - FIce(i,j,bi,bj)) | 
| 144 | 
 | 
| 145 | 
        ENDDO | 
| 146 | 
       ENDDO | 
| 147 | 
 | 
| 148 | 
c pCO2 solver... | 
| 149 | 
 | 
| 150 | 
CADJ STORE ph = comlev1, key = ikey_dynamics | 
| 151 | 
 | 
| 152 | 
C$TAF LOOP = parallel | 
| 153 | 
       DO j=jmin,jmax | 
| 154 | 
C$TAF LOOP = parallel | 
| 155 | 
        DO i=imin,imax | 
| 156 | 
 | 
| 157 | 
          IF ( maskC(i,j,klev,bi,bj).NE.0. _d 0 ) THEN | 
| 158 | 
            CALL CALC_PCO2_APPROX( | 
| 159 | 
     I        surftemp(i,j),surfsalt(i,j), | 
| 160 | 
     I        surfdic(i,j), surfphos(i,j), | 
| 161 | 
     I        surfsi(i,j),surfalk(i,j), | 
| 162 | 
     I        ak1(i,j,bi,bj),ak2(i,j,bi,bj), | 
| 163 | 
     I        ak1p(i,j,bi,bj),ak2p(i,j,bi,bj),ak3p(i,j,bi,bj), | 
| 164 | 
     I        aks(i,j,bi,bj),akb(i,j,bi,bj),akw(i,j,bi,bj), | 
| 165 | 
     I        aksi(i,j,bi,bj),akf(i,j,bi,bj), | 
| 166 | 
     I        ak0(i,j,bi,bj), fugf(i,j,bi,bj), | 
| 167 | 
     I        ff(i,j,bi,bj), | 
| 168 | 
     I        bt(i,j,bi,bj),st(i,j,bi,bj),ft(i,j,bi,bj), | 
| 169 | 
     U        pH(i,j,klev,bi,bj),pCO2(i,j,bi,bj),co3dummy, | 
| 170 | 
     I        i,j,klev,bi,bj,myIter,myThid ) | 
| 171 | 
          ELSE | 
| 172 | 
            pCO2(i,j,bi,bj) = 0. _d 0 | 
| 173 | 
          ENDIF | 
| 174 | 
        ENDDO | 
| 175 | 
       ENDDO | 
| 176 | 
 | 
| 177 | 
       DO j=jmin,jmax | 
| 178 | 
        DO i=imin,imax | 
| 179 | 
 | 
| 180 | 
          IF ( maskC(i,j,1,bi,bj).NE.0. _d 0 ) THEN | 
| 181 | 
C calculate SCHMIDT NO. for CO2 | 
| 182 | 
              SchmidtNoDIC(i,j) = | 
| 183 | 
     &            sca1 | 
| 184 | 
     &          + sca2 * theta(i,j,1,bi,bj) | 
| 185 | 
     &          + sca3 * theta(i,j,1,bi,bj)*theta(i,j,1,bi,bj) | 
| 186 | 
     &          + sca4 * theta(i,j,1,bi,bj)*theta(i,j,1,bi,bj) | 
| 187 | 
     &                *theta(i,j,1,bi,bj) | 
| 188 | 
c make sure Schmidt number is not negative (will happen if temp>39C) | 
| 189 | 
             SchmidtNoDIC(i,j)=max(1.0 _d -2, SchmidtNoDIC(i,j)) | 
| 190 | 
 | 
| 191 | 
C First determine local saturation pCO2 | 
| 192 | 
#ifdef USE_EXFPCO2 | 
| 193 | 
              pCO2sat(i,j) = apco2(i,j,bi,bj)  | 
| 194 | 
#else | 
| 195 | 
              pCO2sat(i,j) = bling_pCO2 | 
| 196 | 
#endif | 
| 197 | 
 | 
| 198 | 
#ifndef BLING_ADJOINT_SAFE | 
| 199 | 
c Correct for atmospheric pressure | 
| 200 | 
              pCO2sat(i,j) = pCO2sat(i,j)*AtmosP(i,j,bi,bj) | 
| 201 | 
#endif  | 
| 202 | 
 | 
| 203 | 
C then account for Schmidt number | 
| 204 | 
              Kwexch(i,j) = Kwexch_Pre(i,j) | 
| 205 | 
     &                    / sqrt(SchmidtNoDIC(i,j)/660.0 _d 0) | 
| 206 | 
 | 
| 207 | 
C Calculate flux in terms of DIC units using K0, solubility | 
| 208 | 
c Flux = kw*rho*(ff*pCO2atm-k0*FugFac*pCO2ocean) | 
| 209 | 
               FluxCO2(i,j,bi,bj) = | 
| 210 | 
     &          Kwexch(i,j)*( | 
| 211 | 
     &            ff(i,j,bi,bj)*pCO2sat(i,j) - | 
| 212 | 
     &            pCO2(i,j,bi,bj)*fugf(i,j,bi,bj) | 
| 213 | 
     &            *ak0(i,j,bi,bj) ) | 
| 214 | 
     & | 
| 215 | 
          ELSE | 
| 216 | 
              FluxCO2(i,j,bi,bj) = 0. _d 0 | 
| 217 | 
          ENDIF | 
| 218 | 
           | 
| 219 | 
C convert flux (mol kg-1 m s-1) to (mol m-2 s-1) | 
| 220 | 
          FluxCO2(i,j,bi,bj) = FluxCO2(i,j,bi,bj)/permil | 
| 221 | 
 | 
| 222 | 
          ENDDO | 
| 223 | 
         ENDDO | 
| 224 | 
 | 
| 225 | 
C update tendency | 
| 226 | 
         DO j=jmin,jmax | 
| 227 | 
          DO i=imin,imax | 
| 228 | 
           SGDIC(i,j)= recip_drF(1)*recip_hFacC(i,j,1,bi,bj) | 
| 229 | 
     &              *FluxCO2(i,j,bi,bj) | 
| 230 | 
          ENDDO | 
| 231 | 
         ENDDO | 
| 232 | 
 | 
| 233 | 
C---------------------------------------------------------------------- | 
| 234 | 
C Now oxygen | 
| 235 | 
C---------------------------------------------------------------------- | 
| 236 | 
 | 
| 237 | 
C calculate SCHMIDT NO. for O2 | 
| 238 | 
        DO j=jmin,jmax | 
| 239 | 
          DO i=imin,imax | 
| 240 | 
            IF (maskC(i,j,1,bi,bj).NE.0.) THEN | 
| 241 | 
              ttemp = theta(i,j,1,bi,bj) | 
| 242 | 
              stemp = salt(i,j,1,bi,bj) | 
| 243 | 
 | 
| 244 | 
              SchmidtNoO2(i,j) = | 
| 245 | 
     &            sox1 | 
| 246 | 
     &          + sox2 * ttemp | 
| 247 | 
     &          + sox3 * ttemp*ttemp | 
| 248 | 
     &          + sox4 * ttemp*ttemp*ttemp | 
| 249 | 
 | 
| 250 | 
C Determine surface flux of O2 | 
| 251 | 
C exchange coeff accounting for ice cover and Schmidt no. | 
| 252 | 
C Kwexch_Pre= pisvel*(1-fice): previously computed above | 
| 253 | 
 | 
| 254 | 
              Kwexch_o2(i,j) = Kwexch_Pre(i,j) | 
| 255 | 
     &                    / sqrt(SchmidtNoO2(i,j)/660.0 _d 0) | 
| 256 | 
 | 
| 257 | 
C determine saturation O2 | 
| 258 | 
C using Garcia and Gordon (1992), L&O (mistake in original ?) | 
| 259 | 
              aTT  = 298.15 _d 0 -ttemp | 
| 260 | 
              aTK  = 273.15 _d 0 +ttemp | 
| 261 | 
              aTS  = log(aTT/aTK) | 
| 262 | 
              aTS2 = aTS*aTS | 
| 263 | 
              aTS3 = aTS2*aTS | 
| 264 | 
              aTS4 = aTS3*aTS | 
| 265 | 
              aTS5 = aTS4*aTS | 
| 266 | 
 | 
| 267 | 
              oCnew  = oA0 + oA1*aTS + oA2*aTS2 + oA3*aTS3 + | 
| 268 | 
     &            oA4*aTS4 + oA5*aTS5 | 
| 269 | 
     &          + stemp*(oB0 + oB1*aTS + oB2*aTS2 + oB3*aTS3) | 
| 270 | 
     &          + oC0*(stemp*stemp) | 
| 271 | 
 | 
| 272 | 
              o2s = EXP(oCnew) | 
| 273 | 
 | 
| 274 | 
c Convert from ml/l to mol/m^3 | 
| 275 | 
              O2sat(i,j) = o2s/22391.6 _d 0 * 1. _d 3 | 
| 276 | 
 | 
| 277 | 
C Determine flux, inc. correction for local atmos surface pressure | 
| 278 | 
              FluxO2(i,j) = Kwexch_o2(i,j)* | 
| 279 | 
     &                     (AtmosP(i,j,bi,bj)*O2sat(i,j) | 
| 280 | 
     &                      - PTR_O2(i,j,1)) | 
| 281 | 
            ELSE | 
| 282 | 
              FluxO2(i,j) = 0. _d 0 | 
| 283 | 
            ENDIF | 
| 284 | 
 | 
| 285 | 
          ENDDO | 
| 286 | 
        ENDDO | 
| 287 | 
 | 
| 288 | 
C update surface tendencies | 
| 289 | 
        DO j=jmin,jmax | 
| 290 | 
          DO i=imin,imax | 
| 291 | 
           SGO2(i,j)= FluxO2(i,j) | 
| 292 | 
     &         *recip_drF(1) * recip_hFacC(i,j,1,bi,bj) | 
| 293 | 
          ENDDO | 
| 294 | 
        ENDDO | 
| 295 | 
 | 
| 296 | 
        _EXCH_XY_RL( pCO2, mythid) | 
| 297 | 
        _EXCH_XYZ_RL( pH, mythid) | 
| 298 | 
 | 
| 299 | 
#endif /* ALLOW_PTRACER */ | 
| 300 | 
 | 
| 301 | 
        RETURN | 
| 302 | 
        END |