pkg/obcs/obcs_apply_eta.F

7af3d6f22c Jean*0001 #include "OBCS_OPTIONS.h"
                0002
55bc9a9ec9 Jean*0003 CBOP
                0004 C     !ROUTINE: OBCS_APPLY_ETA
                0005 C     !INTERFACE:
7af3d6f22c Jean*0006       SUBROUTINE OBCS_APPLY_ETA( bi, bj,
55bc9a9ec9 Jean*0007      U                           etaFld,
                0008      I                           myThid )
                0009
                0010 C     !DESCRIPTION:
                0011 C     *==========================================================*
                0012 C     | S/R OBCS_APPLY_ETA
                0013 C     |   Apply surface position anomaly (Eta) OB values
                0014 C     |   to corresponding field array
                0015 C     *==========================================================*
                0016
                0017 C     !USES:
7af3d6f22c Jean*0018       IMPLICIT NONE
                0019 C     == Global variables ==
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "GRID.h"
85417372a0 Jean*0024 #include "SURFACE.h"
6f4cf52d27 Dimi*0025 #include "OBCS_PARAMS.h"
9b4f2a04e2 Jean*0026 #include "OBCS_GRID.h"
                0027 #include "OBCS_FIELDS.h"
7af3d6f22c Jean*0028
55bc9a9ec9 Jean*0029 C     !INPUT/OUTPUT PARAMETERS:
7af3d6f22c Jean*0030 C     == Routine Arguments ==
55bc9a9ec9 Jean*0031 C    bi, bj   :: indices of current tile
                0032 C    etaFld   :: surface r-position anomaly field
                0033 C    myThid   :: my Thread Id number
                0034       INTEGER bi, bj
7af3d6f22c Jean*0035       _RL etaFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0036       INTEGER myThid
55bc9a9ec9 Jean*0037 CEOP
7af3d6f22c Jean*0038
55bc9a9ec9 Jean*0039 #ifdef NONLIN_FRSURF
                0040 C     !LOCAL VARIABLES:
7af3d6f22c Jean*0041 C     == Local variables ==
55bc9a9ec9 Jean*0042       INTEGER i, j
                0043       INTEGER Iobc, Jobc
7af3d6f22c Jean*0044
55bc9a9ec9 Jean*0045 c     IF ( nonlinFreeSurf.GT.0 ) THEN
c751103723 Jean*0046
                0047 C     Set model variable to OB values on North/South Boundaries
55bc9a9ec9 Jean*0048         IF ( tileHasOBN(bi,bj) ) THEN
c751103723 Jean*0049 C Northern boundary
74019f026d Jean*0050          DO i=1-OLx,sNx+OLx
55bc9a9ec9 Jean*0051           Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0052           IF ( Jobc.NE.OB_indexNone ) THEN
55bc9a9ec9 Jean*0053             IF ( kSurfS(i,Jobc,bi,bj).LE.Nr )
                0054      &        etaFld(i,Jobc,bi,bj) = OBNeta(i,bi,bj)
c751103723 Jean*0055           ENDIF
55bc9a9ec9 Jean*0056          ENDDO
                0057         ENDIF
                0058         IF ( tileHasOBS(bi,bj) ) THEN
c751103723 Jean*0059 C Southern boundary
74019f026d Jean*0060          DO i=1-OLx,sNx+OLx
55bc9a9ec9 Jean*0061           Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0062           IF ( Jobc.NE.OB_indexNone ) THEN
55bc9a9ec9 Jean*0063             IF ( kSurfS(i,Jobc+1,bi,bj).LE.Nr )
                0064      &        etaFld(i,Jobc,bi,bj) = OBSeta(i,bi,bj)
c751103723 Jean*0065           ENDIF
55bc9a9ec9 Jean*0066          ENDDO
                0067         ENDIF
c751103723 Jean*0068
7af3d6f22c Jean*0069 C     Set model variables to OB values on East/West Boundaries
55bc9a9ec9 Jean*0070         IF ( tileHasOBE(bi,bj) ) THEN
7af3d6f22c Jean*0071 C Eastern boundary
74019f026d Jean*0072          DO j=1-OLy,sNy+OLy
55bc9a9ec9 Jean*0073           Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0074           IF ( Iobc.NE.OB_indexNone ) THEN
55bc9a9ec9 Jean*0075             IF ( kSurfW(Iobc,j,bi,bj).LE.Nr )
                0076      &        etaFld(Iobc,j,bi,bj) = OBEeta(j,bi,bj)
c751103723 Jean*0077           ENDIF
55bc9a9ec9 Jean*0078          ENDDO
                0079         ENDIF
                0080         IF ( tileHasOBW(bi,bj) ) THEN
7af3d6f22c Jean*0081 C Western boundary
74019f026d Jean*0082          DO j=1-OLy,sNy+OLy
55bc9a9ec9 Jean*0083           Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0084           IF ( Iobc.NE.OB_indexNone ) THEN
55bc9a9ec9 Jean*0085             IF ( kSurfW(Iobc+1,j,bi,bj).LE.Nr )
                0086      &        etaFld(Iobc,j,bi,bj) = OBWeta(j,bi,bj)
c751103723 Jean*0087           ENDIF
55bc9a9ec9 Jean*0088          ENDDO
                0089         ENDIF
7af3d6f22c Jean*0090
55bc9a9ec9 Jean*0091 c     ENDIF
7af3d6f22c Jean*0092 #endif /* NONLIN_FRSURF */
c751103723 Jean*0093
7af3d6f22c Jean*0094       RETURN
                0095       END