pkg/dic/o2_surfforcing.F

6d54cf9ca1 Ed H*0001 #include "DIC_OPTIONS.h"
daab022f42 Step*0002
08536d17ba Step*0003 CBOP
                0004 C !ROUTINE: O2_SURFFORCING
                0005
                0006 C !INTERFACE: ==========================================================
e561c9c25f Step*0007       SUBROUTINE O2_SURFFORCING( PTR_O2, SGO2,
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:
d6dd396873 Jean*0012 C Calculate the oxygen air-sea flux terms
08536d17ba Step*0013
                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"
                0021 #include "FFIELDS.h"
2ef8966791 Davi*0022 #include "DIC_VARS.h"
daab022f42 Step*0023
08536d17ba Step*0024 c  !INPUT PARAMETERS: ===================================================
                0025 C  PTR_O2               :: oxygen tracer field
2e3e8c330d Jona*0026 C  myTime               :: current time
                0027 C  myIter               :: current timestep
                0028 C  myThid               :: thread number
daab022f42 Step*0029       _RL  PTR_O2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0030       INTEGER iMin,iMax,jMin,jMax, bi, bj
2e3e8c330d Jona*0031       _RL myTime
e561c9c25f Step*0032       INTEGER myIter, myThid
daab022f42 Step*0033
08536d17ba Step*0034 c  !OUTPUT PARAMETERS: ===================================================
e561c9c25f Step*0035 C  SGO2                  :: air-sea exchange of oxygen
                0036       _RL  SGO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
08536d17ba Step*0037
daab022f42 Step*0038 #ifdef ALLOW_PTRACERS
                0039
25bac1e456 Step*0040 #ifdef ALLOW_O2
daab022f42 Step*0041
08536d17ba Step*0042 C !LOCAL VARIABLES: ===================================================
daab022f42 Step*0043 C I, J, K - Loop counters
2e3e8c330d Jona*0044       INTEGER i,j,k
daab022f42 Step*0045 C Solubility relation coefficients
                0046       _RL SchmidtNoO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0047       _RL O2sat(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0048       _RL Kwexch(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0049       _RL FluxO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
d6dd396873 Jean*0050       _RL  aTT
daab022f42 Step*0051       _RL  aTK
                0052       _RL  aTS
                0053       _RL  aTS2
                0054       _RL  aTS3
                0055       _RL  aTS4
                0056       _RL  aTS5
                0057       _RL  o2s
                0058       _RL  ttemp
                0059       _RL  stemp
                0060       _RL  oCnew
08536d17ba Step*0061 CEOP
daab022f42 Step*0062
2e3e8c330d Jona*0063       k=1
daab022f42 Step*0064
                0065 C calculate SCHMIDT NO. for O2
51c3bf0077 Step*0066         DO j=jmin,jmax
                0067           DO i=imin,imax
2c147e6036 Davi*0068             IF (maskC(i,j,k,bi,bj).NE.0.) THEN
                0069               ttemp = theta(i,j,k,bi,bj)
                0070               stemp = salt(i,j,k,bi,bj)
                0071
d6dd396873 Jean*0072               SchmidtNoO2(i,j) =
                0073      &            sox1
2c147e6036 Davi*0074      &          + sox2 * ttemp
d6dd396873 Jean*0075      &          + sox3 * ttemp*ttemp
2c147e6036 Davi*0076      &          + sox4 * ttemp*ttemp*ttemp
daab022f42 Step*0077
d6dd396873 Jean*0078 C Determine surface flux of O2
c8d7031b60 Davi*0079 C exchange coeff accounting for ice cover and Schmidt no.
                0080 C Kwexch_Pre= pisvel*(1-fice): previously computed in dic_surfforcing.F
                0081
                0082               Kwexch(i,j) = Kwexch_Pre(i,j,bi,bj)
                0083      &                    / sqrt(SchmidtNoO2(i,j)/660.0 _d 0)
daab022f42 Step*0084
                0085 C determine saturation O2
d6dd396873 Jean*0086 C using Garcia and Gordon (1992), L&O (mistake in original ?)
e31f9c5af1 Davi*0087               aTT  = 298.15 _d 0 -ttemp
                0088               aTK  = 273.15 _d 0 +ttemp
daab022f42 Step*0089               aTS  = log(aTT/aTK)
                0090               aTS2 = aTS*aTS
                0091               aTS3 = aTS2*aTS
                0092               aTS4 = aTS3*aTS
                0093               aTS5 = aTS4*aTS
                0094
d6dd396873 Jean*0095               oCnew  = oA0 + oA1*aTS + oA2*aTS2 + oA3*aTS3 +
daab022f42 Step*0096      &            oA4*aTS4 + oA5*aTS5
                0097      &          + stemp*(oB0 + oB1*aTS + oB2*aTS2 + oB3*aTS3)
                0098      &          + oC0*(stemp*stemp)
                0099
                0100               o2s = EXP(oCnew)
                0101
                0102 c Convert from ml/l to mol/m^3
e31f9c5af1 Davi*0103               O2sat(i,j) = o2s/22391.6 _d 0 * 1. _d 3
daab022f42 Step*0104
c8d7031b60 Davi*0105 C Determine flux, inc. correction for local atmos surface pressure
2c147e6036 Davi*0106               FluxO2(i,j) = Kwexch(i,j)*
d6dd396873 Jean*0107      &                     (AtmosP(i,j,bi,bj)*O2sat(i,j)
2e3e8c330d Jona*0108      &                      - PTR_O2(i,j,k))
daab022f42 Step*0109             ELSE
e31f9c5af1 Davi*0110               FluxO2(i,j) = 0. _d 0
daab022f42 Step*0111             ENDIF
                0112
                0113           END DO
                0114         END DO
                0115
d6dd396873 Jean*0116 C update surface tendencies
51c3bf0077 Step*0117         DO j=jmin,jmax
                0118           DO i=imin,imax
2c147e6036 Davi*0119            SGO2(i,j)= FluxO2(i,j)
2e3e8c330d Jona*0120      &         *recip_drF(k) * recip_hFacC(i,j,k,bi,bj)
daab022f42 Step*0121           ENDDO
                0122          ENDDO
                0123 #endif
25bac1e456 Step*0124 #endif
daab022f42 Step*0125
                0126         RETURN
                0127         END
                0128