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
0004
0005
0006 SUBROUTINE OBCS_ADJUST_UVICE(
0007 U uFld, vFld,
0008 I myThid )
0009
0010
0011
0012
0013
0014
0015
0016 IMPLICIT NONE
0017
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
0027
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
0036
0037 INTEGER I,J,K,bi,bj
0038
0039
0040 K = 1
0041 DO bj=myByLo(myThid),myByHi(myThid)
0042 DO bi=myBxLo(myThid),myBxHi(myThid)
0043
0044
0045 # ifdef ALLOW_OBCS_NORTH
0046 IF ( tileHasOBN(bi,bj) ) THEN
74019f026d Jean*0047 DO I=1-OLx,sNx+OLx
f39a9f8117 Jean*0048
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
74019f026d Jean*0094 IF (OB_Js(I,bi,bj).NE.OB_indexNone) THEN
f39a9f8117 Jean*0095 # ifdef OBCS_SEAICE_COMPUTE_UVICE
0096
0097
0098
0099
0100
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
0141 # ifdef ALLOW_OBCS_EAST
0142 IF ( tileHasOBE(bi,bj) ) THEN
74019f026d Jean*0143 DO J=1-OLy,sNy+OLy
f39a9f8117 Jean*0144
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
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
0196
0197
0198
0199
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