Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:42:29 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
5459643feb Dimi*0001 #include "OBCS_OPTIONS.h"
f39a9f8117 Jean*0002 #ifdef ALLOW_SEAICE
                0003 #include "SEAICE_OPTIONS.h"
                0004 #endif
5459643feb Dimi*0005 
dc9ed78cb9 Jean*0006 CBOP
                0007 C     !ROUTINE: OBCS_APPLY_UVICE
                0008 C     !INTERFACE:
2fb872de6a Dimi*0009       SUBROUTINE OBCS_APPLY_UVICE(
f39a9f8117 Jean*0010      U                             uFld, vFld,
                0011      I                             myThid )
dc9ed78cb9 Jean*0012 
                0013 C     !DESCRIPTION:
                0014 C     *==========================================================*
                0015 C     | S/R OBCS_APPLY_UVICE
f39a9f8117 Jean*0016 C     |   Apply OB values to corresponding field array
dc9ed78cb9 Jean*0017 C     *==========================================================*
                0018 
                0019 C     !USES:
5459643feb Dimi*0020       IMPLICIT NONE
                0021 C     == Global variables ==
                0022 #include "SIZE.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
f39a9f8117 Jean*0025 c#include "GRID.h"
9b4f2a04e2 Jean*0026 #include "OBCS_PARAMS.h"
                0027 #include "OBCS_GRID.h"
                0028 #include "OBCS_SEAICE.h"
f39a9f8117 Jean*0029 #ifdef ALLOW_SEAICE
a34cef4f76 Jean*0030 # include "SEAICE_SIZE.h"
                0031 # include "SEAICE.h"
f39a9f8117 Jean*0032 #endif
5459643feb Dimi*0033 
dc9ed78cb9 Jean*0034 C     !INPUT/OUTPUT PARAMETERS:
f39a9f8117 Jean*0035 C     == Routine Arguments ==
                0036 C    uFld     :: horizontal velocity field, 1rst component (zonal)
                0037 C    vFld     :: horizontal velocity field, 2nd  component (meridional)
dc9ed78cb9 Jean*0038 C    myThid   :: my Thread Id number
01a1b421cb Mart*0039       _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0040       _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
5459643feb Dimi*0041       INTEGER myThid
                0042 
f39a9f8117 Jean*0043 #ifdef ALLOW_SEAICE
                0044 #ifdef SEAICE_CGRID
                0045 #ifndef OBCS_UVICE_OLD
5459643feb Dimi*0046 
dc9ed78cb9 Jean*0047 C     !LOCAL VARIABLES:
f39a9f8117 Jean*0048 C    bi, bj   :: indices of current tile
                0049 C    i, j     :: Loop counters
                0050       INTEGER bi, bj
                0051       INTEGER i, j
                0052       INTEGER Iobc, Jobc
                0053       _RL uvIceApplyFac
dc9ed78cb9 Jean*0054 CEOP
5459643feb Dimi*0055 
f39a9f8117 Jean*0056 C--   Set model variables to OB values on North/South Boundaries:
                0057 C     2 steps: 1) set tangential component ; 2) set normal component.
                0058 C     This ensures that the normal component is set correctly even
                0059 C     when it conficts with tangential setting from an other OB.
                0060 
                0061       uvIceApplyFac = OBCS_uvApplyFac
                0062 c     IF ( OBCS_monitorFreq.EQ.1. ) uvIceApplyFac =  -1.
                0063 c     IF ( OBCS_monitorFreq.EQ.deltaTmom*0.5 ) uvIceApplyFac = 0.
                0064 c     IF ( OBCS_monitorFreq.EQ.deltaTmom ) uvIceApplyFac = 1.
                0065 c     WRITE(standardMessageUnit,*)
                0066 c          'OBCS_APPLY_UVICE: uvIceApplyFac=', uvIceApplyFac
                0067 
2fb872de6a Dimi*0068       DO bj=myByLo(myThid),myByHi(myThid)
                0069        DO bi=myBxLo(myThid),myBxHi(myThid)
                0070 
f39a9f8117 Jean*0071 C--   Set Tangential component first:
                0072 
5459643feb Dimi*0073 C     Set model variables to OB values on North/South Boundaries
b02fcd2b81 Dimi*0074 # ifdef ALLOW_OBCS_NORTH
f39a9f8117 Jean*0075         IF ( tileHasOBN(bi,bj) ) THEN
00127a5872 Dimi*0076 C     Northern boundary
a34cef4f76 Jean*0077          DO i=1-OLx,sNx+OLx
f39a9f8117 Jean*0078           Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0079           IF ( Jobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0080            uFld(i,Jobc,bi,bj) = OBNuice(i,bi,bj)
                0081      &                        *seaiceMaskU(i,Jobc,bi,bj)
                0082           ENDIF
                0083          ENDDO
                0084         ENDIF
b02fcd2b81 Dimi*0085 # endif /* ALLOW_OBCS_NORTH */
dc9ed78cb9 Jean*0086 
b02fcd2b81 Dimi*0087 # ifdef ALLOW_OBCS_SOUTH
f39a9f8117 Jean*0088         IF ( tileHasOBS(bi,bj) ) THEN
00127a5872 Dimi*0089 C     Southern boundary
a34cef4f76 Jean*0090          DO i=1-OLx,sNx+OLx
f39a9f8117 Jean*0091           Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0092           IF ( Jobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0093            uFld(i,Jobc,bi,bj) = OBSuice(i,bi,bj)
                0094      &                        *seaiceMaskU(i,Jobc,bi,bj)
                0095           ENDIF
                0096          ENDDO
                0097         ENDIF
b02fcd2b81 Dimi*0098 # endif /* ALLOW_OBCS_SOUTH */
5459643feb Dimi*0099 
                0100 C     Set model variables to OB values on East/West Boundaries
b02fcd2b81 Dimi*0101 # ifdef ALLOW_OBCS_EAST
f39a9f8117 Jean*0102         IF ( tileHasOBE(bi,bj) ) THEN
00127a5872 Dimi*0103 C     Eastern boundary
a34cef4f76 Jean*0104          DO j=1-OLy,sNy+OLy
f39a9f8117 Jean*0105           Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0106           IF ( Iobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0107            vFld(Iobc,j,bi,bj) = OBEvice(j,bi,bj)
                0108      &                        *seaiceMaskV(Iobc,j,bi,bj)
                0109           ENDIF
                0110          ENDDO
                0111         ENDIF
b02fcd2b81 Dimi*0112 # endif /* ALLOW_OBCS_EAST */
dc9ed78cb9 Jean*0113 
b02fcd2b81 Dimi*0114 # ifdef ALLOW_OBCS_WEST
f39a9f8117 Jean*0115         IF ( tileHasOBW(bi,bj) ) THEN
00127a5872 Dimi*0116 C     Western boundary
a34cef4f76 Jean*0117          DO j=1-OLy,sNy+OLy
f39a9f8117 Jean*0118           Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0119           IF ( Iobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0120            vFld(Iobc,j,bi,bj) = OBWvice(j,bi,bj)
                0121      &                        *seaiceMaskV(Iobc,j,bi,bj)
                0122           ENDIF
                0123          ENDDO
                0124         ENDIF
                0125 # endif /* ALLOW_OBCS_WEST */
                0126 
                0127 C--   Then set Normal component:
                0128 
                0129 C     Set model variables to OB values on North/South Boundaries
                0130 # ifdef ALLOW_OBCS_NORTH
                0131         IF ( tileHasOBN(bi,bj) ) THEN
                0132 C     Northern boundary
a34cef4f76 Jean*0133          DO i=1-OLx,sNx+OLx
f39a9f8117 Jean*0134           Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0135           IF ( Jobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0136            vFld(i,Jobc,bi,bj)   = OBNvice(i,bi,bj)
                0137      &                          *seaiceMaskV(i,Jobc,bi,bj)
                0138            IF ( uvIceApplyFac.GE.0. )
                0139      &     vFld(i,Jobc+1,bi,bj) = OBNvice(i,bi,bj)
                0140      &                          *seaiceMaskV(i,Jobc,bi,bj)
                0141      &                          *uvIceApplyFac
                0142           ENDIF
                0143          ENDDO
                0144         ENDIF
                0145 # endif /* ALLOW_OBCS_NORTH */
                0146 
                0147 # ifdef ALLOW_OBCS_SOUTH
                0148         IF ( tileHasOBS(bi,bj) ) THEN
                0149 C     Southern boundary
a34cef4f76 Jean*0150          DO i=1-OLx,sNx+OLx
f39a9f8117 Jean*0151           Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0152           IF ( Jobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0153            vFld(i,Jobc+1,bi,bj) = OBSvice(i,bi,bj)
                0154      &                          *seaiceMaskV(i,Jobc+1,bi,bj)
                0155            IF ( uvIceApplyFac.GE.0. )
                0156      &     vFld(i,Jobc,bi,bj)   = OBSvice(i,bi,bj)
                0157      &                          *seaiceMaskV(i,Jobc+1,bi,bj)
                0158      &                          *uvIceApplyFac
                0159           ENDIF
                0160          ENDDO
                0161         ENDIF
                0162 # endif /* ALLOW_OBCS_SOUTH */
                0163 
                0164 C     Set model variables to OB values on East/West Boundaries
                0165 # ifdef ALLOW_OBCS_EAST
                0166         IF ( tileHasOBE(bi,bj) ) THEN
                0167 C     Eastern boundary
a34cef4f76 Jean*0168          DO j=1-OLy,sNy+OLy
f39a9f8117 Jean*0169           Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0170           IF ( Iobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0171            uFld(Iobc,j,bi,bj)   = OBEuice(j,bi,bj)
                0172      &                          *seaiceMaskU(Iobc,j,bi,bj)
                0173            IF ( uvIceApplyFac.GE.0. )
                0174      &     uFld(Iobc+1,j,bi,bj) = OBEuice(j,bi,bj)
                0175      &                          *seaiceMaskU(Iobc,j,bi,bj)
                0176      &                          *uvIceApplyFac
                0177           ENDIF
                0178          ENDDO
                0179         ENDIF
                0180 # endif /* ALLOW_OBCS_EAST */
                0181 
                0182 # ifdef ALLOW_OBCS_WEST
                0183         IF ( tileHasOBW(bi,bj) ) THEN
                0184 C     Western boundary
a34cef4f76 Jean*0185          DO j=1-OLy,sNy+OLy
f39a9f8117 Jean*0186           Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0187           IF ( Iobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0188            uFld(Iobc+1,j,bi,bj) = OBWuice(j,bi,bj)
                0189      &                          *seaiceMaskU(Iobc+1,j,bi,bj)
                0190            IF ( uvIceApplyFac.GE.0. )
                0191      &     uFld(Iobc,j,bi,bj)   = OBWuice(j,bi,bj)
                0192      &                          *seaiceMaskU(Iobc+1,j,bi,bj)
                0193      &                          *uvIceApplyFac
                0194           ENDIF
                0195          ENDDO
                0196         ENDIF
b02fcd2b81 Dimi*0197 # endif /* ALLOW_OBCS_WEST */
5459643feb Dimi*0198 
2fb872de6a Dimi*0199        ENDDO
                0200       ENDDO
                0201 
f39a9f8117 Jean*0202       CALL EXCH_UV_XY_RL( uFld, vFld,.TRUE.,myThid)
dc9ed78cb9 Jean*0203 
f39a9f8117 Jean*0204 #endif /* ndef OBCS_UVICE_OLD */
                0205 #endif /* SEAICE_CGRID */
                0206 #endif /* ALLOW_SEAICE */
5459643feb Dimi*0207 
                0208       RETURN
                0209       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!