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
00f81e6785 Ou W*0085         IF ( .NOT. useSTIC ) THEN
45f2c74f8a Jean*0086 C--   Forcing term
                0087
00f81e6785 Ou W*0088          IF ( .NOT.SHELFICEboundaryLayer ) THEN
45f2c74f8a Jean*0089 C-    for now, forcing using SHELFICEboundaryLayer is done separately
2694f84bda Jean*0090 C     (calling SHELFICE_FORCING_T & _S from APPLY_FORCING_T & _S)
00f81e6785 Ou W*0091           DO j=1,sNy
                0092            DO i=1,sNx
                0093             IF ( kTopC(i,j,bi,bj).NE.0 ) THEN
                0094              surfaceForcingT(i,j,bi,bj) = shelficeForcingT(i,j,bi,bj)
                0095              surfaceForcingS(i,j,bi,bj) = shelficeForcingS(i,j,bi,bj)
                0096             ENDIF
                0097            ENDDO
45f2c74f8a Jean*0098           ENDDO
00f81e6785 Ou W*0099          ENDIF
45f2c74f8a Jean*0100
00f81e6785 Ou W*0101          IF ( SHI_useRealFWflux ) THEN
9952f046d7 dngo*0102 C-    Allows PmE to be used even if boundary layer is being used,
                0103 C     as long as SHI_withBL_realFWflux is set to account for advective flux
5345270720 Jean*0104           DO j=1-OLy,sNy+OLy
                0105            DO i=1-OLx,sNx+OLx
                0106 c           IF ( kTopC(i,j,bi,bj).NE.0 ) THEN
                0107              EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj)
                0108      &         + shelfIceFreshWaterFlux(i,j,bi,bj)
                0109 c           ENDIF
                0110            ENDDO
                0111           ENDDO
00f81e6785 Ou W*0112          ENDIF
                0113
                0114 C-      end-if not useSTIC
45f2c74f8a Jean*0115         ENDIF
                0116
5345270720 Jean*0117 #ifdef EXACT_CONSERV
                0118         IF ( staggerTimeStep ) THEN
                0119           DO j=1-OLy,sNy+OLy
                0120            DO i=1-OLx,sNx+OLx
                0121              PmEpR(i,j,bi,bj) = -EmPmR(i,j,bi,bj)
                0122            ENDDO
                0123           ENDDO
                0124         ENDIF
                0125 #endif /* EXACT_CONSERV */
                0126
45f2c74f8a Jean*0127         IF ( usingZCoords ) THEN
5345270720 Jean*0128           DO j = jMin, jMax
                0129            DO i = iMin, iMax
                0130              phi0surf(i,j,bi,bj) = phi0surf(i,j,bi,bj)
45f2c74f8a Jean*0131      &         + shelficeLoadAnomaly(i,j,bi,bj)*recip_rhoConst
5345270720 Jean*0132            ENDDO
45f2c74f8a Jean*0133           ENDDO
                0134         ENDIF
                0135
470f7fc263 Jean*0136 #ifdef ALLOW_DIAGNOSTICS
                0137         IF ( useDiagnostics ) THEN
                0138           DO j=1-OLy,sNy+OLy
                0139            DO i=1-OLx,sNx+OLx
                0140              shelficeDragU(i,j,bi,bj) = 0.
                0141              shelficeDragV(i,j,bi,bj) = 0.
                0142            ENDDO
                0143           ENDDO
00f81e6785 Ou W*0144         ENDIF
470f7fc263 Jean*0145 #endif /* ALLOW_DIAGNOSTICS */
                0146
45f2c74f8a Jean*0147 c      ENDDO
                0148 c     ENDDO
                0149
                0150 #endif /* ALLOW_SHELFICE */
                0151       RETURN
                0152       END