/[MITgcm]/MITgcm/pkg/gmredi/gmredi_calc_tensor.F
ViewVC logotype

Annotation of /MITgcm/pkg/gmredi/gmredi_calc_tensor.F

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


Revision 1.1.2.1 - (hide annotations) (download)
Fri Jan 12 14:53:01 2001 UTC (23 years, 4 months ago) by jmc
Branch: branch-atmos-merge
CVS Tags: branch-atmos-merge-freeze, branch-atmos-merge-shapiro, branch-atmos-merge-zonalfilt, branch-atmos-merge-phase5, branch-atmos-merge-phase4, branch-atmos-merge-phase7, branch-atmos-merge-phase6, branch-atmos-merge-phase3
Changes since 1.1: +5 -3 lines
Correct DO_LOOP + CPP_IFDEF overlap

1 jmc 1.1.2.1 C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/gmredi/gmredi_calc_tensor.F,v 1.1.2.1 2001/01/12 14:53:01 jmc Exp $
2 adcroft 1.1
3     #include "GMREDI_OPTIONS.h"
4    
5     CStartOfInterface
6     SUBROUTINE GMREDI_CALC_TENSOR(
7     I bi, bj, iMin, iMax, jMin, jMax, K,
8     I sigmaX, sigmaY, sigmaR,
9     I myThid )
10     C /==========================================================\
11     C | SUBROUTINE GMREDI_CALC_TENSOR |
12     C | o Calculate tensor elements for GM/Redi tensor. |
13     C |==========================================================|
14     C \==========================================================/
15     IMPLICIT NONE
16    
17     C == Global variables ==
18     #include "SIZE.h"
19     #include "GRID.h"
20     #include "DYNVARS.h"
21     #include "EEPARAMS.h"
22     #include "PARAMS.h"
23     #include "GMREDI.h"
24     #include "GMREDI_DIAGS.h"
25    
26     C == Routine arguments ==
27     C
28     _RL sigmaX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
29     _RL sigmaY(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
30     _RL sigmaR(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
31     INTEGER bi,bj,iMin,iMax,jMin,jMax,K
32     INTEGER myThid
33     CEndOfInterface
34    
35     #ifdef ALLOW_GMREDI
36    
37     C == Local variables ==
38     INTEGER i,j,km1,kp1
39     _RL SlopeX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
40     _RL SlopeY(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
41     _RL dSigmaDrReal(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
42     _RL dRdSigmaLtd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
43     _RL Ssq
44    
45     #ifdef GM_VISBECK_VARIABLE_K
46     _RS deltaH,zero_rs
47     PARAMETER(zero_rs=0.)
48     _RL N2,SN
49     #endif
50    
51    
52     km1=max(1,K-1)
53     kp1=min(Nr,K)
54    
55    
56     #ifdef ALLOW_AUTODIFF_TAMC
57     !HPF$ INDEPENDENT
58     #endif
59     DO j=1-Oly+1,sNy+Oly-1
60     #ifdef ALLOW_AUTODIFF_TAMC
61     !HPF$ INDEPENDENT
62     #endif
63     DO i=1-Olx+1,sNx+Olx-1
64    
65     C Gradient of Sigma at rVel points
66     SlopeX(i,j)=0.25*( sigmaX(i+1, j ,km1) +sigmaX(i,j,km1)
67     & +sigmaX(i+1, j , k ) +sigmaX(i,j, k ) )
68     SlopeY(i,j)=0.25*( sigmaY( i ,j+1,km1) +sigmaY(i,j,km1)
69     & +sigmaY( i ,j+1, k ) +sigmaY(i,j, k ) )
70     dSigmaDrReal(i,j)=sigmaR(i,j,k)
71    
72     if (hFacC(i,j,k,bi,bj).eq.0.) then
73     SlopeX(i,j)=0.
74     SlopeY(i,j)=0.
75     endif
76    
77     ENDDO
78     ENDDO
79    
80     C Calculate slopes for use in tensor, taper and/or clip
81     CALL GMREDI_SLOPE_LIMIT(
82     I dSigmadRReal,
83     I rF(K),
84     U SlopeX, SlopeY,
85     O dRdSigmaLtd,
86     I bi, bj, myThid )
87    
88     DO j=1-Oly+1,sNy+Oly-1
89     DO i=1-Olx+1,sNx+Olx-1
90    
91     C Mask Iso-neutral slopes
92     if (hFacC(i,j,k,bi,bj).eq.0.) then
93     SlopeX(i,j)=0.
94     SlopeY(i,j)=0.
95     endif
96     Ssq=SlopeX(i,j)*SlopeX(i,j)+SlopeY(i,j)*SlopeY(i,j)
97    
98     C Components of Redi/GM tensor
99     Kwx(i,j,k,myThid)=2.*SlopeX(i,j)
100     Kwy(i,j,k,myThid)=2.*SlopeY(i,j)
101     Kwz(i,j,k,myThid)=Ssq
102    
103     #ifdef GM_VISBECK_VARIABLE_K
104     C-- Depth average of M^2/N^2 * N
105    
106     C Calculate terms for mean Richardson number
107     C which is used in the "variable K" parameterisaton.
108     C Distance between interface above layer and the integration depth
109     deltaH=abs(GM_Visbeck_depth)-abs(rF(k))
110     C If positive we limit this to the layer thickness
111     deltaH=min(deltaH,drF(k))
112     C If negative then we are below the integration level
113     deltaH=max(deltaH,zero_rs)
114     C Now we convert deltaH to a non-dimensional fraction
115     deltaH=deltaH/GM_Visbeck_depth
116    
117     if (K.eq.2) VisbeckK(i,j,myThid)=0.
118     Calt? if (dSigmaDrReal(i,j).NE.0.) then
119     Calt? N2=(-Gravity*recip_Rhonil)*dSigmaDrReal(i,j)
120     if (dRdSigmaLtd(i,j).NE.0.) then
121     N2=(-Gravity*recip_Rhonil)/dRdSigmaLtd(i,j)
122     SN=sqrt(Ssq*N2)
123     VisbeckK(i,j,myThid)=VisbeckK(i,j,myThid)+deltaH
124     & *GM_Visbeck_alpha*GM_Visbeck_length*GM_Visbeck_length*SN
125     endif
126    
127     C Limit range that KapGM can take
128     VisbeckK(i,j,myThid)=
129     & min(VisbeckK(i,j,myThid),GM_Visbeck_maxval_K)
130    
131     #endif /* GM_VISBECK_VARIABLE_K */
132    
133    
134     #ifdef INCLUDE_DIAGNOSTICS_INTERFACE_CODE
135     C-- Time-average
136     GM_Kwx_T(i,j,k,bi,bj)=GM_Kwx_T(i,j,k,bi,bj)
137     & +Kwx(i,j,k,myThid)*deltaTclock
138     GM_Kwy_T(i,j,k,bi,bj)=GM_Kwy_T(i,j,k,bi,bj)
139     & +Kwy(i,j,k,myThid)*deltaTclock
140     GM_Kwz_T(i,j,k,bi,bj)=GM_Kwz_T(i,j,k,bi,bj)
141     & +Kwz(i,j,k,myThid)*deltaTclock
142     #ifdef GM_VISBECK_VARIABLE_K
143     IF (K.EQ.Nr)
144     & Visbeck_K_T(i,j,bi,bj)=Visbeck_K_T(i,j,bi,bj)
145     & +VisbeckK(i,j,myThid)*deltaTclock
146     #endif
147 jmc 1.1.2.1 #endif /* INCLUDE_DIAGNOSTICS_INTERFACE_CODE */
148 adcroft 1.1 ENDDO
149     ENDDO
150    
151 jmc 1.1.2.1 #ifdef INCLUDE_DIAGNOSTICS_INTERFACE_CODE
152     GM_TimeAve(k,bi,bj)=GM_TimeAve(k,bi,bj)+deltaTclock
153     #endif
154 adcroft 1.1
155    
156     #ifdef GM_NON_UNITY_DIAGONAL
157     C Gradient of Sigma at U points
158     DO j=1-Oly+1,sNy+Oly-1
159     DO i=1-Olx+1,sNx+Olx-1
160     SlopeX(i,j)=sigmaX(i,j,km1)
161     & *_maskW(i,j,k,bi,bj)
162     SlopeY(i,j)=0.25*( sigmaY(i-1,j+1,k) +sigmaY(i,j+1,k)
163     & +sigmaY(i-1, j ,k) +sigmaY(i, j ,k) )
164     & *_maskW(i,j,k,bi,bj)
165     dSigmaDrReal(i,j)=0.25*( sigmaR(i-1,j, k ) +sigmaR(i,j, k )
166     & +sigmaR(i-1,j,kp1) +sigmaR(i,j,kp1) )
167     & *_maskW(i,j,k,bi,bj)
168     ENDDO
169     ENDDO
170    
171     C Calculate slopes for use in tensor, taper and/or clip
172     CALL GMREDI_SLOPE_LIMIT(
173     I dSigmadRReal,
174     I rF(K),
175     U SlopeX, SlopeY,
176     O dRdSigmaLtd,
177     I bi, bj, myThid )
178    
179     DO j=1-Oly+1,sNy+Oly-1
180     DO i=1-Olx+1,sNx+Olx-1
181     Kux(i,j,k,myThid)=(dSigmaDrReal(i,j)*dRdSigmaLtd(i,j))**2
182     ENDDO
183     ENDDO
184    
185     C Gradient of Sigma at V points
186     DO j=1-Oly+1,sNy+Oly-1
187     DO i=1-Olx+1,sNx+Olx-1
188     SlopeX(i,j)=0.25*( sigmaX(i, j ,k) +sigmaX(i+1, j ,k)
189     & +sigmaX(i,j-1,k) +sigmaX(i+1,j-1,k) )
190     & *_maskS(i,j,k,bi,bj)
191     SlopeY(i,j)=sigmaY(i,j,km1)
192     & *_maskS(i,j,k,bi,bj)
193     dSigmaDrReal(i,j)=0.25*( sigmaR(i,j-1, k ) +sigmaR(i,j, k )
194     & +sigmaR(i,j-1,kp1) +sigmaR(i,j,kp1) )
195     & *_maskS(i,j,k,bi,bj)
196     ENDDO
197     ENDDO
198    
199     C Calculate slopes for use in tensor, taper and/or clip
200     CALL GMREDI_SLOPE_LIMIT(
201     I dSigmadRReal,
202     I rF(K),
203     U SlopeX, SlopeY,
204     O dRdSigmaLtd,
205     I bi, bj, myThid )
206    
207     DO j=1-Oly+1,sNy+Oly-1
208     DO i=1-Olx+1,sNx+Olx-1
209     Kvy(i,j,k,myThid)=(dSigmaDrReal(i,j)*dRdSigmaLtd(i,j))**2
210     ENDDO
211     ENDDO
212    
213     #endif /* GM_NON_UNITY_DIAGONAL */
214    
215    
216    
217     #endif /* ALLOW_GMREDI */
218    
219     RETURN
220     END

  ViewVC Help
Powered by ViewVC 1.1.22