pkg/obcs/obcs_apply_r_star.F

4535e90cda Jean*0001 #include "OBCS_OPTIONS.h"
                0002
00f96d7f83 Jean*0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: OBCS_APPLY_R_STAR
                0006
                0007 C     !INTERFACE:
4535e90cda Jean*0008       SUBROUTINE OBCS_APPLY_R_STAR(
5fb8330347 Jean*0009      I                bi, bj, etaFld,
4535e90cda Jean*0010      U                rStarFldC, rStarFldW, rStarFldS,
                0011      I                myTime, myIter, myThid )
00f96d7f83 Jean*0012
                0013 C     !DESCRIPTION:
4535e90cda Jean*0014 C     *==========================================================*
                0015 C     | S/R OBCS_APPLY_R_STAR
                0016 C     *==========================================================*
00f96d7f83 Jean*0017
                0018 C     !USES:
4535e90cda Jean*0019       IMPLICIT NONE
                0020 C     == Global variables ==
                0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "PARAMS.h"
                0024 #include "GRID.h"
6f4cf52d27 Dimi*0025 #include "OBCS_PARAMS.h"
9b4f2a04e2 Jean*0026 #include "OBCS_GRID.h"
                0027 #include "OBCS_FIELDS.h"
4535e90cda Jean*0028
00f96d7f83 Jean*0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C     bi, bj    :: tile indices
5fb8330347 Jean*0031 C     etaFld    :: current eta field used to update the hFactor
00f96d7f83 Jean*0032 C     rStarFldC :: r* thickness-factor (grid-cell center)
                0033 C     hFac_FldW :: r* thickness-factor (grid-cell Western -Edge)
                0034 C     hFac_FldS :: r* thickness-factor (grid-cell Southern-Edge)
                0035 C     myTime    :: current time in simlation
                0036 C     myIter    :: current time-step number
                0037 C     myThid    :: my Thread Id number
5fb8330347 Jean*0038       INTEGER bi, bj
74019f026d Jean*0039       _RL etaFld   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
4535e90cda Jean*0040       _RL rStarFldC(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0041       _RL rStarFldW(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0042       _RL rStarFldS(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0043       _RL myTime
                0044       INTEGER myIter, myThid
00f96d7f83 Jean*0045 CEOP
4535e90cda Jean*0046
                0047 #ifdef NONLIN_FRSURF
cb811659bb Patr*0048 #ifndef DISABLE_RSTAR_CODE
4535e90cda Jean*0049
00f96d7f83 Jean*0050 C     !LOCAL VARIABLES:
4535e90cda Jean*0051       INTEGER i,j
5fb8330347 Jean*0052       LOGICAL useOBeta
4535e90cda Jean*0053
                0054 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0055
5fb8330347 Jean*0056 C-- Eta OB values corresponding to previous iteration are not available when
                0057 C   calc_r_star is called for the 1rst time (myIter=-1) form initialise_varia.
                0058 C   Use current "etaFld" values instead, only for this 1rst call (myIter=-1).
                0059       useOBeta = myIter.NE.-1
                0060
4535e90cda Jean*0061 C- Set model rStar_Factor to OB values on North/South Boundaries
00f96d7f83 Jean*0062       IF ( tileHasOBN(bi,bj) ) THEN
4535e90cda Jean*0063 C  Northern boundary
74019f026d Jean*0064        DO i=1-OLx,sNx+OLx
                0065         IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN
                0066          j = OB_Jn(i,bi,bj)
5fb8330347 Jean*0067          IF (kSurfS(i,j,bi,bj).LE.Nr) THEN
                0068           IF ( useOBeta ) THEN
                0069            rStarFldS(i,j,bi,bj) = 1. _d 0
                0070      &      + OBNeta(  j,bi,bj) / (rSurfS(i,j,bi,bj)-rLowS(i,j,bi,bj))
                0071           ELSE
                0072            rStarFldS(i,j,bi,bj) = 1. _d 0
                0073      &      + etaFld(i,j,bi,bj) / (rSurfS(i,j,bi,bj)-rLowS(i,j,bi,bj))
                0074           ENDIF
00f96d7f83 Jean*0075          ENDIF
4535e90cda Jean*0076         ENDIF
00f96d7f83 Jean*0077        ENDDO
                0078       ENDIF
                0079       IF ( tileHasOBS(bi,bj) ) THEN
4535e90cda Jean*0080 C  Southern boundary
74019f026d Jean*0081        DO i=1-OLx,sNx+OLx
                0082         IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN
                0083          j = OB_Js(i,bi,bj)+1
5fb8330347 Jean*0084          IF (kSurfS(i,j,bi,bj).LE.Nr) THEN
                0085           IF ( useOBeta ) THEN
                0086            rStarFldS(i,j,bi,bj) = 1. _d 0
                0087      &      + OBSeta(  j,bi,bj) / (rSurfS(i,j,bi,bj)-rLowS(i,j,bi,bj))
                0088           ELSE
                0089            rStarFldS(i,j,bi,bj) = 1. _d 0
                0090      &      + etaFld(i,j-1,bi,bj)/(rSurfS(i,j,bi,bj)-rLowS(i,j,bi,bj))
                0091           ENDIF
00f96d7f83 Jean*0092          ENDIF
4535e90cda Jean*0093         ENDIF
00f96d7f83 Jean*0094        ENDDO
                0095       ENDIF
4535e90cda Jean*0096
                0097 C- Set model rStar_Factor to OB values on East/West Boundaries
00f96d7f83 Jean*0098       IF ( tileHasOBE(bi,bj) ) THEN
4535e90cda Jean*0099 C  Eastern boundary
74019f026d Jean*0100        DO j=1-OLy,sNy+OLy
                0101         IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN
                0102          i = OB_Ie(j,bi,bj)
5fb8330347 Jean*0103          IF (kSurfW(i,j,bi,bj).LE.Nr) THEN
                0104           IF ( useOBeta ) THEN
                0105            rStarFldW(i,j,bi,bj) = 1. _d 0
                0106      &      + OBEeta(  j,bi,bj) / (rSurfW(i,j,bi,bj)-rLowW(i,j,bi,bj))
                0107           ELSE
                0108            rStarFldW(i,j,bi,bj) = 1. _d 0
                0109      &      + etaFld(i,j,bi,bj) / (rSurfW(i,j,bi,bj)-rLowW(i,j,bi,bj))
                0110           ENDIF
00f96d7f83 Jean*0111          ENDIF
4535e90cda Jean*0112         ENDIF
00f96d7f83 Jean*0113        ENDDO
                0114       ENDIF
                0115       IF ( tileHasOBW(bi,bj) ) THEN
4535e90cda Jean*0116 C  Western boundary
74019f026d Jean*0117        DO j=1-OLy,sNy+OLy
                0118         IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN
                0119          i = OB_Iw(j,bi,bj)+1
5fb8330347 Jean*0120          IF (kSurfW(i,j,bi,bj).LE.Nr) THEN
                0121           IF ( useOBeta ) THEN
                0122            rStarFldW(i,j,bi,bj) = 1. _d 0
                0123      &      + OBWeta(  j,bi,bj) / (rSurfW(i,j,bi,bj)-rLowW(i,j,bi,bj))
                0124           ELSE
                0125            rStarFldW(i,j,bi,bj) = 1. _d 0
                0126      &      + etaFld(i-1,j,bi,bj)/(rSurfW(i,j,bi,bj)-rLowW(i,j,bi,bj))
                0127           ENDIF
00f96d7f83 Jean*0128          ENDIF
4535e90cda Jean*0129         ENDIF
00f96d7f83 Jean*0130        ENDDO
                0131       ENDIF
4535e90cda Jean*0132
                0133 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0134
cb811659bb Patr*0135 #endif /* DISABLE_RSTAR_CODE */
4535e90cda Jean*0136 #endif /* NONLIN_FRSURF */
5fb8330347 Jean*0137
4535e90cda Jean*0138       RETURN
                0139       END