pkg/thsice/thsice_get_ocean.F

9439f3829d Jean*0001 #include "THSICE_OPTIONS.h"
de07cf1f91 Jean*0002 #ifdef ALLOW_SEAICE
                0003 # include "SEAICE_OPTIONS.h"
                0004 #endif /* ALLOW_SEAICE */
9439f3829d Jean*0005
                0006 CBOP
                0007 C     !ROUTINE: THSICE_GET_OCEAN
                0008 C     !INTERFACE:
                0009       SUBROUTINE THSICE_GET_OCEAN(
                0010      I                        bi, bj, myTime, myIter, myThid )
                0011 C     !DESCRIPTION: \bv
                0012 C     *==========================================================*
                0013 C     | S/R THSICE_GET_OCEAN
                0014 C     | o Get mixed layer properties from ocean main
                0015 C     |   variables (surface level) and store them
                0016 C     |   into this package local mixed-layer arrays
                0017 C     *==========================================================*
                0018
                0019 C     !USES:
                0020       IMPLICIT NONE
                0021
                0022 C     === Global variables ===
                0023 #include "SIZE.h"
                0024 #include "EEPARAMS.h"
                0025 #include "PARAMS.h"
                0026 #include "GRID.h"
                0027 #include "SURFACE.h"
                0028 #include "DYNVARS.h"
                0029 c#include "THSICE_PARAMS.h"
                0030 #include "THSICE_SIZE.h"
                0031 #include "THSICE_VARS.h"
de07cf1f91 Jean*0032 #ifdef ALLOW_SEAICE
                0033 # include "SEAICE_SIZE.h"
                0034 # include "SEAICE.h"
                0035 #endif /* ALLOW_SEAICE */
9439f3829d Jean*0036
                0037 C     !INPUT/OUTPUT PARAMETERS:
                0038 C     === Routine arguments ===
                0039 C     bi, bj    :: Tile indices
                0040 C     myTime    :: Current time in simulation (s)
                0041 C     myIter    :: Current iteration number
                0042 C     myThid    :: My Thread Id. number
                0043       INTEGER bi, bj
                0044       _RL     myTime
                0045       INTEGER myIter
                0046       INTEGER myThid
                0047 CEOP
                0048
                0049 #ifdef ALLOW_THSICE
                0050 C     !LOCAL VARIABLES:
                0051 C     === Local variables ===
                0052       INTEGER i,j
                0053       INTEGER ks
de07cf1f91 Jean*0054 #ifdef ALLOW_SEAICE
                0055       _RL uRel1, uRel2, vRel1, vRel2
                0056 #endif /* ALLOW_SEAICE */
9439f3829d Jean*0057
                0058 C--     Mixed layer thickness: take the 1rst layer
                0059         ks = 1
                0060 #ifdef NONLIN_FRSURF
                0061         IF ( staggerTimeStep .AND. nonlinFreeSurf.GT.0 ) THEN
                0062          IF ( select_rStar.GT.0 ) THEN
                0063           DO j=1-OLy,sNy+OLy
                0064            DO i=1-OLx,sNx+OLx
                0065              hOceMxL(i,j,bi,bj) = drF(ks)*h0FacC(i,j,ks,bi,bj)
                0066      &                                   *rStarFacC(i,j,bi,bj)
                0067            ENDDO
                0068           ENDDO
                0069          ELSE
                0070           DO j=1-OLy,sNy+OLy
                0071            DO i=1-OLx,sNx+OLx
                0072             IF ( kSurfC(i,j,bi,bj).EQ.1 ) THEN
                0073              hOceMxL(i,j,bi,bj) = drF(ks)*hFac_surfC(i,j,bi,bj)
                0074             ELSE
                0075              hOceMxL(i,j,bi,bj) = drF(ks)*hFacC(i,j,ks,bi,bj)
                0076             ENDIF
                0077            ENDDO
                0078           ENDDO
                0079          ENDIF
                0080         ELSE
                0081 #else /* ndef NONLIN_FRSURF */
                0082         IF (.TRUE.) THEN
                0083 #endif /* NONLIN_FRSURF */
                0084           DO j=1-OLy,sNy+OLy
                0085            DO i=1-OLx,sNx+OLx
                0086              hOceMxL(i,j,bi,bj) = drF(ks)*hFacC(i,j,ks,bi,bj)
                0087            ENDDO
                0088           ENDDO
                0089         ENDIF
                0090
c87895a3f5 jm-c 0091 #ifdef ALLOW_SHELFICE
                0092 C--   Prevent seaice to form where Ice-Shelf is present
                0093         IF ( useShelfIce ) THEN
148dd84005 jm-c 0094           CALL SHELFICE_MASK_SEAICE(
                0095      U                  hOceMxL,
                0096      I                  bi, bj, myIter, myThid )
c87895a3f5 jm-c 0097         ENDIF
                0098 #endif /* ALLOW_SHELFICE */
                0099
9439f3829d Jean*0100         DO j=1-OLy,sNy+OLy
                0101          DO i=1-OLx,sNx+OLx
                0102           tOceMxL(i,j,bi,bj) = theta(i,j,ks,bi,bj)
                0103           sOceMxL(i,j,bi,bj) = salt (i,j,ks,bi,bj)
                0104           v2ocMxL(i,j,bi,bj) = 0. _d 0
                0105           icFrwAtm(i,j,bi,bj) = 0. _d 0
                0106           icFlxAtm(i,j,bi,bj) = 0. _d 0
                0107           icFlxSW (i,j,bi,bj) = 0. _d 0
                0108           siceAlb (i,j,bi,bj) = 0. _d 0
                0109          ENDDO
                0110         ENDDO
de07cf1f91 Jean*0111         IF ( .NOT.useSEAICE ) THEN
                0112          DO j=1-OLy,sNy+OLy-1
                0113           DO i=1-OLx,sNx+OLx-1
                0114            v2ocMxL(i,j,bi,bj) =
9439f3829d Jean*0115      &              ( uVel(i,j,ks,bi,bj) * uVel(i,j,ks,bi,bj)
                0116      &              + uVel(i+1,j,ks,bi,bj)*uVel(i+1,j,ks,bi,bj)
                0117      &              + vVel(i,j+1,ks,bi,bj)*vVel(i,j+1,ks,bi,bj)
                0118      &              + vVel(i,j,ks,bi,bj) * vVel(i,j,ks,bi,bj)
                0119      &              )*0.5 _d 0
                0120          ENDDO
                0121         ENDDO
de07cf1f91 Jean*0122 #ifdef ALLOW_SEAICE
                0123         ELSE
                0124          DO j=1-OLy,sNy+OLy-1
                0125           DO i=1-OLx,sNx+OLx-1
                0126            uRel1 = uVel( i, j,ks,bi,bj)-uIce( i, j,bi,bj)
                0127            uRel2 = uVel(i+1,j,ks,bi,bj)-uIce(i+1,j,bi,bj)
                0128            vRel1 = vVel(i, j, ks,bi,bj)-vIce(i, j, bi,bj)
                0129            vRel2 = vVel(i,j+1,ks,bi,bj)-vIce(i,j+1,bi,bj)
                0130            v2ocMxL(i,j,bi,bj) =
                0131      &              ( ( uRel1*uRel1 + uRel2*uRel2 )
                0132      &              + ( vRel1*vRel1 + vRel2*vRel2 )
                0133      &              )*0.5 _d 0
                0134           ENDDO
                0135          ENDDO
                0136 #endif /* ALLOW_SEAICE */
                0137         ENDIF
9439f3829d Jean*0138
                0139 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0140 #endif  /*ALLOW_THSICE*/
                0141
                0142       RETURN
                0143       END