C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_preconditioner.F,v 1.33 2016/04/22 08:50:34 mlosch Exp $ C $Name: $ #include "SEAICE_OPTIONS.h" #ifdef ALLOW_OBCS # include "OBCS_OPTIONS.h" #endif C-- File seaice_preconditioner.F: C-- Contents C-- o SEAICE_PRECONDITIONER C-- o SEAICE_PRECOND_RHSU C-- o SEAICE_PRECOND_RHSV C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP C !ROUTINE: SEAICE_PRECONDITIONER C !INTERFACE: SUBROUTINE SEAICE_PRECONDITIONER( U duIce, dvIce, I zetaPre, etaPre, etaZpre, zetaZpre, dwatPre, I newtonIter, krylovIter, myTime, myIter, myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE SEAICE_PRECONDITIONER C | o Preconditioner for Jacobian-free Newton-Krylov solver, C | compute improved first guess solution du/vIce, with C | suboptimal solver, here LSOR C *==========================================================* C | written by Martin Losch, Oct 2012 C *==========================================================* C \ev C !USES: IMPLICIT NONE C === Global variables === #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "DYNVARS.h" #include "GRID.h" #include "SEAICE_SIZE.h" #include "SEAICE_PARAMS.h" #include "SEAICE.h" C !INPUT PARAMETERS: C === Routine arguments === C myTime :: Simulation time C myIter :: Simulation timestep number C myThid :: my Thread Id. number C newtonIter :: current iterate of Newton iteration C krylovIter :: current iterate of Krylov iteration C *Pre are precomputed and held fixed during the Krylov iteration _RL zetaPre(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL zetaZPre(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL etaPre(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL etaZPre(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL dwatPre(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) INTEGER newtonIter INTEGER krylovIter _RL myTime INTEGER myIter INTEGER myThid C !OUTPUT PARAMETERS: C du/vIce :: solution vector _RL duIce(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL dvIce(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) CEOP #if (defined SEAICE_ALLOW_DYNAMICS defined SEAICE_ALLOW_JFNK) C !FUNCTIONS: LOGICAL DIFFERENT_MULTIPLE EXTERNAL C !LOCAL VARIABLES: C === Local variables === C i,j,bi,bj :: Loop counters INTEGER i, j, m, bi, bj INTEGER k INTEGER iMin, iMax, jMin, jMax CHARACTER*(MAX_LEN_MBUF) msgBuf _RL WFAU, WFAV C diagonals of coefficient matrices _RL AU (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL BU (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL CU (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL AV (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL BV (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL CV (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) C RHS _RL rhsU (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL rhsV (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL rhsU0(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL rhsV0(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) C coefficients for lateral points, u(j+/-1) _RL uRt1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL uRt2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) C coefficients for lateral points, v(i+/-1) _RL vRt1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL vRt2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) C abbreviations _RL etaPlusZeta (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL zetaMinusEta(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) C symmetric drag coefficient _RL dragSym(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) C auxillary fields _RL uTmp (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL vTmp (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RS SINWAT _RL COSWAT _RL coriFac _RL fricFac LOGICAL printResidual _RL residUini, residVini, residUend, residVend C CEOP C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| printResidual = debugLevel.GE.debLevC & .AND. DIFFERENT_MULTIPLE( SEAICE_monFreq, myTime, deltaTClock ) C extra overlap for (restricted) additive Schwarz method jMin = 1-SEAICE_OLy jMax = sNy+SEAICE_OLy iMin = 1-SEAICE_OLx iMax = sNx+SEAICE_OLx C convergence is affected with coriFac = fricFac = 1 coriFac = 0. _d 0 fricFac = coriFac C surface level k = 1 C-- introduce turning angles SINWAT=SIN(SEAICE_waterTurnAngle*deg2rad) COSWAT=COS(SEAICE_waterTurnAngle*deg2rad) C copy relaxation parameters WFAU=SEAICE_LSRrelaxU WFAV=SEAICE_LSRrelaxV C C Initialise C DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) DO j=1-OLy,sNy+OLy DO i=1-OLx,sNx+OLx rhsU (I,J,bi,bj) = 0. _d 0 rhsV (I,J,bi,bj) = 0. _d 0 rhsU0(I,J,bi,bj) = duIce(I,J,bi,bj) rhsV0(I,J,bi,bj) = dvIce(I,J,bi,bj) C first guess for the increment is 0. duIce(I,J,bi,bj) = 0. _d 0 dvIce(I,J,bi,bj) = 0. _d 0 C this is only the symmetric part of the drag dragSym(I,J,bi,bj) = dwatPre(I,J,bi,bj)*COSWAT ENDDO ENDDO ENDDO ENDDO C C some abbreviations C DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) DO J=jMin-1,jMax DO I=iMin-1,iMax etaPlusZeta (I,J,bi,bj)= etaPre(I,J,bi,bj)+zetaPre(I,J,bi,bj) zetaMinusEta(I,J,bi,bj)=zetaPre(I,J,bi,bj)- etaPre(I,J,bi,bj) ENDDO ENDDO ENDDO ENDDO C C calculate coefficients of tridiagonal matrices for both u- and C v-equations C CALL SEAICE_LSR_CALC_COEFFS( I etaPlusZeta, zetaMinusEta, etaZpre, zetaZpre, dragSym, O AU, BU, CU, AV, BV, CV, uRt1, uRt2, vRt1, vRt2, I iMin, iMax, jMin, jMax, myTime, myIter, myThid ) #ifndef OBCS_UVICE_OLD C-- prevent tri-diagonal solver from modifying OB values: DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) DO J=jMin,jMax DO I=iMin,iMax IF ( maskInC(i,j,bi,bj)*maskInC(i-1,j,bi,bj) .EQ. 0. ) THEN AU(I,J,bi,bj) = ZERO BU(I,J,bi,bj) = ONE CU(I,J,bi,bj) = ZERO uRt1(I,J,bi,bj) = ZERO uRt2(I,J,bi,bj) = ZERO ENDIF IF ( maskInC(i,j,bi,bj)*maskInC(i,j-1,bi,bj) .EQ. 0. ) THEN AV(I,J,bi,bj) = ZERO BV(I,J,bi,bj) = ONE CV(I,J,bi,bj) = ZERO vRt1(I,J,bi,bj) = ZERO vRt2(I,J,bi,bj) = ZERO ENDIF ENDDO ENDDO ENDDO ENDDO #endif /* OBCS_UVICE_OLD */ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| #ifdef ALLOW_DEBUG IF ( debugLevel .GE. debLevD ) THEN WRITE(msgBuf,'(A,I3,A,I3,A)') & 'Uice pre iter (SEAICE_PRECONDITIONER', & newtonIter, ',', krylovIter, ')' CALL DEBUG_STATS_RL( 1, UICE, msgBuf, myThid ) WRITE(msgBuf,'(A,I3,A,I3,A)') & 'Vice pre iter (SEAICE_PRECONDITIONER', & newtonIter, ',', krylovIter, ')' CALL DEBUG_STATS_RL( 1, VICE, msgBuf, myThid ) ENDIF #endif /* ALLOW_DEBUG */ C-- Calculate initial residual of the linearised system IF ( printResidual ) THEN C set up right-hand side now (will be redone in each iteration) DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) DO j=jMin,jMax DO i=iMin,iMax rhsU(I,J,bi,bj) = rhsU0(I,J,bi,bj) rhsV(I,J,bi,bj) = rhsV0(I,J,bi,bj) ENDDO ENDDO CALL SEAICE_PRECOND_RHSU ( I zetaMinusEta, etaPlusZeta, etaZpre, zetaZpre, I dwatPre, coriFac, fricFac, SINWAT, COSWAT, I duIce, dvIce, O rhsU, I iMin,iMax,jMin,jMax,bi,bj,myThid ) CALL SEAICE_PRECOND_RHSV ( I zetaMinusEta, etaPlusZeta, etaZpre, zetaZpre, I dwatPre, coriFac, fricFac, SINWAT, COSWAT, I duIce, dvIce, O rhsV, I iMin,iMax,jMin,jMax,bi,bj,myThid ) #ifndef OBCS_UVICE_OLD DO J=jMin,jMax DO I=iMin,iMax IF ( maskInC(i,j,bi,bj)*maskInC(i-1,j,bi,bj) .EQ. 0. ) THEN rhsU(I,J,bi,bj) = duIce(I,J,bi,bj) ENDIF IF ( maskInC(i,j,bi,bj)*maskInC(i,j-1,bi,bj) .EQ. 0. ) THEN rhsV(I,J,bi,bj) = dvIce(I,J,bi,bj) ENDIF ENDDO ENDDO #endif /* OBCS_UVICE_OLD */ ENDDO ENDDO CALL SEAICE_RESIDUAL( I rhsU, rhsV, uRt1, uRt2, vRt1, vRt2, I AU, BU, CU, AV, BV, CV, duIce, dvIce, O residUini, residVini, uTmp, vTmp, I printResidual, myIter, myThid ) ENDIF C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| C NOW DO ITERATION C ITERATION START ----------------------------------------------------- DO m = 1, SEAICEpreconLinIter DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) C save du/vIce prior to iteration DO j=1-OLy,sNy+OLy DO i=1-OLx,sNx+OLx uTmp(I,J,bi,bj)=duIce(I,J,bi,bj) vTmp(I,J,bi,bj)=dvIce(I,J,bi,bj) ENDDO ENDDO C set up right-hand sides for u- and v-equations DO j=jMin,jMax DO i=iMin,iMax rhsU(I,J,bi,bj) = rhsU0(I,J,bi,bj) #ifndef SEAICE_PRECOND_EXTRA_EXCHANGE rhsV(I,J,bi,bj) = rhsV0(I,J,bi,bj) #endif /* SEAICE_PRECOND_EXTRA_EXCHANGE */ ENDDO ENDDO CALL SEAICE_PRECOND_RHSU ( I zetaMinusEta, etaPlusZeta, etaZpre, zetaZPre, I dwatPre, coriFac, fricFac, SINWAT, COSWAT, I duIce, dvIce, U rhsU, I iMin,iMax,jMin,jMax,bi,bj,myThid ) #ifndef SEAICE_PRECOND_EXTRA_EXCHANGE CALL SEAICE_PRECOND_RHSV ( I zetaMinusEta, etaPlusZeta, etaZpre, zetaZpre, I dwatPre, coriFac, fricFac, SINWAT, COSWAT, I duIce, dvIce, U rhsV, I iMin,iMax,jMin,jMax,bi,bj,myThid ) #endif /* SEAICE_PRECOND_EXTRA_EXCHANGE */ #ifndef OBCS_UVICE_OLD C-- prevent tri-diagonal solver from modifying OB values: DO J=jMin,jMax DO I=iMin,iMax IF ( maskInC(i,j,bi,bj)*maskInC(i-1,j,bi,bj) .EQ. 0. ) THEN rhsU(I,J,bi,bj) = duIce(I,J,bi,bj) ENDIF #ifndef SEAICE_PRECOND_EXTRA_EXCHANGE IF ( maskInC(i,j,bi,bj)*maskInC(i,j-1,bi,bj) .EQ. 0. ) THEN rhsV(I,J,bi,bj) = dvIce(I,J,bi,bj) ENDIF #endif /* SEAICE_PRECOND_EXTRA_EXCHANGE */ ENDDO ENDDO #endif /* OBCS_UVICE_OLD */ C Solve for uIce : CALL SEAICE_LSR_TRIDIAGU( I AU, BU, CU, uRt1, uRt2, rhsU, uTmp, seaiceMaskU, WFAU, U duIce, I imin, imax, jmin, jmax, bi, bj, myTime, myIter, myThid ) #ifdef SEAICE_PRECOND_EXTRA_EXCHANGE ENDDO ENDDO C ideally one would like to get rid off this exchange CALL EXCH_UV_XY_RL( duIce, dvIce, .TRUE., myThid ) DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) C set up right-hand-side for v-equation DO j=jMin,jMax DO i=iMin,iMax rhsV(I,J,bi,bj) = rhsV0(I,J,bi,bj) ENDDO ENDDO CALL SEAICE_PRECOND_RHSV ( I zetaMinusEta, etaPlusZeta, etaZpre, zetaZpre, I dwatPre, coriFac, fricFac, SINWAT, COSWAT, I duIce, dvIce, U rhsV, I iMin,iMax,jMin,jMax,bi,bj,myThid ) #ifndef OBCS_UVICE_OLD C-- prevent tri-diagonal solver from modifying OB values: DO J=jMin,jMax DO I=iMin,iMax IF ( maskInC(i,j,bi,bj)*maskInC(i,j-1,bi,bj) .EQ. 0. ) THEN rhsV(I,J,bi,bj) = dvIce(I,J,bi,bj) ENDIF ENDDO ENDDO #endif /* OBCS_UVICE_OLD */ #endif /* SEAICE_PRECOND_EXTRA_EXCHANGE */ C Solve for dvIce CALL SEAICE_LSR_TRIDIAGV( I AV, BV, CV, vRt1, vRt2, rhsV, vTmp, seaiceMaskV, WFAV, U dvIce, I imin, imax, jmin, jmax, bi, bj, myTime, myIter, myThid ) C end bi,bj-loops ENDDO ENDDO CALL EXCH_UV_XY_RL( duIce, dvIce, .TRUE., myThid ) ENDDO C ITERATION END ----------------------------------------------------- C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| IF ( printResidual ) THEN C-- Calculate final residual of the linearised system CALL SEAICE_RESIDUAL( I rhsU, rhsV, uRt1, uRt2, vRt1, vRt2, I AU, BU, CU, AV, BV, CV, duIce, dvIce, O residUend, residVend, uTmp, vTmp, I printResidual, myIter, myThid ) _BEGIN_MASTER( myThid ) WRITE(standardMessageUnit,'(A,A,1X,1P2E16.8)') & ' SEAICE_PRECONDITIONER: Residual Initial Uice,Vice =', & ' ', residUini, residVini WRITE(standardMessageUnit,'(A,I4,A,I4,A,I6,1P2E16.8)') & ' SEAICE_PRECONDITIONER (iter=',newtonIter,',', & krylovIter, ') iters, U/VResid=', & SEAICEpreconLinIter, residUend, residVend _END_MASTER( myThid ) ENDIF #ifdef ALLOW_DEBUG IF ( debugLevel .GE. debLevD ) THEN WRITE(msgBuf,'(A,I3,A,I3,A)') & 'Uice post iter (SEAICE_PRECONDITIONER', & newtonIter, ',', krylovIter, ')' CALL DEBUG_STATS_RL( 1, UICE, msgBuf, myThid ) WRITE(msgBuf,'(A,I3,A,I3,A)') & 'Vice post iter (SEAICE_PRECONDITIONER', & newtonIter, ',', krylovIter, ')' CALL DEBUG_STATS_RL( 1, VICE, msgBuf, myThid ) ENDIF #endif /* ALLOW_DEBUG */ C APPLY MASKS DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) DO J=1-OLy,sNy+OLy DO I=1-OLx,sNx+OLx duIce(I,J,bi,bj)=duIce(I,J,bi,bj)* seaiceMaskU(I,J,bi,bj) dvIce(I,J,bi,bj)=dvIce(I,J,bi,bj)* seaiceMaskV(I,J,bi,bj) ENDDO ENDDO ENDDO ENDDO RETURN END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP C !ROUTINE: SEAICE_PRECOND_RHSU C !INTERFACE: SUBROUTINE SEAICE_PRECOND_RHSU ( I zetaMinusEta, etaPlusZeta, etaZpre, zetaZpre, I dwatPre, coriFac, fricFac, SINWAT, COSWAT, I uIceLoc, vIceLoc, U rhsU, I iMin,iMax,jMin,jMax,bi,bj,myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE SEAICE_PRECOND_RHSU C | o Calculate the right-hand-side of the u-momentum equation C *==========================================================* C \ev C !USES: IMPLICIT NONE #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "DYNVARS.h" #include "GRID.h" #include "SEAICE_SIZE.h" #include "SEAICE_PARAMS.h" #include "SEAICE.h" C !INPUT/OUTPUT PARAMETERS: _RL zetaMinusEta(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL etaPlusZeta (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL etaZpre (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL zetaZpre (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL uIceLoc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL vIceLoc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL dwatPre (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL coriFac, fricFac _RS SINWAT _RL COSWAT _RL rhsU (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) INTEGER iMin, iMax, jMin, jMax, bi, bj, myThid CEOP C !LOCAL VARIABLES: INTEGER I,J,K _RL zeros(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL areaW(1-OLx:sNx+OLx,1-OLy:sNy+OLy) C surface level k = 1 C set dummy pressure to zero DO J=1-OLy,sNy+OLy DO I=1-OLx,sNx+OLx zeros(I,J,bi,bj) = 0. _d 0 ENDDO ENDDO CALL SEAICE_LSR_RHSU( I zetaMinusEta, etaPlusZeta, etaZpre, zetaZpre, zeros, I uIceLoc, vIceLoc, U rhsU, I iMin, iMax, jMin, jMax, bi, bj, myThid ) C neglected for preconditioning step IF ( fricFac+coriFac .NE. 0. _d 0 ) THEN IF ( SEAICEscaleSurfStress ) THEN DO J=jMin,jMax DO I=iMin,iMax areaW(I,J) = 0.5 _d 0*(AREA(I,J,bi,bj)+AREA(I-1,J,bi,bj)) ENDDO ENDDO ELSE DO J=jMin,jMax DO I=iMin,iMax areaW(I,J) = 1. _d 0 ENDDO ENDDO ENDIF DO J=jMin,jMax DO I=iMin,iMax rhsU(I,J,bi,bj) = rhsU(I,J,bi,bj) & - SIGN(SINWAT, _fCori(I,J,bi,bj))* 0.5 _d 0 * & ( dwatPre(I ,J,bi,bj) * 0.5 _d 0 * & (vVel(I ,J ,k,bi,bj)-vIceLoc(I ,J ,bi,bj) & +vVel(I ,J+1,k,bi,bj)-vIceLoc(I ,J+1,bi,bj)) & + dwatPre(I-1,J,bi,bj) * 0.5 _d 0 * & (vVel(I-1,J ,k,bi,bj)-vIceLoc(I-1,J ,bi,bj) & +vVel(I-1,J+1,k,bi,bj)-vIceLoc(I-1,J+1,bi,bj)) & ) * fricFac * areaW(I,J) C- add Coriolis term rhsU(I,J,bi,bj) = rhsU(I,J,bi,bj) + 0.5 _d 0 * & ( seaiceMassC(I ,J,bi,bj) * _fCori(I ,J,bi,bj) & *0.5 _d 0*(vIceLoc( i ,j,bi,bj)+vIceLoc( i ,j+1,bi,bj)) & + seaiceMassC(I-1,J,bi,bj) * _fCori(I-1,J,bi,bj) & *0.5 _d 0*(vIceLoc(i-1,j,bi,bj)+vIceLoc(i-1,j+1,bi,bj)) & ) * coriFac ENDDO ENDDO ENDIF RETURN END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP C !ROUTINE: SEAICE_PRECOND_RHSV C !INTERFACE: SUBROUTINE SEAICE_PRECOND_RHSV ( I zetaMinusEta, etaPlusZeta, etaZpre, zetaZpre, I dwatPre, coriFac, fricFac, SINWAT, COSWAT, I uIceLoc, vIceLoc, U rhsV, I iMin,iMax,jMin,jMax,bi,bj,myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE SEAICE_PRECOND_RHSV C | o Calculate the right-hand-side of the v-momentum equation C *==========================================================* C \ev C !USES: IMPLICIT NONE #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "DYNVARS.h" #include "GRID.h" #include "SEAICE_SIZE.h" #include "SEAICE_PARAMS.h" #include "SEAICE.h" C !INPUT/OUTPUT PARAMETERS: _RL zetaMinusEta(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL etaPlusZeta (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL etaZpre (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL zetaZpre (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL uIceLoc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL vIceLoc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL dwatPre (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL coriFac, fricFac _RS SINWAT _RL COSWAT _RL rhsV (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) INTEGER iMin, iMax, jMin, jMax, bi, bj, myThid CEOP C !LOCAL VARIABLES: INTEGER I,J,K _RL zeros(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL areaS(1-OLx:sNx+OLx,1-OLy:sNy+OLy) C surface level k = 1 C set dummy pressure to zero DO J=1-OLy,sNy+OLy DO I=1-OLx,sNx+OLx zeros(I,J,bi,bj) = 0. _d 0 ENDDO ENDDO CALL SEAICE_LSR_RHSV( I zetaMinusEta, etaPlusZeta, etaZpre, zetaZpre, zeros, I uIceLoc, vIceLoc, U rhsV, I iMin, iMax, jMin, jMax, bi, bj, myThid ) C neglected for preconditioning step IF ( fricFac+coriFac .NE. 0. _d 0 ) THEN IF ( SEAICEscaleSurfStress ) THEN DO J=jMin,jMax DO I=iMin,iMax areaS(I,J) = 0.5 _d 0*(AREA(I,J,bi,bj)+AREA(I,J-1,bi,bj)) ENDDO ENDDO ELSE DO J=jMin,jMax DO I=iMin,iMax areaS(I,J) = 1. _d 0 ENDDO ENDDO ENDIF DO J=jMin,jMax DO I=iMin,iMax rhsV(I,J,bi,bj) = rhsV(I,J,bi,bj) & + SIGN(SINWAT, _fCori(I,J,bi,bj)) * 0.5 _d 0 * & ( dwatPre(I,J ,bi,bj) * 0.5 _d 0 * & (uVel(I ,J ,k,bi,bj)-uIceLoc(I ,J ,bi,bj) & +uVel(I+1,J ,k,bi,bj)-uIceLoc(I+1,J ,bi,bj)) & + dwatPre(I,J-1,bi,bj) * 0.5 _d 0 * & (uVel(I ,J-1,k,bi,bj)-uIceLoc(I ,J-1,bi,bj) & +uVel(I+1,J-1,k,bi,bj)-uIceLoc(I+1,J-1,bi,bj)) & ) * fricFac * areaS(I,J) C- add Coriolis term rhsV(I,J,bi,bj) = rhsV(I,J,bi,bj) - 0.5 _d 0 * & ( seaiceMassC(I,J ,bi,bj) * _fCori(I,J ,bi,bj) & *0.5 _d 0*(uIceLoc(i ,j ,bi,bj)+uIceLoc(i+1, j,bi,bj)) & + seaiceMassC(I,J-1,bi,bj) * _fCori(I,J-1,bi,bj) & *0.5 _d 0*(uIceLoc(i ,j-1,bi,bj)+uIceLoc(i+1,j-1,bi,bj)) & ) * coriFac ENDDO ENDDO ENDIF #endif /* SEAICE_ALLOW_JFNK */ RETURN END