pkg/mom_fluxform/mom_v_metric_sphere.F

6d54cf9ca1 Ed H*0001 #include "MOM_FLUXFORM_OPTIONS.h"
aea29c8517 Alis*0002
71207ba845 Alis*0003 CBOP
                0004 C !ROUTINE: MOM_V_METRIC_SPHERE
                0005
                0006 C !INTERFACE: ==========================================================
aea29c8517 Alis*0007       SUBROUTINE MOM_V_METRIC_SPHERE(
31fb0e0e6d Jean*0008      I        bi, bj, k,
aea29c8517 Alis*0009      I        uFld,
                0010      O        vMetricTerms,
eaba2fd266 Jean*0011      I        myThid )
aea29c8517 Alis*0012
71207ba845 Alis*0013 C !DESCRIPTION:
                0014 C Calculates the meridional metric term due to sphericity:
                0015 C \begin{equation}
                0016 C \frac{1}{a} \overline{u}^{ij} \overline{u}^{ij} \tan{\phi}
                0017 C \end{equation}
                0018
                0019 C !USES: ===============================================================`
                0020       IMPLICIT NONE
aea29c8517 Alis*0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "PARAMS.h"
                0024 #include "GRID.h"
                0025
71207ba845 Alis*0026 C !INPUT PARAMETERS: ===================================================
31fb0e0e6d Jean*0027 C  bi, bj               :: tile indices
71207ba845 Alis*0028 C  k                    :: vertical level
31fb0e0e6d Jean*0029 C  uFld                 :: zonal velocity
                0030 C  myThid               :: my Thread Id number
                0031       INTEGER bi, bj, k
aea29c8517 Alis*0032       _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0033       INTEGER myThid
                0034
71207ba845 Alis*0035 C !OUTPUT PARAMETERS: ==================================================
                0036 C  vMetricTerms         :: metric term
                0037       _RL vMetricTerms(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0038
                0039 C !LOCAL VARIABLES: ====================================================
31fb0e0e6d Jean*0040 C  i, j                 :: loop indices
                0041       INTEGER i, j
71207ba845 Alis*0042 CEOP
aea29c8517 Alis*0043
31fb0e0e6d Jean*0044       IF ( selectMetricTerms.EQ.1 ) THEN
                0045 C-    Use analytical expression for tan(Phi) (stored in: tanPhiAtV)
                0046         DO j=1-OLx+1,sNy+OLy
                0047          DO i=1-OLx,sNx+OLx-1
                0048            vMetricTerms(i,j) = -recip_rSphere*recip_deepFacC(k)
                0049      &      *0.25 _d 0*( uFld(i,j  ) + uFld(i+1,j  )
                0050      &                 + uFld(i,j-1) + uFld(i+1,j-1)
                0051      &                 )
                0052      &      *0.25 _d 0*( uFld(i,j  ) + uFld(i+1,j  )
                0053      &                 + uFld(i,j-1) + uFld(i+1,j-1)
                0054      &                 )
                0055      &      *_tanPhiAtV(i,j,bi,bj)
                0056          ENDDO
                0057         ENDDO
                0058       ELSE
                0059 C-    Using grid-spacing gradient: estimates tan(Phi)/rSphere as -del^j(dxC)/rAz
                0060         DO j=2-OLx,sNy+OLy
                0061          DO i=1-OLx,sNx+OLx-1
                0062            vMetricTerms(i,j) = +halfRL*
                0063      &     ( ( uFld(i,j-1) + uFld(i,j) )*halfRL
                0064      &      *( dxC( i,  j, bi,bj)
                0065      &       - dxC( i, j-1,bi,bj) )*recip_rAz( i, j,bi,bj)
                0066      &      *( uFld( i, j-1)*dyG( i, j-1,bi,bj)*hFacW( i, j-1,k,bi,bj)
                0067      &       + uFld( i,  j )*dyG( i,  j, bi,bj)*hFacW( i,  j, k,bi,bj)
                0068      &       )*halfRL
                0069      &     + ( uFld(i+1,j-1) + uFld(i+1,j) )*halfRL
                0070      &      *( dxC(i+1, j, bi,bj)
                0071      &       - dxC(i+1,j-1,bi,bj) )*recip_rAz(i+1,j,bi,bj)
                0072      &      *( uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*hFacW(i+1,j-1,k,bi,bj)
                0073      &       + uFld(i+1, j )*dyG(i+1, j, bi,bj)*hFacW(i+1, j, k,bi,bj)
                0074      &       )*halfRL
                0075      &     )*recip_hFacS(i,j,k,bi,bj)
                0076      &      *recip_dyC(i,j,bi,bj)*recip_deepFacC(k)
                0077          ENDDO
                0078         ENDDO
                0079       ENDIF
aea29c8517 Alis*0080
                0081       RETURN
                0082       END