pkg/obcs/obcs_apply_surf_dr.F

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