/[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.23 - (hide annotations) (download)
Thu Jun 8 15:10:05 2017 UTC (7 years, 3 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, HEAD
Changes since 1.22: +35 -1 lines
add the option to compute no-slip du/dy, dv/dx (i.e.
the offdiagonal strain rate e12) by a second order approximation
on the boundary; works only with JFNK, KRYLOV, or EVP solvers, because
it is too messy to implement for the implicit LSR matrix.
SEAICE_2ndOrderBC = .FALSE. by default

1 mlosch 1.23 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_calc_strainrates.F,v 1.22 2017/05/26 09:08:32 mlosch Exp $
2 mlosch 1.1 C $Name: $
3    
4     #include "SEAICE_OPTIONS.h"
5 jmc 1.18 #ifdef ALLOW_OBCS
6     # include "OBCS_OPTIONS.h"
7     #else
8     # define OBCS_UVICE_OLD
9     #endif
10 gforget 1.21 #ifdef ALLOW_AUTODIFF
11     # include "AUTODIFF_OPTIONS.h"
12     #endif
13 mlosch 1.1
14 jmc 1.18 CBOP
15     C !ROUTINE: SEAICE_CALC_STRAINRATES
16     C !INTERFACE:
17 jmc 1.8 SUBROUTINE SEAICE_CALC_STRAINRATES(
18 mlosch 1.1 I uFld, vFld,
19 mlosch 1.12 O e11Loc, e22Loc, e12Loc,
20 mlosch 1.14 I iStep, myTime, myIter, myThid )
21 jmc 1.18
22     C !DESCRIPTION: \bv
23     C *==========================================================*
24     C | SUBROUTINE SEAICE_CALC_STRAINRATES
25     C | o compute strain rates from ice velocities
26     C *==========================================================*
27     C | written by Martin Losch, Apr 2007
28     C *==========================================================*
29     C \ev
30    
31     C !USES:
32 mlosch 1.1 IMPLICIT NONE
33    
34     C === Global variables ===
35     #include "SIZE.h"
36     #include "EEPARAMS.h"
37     #include "PARAMS.h"
38     #include "GRID.h"
39 jmc 1.19 #include "SEAICE_SIZE.h"
40 mlosch 1.1 #include "SEAICE_PARAMS.h"
41 mlosch 1.11 #include "SEAICE.h"
42 mlosch 1.1
43     #ifdef ALLOW_AUTODIFF_TAMC
44     # include "tamc.h"
45     #endif
46    
47 jmc 1.18 C !INPUT/OUTPUT PARAMETERS:
48 mlosch 1.1 C === Routine arguments ===
49 jmc 1.18 C uFld :: ice velocity, u-component
50     C vFld :: ice velocity, v-component
51     C e11Loc :: strain rate tensor, component 1,1
52     C e22Loc :: strain rate tensor, component 2,2
53     C e12Loc :: strain rate tensor, component 1,2
54 jmc 1.8 C iStep :: Sub-time-step number
55     C myTime :: Simulation time
56     C myIter :: Simulation timestep number
57     C myThid :: My Thread Id. number
58 jmc 1.19 _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
59     _RL vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
60 mlosch 1.12 _RL e11Loc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
61     _RL e22Loc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
62     _RL e12Loc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
63 jmc 1.18 INTEGER iStep
64     _RL myTime
65     INTEGER myIter
66     INTEGER myThid
67     CEOP
68 mlosch 1.1
69     #ifdef SEAICE_CGRID
70     #ifdef SEAICE_ALLOW_DYNAMICS
71 jmc 1.18 C !LOCAL VARIABLES:
72 mlosch 1.1 C === Local variables ===
73 jmc 1.18 C i,j,bi,bj :: Loop counters
74 mlosch 1.1 INTEGER i, j, bi, bj
75 jmc 1.18 C hFacU, hFacV :: determine the no-slip boundary condition
76 mlosch 1.2 INTEGER k
77 mlosch 1.11 _RS hFacU, hFacV, noSlipFac
78 mlosch 1.23 _RL third
79     PARAMETER ( third = 0.333333333333333333333333333 _d 0 )
80 mlosch 1.15 C auxillary variables that help writing code that
81     C vectorizes even after TAFization
82     _RL dudx (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
83     _RL dvdy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
84     _RL dudy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
85     _RL dvdx (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
86     _RL uave (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
87     _RL vave (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
88 mlosch 1.2
89 mlosch 1.4 k = 1
90 mlosch 1.11 noSlipFac = 0. _d 0
91     IF ( SEAICE_no_slip ) noSlipFac = 1. _d 0
92 mlosch 1.20 C in order repoduce results before fixing a bug in r1.20 comment out
93     C the following line
94     CML IF ( SEAICE_no_slip ) noSlipFac = 2. _d 0
95 mlosch 1.1 C
96 mlosch 1.11 DO bj=myByLo(myThid),myByHi(myThid)
97     DO bi=myBxLo(myThid),myBxHi(myThid)
98 mlosch 1.15 C abbreviations on C-points, need to do them in separate loops
99     C for vectorization
100 jmc 1.19 DO j=1-OLy,sNy+OLy-1
101     DO i=1-OLx,sNx+OLx-1
102 jmc 1.18 dudx(i,j) = _recip_dxF(i,j,bi,bj) *
103     & (uFld(i+1,j,bi,bj)-uFld(i,j,bi,bj))
104     uave(i,j) = 0.5 _d 0 * (uFld(i,j,bi,bj)+uFld(i+1,j,bi,bj))
105 mlosch 1.15 ENDDO
106     ENDDO
107 jmc 1.19 DO j=1-OLy,sNy+OLy-1
108     DO i=1-OLx,sNx+OLx-1
109 jmc 1.18 dvdy(i,j) = _recip_dyF(i,j,bi,bj) *
110     & (vFld(i,j+1,bi,bj)-vFld(i,j,bi,bj))
111     vave(i,j) = 0.5 _d 0 * (vFld(i,j,bi,bj)+vFld(i,j+1,bi,bj))
112 mlosch 1.15 ENDDO
113     ENDDO
114     C evaluate strain rates at C-points
115 jmc 1.19 DO j=1-OLy,sNy+OLy-1
116     DO i=1-OLx,sNx+OLx-1
117 jmc 1.18 e11Loc(i,j,bi,bj) = dudx(i,j) + vave(i,j) * k2AtC(i,j,bi,bj)
118     e22Loc(i,j,bi,bj) = dvdy(i,j) + uave(i,j) * k1AtC(i,j,bi,bj)
119     ENDDO
120     ENDDO
121     #ifndef OBCS_UVICE_OLD
122     C-- for OBCS: assume no gradient beyong OB
123 jmc 1.19 DO j=1-OLy,sNy+OLy-1
124     DO i=1-OLx,sNx+OLx-1
125 jmc 1.18 e11Loc(i,j,bi,bj) = e11Loc(i,j,bi,bj)*maskInC(i,j,bi,bj)
126     e22Loc(i,j,bi,bj) = e22Loc(i,j,bi,bj)*maskInC(i,j,bi,bj)
127 mlosch 1.11 ENDDO
128     ENDDO
129 jmc 1.18 #endif /* OBCS_UVICE_OLD */
130    
131 mlosch 1.15 C abbreviations at Z-points, need to do them in separate loops
132     C for vectorization
133 jmc 1.19 DO j=1-OLy+1,sNy+OLy
134     DO i=1-OLx+1,sNx+OLx
135 jmc 1.18 dudy(i,j) = ( uFld(i,j,bi,bj) - uFld(i ,j-1,bi,bj) )
136     & * _recip_dyU(i,j,bi,bj)
137     uave(i,j) = 0.5 _d 0 * (uFld(i,j,bi,bj)+uFld(i ,j-1,bi,bj))
138 mlosch 1.15 ENDDO
139     ENDDO
140 jmc 1.19 DO j=1-OLy+1,sNy+OLy
141     DO i=1-OLx+1,sNx+OLx
142 jmc 1.18 dvdx(i,j) = ( vFld(i,j,bi,bj) - vFld(i-1,j ,bi,bj) )
143     & * _recip_dxV(i,j,bi,bj)
144     vave(i,j) = 0.5 _d 0 * (vFld(i,j,bi,bj)+vFld(i-1,j ,bi,bj))
145 mlosch 1.15 ENDDO
146     ENDDO
147     C evaluate strain rates at Z-points
148 jmc 1.19 DO j=1-OLy+1,sNy+OLy
149     DO i=1-OLx+1,sNx+OLx
150 mlosch 1.11 hFacU = _maskW(i,j,k,bi,bj) - _maskW(i,j-1,k,bi,bj)
151     hFacV = _maskS(i,j,k,bi,bj) - _maskS(i-1,j,k,bi,bj)
152 jmc 1.18 e12Loc(i,j,bi,bj) = 0.5 _d 0 * (
153     & dudy(i,j) + dvdx(i,j)
154     & - k1AtZ(i,j,bi,bj) * vave(i,j)
155     & - k2AtZ(i,j,bi,bj) * uave(i,j)
156 mlosch 1.11 & )
157 jmc 1.18 & *maskC(i ,j ,k,bi,bj)*maskC(i-1,j ,k,bi,bj)
158     & *maskC(i ,j-1,k,bi,bj)*maskC(i-1,j-1,k,bi,bj)
159 mlosch 1.20 & + noSlipFac * (
160 jmc 1.18 & 2.0 _d 0 * uave(i,j) * _recip_dyU(i,j,bi,bj) * hFacU
161     & + 2.0 _d 0 * vave(i,j) * _recip_dxV(i,j,bi,bj) * hFacV
162 mlosch 1.11 & )
163     C no slip at the boundary implies u(j)+u(j-1)=0 and v(i)+v(i-1)=0
164     C accross the boundary; this is already accomplished by masking so
165     C that the following lines are not necessary
166 jmc 1.18 c$$$ & - hFacV * k1AtZ(i,j,bi,bj) * vave(i,j)
167     c$$$ & - hFacU * k2AtZ(i,j,bi,bj) * uave(i,j)
168 mlosch 1.11 ENDDO
169     ENDDO
170 mlosch 1.23 IF ( SEAICE_no_slip .AND. SEAICE_2ndOrderBC ) THEN
171     DO j=1-OLy+2,sNy+OLy-1
172     DO i=1-OLx+2,sNx+OLx-1
173     hFacU = (_maskW(i,j,k,bi,bj) - _maskW(i,j-1,k,bi,bj))*third
174     hFacV = (_maskS(i,j,k,bi,bj) - _maskS(i-1,j,k,bi,bj))*third
175     hFacU = hFacU*( _maskW(i,j-2,k,bi,bj)*_maskW(i,j-1,k,bi,bj)
176     & + _maskW(i,j+1,k,bi,bj)*_maskW(i,j, k,bi,bj) )
177     hFacV = hFacV*( _maskS(i-2,j,k,bi,bj)*_maskS(i-1,j,k,bi,bj)
178     & + _maskS(i+1,j,k,bi,bj)*_maskS(i ,j,k,bi,bj) )
179     C right hand sided dv/dx = (9*v(i,j)-v(i+1,j))/(4*dxv(i,j)-dxv(i+1,j))
180     C according to a Taylor expansion to 2nd order. We assume that dxv
181     C varies very slowly, so that the denominator simplifies to 3*dxv(i,j),
182     C then dv/dx = (6*v(i,j)+3*v(i,j)-v(i+1,j))/(3*dxv(i,j))
183     C = 2*v(i,j)/dxv(i,j) + (3*v(i,j)-v(i+1,j))/(3*dxv(i,j))
184     C the left hand sided dv/dx is analogously
185     C = - 2*v(i-1,j)/dxv(i,j) - (3*v(i-1,j)-v(i-2,j))/(3*dxv(i,j))
186     C the first term is the first order part, which is already added.
187     C For e12 we only need 0.5 of this gradient and vave = is either
188     C 0.5*v(i,j) or 0.5*v(i-1,j) near the boundary so that we need an
189     C extra factor of 2. This explains the six. du/dy is analogous.
190     C The masking is ugly, but hopefully effective.
191     e12Loc(i,j,bi,bj) = e12Loc(i,j,bi,bj) + 0.5 _d 0 * (
192     & _recip_dyU(i,j,bi,bj) * ( 6.0 _d 0 * uave(i,j)
193     & - uFld(i,j-2,bi,bj)*_maskW(i,j-1,k,bi,bj)
194     & - uFld(i,j+1,bi,bj)*_maskW(i,j ,k,bi,bj) ) * hFacU
195     & + _recip_dxV(i,j,bi,bj) * ( 6.0 _d 0 * vave(i,j)
196     & - vFld(i-2,j,bi,bj)*_maskS(i-1,j,k,bi,bj)
197     & - vFld(i+1,j,bi,bj)*_maskS(i ,j,k,bi,bj) ) * hFacV
198     & )
199     ENDDO
200     ENDDO
201     ENDIF
202 mlosch 1.11 ENDDO
203     ENDDO
204 gforget 1.16
205     #ifdef ALLOW_AUTODIFF_TAMC
206     #ifdef SEAICE_DYN_STABLE_ADJOINT
207     cgf zero out adjoint fields to stabilize pkg/seaice dyna. adjoint
208     CALL ZERO_ADJ( 1, e11Loc, myThid)
209     CALL ZERO_ADJ( 1, e12Loc, myThid)
210     CALL ZERO_ADJ( 1, e22Loc, myThid)
211     #endif
212     #endif /* ALLOW_AUTODIFF_TAMC */
213    
214 mlosch 1.1 #endif /* SEAICE_ALLOW_DYNAMICS */
215     #endif /* SEAICE_CGRID */
216     RETURN
217     END

  ViewVC Help
Powered by ViewVC 1.1.22