Back to home page

MITgcm

 
 

    


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

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
f39a9f8117 Jean*0001 #include "OBCS_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C     !ROUTINE: OBCS_ADJUST_UVICE
                0005 C     !INTERFACE:
                0006       SUBROUTINE OBCS_ADJUST_UVICE(
                0007      U                          uFld, vFld,
                0008      I                          myThid )
                0009 
                0010 C     !DESCRIPTION:
                0011 C     *==========================================================*
                0012 C     | S/R OBCS_ADJUST_UVICE
                0013 C     *==========================================================*
                0014 
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017 C     == Global variables ==
                0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
                0021 #include "GRID.h"
                0022 #include "OBCS_PARAMS.h"
                0023 #include "OBCS_GRID.h"
                0024 #include "OBCS_SEAICE.h"
                0025 
                0026 C     !INPUT/OUTPUT PARAMETERS:
                0027 C    myThid   :: my Thread Id number
                0028       _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0029       _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0030       INTEGER myThid
                0031 
                0032 #if (defined (ALLOW_OBCS) && defined (ALLOW_SEAICE))
                0033 #ifdef OBCS_UVICE_OLD
                0034 
                0035 C     !LOCAL VARIABLES:
                0036 C     I,J,K,bi,bj :: Loop counters
                0037       INTEGER I,J,K,bi,bj
                0038 CEOP
                0039 
                0040       K = 1
                0041       DO bj=myByLo(myThid),myByHi(myThid)
                0042        DO bi=myBxLo(myThid),myBxHi(myThid)
                0043 
                0044 C     Set model variables to OB values on North/South Boundaries
                0045 # ifdef ALLOW_OBCS_NORTH
                0046       IF ( tileHasOBN(bi,bj) ) THEN
74019f026d Jean*0047       DO I=1-OLx,sNx+OLx
f39a9f8117 Jean*0048 C     Northern boundary
74019f026d Jean*0049        IF (OB_Jn(I,bi,bj).NE.OB_indexNone) THEN
f39a9f8117 Jean*0050 #  ifdef OBCS_SEAICE_COMPUTE_UVICE
                0051         uFld(I,OB_Jn(I,bi,bj)  ,bi,bj) =
                0052      &       _maskW(I,OB_Jn(I,bi,bj),K,bi,bj) *
                0053      &       uFld(I,OB_Jn(I,bi,bj)-1,bi,bj)
                0054         vFld(I,OB_Jn(I,bi,bj)  ,bi,bj) =
                0055      &       _maskS(I,OB_Jn(I,bi,bj),K,bi,bj) *
                0056      &       vFld(I,OB_Jn(I,bi,bj)-1,bi,bj)
                0057 #  else /* OBCS_SEAICE_COMPUTE_UVICE */
                0058 #   ifdef OBCS_SEAICE_AVOID_CONVERGENCE
                0059         vFld(I,OB_Jn(I,bi,bj),bi,bj) =
                0060      &       max(OBNvice(I,bi,bj),vFld(I,OB_Jn(I,bi,bj),bi,bj)) *
                0061      &       _maskS(I,OB_Jn(I,bi,bj),K,bi,bj)
                0062 #   else /* OBCS_SEAICE_AVOID_CONVERGENCE */
                0063         vFld(I,OB_Jn(I,bi,bj),bi,bj) = OBNvice(I,bi,bj) *
                0064      &       _maskS(I,OB_Jn(I,bi,bj),K,bi,bj)
                0065 #   endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
                0066         uFld(I,OB_Jn(I,bi,bj),bi,bj) = OBNuice(I,bi,bj) *
                0067      &       _maskW(I,OB_Jn(I,bi,bj),K,bi,bj)
                0068 #   ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
                0069         if ( _maskS(I,OB_Jn(I,bi,bj)  ,K,bi,bj) .NE. 0. .AND.
                0070      &       _maskS(I,OB_Jn(I,bi,bj)-2,K,bi,bj) .NE. 0. )
                0071      &       vFld(I,OB_Jn(I,bi,bj)-1,bi,bj) = 0.5 _d 0 *
                0072      &       ( vFld(I,OB_Jn(I,bi,bj)  ,bi,bj) +
                0073      &       vFld(I,OB_Jn(I,bi,bj)-2,bi,bj) ) *
                0074      &       _maskS(I,OB_Jn(I,bi,bj)-1,K,bi,bj)
                0075 #   endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
                0076 #   ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
                0077         if ( _maskW(I,OB_Jn(I,bi,bj)  ,K,bi,bj) .NE. 0. .AND.
                0078      &       _maskW(I,OB_Jn(I,bi,bj)-2,K,bi,bj) .NE. 0. )
                0079      &       uFld(I,OB_Jn(I,bi,bj)-1,bi,bj) = 0.5 _d 0 *
                0080      &       ( uFld(I,OB_Jn(I,bi,bj)  ,bi,bj) +
                0081      &       uFld(I,OB_Jn(I,bi,bj)-2,bi,bj) ) *
                0082      &       _maskW(I,OB_Jn(I,bi,bj)-1,K,bi,bj)
                0083 #   endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
                0084 #  endif /* OBCS_SEAICE_COMPUTE_UVICE */
                0085        ENDIF
                0086       ENDDO
                0087       ENDIF
                0088 # endif /* ALLOW_OBCS_NORTH */
                0089 
                0090 # ifdef ALLOW_OBCS_SOUTH
                0091       IF ( tileHasOBS(bi,bj) ) THEN
74019f026d Jean*0092       DO I=1-OLx,sNx+OLx
f39a9f8117 Jean*0093 C     Southern boundary
74019f026d Jean*0094        IF (OB_Js(I,bi,bj).NE.OB_indexNone) THEN
f39a9f8117 Jean*0095 #  ifdef OBCS_SEAICE_COMPUTE_UVICE
                0096 C-jmc: this uFld looks like a bug; should be:
                0097 c       uFld(I,OB_Js(I,bi,bj),bi,bj) =
                0098 c    &         _maskW(I,OB_Js(I,bi,bj),K,bi,bj) *
                0099 c    &         uFld(I,OB_Js(I,bi,bj)+1,bi,bj)
                0100 C- rather than:
                0101         uFld(I,OB_Js(I,bi,bj)+1,bi,bj) =
                0102      &         _maskW(I,OB_Js(I,bi,bj)+1,K,bi,bj) *
                0103      &         uFld(I,OB_Js(I,bi,bj)+2,bi,bj)
                0104         vFld(I,OB_Js(I,bi,bj)+1,bi,bj) =
                0105      &         _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj) *
                0106      &         vFld(I,OB_Js(I,bi,bj)+2,bi,bj)
                0107 #  else /* OBCS_SEAICE_COMPUTE_UVICE */
                0108 #   ifdef OBCS_SEAICE_AVOID_CONVERGENCE
                0109         vFld(I,OB_Js(I,bi,bj)+1,bi,bj)=
                0110      &       min(OBSvice(I,bi,bj),vFld(I,OB_Js(I,bi,bj)+1,bi,bj))
                0111      &       * _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj)
                0112 #   else /* OBCS_SEAICE_AVOID_CONVERGENCE */
                0113         vFld(I,OB_Js(I,bi,bj)+1,bi,bj)=OBSvice(I,bi,bj)
                0114      &       * _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj)
                0115 #   endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
                0116         uFld(I,OB_Js(I,bi,bj),bi,bj)=OBSuice(I,bi,bj)
                0117      &       * _maskW(I,OB_Js(I,bi,bj),K,bi,bj)
                0118 #   ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
                0119         if ( _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj) .NE. 0. .AND.
                0120      &       _maskS(I,OB_Js(I,bi,bj)+3,K,bi,bj) .NE. 0. )
                0121      &       vFld(I,OB_Js(I,bi,bj)+2,bi,bj) = 0.5 _d 0 *
                0122      &       ( vFld(I,OB_Js(I,bi,bj)+1,bi,bj) +
                0123      &       vFld(I,OB_Js(I,bi,bj)+3,bi,bj) ) *
                0124      &       _maskS(I,OB_Js(I,bi,bj)+2,K,bi,bj)
                0125 #   endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
                0126 #   ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
                0127         if ( _maskW(I,OB_Js(I,bi,bj)  ,K,bi,bj) .NE. 0. .AND.
                0128      &       _maskW(I,OB_Js(I,bi,bj)+2,K,bi,bj) .NE. 0. )
                0129      &       uFld(I,OB_Js(I,bi,bj)+1,bi,bj) = 0.5 _d 0 *
                0130      &       ( uFld(I,OB_Js(I,bi,bj)  ,bi,bj) +
                0131      &       uFld(I,OB_Js(I,bi,bj)+2,bi,bj) ) *
                0132      &       _maskW(I,OB_Js(I,bi,bj)+1,K,bi,bj)
                0133 #   endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
                0134 #  endif /* OBCS_SEAICE_COMPUTE_UVICE */
                0135        ENDIF
                0136       ENDDO
                0137       ENDIF
                0138 # endif /* ALLOW_OBCS_SOUTH */
                0139 
                0140 C     Set model variables to OB values on East/West Boundaries
                0141 # ifdef ALLOW_OBCS_EAST
                0142       IF ( tileHasOBE(bi,bj) ) THEN
74019f026d Jean*0143       DO J=1-OLy,sNy+OLy
f39a9f8117 Jean*0144 C     Eastern boundary
74019f026d Jean*0145        IF (OB_Ie(J,bi,bj).NE.OB_indexNone) THEN
f39a9f8117 Jean*0146 #  ifdef OBCS_SEAICE_COMPUTE_UVICE
                0147         uFld(OB_Ie(J,bi,bj),J,bi,bj) =
                0148      &         _maskW(OB_Ie(J,bi,bj),J,K,bi,bj) *
                0149      &         uFld(OB_Ie(J,bi,bj)-1,J,bi,bj)
                0150         vFld(OB_Ie(J,bi,bj),J,bi,bj) =
                0151      &         _maskS(OB_Ie(J,bi,bj),J,K,bi,bj) *
                0152      &         vFld(OB_Ie(J,bi,bj)-1,J,bi,bj)
                0153 #  else /* OBCS_SEAICE_COMPUTE_UVICE */
                0154 #   ifdef OBCS_SEAICE_AVOID_CONVERGENCE
                0155         uFld(OB_Ie(J,bi,bj),J,bi,bj)=
                0156      &       max(OBEuice(J,bi,bj),uFld(OB_Ie(J,bi,bj),J,bi,bj))
                0157      &       * _maskW(OB_Ie(J,bi,bj),J,K,bi,bj)
                0158 #   else /* OBCS_SEAICE_AVOID_CONVERGENCE */
                0159         uFld(OB_Ie(J,bi,bj),J,bi,bj)=OBEuice(J,bi,bj)
                0160      &       * _maskW(OB_Ie(J,bi,bj),J,K,bi,bj)
                0161 #   endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
                0162         vFld(OB_Ie(J,bi,bj),J,bi,bj)=OBEvice(J,bi,bj)
                0163      &       * _maskS(OB_Ie(J,bi,bj),J,K,bi,bj)
                0164 #   ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
                0165         if ( _maskW(OB_Ie(J,bi,bj)  ,J,K,bi,bj) .NE. 0. .AND.
                0166      &       _maskW(OB_Ie(J,bi,bj)-2,J,K,bi,bj) .NE. 0. )
                0167      &       uFld(OB_Ie(J,bi,bj)-1,J,bi,bj) = 0.5 _d 0 *
                0168      &       ( uFld(OB_Ie(J,bi,bj)  ,J,bi,bj) +
                0169      &       uFld(OB_Ie(J,bi,bj)-2,J,bi,bj) ) *
                0170      &       _maskW(OB_Ie(J,bi,bj)-1,J,K,bi,bj)
                0171 #   endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
                0172 #   ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
                0173         if ( _maskS(OB_Ie(J,bi,bj)  ,J,K,bi,bj) .NE. 0. .AND.
                0174      &       _maskS(OB_Ie(J,bi,bj)-2,J,K,bi,bj) .NE. 0. )
                0175      &       vFld(OB_Ie(J,bi,bj)-1,J,bi,bj) = 0.5 _d 0 *
                0176      &       ( vFld(OB_Ie(J,bi,bj)  ,J,bi,bj) +
                0177      &       vFld(OB_Ie(J,bi,bj)-2,J,bi,bj) ) *
                0178      &       _maskS(OB_Ie(J,bi,bj)-1,J,K,bi,bj)
                0179 #   endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
                0180 #  endif /* OBCS_SEAICE_COMPUTE_UVICE */
                0181        ENDIF
                0182       ENDDO
                0183       ENDIF
                0184 # endif /* ALLOW_OBCS_EAST */
                0185 
                0186 # ifdef ALLOW_OBCS_WEST
                0187       IF ( tileHasOBW(bi,bj) ) THEN
74019f026d Jean*0188       DO J=1-OLy,sNy+OLy
f39a9f8117 Jean*0189 C     Western boundary
74019f026d Jean*0190        IF (OB_Iw(J,bi,bj).NE.OB_indexNone) THEN
f39a9f8117 Jean*0191 #  ifdef OBCS_SEAICE_COMPUTE_UVICE
                0192         uFld(OB_Iw(J,bi,bj)+1,J,bi,bj)=
                0193      &         _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj) *
                0194      &         uFld(OB_Iw(J,bi,bj)+2,J,bi,bj)
                0195 C-jmc: this vFld looks like a bug; should be:
                0196 c       vFld(OB_Iw(J,bi,bj),J,bi,bj)=
                0197 c    &         _maskS(OB_Iw(J,bi,bj),J,K,bi,bj) *
                0198 c    &         vFld(OB_Iw(J,bi,bj)+1,J,bi,bj)
                0199 C- rather than:
                0200         vFld(OB_Iw(J,bi,bj)+1,J,bi,bj)=
                0201      &         _maskS(OB_Iw(J,bi,bj)+1,J,K,bi,bj) *
                0202      &         vFld(OB_Iw(J,bi,bj)+2,J,bi,bj)
                0203 #  else /* OBCS_SEAICE_COMPUTE_UVICE */
                0204 #   ifdef OBCS_SEAICE_AVOID_CONVERGENCE
                0205         uFld(OB_Iw(J,bi,bj)+1,J,bi,bj)=
                0206      &       min(OBWuice(J,bi,bj),uFld(OB_Iw(J,bi,bj)+1,J,bi,bj))
                0207      &       * _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj)
                0208 #   else /* OBCS_SEAICE_AVOID_CONVERGENCE */
                0209         uFld(OB_Iw(J,bi,bj)+1,J,bi,bj)=OBWuice(J,bi,bj)
                0210      &       * _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj)
                0211 #   endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
                0212         vFld(OB_Iw(J,bi,bj),J,bi,bj)=OBWvice(J,bi,bj)
                0213      &       * _maskS(OB_Iw(J,bi,bj),J,K,bi,bj)
                0214 #   ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
                0215         if ( _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj) .NE. 0. .AND.
                0216      &       _maskW(OB_Iw(J,bi,bj)+3,J,K,bi,bj) .NE. 0. )
                0217      &       uFld(OB_Iw(J,bi,bj)+2,J,bi,bj) = 0.5 _d 0 *
                0218      &       ( uFld(OB_Iw(J,bi,bj)+1,J,bi,bj) +
                0219      &       uFld(OB_Iw(J,bi,bj)+3,J,bi,bj) ) *
                0220      &       _maskW(OB_Iw(J,bi,bj)+2,J,K,bi,bj)
                0221 #   endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
                0222 #   ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
                0223         if ( _maskS(OB_Iw(J,bi,bj)  ,J,K,bi,bj) .NE. 0. .AND.
                0224      &       _maskS(OB_Iw(J,bi,bj)+2,J,K,bi,bj) .NE. 0. )
                0225      &       vFld(OB_Iw(J,bi,bj)+1,J,bi,bj) = 0.5 _d 0 *
                0226      &       ( vFld(OB_Iw(J,bi,bj)  ,J,bi,bj) +
                0227      &       vFld(OB_Iw(J,bi,bj)+2,J,bi,bj) ) *
                0228      &       _maskS(OB_Iw(J,bi,bj)+1,J,K,bi,bj)
                0229 #   endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
                0230 #  endif /* OBCS_SEAICE_COMPUTE_UVICE */
                0231        ENDIF
                0232       ENDDO
                0233       ENDIF
                0234 # endif /* ALLOW_OBCS_WEST */
                0235 
                0236        ENDDO
                0237       ENDDO
                0238 
                0239       CALL EXCH_UV_XY_RL( uFld, vFld, .TRUE., myThid )
                0240 
                0241 #endif /* OBCS_UVICE_OLD */
                0242 #endif /* defined (ALLOW_OBCS) && defined (ALLOW_SEAICE) */
                0243 
                0244       RETURN
                0245       END