aim.5l_cs/code/mom_vi_hfacz_diss.F

4e8a78de50 Jean*0001 #include "CPP_OPTIONS.h"
                0002
                0003       SUBROUTINE MOM_VI_HFACZ_DISS(
                0004      I        bi,bj,k,
                0005      O        hFacZ,r_hFacZ,
                0006      I        myThid)
                0007       IMPLICIT NONE
                0008 C
                0009 C     Compute hFactor (and reciprol) at the corner (Z-point)
                0010 C       used for vorticity,divergence form of viscous term
                0011 C        (also in Shap_S2 formulation)
                0012 C
                0013
                0014 C     == Global variables ==
                0015 #include "SIZE.h"
6a5bc76422 Jean*0016 #include "EEPARAMS.h"
                0017 #include "PARAMS.h"
4e8a78de50 Jean*0018 #include "GRID.h"
                0019
                0020 C     == Routine arguments ==
                0021       INTEGER bi,bj,k
                0022       _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0023       _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0024       _RS hFacZOpen
                0025       INTEGER myThid
                0026
                0027 C     == Local variables ==
                0028       INTEGER I,J
                0029
                0030 C--   Calculate open water fraction at vorticity points
                0031
                0032       DO i=1-Olx,sNx+Olx
                0033        hFacZ(i,1-Oly)=0.
                0034        r_hFacZ(i,1-Oly)=0.
                0035       ENDDO
                0036
                0037       DO j=2-Oly,sNy+Oly
                0038        hFacZ(1-Olx,j)=0.
                0039        r_hFacZ(1-Olx,j)=0.
                0040        DO i=2-Olx,sNx+Olx
                0041         hFacZOpen=MIN(_hFacW(i,j,k,bi,bj)
                0042      &              + _hFacW(i,j-1,k,bi,bj)
                0043      &              , _hFacS(i,j,k,bi,bj)
                0044      &              + _hFacS(i-1,j,k,bi,bj)
                0045      &               )
                0046         hFacZ(i,j)=0.5*hFacZOpen
                0047         IF (hFacZ(i,j).EQ.0.) THEN
                0048          r_hFacZ(i,j)=0.
                0049         ELSE
                0050          r_hFacZ(i,j)=1./hFacZ(i,j)
                0051         ENDIF
                0052        ENDDO
                0053       ENDDO
                0054
6a5bc76422 Jean*0055 C-    Special stuff for Cubed Sphere
                0056 C      above formula is ambiguous when only 3 edges instead of 4,
                0057 C      => return to min-3 definition at the Cubed-Sphere corners
                0058       IF (useCubedSphereExchange) THEN
                0059        DO j=1,sNy+1,sNy
                0060         DO i=1,sNx+1,sNx
                0061          hFacZOpen=MIN( _hFacW(i,j,k,bi,bj)
                0062      &                , _hFacW(i,j-1,k,bi,bj)
                0063      &                , _hFacS(i,j,k,bi,bj)
                0064      &                , _hFacS(i-1,j,k,bi,bj)
                0065      &                )
                0066          hFacZ(i,j)=hFacZOpen
                0067          IF (hFacZOpen.EQ.0.) THEN
                0068           r_hFacZ(i,j)=0.
                0069          ELSE
                0070           r_hFacZ(i,j)=1./hFacZOpen
                0071          ENDIF
                0072         ENDDO
                0073        ENDDO
                0074       ENDIF
                0075
4e8a78de50 Jean*0076       RETURN
                0077       END