File indexing completed on 2025-05-05 05:08:25 UTC
view on githubraw file Latest commit 31fb0e0e on 2025-05-05 02:15:14 UTC
cec2469d72 Alis*0001 #include "MOM_VECINV_OPTIONS.h"
aea29c8517 Alis*0002
355718db32 Jean*0003
0004
0005
5d7e0a8948 Jean*0006 SUBROUTINE MOM_VI_V_CORIOLIS(
355718db32 Jean*0007 I bi, bj, k,
3370e71df9 Mart*0008 I selectVortScheme, useJamartMomAdv,
355718db32 Jean*0009 I uFld, omega3, hFacZ, r_hFacZ,
0010 O vCoriolisTerm,
0011 I myThid )
0012
cab1a69b8a Jean*0013
0014
355718db32 Jean*0015
0016
0017
cab1a69b8a Jean*0018
355718db32 Jean*0019
0020
0021
0022 IMPLICIT NONE
aea29c8517 Alis*0023
0024
0025 #include "SIZE.h"
0026 #include "EEPARAMS.h"
0027 #include "GRID.h"
0028
355718db32 Jean*0029
aea29c8517 Alis*0030
355718db32 Jean*0031 INTEGER bi, bj, k
0032 _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0033 _RL omega3 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0034 _RS hFacZ (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0035 _RS r_hFacZ (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
aea29c8517 Alis*0036 _RL vCoriolisTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
3370e71df9 Mart*0037 INTEGER selectVortScheme
0038 LOGICAL useJamartMomAdv
aea29c8517 Alis*0039 INTEGER myThid
355718db32 Jean*0040
aea29c8517 Alis*0041
0042
31fb0e0e6d Jean*0043
355718db32 Jean*0044 CHARACTER*(MAX_LEN_MBUF) msgBuf
0045 INTEGER i, j
0046 _RL uBarXY, uBarYm, uBarYp
0047 _RL vort3v
4e5f84a272 Jean*0048 _RL vort3im, vort3ij, vort3pm, vort3pj
0049 _RL oneThird, tmpFac
355718db32 Jean*0050 _RS epsil
aea29c8517 Alis*0051
cab1a69b8a Jean*0052 epsil = 1. _d -9
4e5f84a272 Jean*0053 tmpFac = 1. _d 0
0054
0055 oneThird = 1. _d 0 / 3. _d 0
aea29c8517 Alis*0056
355718db32 Jean*0057 IF ( selectVortScheme.EQ.0 ) THEN
0058
0059
31fb0e0e6d Jean*0060 DO j=2-OLy,sNy+OLy
0061 DO i=1-OLx,sNx+OLx-1
0062 uBarXY = 0.25 _d 0 *(
0063 & ( uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
0064 & + uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj) )
0065 & +( uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
0066 & + uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj) )
0067 & )
0068 vort3v = halfRL*( omega3(i,j)*r_hFacZ(i,j)
0069 & + omega3(i+1,j)*r_hFacZ(i+1,j) )
0070 vCoriolisTerm(i,j) = -vort3v*uBarXY*recip_dyC(i,j,bi,bj)
0071 & * _maskS(i,j,k,bi,bj)
355718db32 Jean*0072 ENDDO
0073 ENDDO
0074
0075 ELSEIF ( selectVortScheme.EQ.1 ) THEN
0076
0077
31fb0e0e6d Jean*0078 DO j=2-OLy,sNy+OLy
0079 DO i=1-OLx,sNx+OLx-1
0080 uBarXY = halfRL*(
0081 & ( uFld( i , j )*dyG( i , j ,bi,bj)*hFacZ( i ,j)
0082 & + uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*hFacZ( i ,j) )
0083 & +( uFld(i+1, j )*dyG(i+1, j ,bi,bj)*hFacZ(i+1,j)
0084 & + uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*hFacZ(i+1,j) )
0085 & )/MAX( epsil, hFacZ(i,j)+hFacZ(i+1,j) )
0086 vort3v = halfRL*( omega3(i,j) + omega3(i+1,j) )
0087 vCoriolisTerm(i,j) = -vort3v*uBarXY*recip_dyC(i,j,bi,bj)
0088 & * _maskS(i,j,k,bi,bj)
355718db32 Jean*0089 ENDDO
0090 ENDDO
0091
0092 ELSEIF ( selectVortScheme.EQ.2 ) THEN
0093
0094
31fb0e0e6d Jean*0095 DO j=2-OLy,sNy+OLy
0096 DO i=1-OLx,sNx+OLx-1
0097 uBarYm = halfRL*(
355718db32 Jean*0098 & uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
31fb0e0e6d Jean*0099 & + uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj) )
0100 uBarYp = halfRL*(
355718db32 Jean*0101 & uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
31fb0e0e6d Jean*0102 & + uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj) )
0103 vort3v = ( uBarYm*r_hFacZ( i ,j)*omega3( i ,j)
0104 & + uBarYp*r_hFacZ(i+1,j)*omega3(i+1,j)
0105 & )*halfRL
0106 vCoriolisTerm(i,j) = -vort3v*recip_dyC(i,j,bi,bj)
0107 & * _maskS(i,j,k,bi,bj)
355718db32 Jean*0108 ENDDO
0109 ENDDO
0110
4e5f84a272 Jean*0111 ELSEIF ( selectVortScheme.EQ.3 ) THEN
0112
0113
0114
0115
0116
0117
31fb0e0e6d Jean*0118 DO j=2-OLy,sNy+OLy-1
0119 DO i=1-OLx,sNx+OLx-1
0120 vort3im = ( r_hFacZ(i, j )*omega3(i, j )
0121 & +(r_hFacZ(i+1,j)*omega3(i+1,j)
0122 & +r_hFacZ(i,j-1)*omega3(i,j-1)
0123 & ))*oneThird
0124
4e5f84a272 Jean*0125 & *uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj)
31fb0e0e6d Jean*0126 vort3ij = ( r_hFacZ(i, j )*omega3(i, j )
0127 & +(r_hFacZ(i+1,j)*omega3(i+1,j)
0128 & +r_hFacZ(i,j+1)*omega3(i,j+1)
0129 & ))*oneThird
0130
4e5f84a272 Jean*0131 & *uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
31fb0e0e6d Jean*0132 vort3pm = ( r_hFacZ(i+1,j)*omega3(i+1,j)
0133 & +(r_hFacZ(i, j )*omega3(i, j )
0134 & +r_hFacZ(i+1,j-1)*omega3(i+1,j-1)
0135 & ))*oneThird
0136
4e5f84a272 Jean*0137 & *uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj)
31fb0e0e6d Jean*0138 vort3pj = ( r_hFacZ(i+1,j)*omega3(i+1,j)
0139 & +(r_hFacZ(i, j )*omega3(i, j )
0140 & +r_hFacZ(i+1,j+1)*omega3(i+1,j+1)
0141 & ))*oneThird
0142
4e5f84a272 Jean*0143 & *uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
0144
31fb0e0e6d Jean*0145 vCoriolisTerm(i,j) = -( (vort3im+vort3ij)+(vort3pm+vort3pj) )
0146 & *0.25 _d 0 *recip_dyC(i,j,bi,bj)
0147 & * _maskS(i,j,k,bi,bj)
0148 ENDDO
0149 ENDDO
0150
0151 ELSEIF ( selectVortScheme.EQ.4 ) THEN
0152
0153
0154 DO j=2-OLy,sNy+OLy
0155 DO i=1-OLx,sNx+OLx-1
0156 uBarYm = halfRL*(
0157 & uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
0158 & + uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj) )
0159 uBarYp = halfRL*(
0160 & uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
0161 & + uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj) )
0162 vort3v = ( uBarYm*omega3( i ,j)
0163 & + uBarYp*omega3(i+1,j)
0164 & )*halfRL
0165 vCoriolisTerm(i,j) = -vort3v*recip_dyC(i,j,bi,bj)
0166 & *recip_hFacS(i,j,k,bi,bj)
4e5f84a272 Jean*0167 ENDDO
0168 ENDDO
0169
355718db32 Jean*0170 ELSE
0171 WRITE(msgBuf,'(A,I5,A)')
0172 & 'MOM_VI_V_CORIOLIS: selectVortScheme=', selectVortScheme,
0173 & ' not implemented'
0174 CALL PRINT_ERROR( msgBuf, myThid )
0175 STOP 'ABNORMAL END: S/R MOM_VI_V_CORIOLIS'
0176
0177 ENDIF
0178
0179 IF ( useJamartMomAdv ) THEN
31fb0e0e6d Jean*0180 DO j=2-OLy,sNy+OLy-1
0181 DO i=1-OLx,sNx+OLx-1
355718db32 Jean*0182 vCoriolisTerm(i,j) = vCoriolisTerm(i,j)
0183 & * 4. _d 0 * _hFacS(i,j,k,bi,bj)
0184 & / MAX( epsil,
0185 & (_hFacW( i ,j,k,bi,bj)+_hFacW( i ,j-1,k,bi,bj))
0186 & +(_hFacW(i+1,j,k,bi,bj)+_hFacW(i+1,j-1,k,bi,bj))
0187 & )
0188 ENDDO
aea29c8517 Alis*0189 ENDDO
355718db32 Jean*0190 ENDIF
aea29c8517 Alis*0191
0192 RETURN
0193 END