Back to home page

MITgcm

 
 

    


File indexing completed on 2018-03-02 18:43:56 UTC

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