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

Contents of /MITgcm/pkg/gmredi/gmredi_slope_psi.F

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

Revision 1.2.2.2 - (show annotations) (download)
Mon Apr 8 20:10:39 2002 UTC (22 years, 3 months ago) by heimbach
Branch: release1
CVS Tags: release1_p13_pre, release1_p13, release1_p8, release1_p9, release1_p1, release1_p2, release1_p3, release1_p4, release1_p5, release1_p6, release1_p7, release1_chkpt44d_post, release1_p11, release1_p12, release1_p10, release1_p16, release1_p17, release1_p14, release1_p15, release1_p12_pre
Branch point for: release1_50yr
Changes since 1.2.2.1: +4 -4 lines 
Changes encapsulated by checkpoint43a-release1mods and chkpt44d_post
on the main trunk.
These are:

 o added missing EXCLUDE_MONITOR flags
 o changed "e" to "_d" in gmredi_slope_limit, gmredi_slope_psi
   (incompatible typ in MIN/MAX expressions caused problems
   on IBM SP3)
 o in genmake added variable MAKEDEPEND
   plus resetting for case SunOS
 o added timer_stats.c routine for IBM SP3
 o removed variables in dynamics
 o real fresh water flux implemented with non-linear free-surface.
 o few fix (mask in shap_s2, EmPmR in external_field_load,
   USE_NATURAL_BCS in solve_for_P);
 o add arguments myIter & myTime to S/R obcs_calc & solve_for_P
 o merge of relevant stuff from the ecco-branch:
   - genmake: removed $S64 overwrite for case SunOS
   - pkg/exf: update and corrections for field swapping and obcs
   - pkg/ecco: parameter lists for the_model_main, the_main_loop
               harmonized between ECCO and MITgcm
   - pkg/autodiff: added flow directives for obcs, mdsio_gl_slice
                   updated checkpointing_lev... lists for obcs
   - model/src: minor changes in forward_step, plot_field
                added directive for divided adjoint in the_main_loop
   - pkg/mdsio: added mdsio_gl_slice
 o check parameters & config (chkpt44a_pre,post)
 o OBC and NonLin_FrSurf.
 o fix bug in mom_vi_del2uv
 o select when filters are applied ; add options to zonal_filter (data.zonfilt)
 o gmredi: fix Pb in the adiabatic form ; add options (.e.g. Bolus advection)
 o update AIM experiments (NCEP input files)
 o improve and extend diagnostics (Monitor, TimeAve with NonLin-FrSurf)
 o added some stuff for AD

These were merged with
cvs co -r release1 -P MITgcm
cd MITgcm
cvs update -kk
cvs update -j checkpoint43a-release1mods -j chkpt44d_post -d -P -kk
1 C $Header$
2 C $Name$
3
4 #include "GMREDI_OPTIONS.h"
5
6 CStartOfInterface
7 SUBROUTINE GMREDI_SLOPE_PSI_B(
8 I dSigmaDrW,dSigmaDrS,
9 I depthZ,
10 U SlopeX, SlopeY,
11 O taperX, taperY,
12 I bi,bj, myThid )
13 C /==========================================================\
14 C | SUBROUTINE GMREDI_SLOPE_PSI_B |
15 C | o Calculate slopes for use in GM/Redi tensor |
16 C |==========================================================|
17 C | On entry: |
18 C | dSigmaDrW conatins the d/dz Sigma |
19 C | SlopeX/Y contains X/Y gradients of sigma |
20 C | depthZ conatins the height (m) of level |
21 C | On exit: |
22 C | dSigmaDrW conatins the effective dSig/dz |
23 C | SlopeX/Y contains X/Y slopes |
24 C | taperFct contains tapering funct. value ; |
25 C | = 1 when using no tapering |
26 C \==========================================================/
27 IMPLICIT NONE
28
29 C == Global variables ==
30 #include "SIZE.h"
31 #include "EEPARAMS.h"
32 #include "GMREDI.h"
33 #include "PARAMS.h"
34
35 C == Routine arguments ==
36 C
37 _RL SlopeX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
38 _RL SlopeY(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
39 _RL dSigmaDrW(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
40 _RL dSigmaDrS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
41 _RL taperX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
42 _RL taperY(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
43 _RL depthZ
44 INTEGER bi,bj,myThid
45 CEndOfInterface
46
47 #ifdef ALLOW_GMREDI
48
49 C == Local variables ==
50 _RL Small_Number
51 PARAMETER(Small_Number=1.D-12)
52 _RL gradSmod,f1,Smod,f2,Rnondim,Cspd,Lrho
53 _RL dSigmaDrLtd, dRdSigmaLtd
54 _RL maxSlopeSqr
55 _RL fpi
56 PARAMETER(fpi=3.141592653589793047592d0)
57 INTEGER i,j
58
59 IF (GM_taper_scheme.EQ.'orig' .OR.
60 & GM_taper_scheme.EQ.'clipping') THEN
61
62 C- Original implementation in mitgcmuv
63 C (this turns out to be the same as Cox slope clipping)
64
65 C- Cox 1987 "Slope clipping"
66 DO j=1-Oly+1,sNy+Oly-1
67 DO i=1-Olx+1,sNx+Olx-1
68
69 c gradSmod=SlopeX(i,j)*SlopeX(i,j)
70 c & +SlopeY(i,j)*SlopeY(i,j)
71 c if (gradSmod .NE. 0.) gradSmod=sqrt(gradSmod)
72 gradSmod=abs(SlopeX(i,j))
73
74 dSigmaDrLtd = -(Small_Number+gradSmod*GM_rMaxSlope)
75 IF (dSigmaDrW(i,j).GE.dSigmaDrLtd)
76 & dSigmaDrW(i,j) = dSigmaDrLtd
77 SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)
78
79 gradSmod=abs(SlopeY(i,j))
80 dSigmaDrLtd = -(Small_Number+gradSmod*GM_rMaxSlope)
81 IF (dSigmaDrS(i,j).GE.dSigmaDrLtd)
82 & dSigmaDrS(i,j) = dSigmaDrLtd
83 SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)
84
85 taperX(i,j)=1. _d 0
86 taperY(i,j)=1. _d 0
87
88 ENDDO
89 ENDDO
90
91 ELSE
92
93 C- Compute the slope, no clipping, but avoid reverse slope in negatively
94 C stratified (Sigma_Z > 0) region :
95 DO j=1-Oly+1,sNy+Oly-1
96 DO i=1-Olx+1,sNx+Olx-1
97
98 dSigmaDrLtd = -Small_Number
99 IF (dSigmaDrW(i,j).GE.dSigmaDrLtd)
100 & dSigmaDrW(i,j) = dSigmaDrLtd
101 dRdSigmaLtd = 1./dSigmaDrW(i,j)
102 SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)
103
104 dSigmaDrLtd = -Small_Number
105 IF (dSigmaDrS(i,j).GE.dSigmaDrLtd)
106 & dSigmaDrS(i,j) = dSigmaDrLtd
107 SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)
108
109 c SlopeSqr(i,j)=SlopeX(i,j)*SlopeX(i,j)
110 c & +SlopeY(i,j)*SlopeY(i,j)
111
112 taperX(i,j)=1. _d 0
113 taperY(i,j)=1. _d 0
114
115 ENDDO
116 ENDDO
117
118 C- Compute the tapering function for the GM+Redi tensor :
119
120 IF (GM_taper_scheme.EQ.'linear') THEN
121
122 C- Simplest adiabatic tapering = Smax/Slope (linear)
123 DO j=1-Oly+1,sNy+Oly-1
124 DO i=1-Olx+1,sNx+Olx-1
125
126 IF (abs(SlopeX(i,j)).GT.GM_maxSlope)
127 & taperX(i,j)=GM_maxSlope/abs(SlopeX(i,j))
128 IF (abs(SlopeY(i,j)).GT.GM_maxSlope)
129 & taperY(i,j)=GM_maxSlope/abs(SlopeY(i,j))
130
131 ENDDO
132 ENDDO
133
134 ELSEIF (GM_taper_scheme.EQ.'gkw91') THEN
135
136 C- Gerdes, Koberle and Willebrand, Clim. Dyn. 1991
137 maxSlopeSqr = GM_maxSlope*GM_maxSlope
138 DO j=1-Oly+1,sNy+Oly-1
139 DO i=1-Olx+1,sNx+Olx-1
140
141 IF (abs(SlopeX(i,j)).GT.GM_maxSlope)
142 & taperX(i,j)=maxSlopeSqr/(SlopeX(i,j)*SlopeX(i,j))
143 IF (abs(SlopeY(i,j)).GT.GM_maxSlope)
144 & taperY(i,j)=maxSlopeSqr/(SlopeY(i,j)*SlopeY(i,j))
145
146 ENDDO
147 ENDDO
148
149 ELSEIF (GM_taper_scheme.EQ.'dm95') THEN
150
151 C- Danabasoglu and McWilliams, J. Clim. 1995
152 DO j=1-Oly+1,sNy+Oly-1
153 DO i=1-Olx+1,sNx+Olx-1
154
155 Smod = abs(SlopeX(i,j))
156 taperX(i,j)=0.5*(1.+tanh( (GM_Scrit-Smod)/GM_Sd ))
157 Smod = abs(SlopeY(i,j))
158 taperY(i,j)=0.5*(1.+tanh( (GM_Scrit-Smod)/GM_Sd ))
159
160 ENDDO
161 ENDDO
162
163 ELSEIF (GM_taper_scheme.EQ.'ldd97') THEN
164
165 C- Large, Danabasoglu and Doney, JPO 1997
166 DO j=1-Oly+1,sNy+Oly-1
167 DO i=1-Olx+1,sNx+Olx-1
168
169 Cspd=2.
170 Lrho=100.e3
171 if (FCori(i,j,bi,bj).NE.0.) Lrho=Cspd/abs(Fcori(i,j,bi,bj))
172 Lrho=min(Lrho , 100. _d 3)
173 Lrho=max(Lrho , 15. _d 3)
174
175 Smod = abs(SlopeX(i,j))
176 f1=0.5*(1.+tanh( (GM_Scrit-Smod)/GM_Sd ))
177 if (Smod.NE.0.) then
178 Rnondim=depthZ/(Lrho*Smod)
179 else
180 Rnondim=0.
181 endif
182 f2=0.5*(1.+sin( fpi*(Rnondim-0.5)))
183 taperX(i,j)=f1*f2
184
185 Smod = abs(SlopeY(i,j))
186 f1=0.5*(1.+tanh( (GM_Scrit-Smod)/GM_Sd ))
187 if (Smod.NE.0.) then
188 Rnondim=depthZ/(Lrho*Smod)
189 else
190 Rnondim=0.
191 endif
192 f2=0.5*(1.+sin( fpi*(Rnondim-0.5)))
193 taperY(i,j)=f1*f2
194
195 ENDDO
196 ENDDO
197
198 ELSEIF (GM_taper_scheme.NE.' ') THEN
199 STOP 'GMREDI_SLOPE_PSI: Bad GM_taper_scheme'
200 ENDIF
201
202 ENDIF
203
204
205 #endif /* ALLOW_GMREDI */
206
207 RETURN
208 END
  ViewVC Help
Powered by ViewVC 1.1.22