--- MITgcm/pkg/seaice/seaice_calc_strainrates.F 2011/10/21 17:32:01 1.18 +++ MITgcm/pkg/seaice/seaice_calc_strainrates.F 2017/06/08 15:10:05 1.23 @@ -1,4 +1,4 @@ -C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/seaice/seaice_calc_strainrates.F,v 1.18 2011/10/21 17:32:01 jmc Exp $ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/seaice/seaice_calc_strainrates.F,v 1.23 2017/06/08 15:10:05 mlosch Exp $ C $Name: $ #include "SEAICE_OPTIONS.h" @@ -7,6 +7,9 @@ #else # define OBCS_UVICE_OLD #endif +#ifdef ALLOW_AUTODIFF +# include "AUTODIFF_OPTIONS.h" +#endif CBOP C !ROUTINE: SEAICE_CALC_STRAINRATES @@ -33,6 +36,7 @@ #include "EEPARAMS.h" #include "PARAMS.h" #include "GRID.h" +#include "SEAICE_SIZE.h" #include "SEAICE_PARAMS.h" #include "SEAICE.h" @@ -51,8 +55,8 @@ C myTime :: Simulation time C myIter :: Simulation timestep number C myThid :: My Thread Id. number - _RL uFld (1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) - _RL vFld (1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) + _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL e11Loc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL e22Loc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL e12Loc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) @@ -71,6 +75,8 @@ C hFacU, hFacV :: determine the no-slip boundary condition INTEGER k _RS hFacU, hFacV, noSlipFac + _RL third + PARAMETER ( third = 0.333333333333333333333333333 _d 0 ) C auxillary variables that help writing code that C vectorizes even after TAFization _RL dudx (1-OLx:sNx+OLx,1-OLy:sNy+OLy) @@ -83,36 +89,39 @@ k = 1 noSlipFac = 0. _d 0 IF ( SEAICE_no_slip ) noSlipFac = 1. _d 0 +C in order repoduce results before fixing a bug in r1.20 comment out +C the following line +CML IF ( SEAICE_no_slip ) noSlipFac = 2. _d 0 C DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) C abbreviations on C-points, need to do them in separate loops C for vectorization - DO j=1-Oly,sNy+Oly-1 - DO i=1-Olx,sNx+Olx-1 + DO j=1-OLy,sNy+OLy-1 + DO i=1-OLx,sNx+OLx-1 dudx(i,j) = _recip_dxF(i,j,bi,bj) * & (uFld(i+1,j,bi,bj)-uFld(i,j,bi,bj)) uave(i,j) = 0.5 _d 0 * (uFld(i,j,bi,bj)+uFld(i+1,j,bi,bj)) ENDDO ENDDO - DO j=1-Oly,sNy+Oly-1 - DO i=1-Olx,sNx+Olx-1 + DO j=1-OLy,sNy+OLy-1 + DO i=1-OLx,sNx+OLx-1 dvdy(i,j) = _recip_dyF(i,j,bi,bj) * & (vFld(i,j+1,bi,bj)-vFld(i,j,bi,bj)) vave(i,j) = 0.5 _d 0 * (vFld(i,j,bi,bj)+vFld(i,j+1,bi,bj)) ENDDO ENDDO C evaluate strain rates at C-points - DO j=1-Oly,sNy+Oly-1 - DO i=1-Olx,sNx+Olx-1 + DO j=1-OLy,sNy+OLy-1 + DO i=1-OLx,sNx+OLx-1 e11Loc(i,j,bi,bj) = dudx(i,j) + vave(i,j) * k2AtC(i,j,bi,bj) e22Loc(i,j,bi,bj) = dvdy(i,j) + uave(i,j) * k1AtC(i,j,bi,bj) ENDDO ENDDO #ifndef OBCS_UVICE_OLD C-- for OBCS: assume no gradient beyong OB - DO j=1-Oly,sNy+Oly-1 - DO i=1-Olx,sNx+Olx-1 + DO j=1-OLy,sNy+OLy-1 + DO i=1-OLx,sNx+OLx-1 e11Loc(i,j,bi,bj) = e11Loc(i,j,bi,bj)*maskInC(i,j,bi,bj) e22Loc(i,j,bi,bj) = e22Loc(i,j,bi,bj)*maskInC(i,j,bi,bj) ENDDO @@ -121,23 +130,23 @@ C abbreviations at Z-points, need to do them in separate loops C for vectorization - DO j=1-Oly+1,sNy+Oly - DO i=1-Olx+1,sNx+Olx + DO j=1-OLy+1,sNy+OLy + DO i=1-OLx+1,sNx+OLx dudy(i,j) = ( uFld(i,j,bi,bj) - uFld(i ,j-1,bi,bj) ) & * _recip_dyU(i,j,bi,bj) uave(i,j) = 0.5 _d 0 * (uFld(i,j,bi,bj)+uFld(i ,j-1,bi,bj)) ENDDO ENDDO - DO j=1-Oly+1,sNy+Oly - DO i=1-Olx+1,sNx+Olx + DO j=1-OLy+1,sNy+OLy + DO i=1-OLx+1,sNx+OLx dvdx(i,j) = ( vFld(i,j,bi,bj) - vFld(i-1,j ,bi,bj) ) & * _recip_dxV(i,j,bi,bj) vave(i,j) = 0.5 _d 0 * (vFld(i,j,bi,bj)+vFld(i-1,j ,bi,bj)) ENDDO ENDDO C evaluate strain rates at Z-points - DO j=1-Oly+1,sNy+Oly - DO i=1-Olx+1,sNx+Olx + DO j=1-OLy+1,sNy+OLy + DO i=1-OLx+1,sNx+OLx hFacU = _maskW(i,j,k,bi,bj) - _maskW(i,j-1,k,bi,bj) hFacV = _maskS(i,j,k,bi,bj) - _maskS(i-1,j,k,bi,bj) e12Loc(i,j,bi,bj) = 0.5 _d 0 * ( @@ -147,7 +156,7 @@ & ) & *maskC(i ,j ,k,bi,bj)*maskC(i-1,j ,k,bi,bj) & *maskC(i ,j-1,k,bi,bj)*maskC(i-1,j-1,k,bi,bj) - & + 2.0 _d 0 * noSlipFac * ( + & + noSlipFac * ( & 2.0 _d 0 * uave(i,j) * _recip_dyU(i,j,bi,bj) * hFacU & + 2.0 _d 0 * vave(i,j) * _recip_dxV(i,j,bi,bj) * hFacV & ) @@ -158,7 +167,38 @@ c$$$ & - hFacU * k2AtZ(i,j,bi,bj) * uave(i,j) ENDDO ENDDO - + IF ( SEAICE_no_slip .AND. SEAICE_2ndOrderBC ) THEN + DO j=1-OLy+2,sNy+OLy-1 + DO i=1-OLx+2,sNx+OLx-1 + hFacU = (_maskW(i,j,k,bi,bj) - _maskW(i,j-1,k,bi,bj))*third + hFacV = (_maskS(i,j,k,bi,bj) - _maskS(i-1,j,k,bi,bj))*third + hFacU = hFacU*( _maskW(i,j-2,k,bi,bj)*_maskW(i,j-1,k,bi,bj) + & + _maskW(i,j+1,k,bi,bj)*_maskW(i,j, k,bi,bj) ) + hFacV = hFacV*( _maskS(i-2,j,k,bi,bj)*_maskS(i-1,j,k,bi,bj) + & + _maskS(i+1,j,k,bi,bj)*_maskS(i ,j,k,bi,bj) ) +C right hand sided dv/dx = (9*v(i,j)-v(i+1,j))/(4*dxv(i,j)-dxv(i+1,j)) +C according to a Taylor expansion to 2nd order. We assume that dxv +C varies very slowly, so that the denominator simplifies to 3*dxv(i,j), +C then dv/dx = (6*v(i,j)+3*v(i,j)-v(i+1,j))/(3*dxv(i,j)) +C = 2*v(i,j)/dxv(i,j) + (3*v(i,j)-v(i+1,j))/(3*dxv(i,j)) +C the left hand sided dv/dx is analogously +C = - 2*v(i-1,j)/dxv(i,j) - (3*v(i-1,j)-v(i-2,j))/(3*dxv(i,j)) +C the first term is the first order part, which is already added. +C For e12 we only need 0.5 of this gradient and vave = is either +C 0.5*v(i,j) or 0.5*v(i-1,j) near the boundary so that we need an +C extra factor of 2. This explains the six. du/dy is analogous. +C The masking is ugly, but hopefully effective. + e12Loc(i,j,bi,bj) = e12Loc(i,j,bi,bj) + 0.5 _d 0 * ( + & _recip_dyU(i,j,bi,bj) * ( 6.0 _d 0 * uave(i,j) + & - uFld(i,j-2,bi,bj)*_maskW(i,j-1,k,bi,bj) + & - uFld(i,j+1,bi,bj)*_maskW(i,j ,k,bi,bj) ) * hFacU + & + _recip_dxV(i,j,bi,bj) * ( 6.0 _d 0 * vave(i,j) + & - vFld(i-2,j,bi,bj)*_maskS(i-1,j,k,bi,bj) + & - vFld(i+1,j,bi,bj)*_maskS(i ,j,k,bi,bj) ) * hFacV + & ) + ENDDO + ENDDO + ENDIF ENDDO ENDDO