pkg/thsice/thsice_slab_ocean.F

87ea84cac6 Jean*0001 #include "THSICE_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: THSICE_SLAB_OCEAN
                0005 C     !INTERFACE:
3a77421753 Jean*0006       SUBROUTINE THSICE_SLAB_OCEAN(
                0007      I                      aim_sWght0, aim_sWght1,
2d218141ac Jean*0008      O                      dTsurf,
3a77421753 Jean*0009      I                      bi, bj, myTime, myIter, myThid )
87ea84cac6 Jean*0010 C     !DESCRIPTION: \bv
                0011 C     *==========================================================*
                0012 C     | S/R  THSICE_SLAB_OCEAN
3a77421753 Jean*0013 C     | o Slab ocean for atmosphere (and sea-ice) model
87ea84cac6 Jean*0014 C     *==========================================================*
                0015 C     | o add ocean-surface fluxes + restoring term
                0016 C     |   and step forward ocean mixed-layer Temp. & Salinity
                0017 C     *==========================================================*
                0018 C     \ev
                0019
                0020 C     !USES:
                0021       IMPLICIT NONE
                0022
                0023 C     == Global variables ==
                0024 C-- MITgcm
                0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
                0027 #include "PARAMS.h"
                0028 #include "FFIELDS.h"
                0029
                0030 C-- Sea-Ice package
                0031 #include "THSICE_PARAMS.h"
                0032 #include "THSICE_VARS.h"
                0033
                0034 C-- Physics package
                0035 #ifdef ALLOW_AIM
                0036 #include "AIM_FFIELDS.h"
                0037 #endif
                0038
                0039 C     !INPUT/OUTPUT PARAMETERS:
                0040 C     == Routine Arguments ==
3a77421753 Jean*0041 C     aim_sWght0 :: weight for time interpolation of surface BC
                0042 C     aim_sWght1 :: 0/1 = time period before/after the current time
                0043 C     dTsurf     :: diagnostics of slab-ocean temperature change [K/iter]
                0044 C     bi,bj      :: tile indices
                0045 C     myTime     :: Current time of simulation ( s )
                0046 C     myIter     :: Current iteration number in simulation
                0047 C     myThid     :: my Thread number Id.
                0048       _RL     aim_sWght0, aim_sWght1
                0049       _RL     dTsurf(sNx,sNy)
                0050       _RL     myTime
87ea84cac6 Jean*0051       INTEGER bi,bj
3a77421753 Jean*0052       INTEGER myIter, myThid
87ea84cac6 Jean*0053 CEOP
                0054
                0055 #ifdef ALLOW_THSICE
                0056
                0057 C     == Local variables ==
                0058 C     i,j          :: Loop counters
2cf110c259 Jean*0059       _RL dtFac, fwFac, heatFac
                0060 #ifdef ALLOW_AIM
5e328a6c4a Davi*0061       _RL oceTfreez, locTemp, locQflux, dtFacR
2cf110c259 Jean*0062 #endif
87ea84cac6 Jean*0063       INTEGER i,j
                0064
c8458785ea Patr*0065 cph the following structure is not supported by TAF
                0066 cph      IF ( .NOT.stepFwd_oceMxL ) RETURN
                0067       IF ( stepFwd_oceMxL ) THEN
87ea84cac6 Jean*0068
                0069 C--    add heat flux and fresh-water + salt flux :
                0070        dtFac   = ocean_deltaT/rhosw
6206cdb986 Jean*0071        fwFac   = ocean_deltaT*sMxL_default/rhosw
87ea84cac6 Jean*0072        heatFac = ocean_deltaT/(cpwater*rhosw)
                0073        DO j=1,sNy
                0074         DO i=1,sNx
                0075          IF ( hOceMxL(i,j,bi,bj).NE.0. _d 0 ) THEN
2d218141ac Jean*0076           dTsurf(i,j) = tOceMxL(i,j,bi,bj)
87ea84cac6 Jean*0077           tOceMxL(i,j,bi,bj) = tOceMxL(i,j,bi,bj)
                0078      &       - heatFac*Qnet(i,j,bi,bj) / hOceMxL(i,j,bi,bj)
                0079           sOceMxL(i,j,bi,bj) = sOceMxL(i,j,bi,bj)
                0080      &       + (fwFac*EmPmR(i,j,bi,bj) - dtFac*saltFlux(i,j,bi,bj))
                0081      &                                 / hOceMxL(i,j,bi,bj)
                0082          ENDIF
                0083         ENDDO
                0084        ENDDO
                0085
                0086 #ifdef ALLOW_AIM
cb1db3a022 Davi*0087        IF ( tauRelax_MxL_salt .GT. 0. _d 0 ) THEN
                0088 C--    add restoring (backward) toward climatological fixed Salinity
                0089         dtFac   = ocean_deltaT/tauRelax_MxL_salt
                0090         dtFacR  = 1. _d 0 /(1. _d 0 + dtFac)
                0091         DO j=1,sNy
                0092          DO i=1,sNx
                0093           IF ( hOceMxL(i,j,bi,bj).NE.0. _d 0 ) THEN
                0094            sOceMxL(i,j,bi,bj) =
                0095      &         (sOceMxL(i,j,bi,bj) + dtFac*sMxL_default)*dtFacR
                0096           ENDIF
                0097          ENDDO
                0098         ENDDO
                0099        ENDIF
3a77421753 Jean*0100        IF ( tauRelax_MxL .GT. 0. _d 0 ) THEN
7c5790770d Davi*0101 C--    add restoring (backward) toward climatological Temp.
3a77421753 Jean*0102         dtFac   = ocean_deltaT/tauRelax_MxL
                0103         dtFacR  = 1. _d 0 /(1. _d 0 + dtFac)
                0104         oceTfreez = - 1.9 _d 0
                0105         DO j=1,sNy
                0106          DO i=1,sNx
                0107           IF ( hOceMxL(i,j,bi,bj).NE.0. _d 0 ) THEN
                0108            oceTfreez = -mu_Tf*sOceMxL(i,j,bi,bj)
                0109            locTemp = ( aim_sWght0*aim_sst0(i,j,bi,bj)
                0110      &               + aim_sWght1*aim_sst1(i,j,bi,bj)
                0111      &               ) - celsius2K
                0112            locTemp = MAX( locTemp , oceTfreez )
                0113            tOceMxL(i,j,bi,bj) =
87ea84cac6 Jean*0114      &         (tOceMxL(i,j,bi,bj) + dtFac*locTemp)*dtFacR
3a77421753 Jean*0115           ENDIF
                0116          ENDDO
87ea84cac6 Jean*0117         ENDDO
3a77421753 Jean*0118        ENDIF
5e328a6c4a Davi*0119        DO j=1,sNy
                0120         DO i=1,sNx
                0121           IF ( hOceMxL(i,j,bi,bj).NE.0. _d 0 ) THEN
                0122            locQflux = ( aim_sWght0*aim_qfx0(i,j,bi,bj)
                0123      &                + aim_sWght1*aim_qfx1(i,j,bi,bj)
                0124      &                )
                0125            tOceMxL(i,j,bi,bj) = tOceMxL(i,j,bi,bj)
                0126      &            + heatFac*locQflux / hOceMxL(i,j,bi,bj)
                0127           ENDIF
                0128         ENDDO
                0129        ENDDO
87ea84cac6 Jean*0130 #endif /* ALLOW_AIM */
                0131
2d218141ac Jean*0132 C-    Diagnose surf. temp. change
                0133        DO j=1,sNy
                0134         DO i=1,sNx
                0135          IF ( hOceMxL(i,j,bi,bj).NE.0. _d 0 ) THEN
                0136           dTsurf(i,j) = tOceMxL(i,j,bi,bj) - dTsurf(i,j)
                0137          ENDIF
                0138         ENDDO
                0139        ENDDO
                0140
c8458785ea Patr*0141 c-- End of IF ( stepFwd_oceMxL ) THEN
                0142       ENDIF
                0143
41e6ab0e43 Jean*0144 C--   Cumulate time-averaged fields and also fill-up flux diagnostics
                0145 C     (if not done in THSICE_DO_ADVECT call)
                0146       IF ( thSIceAdvScheme.LE.0 ) THEN
                0147          CALL THSICE_AVE(
                0148      I                    bi, bj, myTime, myIter, myThid )
                0149       ENDIF
                0150
87ea84cac6 Jean*0151 #endif  /* ALLOW_THSICE */
                0152
                0153       RETURN
                0154       END