pkg/mom_vecinv/mom_vi_del2uv.F

cec2469d72 Alis*0001 #include "MOM_VECINV_OPTIONS.h"
aea29c8517 Alis*0002
                0003       SUBROUTINE MOM_VI_DEL2UV(
                0004      I        bi,bj,k,
                0005      I        hDiv,vort3,hFacZ,
                0006      O        del2u,del2v,
                0007      I        myThid)
                0008       IMPLICIT NONE
                0009 C
                0010 C     Calculate del^2 of (u,v) in terms of hDiv and vort3
                0011 C
                0012
                0013 C     == Global variables ==
                0014 #include "SIZE.h"
                0015 #include "GRID.h"
404487e0d3 Andr*0016 #include "EEPARAMS.h"
aea29c8517 Alis*0017
                0018 C     == Routine arguments ==
                0019       INTEGER bi,bj,k
                0020       _RL hDiv(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0021       _RL vort3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0022       _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0023       _RL del2u(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0024       _RL del2v(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0025       INTEGER myThid
                0026
                0027 C     == Local variables ==
85504c2f03 Jean*0028       INTEGER i,j
                0029 c     _RL Zip,Zij,Zpj,Dim,Dij,Dmj,uDij
aea29c8517 Alis*0030
85504c2f03 Jean*0031 C     - bi-harmonic viscosity :
                0032
f1a4cec01a Jean*0033 c     DO j=2-OLy,sNy+OLy-1
                0034 c      DO i=2-OLx,sNx+OLx-1
aea29c8517 Alis*0035
                0036 c       Dim=dyF( i ,j-1,bi,bj)*hFacC( i ,j-1,k,bi,bj)*hDiv( i ,j-1)
                0037 c       Dij=dyF( i , j ,bi,bj)*hFacC( i , j ,k,bi,bj)*hDiv( i , j )
                0038 c       Dmj=dyF(i-1, j ,bi,bj)*hFacC(i-1, j ,k,bi,bj)*hDiv(i-1, j )
                0039 c       Dim=dyF( i ,j-1,bi,bj)*                       hDiv( i ,j-1)
                0040 c       Dij=dyF( i , j ,bi,bj)*                       hDiv( i , j )
                0041 c       Dmj=dyF(i-1, j ,bi,bj)*                       hDiv(i-1, j )
85504c2f03 Jean*0042 c       Dim=                                          hDiv( i ,j-1)
                0043 c       Dij=                                          hDiv( i , j )
                0044 c       Dmj=                                          hDiv(i-1, j )
aea29c8517 Alis*0045
                0046 c       Zip=dxV( i ,j+1,bi,bj)*hFacZ( i ,j+1)*vort3( i ,j+1)
                0047 c       Zij=dxV( i , j ,bi,bj)*hFacZ( i , j )*vort3( i , j )
                0048 c       Zpj=dxV(i+1, j ,bi,bj)*hFacZ(i+1, j )*vort3(i+1, j )
85504c2f03 Jean*0049 c       Zip=                   hFacZ( i ,j+1)*vort3( i ,j+1)
                0050 c       Zij=                   hFacZ( i , j )*vort3( i , j )
                0051 c       Zpj=                   hFacZ(i+1, j )*vort3(i+1, j )
                0052
aea29c8517 Alis*0053 c       del2u(i,j) = recip_rAw(i,j,bi,bj)*(
                0054 c    &   +recip_hFacW(i,j,k,bi,bj)*( Dij-Dmj )
                0055 c    &   -recip_hFacW(i,j,k,bi,bj)*( Zip-Zij ) )
                0056 c       del2u(i,j) = recip_rAw(i,j,bi,bj)*(
                0057 c    &   +                         ( Dij-Dmj )
                0058 c    &   -recip_hFacW(i,j,k,bi,bj)*( Zip-Zij ) )
85504c2f03 Jean*0059 c       del2u(i,j) =
                0060 c    &   +                         ( Dij-Dmj )*recip_DXC(i,j,bi,bj)
                0061 c    &   -recip_hFacW(i,j,k,bi,bj)*( Zip-Zij )*recip_DYG(i,j,bi,bj)
aea29c8517 Alis*0062
                0063 c       del2v(i,j) = recip_rAs(i,j,bi,bj)*(
                0064 c    &    recip_hFacS(i,j,k,bi,bj)*( Zpj-Zij )
                0065 c    &   +recip_hFacS(i,j,k,bi,bj)*( Dij-Dim ) )
                0066 c       del2v(i,j) = recip_rAs(i,j,bi,bj)*(
                0067 c    &    recip_hFacS(i,j,k,bi,bj)*( Zpj-Zij )
                0068 c    &   +                         ( Dij-Dim ) )
85504c2f03 Jean*0069 c       del2v(i,j) =
                0070 c    &    recip_hFacS(i,j,k,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
                0071 c    &   +                         ( Dij-Dim )*recip_DYC(i,j,bi,bj)
                0072
                0073 c      ENDDO
                0074 c     ENDDO
                0075
                0076 C     - bi-harmonic viscosity : del^2(U_component)
                0077
7f82819bd8 Patr*0078 cph-exch2#ifndef ALLOW_AUTODIFF_TAMC
85504c2f03 Jean*0079       IF (useCubedSphereExchange) THEN
                0080 C     to compute d/dx(hDiv), fill corners with appropriate values:
93e3461d85 Jean*0081         CALL FILL_CS_CORNER_TR_RL( 1, .FALSE.,
1891130b05 Jean*0082      &                             hDiv, bi,bj, myThid )
85504c2f03 Jean*0083       ENDIF
7f82819bd8 Patr*0084 cph-exch2#endif
85504c2f03 Jean*0085 c     DO j=1,sNy
                0086 c      DO i=1,sNx+1
f1a4cec01a Jean*0087       DO j=2-OLy,sNy+OLy-1
                0088        DO i=2-OLx,sNx+OLx-1
85504c2f03 Jean*0089         del2u(i,j) =
40adf483e7 Jean*0090      &      (  ( hDiv(i,j) - hDiv(i-1,j) )*recip_dxC(i,j,bi,bj)
                0091      &        -_recip_hFacW(i,j,k,bi,bj)*
85504c2f03 Jean*0092      &         ( hFacZ(i,j+1)*vort3(i,j+1) - hFacZ(i,j)*vort3(i,j) )
40adf483e7 Jean*0093      &                                    *recip_dyG(i,j,bi,bj)
f1a4cec01a Jean*0094      &      )*maskW(i,j,k,bi,bj)*recip_deepFacC(k)
a127177afc Jean*0095 #ifdef ALLOW_OBCS
                0096      &       *maskInW(i,j,bi,bj)
                0097 #endif
85504c2f03 Jean*0098        ENDDO
                0099       ENDDO
aea29c8517 Alis*0100
85504c2f03 Jean*0101 C     - bi-harmonic viscosity : del^2(V_component)
                0102
7f82819bd8 Patr*0103 cph-exch2#ifndef ALLOW_AUTODIFF_TAMC
85504c2f03 Jean*0104       IF (useCubedSphereExchange) THEN
                0105 C     to compute d/dy(hDiv), fill corners with appropriate values:
93e3461d85 Jean*0106         CALL FILL_CS_CORNER_TR_RL( 2, .FALSE.,
1891130b05 Jean*0107      &                             hDiv, bi,bj, myThid )
85504c2f03 Jean*0108       ENDIF
7f82819bd8 Patr*0109 cph-exch2#endif
85504c2f03 Jean*0110 c     DO j=1,sNy+1
                0111 c      DO i=1,sNx
f1a4cec01a Jean*0112       DO j=2-OLy,sNy+OLy-1
                0113        DO i=2-OLx,sNx+OLx-1
85504c2f03 Jean*0114         del2v(i,j) =
40adf483e7 Jean*0115      &      (  ( hDiv(i,j) - hDiv(i,j-1) )*recip_dyC(i,j,bi,bj)
                0116      &        +_recip_hFacS(i,j,k,bi,bj)*
85504c2f03 Jean*0117      &         ( hFacZ(i+1,j)*vort3(i+1,j) - hFacZ(i,j)*vort3(i,j) )
40adf483e7 Jean*0118      &                                    *recip_dxG(i,j,bi,bj)
f1a4cec01a Jean*0119      &      )*maskS(i,j,k,bi,bj)*recip_deepFacC(k)
a127177afc Jean*0120 #ifdef ALLOW_OBCS
                0121      &       *maskInS(i,j,bi,bj)
                0122 #endif
aea29c8517 Alis*0123        ENDDO
                0124       ENDDO
                0125
                0126       RETURN
                0127       END