** Warning **
Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.
Last-Modified: Fri, 18 Sep 2025 05:09:21 GMT
Content-Type: text/html; charset=utf-8
MITgcm/MITgcm/pkg/mom_common/mom_calc_ke.F
File indexing completed on 2018-03-02 18:42:04 UTC
view on github raw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
dcd1f9d5ca Alis* 0001 #include "MOM_COMMON_OPTIONS.h "
aea29c8517 Alis* 0002
71207ba845 Alis* 0003
0004
0005
0006
aea29c8517 Alis* 0007 SUBROUTINE MOM_CALC_KE (
dcd1f9d5ca Alis* 0008 I bi ,bj ,k ,KEscheme ,
aea29c8517 Alis* 0009 I uFld , vFld ,
0010 O KE ,
0011 I myThid )
0012
71207ba845 Alis* 0013
0014
0015
0016
0017
0018
0019
0020 IMPLICIT NONE
aea29c8517 Alis* 0021 #include "SIZE.h "
0022 #include "GRID.h "
0023
71207ba845 Alis* 0024
0025
0026
3bbb8876e3 Jean* 0027
71207ba845 Alis* 0028
0029
3bbb8876e3 Jean* 0030
71207ba845 Alis* 0031
aea29c8517 Alis* 0032 INTEGER bi ,bj ,k
0033 _RL uFld (1-OLx :sNx +OLx ,1-OLy :sNy +OLy )
0034 _RL vFld (1-OLx :sNx +OLx ,1-OLy :sNy +OLy )
dcd1f9d5ca Alis* 0035 INTEGER KEscheme
aea29c8517 Alis* 0036 INTEGER myThid
0037
71207ba845 Alis* 0038
0039
0040 _RL KE (1-OLx :sNx +OLx ,1-OLy :sNy +OLy )
0041
0042
0043
f6007f3cc5 Jean* 0044 INTEGER i ,j
71207ba845 Alis* 0045
aea29c8517 Alis* 0046
0047
0048
0049
0050
0051
0052
14bb46b4fa Jean* 0053 #ifdef ALLOW_AUTODIFF
f6007f3cc5 Jean* 0054 DO j =1-OLy ,sNy +OLy
0055 DO i =1-OLx ,sNx +OLx
0056 KE (i ,j ) = 0.
0057 ENDDO
0058 ENDDO
0059 #endif
0060
f7fdcad707 Jean* 0061 IF (KEscheme .EQ. -1) THEN
f6007f3cc5 Jean* 0062 DO j =1-OLy ,sNy +OLy -1
0063 DO i =1-OLx ,sNx +OLx -1
dcd1f9d5ca Alis* 0064 KE (i ,j ) = 0.125*(
0065 & ( uFld (i ,j )+uFld (i +1, j ) )**2
0066 & +( vFld (i ,j )+vFld ( i ,j +1) )**2 )
f6007f3cc5 Jean* 0067 ENDDO
dcd1f9d5ca Alis* 0068 ENDDO
aea29c8517 Alis* 0069
f7fdcad707 Jean* 0070 ELSEIF (KEscheme .EQ. 0) THEN
aea29c8517 Alis* 0071
0072
0073
0074
0075
0076
f6007f3cc5 Jean* 0077 DO j =1-OLy ,sNy +OLy -1
0078 DO i =1-OLx ,sNx +OLx -1
dcd1f9d5ca Alis* 0079 KE (i ,j ) = 0.25*(
f7fdcad707 Jean* 0080 & ( uFld ( i , j )*uFld ( i , j )
0081 & +uFld (i +1, j )*uFld (i +1, j ) )
0082 & + ( vFld ( i , j )*vFld ( i , j )
dcd1f9d5ca Alis* 0083 & +vFld ( i ,j +1)*vFld ( i ,j +1) )
f7fdcad707 Jean* 0084 & )
dcd1f9d5ca Alis* 0085 ENDDO
0086 ENDDO
aea29c8517 Alis* 0087
f7fdcad707 Jean* 0088 ELSEIF (KEscheme .EQ. 1) THEN
0089
f6007f3cc5 Jean* 0090 DO j =1-OLy ,sNy +OLy -1
0091 DO i =1-OLx ,sNx +OLx -1
f7fdcad707 Jean* 0092 KE (i ,j ) = 0.25*(
0093 & ( uFld (i , j )*uFld (i , j )*rAw (i ,j , bi ,bj )
0094 & +uFld (i +1,j )*uFld (i +1,j )*rAw (i +1,j ,bi ,bj ) )
0095 & + ( vFld (i , j )*vFld (i , j )*rAs (i ,j , bi ,bj )
0096 & +vFld (i ,j +1)*vFld (i ,j +1)*rAs (i ,j +1,bi ,bj ) )
0097 & )*recip_rA (i ,j ,bi ,bj )
0098 ENDDO
0099 ENDDO
0100
0101 ELSEIF (KEscheme .EQ. 2) THEN
0102
aea29c8517 Alis* 0103
f6007f3cc5 Jean* 0104 DO j =1-OLy ,sNy +OLy -1
0105 DO i =1-OLx ,sNx +OLx -1
dcd1f9d5ca Alis* 0106 KE (i ,j ) = 0.25*(
616600b8d2 Patr* 0107 & ( uFld ( i , j )*uFld ( i , j )*_hFacW (i ,j ,k ,bi ,bj )
0108 & +uFld (i +1, j )*uFld (i +1, j )*_hFacW (i +1,j ,k ,bi ,bj ) )
0109 & + ( vFld ( i , j )*vFld ( i , j )*_hFacS (i ,j ,k ,bi ,bj )
0110 & +vFld ( i ,j +1)*vFld ( i ,j +1)*_hFacS (i ,j +1,k ,bi ,bj ) )
0111 & )*_recip_hFacC (i ,j ,k ,bi ,bj )
dcd1f9d5ca Alis* 0112 ENDDO
aea29c8517 Alis* 0113 ENDDO
dcd1f9d5ca Alis* 0114
f7fdcad707 Jean* 0115 ELSEIF (KEscheme .EQ. 3) THEN
0116
f6007f3cc5 Jean* 0117 DO j =1-OLy ,sNy +OLy -1
0118 DO i =1-OLx ,sNx +OLx -1
3bbb8876e3 Jean* 0119 KE (i ,j ) = 0.25*(
f7fdcad707 Jean* 0120 & (
616600b8d2 Patr* 0121 & uFld (i , j )*uFld (i , j )
0122 & *_hFacW (i ,j , k ,bi ,bj )*rAw (i ,j , bi ,bj )
0123 & +uFld (i +1,j )*uFld (i +1,j )
0124 & *_hFacW (i +1,j ,k ,bi ,bj )*rAw (i +1,j ,bi ,bj )
f6007f3cc5 Jean* 0125 & )
f7fdcad707 Jean* 0126 & + (
616600b8d2 Patr* 0127 & vFld (i , j )*vFld (i , j )
0128 & *_hFacS (i , j , k ,bi ,bj )*rAs (i ,j , bi ,bj )
0129 & +vFld (i ,j +1)*vFld (i ,j +1)
0130 & *_hFacS (i ,j +1,k ,bi ,bj )*rAs (i ,j +1,bi ,bj )
0131 & ) )*_recip_hFacC (i ,j ,k ,bi ,bj )
0132 & * recip_rA (i ,j ,bi ,bj )
3bbb8876e3 Jean* 0133 ENDDO
0134 ENDDO
0135
dcd1f9d5ca Alis* 0136 ELSE
0137 STOP 'S/R MOM_CALC_KE: We should never reach this point!'
0138 ENDIF
aea29c8517 Alis* 0139
0140 RETURN
0141 END