pkg/shelfice/shelfice_forcing_surf.F

45f2c74f8a Jean*0001 #include "SHELFICE_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: SHELFICE_FORCING_SURF
                0006 C     !INTERFACE:
                0007       SUBROUTINE SHELFICE_FORCING_SURF(
                0008      I           bi, bj, iMin, iMax, jMin, jMax,
                0009      I           myTime, myIter, myThid )
                0010 C     !DESCRIPTION: \bv
                0011 C     *==========================================================*
                0012 C     | S/R SHELFICE_FORCING_SURF
                0013 C     | o Contains problem specific surface forcing
                0014 C     *==========================================================*
                0015 C     \ev
                0016
                0017 C     !USES:
                0018       IMPLICIT NONE
                0019 C     == Global data ==
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "GRID.h"
                0024 c#include "DYNVARS.h"
                0025 #include "SURFACE.h"
                0026 #include "FFIELDS.h"
                0027 #include "SHELFICE.h"
                0028
                0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C     == Routine arguments ==
                0031 C     bi,bj     :: Current tile indices
                0032 C     iMin,iMax :: Working range of x-index for applying forcing.
                0033 C     jMin,jMax :: Working range of y-index for applying forcing.
                0034 C     myTime    :: Current time in simulation
                0035 C     myIter    :: Current iteration number in simulation
                0036 C     myThid    :: Thread Id number
                0037       INTEGER bi, bj
                0038       INTEGER iMin, iMax, jMin, jMax
                0039       _RL myTime
                0040       INTEGER myIter
                0041       INTEGER myThid
                0042
                0043 #ifdef ALLOW_SHELFICE
                0044 C     !LOCAL VARIABLES:
                0045 C     == Local variables ==
                0046 C     i,j   :: Loop counters
                0047       INTEGER i, j
9952f046d7 dngo*0048       LOGICAL SHI_useRealFWflux
45f2c74f8a Jean*0049 CEOP
                0050
9952f046d7 dngo*0051       SHI_useRealFWflux = useRealFreshWaterFlux .AND.
                0052      &  ( .NOT.SHELFICEboundaryLayer .OR. SHI_withBL_realFWflux )
                0053
45f2c74f8a Jean*0054 c     DO bj=myByLo(myThid),myByHi(myThid)
                0055 c      DO bi=myBxLo(myThid),myBxHi(myThid)
                0056
5345270720 Jean*0057 C--   Zero out surface forcing terms below ice-shelf
                0058         DO j=1-OLy,sNy+OLy
                0059          DO i=1-OLx,sNx+OLx
                0060           IF ( kTopC(i,j,bi,bj).NE.0 ) THEN
                0061             surfaceForcingT(i,j,bi,bj) = 0.
                0062             surfaceForcingS(i,j,bi,bj) = 0.
                0063             EmPmR(i,j,bi,bj) = 0.
c87895a3f5 jm-c 0064             Qsw  (i,j,bi,bj) = 0.
                0065 C-    just for consistent diagnostics, also reset Qnet:
                0066             Qnet (i,j,bi,bj) = 0.
5345270720 Jean*0067           ENDIF
                0068          ENDDO
                0069         ENDDO
2694f84bda Jean*0070         DO j=1-OLy,sNy+OLy
                0071          DO i=2-OLx,sNx+OLx
                0072           IF ( MAX( kTopC(i-1,j,bi,bj), kTopC(i,j,bi,bj) ).NE.0 ) THEN
                0073             surfaceForcingU(i,j,bi,bj) = 0.
                0074           ENDIF
                0075          ENDDO
                0076         ENDDO
                0077         DO j=2-OLy,sNy+OLy
                0078          DO i=1-OLx,sNx+OLx
                0079           IF ( MAX( kTopC(i,j-1,bi,bj), kTopC(i,j,bi,bj) ).NE.0 ) THEN
                0080             surfaceForcingV(i,j,bi,bj) = 0.
                0081           ENDIF
                0082          ENDDO
                0083         ENDDO
5345270720 Jean*0084
45f2c74f8a Jean*0085 C--   Forcing term
                0086
                0087         IF ( .NOT.SHELFICEboundaryLayer ) THEN
                0088 C-    for now, forcing using SHELFICEboundaryLayer is done separately
2694f84bda Jean*0089 C     (calling SHELFICE_FORCING_T & _S from APPLY_FORCING_T & _S)
45f2c74f8a Jean*0090          DO j=1,sNy
                0091           DO i=1,sNx
5345270720 Jean*0092            IF ( kTopC(i,j,bi,bj).NE.0 ) THEN
45f2c74f8a Jean*0093             surfaceForcingT(i,j,bi,bj) = shelficeForcingT(i,j,bi,bj)
                0094             surfaceForcingS(i,j,bi,bj) = shelficeForcingS(i,j,bi,bj)
                0095            ENDIF
                0096           ENDDO
                0097          ENDDO
9952f046d7 dngo*0098         ENDIF
45f2c74f8a Jean*0099
9952f046d7 dngo*0100         IF ( SHI_useRealFWflux ) THEN
                0101 C-    Allows PmE to be used even if boundary layer is being used,
                0102 C     as long as SHI_withBL_realFWflux is set to account for advective flux
5345270720 Jean*0103           DO j=1-OLy,sNy+OLy
                0104            DO i=1-OLx,sNx+OLx
                0105 c           IF ( kTopC(i,j,bi,bj).NE.0 ) THEN
                0106              EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj)
                0107      &         + shelfIceFreshWaterFlux(i,j,bi,bj)
                0108 c           ENDIF
                0109            ENDDO
                0110           ENDDO
45f2c74f8a Jean*0111         ENDIF
                0112
5345270720 Jean*0113 #ifdef EXACT_CONSERV
                0114         IF ( staggerTimeStep ) THEN
                0115           DO j=1-OLy,sNy+OLy
                0116            DO i=1-OLx,sNx+OLx
                0117              PmEpR(i,j,bi,bj) = -EmPmR(i,j,bi,bj)
                0118            ENDDO
                0119           ENDDO
                0120         ENDIF
                0121 #endif /* EXACT_CONSERV */
                0122
45f2c74f8a Jean*0123         IF ( usingZCoords ) THEN
5345270720 Jean*0124           DO j = jMin, jMax
                0125            DO i = iMin, iMax
                0126              phi0surf(i,j,bi,bj) = phi0surf(i,j,bi,bj)
45f2c74f8a Jean*0127      &         + shelficeLoadAnomaly(i,j,bi,bj)*recip_rhoConst
5345270720 Jean*0128            ENDDO
45f2c74f8a Jean*0129           ENDDO
                0130         ENDIF
                0131
470f7fc263 Jean*0132 #ifdef ALLOW_DIAGNOSTICS
                0133         IF ( useDiagnostics ) THEN
                0134           DO j=1-OLy,sNy+OLy
                0135            DO i=1-OLx,sNx+OLx
                0136              shelficeDragU(i,j,bi,bj) = 0.
                0137              shelficeDragV(i,j,bi,bj) = 0.
                0138            ENDDO
                0139           ENDDO
                0140          ENDIF
                0141 #endif /* ALLOW_DIAGNOSTICS */
                0142
45f2c74f8a Jean*0143 c      ENDDO
                0144 c     ENDDO
                0145
                0146 #endif /* ALLOW_SHELFICE */
                0147       RETURN
                0148       END