/[MITgcm]/MITgcm/pkg/seaice/seaice_calc_strainrates.F
ViewVC logotype

Annotation of /MITgcm/pkg/seaice/seaice_calc_strainrates.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.6 - (hide annotations) (download)
Tue Jun 19 12:09:36 2007 UTC (17 years, 3 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f
Changes since 1.5: +5 -5 lines
beautify code (align a few equal signs etc.)

1 mlosch 1.6 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_calc_strainrates.F,v 1.5 2007/05/15 14:32:55 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     & ( hFacU * ( _dxC(i,j ,bi,bj)*uFld(i,j ,bi,bj)
96     & + _dxC(i,j-1,bi,bj)*uFld(i,j-1,bi,bj) )
97     & + hFacV * ( _dyC(i ,j,bi,bj)*vFld(i ,j,bi,bj)
98     & + _dyC(i-1,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

  ViewVC Help
Powered by ViewVC 1.1.22