Back to home page

MITgcm
 
 

    

File indexing completed on 2024-05-25 05:11:10 UTC

view on githubraw file Latest commit 00f81e67 on 2024-05-24 21:00:12 UTC
cc36b35673 Jean*0001 #include "SHELFICE_OPTIONS.h"
00f81e6785 Ou W*0002 #ifdef ALLOW_STEEP_ICECAVITY
                0003 # include "STIC_OPTIONS.h"
                0004 #endif
ffe464dc7d Mart*0005 
45f2c74f8a Jean*0006 C--  File shelfice_forcing.F:
                0007 C--   Contents
                0008 C--   o SHELFICE_FORCING_T
                0009 C--   o SHELFICE_FORCING_S
                0010 
ffe464dc7d Mart*0011 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0012 CBOP
                0013 C     !ROUTINE: SHELFICE_FORCING_T
                0014 C     !INTERFACE:
                0015       SUBROUTINE SHELFICE_FORCING_T(
73b1dccda0 Jean*0016      U                    gT_arr,
                0017      I                    iMin,iMax,jMin,jMax, kLev, bi, bj,
                0018      I                    myTime, myIter, myThid )
                0019 
ffe464dc7d Mart*0020 C     !DESCRIPTION: \bv
                0021 C     *==========================================================*
                0022 C     | S/R SHELFICE_FORCING_T
                0023 C     | o Contains problem specific forcing for temperature.
                0024 C     *==========================================================*
                0025 C     | Adds terms to gT for forcing by shelfice sources
                0026 C     | e.g. heat flux
                0027 C     *==========================================================*
                0028 C     \ev
                0029 
                0030 C     !USES:
                0031       IMPLICIT NONE
                0032 C     == Global data ==
                0033 #include "SIZE.h"
                0034 #include "EEPARAMS.h"
                0035 #include "PARAMS.h"
                0036 #include "GRID.h"
73b1dccda0 Jean*0037 c#include "DYNVARS.h"
                0038 c#include "FFIELDS.h"
ffe464dc7d Mart*0039 #include "SHELFICE.h"
00f81e6785 Ou W*0040 #ifdef ALLOW_STEEP_ICECAVITY
                0041 # include "STIC.h"
                0042 #endif
ffe464dc7d Mart*0043 
                0044 C     !INPUT/OUTPUT PARAMETERS:
73b1dccda0 Jean*0045 C     gT_arr    :: the tendency array
ffe464dc7d Mart*0046 C     iMin,iMax :: Working range of x-index for applying forcing.
                0047 C     jMin,jMax :: Working range of y-index for applying forcing.
                0048 C     kLev      :: Current vertical level index
73b1dccda0 Jean*0049 C     bi,bj     :: Current tile indices
ffe464dc7d Mart*0050 C     myTime    :: Current time in simulation
73b1dccda0 Jean*0051 C     myIter    :: Current iteration number
                0052 C     myThid    :: my Thread Id number
                0053       _RL     gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0054       INTEGER iMin, iMax, jMin, jMax
                0055       INTEGER kLev, bi, bj
                0056       _RL     myTime
                0057       INTEGER myIter
ffe464dc7d Mart*0058       INTEGER myThid
                0059 
                0060 #ifdef ALLOW_SHELFICE
                0061 C     !LOCAL VARIABLES:
                0062 C     == Local variables ==
40b188dddd Mart*0063 C     i,j   :: Loop counters
                0064 C     kp1,km1 :: index of next/previous level
                0065 C     gTloc   :: local tendency in boundary layer
                0066 C     drLoc   :: fractional cell width of boundary layer in (k+/-1)th layer
ffe464dc7d Mart*0067       INTEGER i, j
40b188dddd Mart*0068       INTEGER Kp1, Km1
                0069       _RS     drLoc
                0070       _RL     gTloc
ffe464dc7d Mart*0071 CEOP
                0072 
                0073 C--   Forcing term
45f2c74f8a Jean*0074       IF ( SHELFICEboundaryLayer ) THEN
                0075        DO j=1,sNy
                0076         DO i=1,sNx
40b188dddd Mart*0077          IF ( kLev .LT. Nr .AND. kLev .EQ. kTopC(I,J,bi,bj) ) THEN
                0078           kp1 = MIN(kLev+1,Nr)
                0079           drLoc = drF(kLev)*( 1. _d 0 - _hFacC(I,J,kLev,bi,bj) )
cc36b35673 Jean*0080           drLoc = MIN( drLoc, drF(Kp1) * _hFacC(I,J,Kp1,bi,bj) )
09df6ae39f Dani*0081           drLoc = MAX( drLoc, 0. _d 0)
cc36b35673 Jean*0082           gTloc = shelficeForcingT(i,j,bi,bj)
40b188dddd Mart*0083      &         /( drF(kLev)*_hFacC(I,J,kLev,bi,bj)+drLoc )
73b1dccda0 Jean*0084           gT_arr(i,j) = gT_arr(i,j) + gTloc
40b188dddd Mart*0085          ELSEIF ( kLev .GT. 1 .AND. kLev-1 .EQ. kTopC(I,J,bi,bj) ) THEN
                0086           km1 = MAX(kLev-1,1)
                0087           drLoc = drF(km1)*( 1. _d 0 - _hFacC(I,J,km1,bi,bj) )
cc36b35673 Jean*0088           drLoc = MIN( drLoc, drF(kLev) * _hFacC(I,J,kLev,bi,bj) )
09df6ae39f Dani*0089           drLoc = MAX( drLoc, 0. _d 0)
cc36b35673 Jean*0090           gTloc = shelficeForcingT(i,j,bi,bj)
40b188dddd Mart*0091      &         /( drF(km1)*_hFacC(I,J,km1,bi,bj)+drLoc )
                0092 C     The following is shorthand for the averaged tendency:
                0093 C     gT(k+1) = gT(k+1) + { gTloc * [drF(k)*(1-hFacC(k))]
                0094 C                       +   0     * [drF(k+1) - drF(k)*(1-hFacC(k))]
                0095 C                         }/[drF(k+1)*hFacC(k+1)]
73b1dccda0 Jean*0096           gT_arr(i,j) = gT_arr(i,j) + gTloc
40b188dddd Mart*0097      &         * drLoc*recip_drF(kLev)* _recip_hFacC(i,j,kLev,bi,bj)
                0098          ENDIF
45f2c74f8a Jean*0099         ENDDO
ffe464dc7d Mart*0100        ENDDO
45f2c74f8a Jean*0101       ENDIF
ffe464dc7d Mart*0102 
00f81e6785 Ou W*0103 # ifdef ALLOW_STEEP_ICECAVITY
                0104       IF ( useSTIC ) THEN
                0105        DO j=1,sNy
                0106         DO i=1,sNx
                0107 C--     TENDENCY FROM STEEP ICECAVITY (BOTH ICE SHELF AND ICE FRONT)
                0108          gT_arr(i,j) = gT_arr(i,j) + stic_gT(i,j,kLev,bi,bj)
                0109         ENDDO
                0110        ENDDO
                0111       ENDIF
                0112 # endif /* ALLOW_STEEP_ICECAVITY */
                0113 
ffe464dc7d Mart*0114 #endif /* ALLOW_SHELFICE */
                0115       RETURN
                0116       END
                0117 
                0118 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0119 CBOP
                0120 C     !ROUTINE: SHELFICE_FORCING_S
                0121 C     !INTERFACE:
                0122       SUBROUTINE SHELFICE_FORCING_S(
73b1dccda0 Jean*0123      U                    gS_arr,
                0124      I                    iMin,iMax,jMin,jMax, kLev, bi, bj,
                0125      I                    myTime, myIter, myThid )
ffe464dc7d Mart*0126 
                0127 C     !DESCRIPTION: \bv
                0128 C     *==========================================================*
                0129 C     | S/R SHELFICE_FORCING_S
                0130 C     | o Contains problem specific forcing for merid velocity.
                0131 C     *==========================================================*
                0132 C     | Adds terms to gS for forcing by shelfice sources
                0133 C     | e.g. fresh-water flux (virtual salt flux).
                0134 C     *==========================================================*
                0135 C     \ev
                0136 
                0137 C     !USES:
                0138       IMPLICIT NONE
                0139 C     == Global data ==
                0140 #include "SIZE.h"
                0141 #include "EEPARAMS.h"
                0142 #include "PARAMS.h"
                0143 #include "GRID.h"
73b1dccda0 Jean*0144 c#include "DYNVARS.h"
                0145 c#include "FFIELDS.h"
ffe464dc7d Mart*0146 #include "SHELFICE.h"
00f81e6785 Ou W*0147 #ifdef ALLOW_STEEP_ICECAVITY
                0148 # include "STIC.h"
                0149 #endif
ffe464dc7d Mart*0150 
                0151 C     !INPUT/OUTPUT PARAMETERS:
73b1dccda0 Jean*0152 C     gS_arr    :: the tendency array
ffe464dc7d Mart*0153 C     iMin,iMax :: Working range of x-index for applying forcing.
                0154 C     jMin,jMax :: Working range of y-index for applying forcing.
                0155 C     kLev      :: Current vertical level index
73b1dccda0 Jean*0156 C     bi,bj     :: Current tile indices
ffe464dc7d Mart*0157 C     myTime    :: Current time in simulation
73b1dccda0 Jean*0158 C     myIter    :: Current iteration number
                0159 C     myThid    :: my Thread Id number
                0160       _RL     gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0161       INTEGER iMin, iMax, jMin, jMax
                0162       INTEGER kLev, bi, bj
                0163       _RL     myTime
                0164       INTEGER myIter
ffe464dc7d Mart*0165       INTEGER myThid
                0166 
                0167 #ifdef ALLOW_SHELFICE
                0168 C     !LOCAL VARIABLES:
40b188dddd Mart*0169 C     i,j   :: Loop counters
                0170 C     kp/m1 :: index of next/previous level
                0171 C     gTloc :: local tendency in boundary layer
                0172 C     drLoc :: fractional cell width of boundary layer
ffe464dc7d Mart*0173       INTEGER i, j
40b188dddd Mart*0174       INTEGER Kp1, Km1
                0175       _RS     drLoc
cc36b35673 Jean*0176       _RL     gSloc
ffe464dc7d Mart*0177 CEOP
                0178 
                0179 C--   Forcing term
45f2c74f8a Jean*0180       IF ( SHELFICEboundaryLayer ) THEN
                0181        DO j=1,sNy
                0182         DO i=1,sNx
40b188dddd Mart*0183          IF ( kLev .LT. Nr .AND. kLev .EQ. kTopC(I,J,bi,bj) ) THEN
                0184           kp1 = MIN(kLev+1,Nr)
                0185           drLoc = drF(kLev)*( 1. _d 0 - _hFacC(I,J,kLev,bi,bj) )
cc36b35673 Jean*0186           drLoc = MIN( drLoc, drF(Kp1) * _hFacC(I,J,Kp1,bi,bj) )
09df6ae39f Dani*0187           drLoc = MAX( drLoc, 0. _d 0)
cc36b35673 Jean*0188           gSloc = shelficeForcingS(i,j,bi,bj)
40b188dddd Mart*0189      &         /( drF(kLev)*_hFacC(I,J,kLev,bi,bj)+drLoc )
73b1dccda0 Jean*0190           gS_arr(i,j) = gS_arr(i,j) + gSloc
40b188dddd Mart*0191          ELSEIF ( kLev .GT. 1 .AND. kLev-1 .EQ. kTopC(I,J,bi,bj) ) THEN
                0192           km1 = MAX(kLev-1,1)
                0193           drLoc = drF(km1)*( 1. _d 0 - _hFacC(I,J,km1,bi,bj) )
cc36b35673 Jean*0194           drLoc = MIN( drLoc, drF(kLev) * _hFacC(I,J,kLev,bi,bj) )
09df6ae39f Dani*0195           drLoc = MAX( drLoc, 0. _d 0)
cc36b35673 Jean*0196           gSloc = shelficeForcingS(i,j,bi,bj)
40b188dddd Mart*0197      &         /( drF(km1)*_hFacC(I,J,km1,bi,bj)+drLoc )
                0198 C     The following is shorthand for the averaged tendency:
                0199 C     gS(k+1) = gS(k+1) + { gSloc * [drF(k)*(1-hFacC(k))]
                0200 C                       +   0     * [drF(k+1) - drF(k)*(1-hFacC(k))]
                0201 C                         }/[drF(k+1)*hFacC(k+1)]
73b1dccda0 Jean*0202           gS_arr(i,j) = gS_arr(i,j) + gSloc
40b188dddd Mart*0203      &         * drLoc*recip_drF(kLev)* _recip_hFacC(i,j,kLev,bi,bj)
                0204          ENDIF
45f2c74f8a Jean*0205         ENDDO
ffe464dc7d Mart*0206        ENDDO
45f2c74f8a Jean*0207       ENDIF
ffe464dc7d Mart*0208 
00f81e6785 Ou W*0209 # ifdef ALLOW_STEEP_ICECAVITY
                0210       IF ( useSTIC ) THEN
                0211        DO j=1,sNy
                0212         DO i=1,sNx
                0213 C--     TENDENCY FROM STEEP ICECAVITY (BOTH ICE SHELF AND ICE FRONT)
                0214          gS_arr(i,j) = gS_arr(i,j) + stic_gS(i,j,kLev,bi,bj)
                0215         ENDDO
                0216        ENDDO
                0217       ENDIF
                0218 # endif /* ALLOW_STEEP_ICECAVITY */
                0219 
ffe464dc7d Mart*0220 #endif /* ALLOW_SHELFICE */
                0221       RETURN
                0222       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!