| 1 | mlosch | 1.7 | C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_calc_strainrates.F,v 1.6 2007/06/19 12:09:36 mlosch Exp $ | 
| 2 | mlosch | 1.1 | C $Name:  $ | 
| 3 |  |  |  | 
| 4 |  |  | #include "SEAICE_OPTIONS.h" | 
| 5 |  |  |  | 
| 6 |  |  | CStartOfInterface | 
| 7 |  |  | SUBROUTINE SEAICE_CALC_STRAINRATES( | 
| 8 |  |  | I     uFld, vFld, | 
| 9 |  |  | O     e11, e22, e12, | 
| 10 |  |  | I     myThid ) | 
| 11 |  |  | C     /==========================================================\ | 
| 12 |  |  | C     | SUBROUTINE  SEAICE_CALC_STRAINRATES                      | | 
| 13 |  |  | C     | o compute strain rates from ice velocities               | | 
| 14 |  |  | C     |==========================================================| | 
| 15 |  |  | C     | written by Martin Losch, Apr 2007                        | | 
| 16 |  |  | C     \==========================================================/ | 
| 17 |  |  | IMPLICIT NONE | 
| 18 |  |  |  | 
| 19 |  |  | C     === Global variables === | 
| 20 |  |  | #include "SIZE.h" | 
| 21 |  |  | #include "EEPARAMS.h" | 
| 22 |  |  | #include "PARAMS.h" | 
| 23 |  |  | #include "GRID.h" | 
| 24 |  |  | #include "SEAICE_PARAMS.h" | 
| 25 |  |  |  | 
| 26 |  |  | #ifdef ALLOW_AUTODIFF_TAMC | 
| 27 |  |  | # include "tamc.h" | 
| 28 |  |  | #endif | 
| 29 |  |  |  | 
| 30 |  |  | C     === Routine arguments === | 
| 31 |  |  | C     myThid - Thread no. that called this routine. | 
| 32 |  |  | INTEGER myThid | 
| 33 |  |  | C     ice velocities | 
| 34 |  |  | _RL uFld(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) | 
| 35 |  |  | _RL vFld(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) | 
| 36 |  |  | C     strain rate tensor | 
| 37 |  |  | _RL e11 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) | 
| 38 |  |  | _RL e22 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) | 
| 39 |  |  | _RL e12 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) | 
| 40 |  |  | CEndOfInterface | 
| 41 |  |  |  | 
| 42 |  |  | #ifdef SEAICE_CGRID | 
| 43 |  |  | #ifdef SEAICE_ALLOW_DYNAMICS | 
| 44 |  |  | C     === Local variables === | 
| 45 |  |  | C     i,j,bi,bj - Loop counters | 
| 46 |  |  | INTEGER i, j, bi, bj | 
| 47 | mlosch | 1.2 | C  hFacU, hFacV - determine the no-slip boundary condition | 
| 48 |  |  | INTEGER k | 
| 49 |  |  | _RS hFacU, hFacV | 
| 50 |  |  |  | 
| 51 | mlosch | 1.4 | k = 1 | 
| 52 | mlosch | 1.1 | C | 
| 53 |  |  | DO bj=myByLo(myThid),myByHi(myThid) | 
| 54 |  |  | DO bi=myBxLo(myThid),myBxHi(myThid) | 
| 55 | mlosch | 1.5 | DO j=1-Oly,sNy+Oly-1 | 
| 56 |  |  | DO i=1-Olx,sNx+Olx-1 | 
| 57 |  |  | C     evaluate strain rates | 
| 58 | mlosch | 1.6 | e11(I,J,bi,bj) = _recip_dxF(I,J,bi,bj) * | 
| 59 | mlosch | 1.1 | &         (uFld(I+1,J,bi,bj)-uFld(I,J,bi,bj)) | 
| 60 |  |  | &         -HALF* | 
| 61 |  |  | &         (vFld(I,J,bi,bj)+vFld(I,J+1,bi,bj)) | 
| 62 |  |  | &         * _tanPhiAtU(I,J,bi,bj)*recip_rSphere | 
| 63 | mlosch | 1.6 | e22(I,J,bi,bj) = _recip_dyF(I,J,bi,bj) * | 
| 64 | mlosch | 1.1 | &         (vFld(I,J+1,bi,bj)-vFld(I,J,bi,bj)) | 
| 65 |  |  | C     one metric term is missing | 
| 66 | mlosch | 1.5 | ENDDO | 
| 67 |  |  | ENDDO | 
| 68 |  |  | DO j=1-Oly+1,sNy+Oly | 
| 69 |  |  | DO i=1-Olx+1,sNx+Olx | 
| 70 | mlosch | 1.6 | e12(I,J,bi,bj) = HALF*( | 
| 71 | mlosch | 1.1 | &         (uFld(I  ,J  ,bi,bj) * _dxC(I  ,J  ,bi,bj) | 
| 72 |  |  | &         -uFld(I  ,J-1,bi,bj) * _dxC(I  ,J-1,bi,bj) | 
| 73 |  |  | &         +vFld(I  ,J  ,bi,bj) * _dyC(I  ,J  ,bi,bj) | 
| 74 |  |  | &         -vFld(I-1,J  ,bi,bj) * _dyC(I-1,J  ,bi,bj)) | 
| 75 |  |  | &         * recip_rAz(I,J,bi,bj) | 
| 76 |  |  | &         + | 
| 77 |  |  | &         0.25 _d 0 * (uFld(I,J,bi,bj)+uFld(I  ,J-1,bi,bj)) | 
| 78 |  |  | &         * ( _tanPhiAtU(I,J,bi,bj) + _tanPhiAtU(I,J-1,bi,bj) ) | 
| 79 |  |  | &         *recip_rSphere | 
| 80 |  |  | &         ) | 
| 81 | mlosch | 1.4 | &         *maskC(I  ,J  ,k,bi,bj)*maskC(I-1,J  ,k,bi,bj) | 
| 82 |  |  | &         *maskC(I  ,J-1,k,bi,bj)*maskC(I-1,J-1,k,bi,bj) | 
| 83 | mlosch | 1.1 | C     one metric term is missing | 
| 84 |  |  | ENDDO | 
| 85 |  |  | ENDDO | 
| 86 | mlosch | 1.2 | IF ( SEAICE_no_slip ) THEN | 
| 87 | mlosch | 1.3 | C     no slip boundary conditions apply only to e12 | 
| 88 | mlosch | 1.5 | DO j=1-Oly+1,sNy+Oly | 
| 89 |  |  | DO i=1-Olx+1,sNx+Olx | 
| 90 | mlosch | 1.2 | hFacU = _maskW(i,j,k,bi,bj) - _maskW(i,j-1,k,bi,bj) | 
| 91 |  |  | hFacV = _maskS(i,j,k,bi,bj) - _maskS(i-1,j,k,bi,bj) | 
| 92 |  |  |  | 
| 93 | mlosch | 1.6 | e12(I,J,bi,bj) = e12(I,J,bi,bj) | 
| 94 | mlosch | 1.4 | &          + recip_rAz(i,j,bi,bj) * | 
| 95 | mlosch | 1.7 | &          ( hFacU * ( _dxC(i,j-1,bi,bj)*uFld(i,j  ,bi,bj) | 
| 96 |  |  | &                    + _dxC(i,j,  bi,bj)*uFld(i,j-1,bi,bj) ) | 
| 97 |  |  | &          + hFacV * ( _dyC(i-1,j,bi,bj)*vFld(i  ,j,bi,bj) | 
| 98 |  |  | &                    + _dyC(i,  j,bi,bj)*vFld(i-1,j,bi,bj) ) ) | 
| 99 | mlosch | 1.2 | &         - hFacU | 
| 100 |  |  | &         * 0.25 _d 0 * (uFld(I,J,bi,bj)+uFld(I  ,J-1,bi,bj)) | 
| 101 |  |  | &         * ( _tanPhiAtU(I,J,bi,bj) + _tanPhiAtU(I,J-1,bi,bj) ) | 
| 102 |  |  | &         *recip_rSphere | 
| 103 |  |  | C     one metric term is missing | 
| 104 |  |  | ENDDO | 
| 105 |  |  | ENDDO | 
| 106 |  |  |  | 
| 107 |  |  | ENDIF | 
| 108 | mlosch | 1.1 | ENDDO | 
| 109 |  |  | ENDDO | 
| 110 |  |  | #endif /* SEAICE_ALLOW_DYNAMICS */ | 
| 111 |  |  | #endif /* SEAICE_CGRID */ | 
| 112 |  |  | RETURN | 
| 113 |  |  | END |