source: trunk/SRC/Computation/grad.pro @ 242

Last change on this file since 242 was 242, checked in by pinsard, 17 years ago

improvements/corrections of some *.pro headers + replace some message by some report

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 11.7 KB
Line 
1;+
2;
3; @file_comments
4; compute the gradient of a variable
5;
6; @categories
7; Calculation
8;
9; @param FIELD
10; The field for which we want to compute the gradient. A 2D (xy),
11; 3D (xyz or yt) or 4D (xyzt) array or a structure readable by
12; <proidl>litchamp</proidl>
13; and containing a 2D (xy), 3D (xyz or yt) or 4D (xyzt) array.
14; Note that the dimension of the array must suit the domain dimension.
15;
16; @param DIREC {type=scalar string}
17; the gradient direction: 'x', 'y', 'z'
18;
19; @returns
20; the gradient of the input data with the same size 2D, 3D or 4D array
21;
22; @uses
23; cm_4cal
24; cm_4data
25; cm_4mmesh
26;
27; @restrictions
28; - Works only for Arakawa C-grid.
29; - When computing the gradient, the result is not on the same grid point
30;   than the input data. In consequence, we update, vargrid and the grid position
31;   parameters (firstx[tuvf], lastx[tuvf], nx[tuvf], firsty[tuvf], lasty[tuvf],
32;   ny[tuvf], firstz[tw], lastz[tw], nz[tw]).
33; - points that cannot be computed (domain boundaries, coastline) are set to NaN
34; - the common variable jpt is used to differ xyz (jpt=1) and xyt (jpt\=1) cases.
35;
36; @examples
37; IDL> \@tst_initorca2
38; IDL> plt, grad({arr:gphit,g:'T'}, 'x')
39; IDL> plt, grad({arr:gphit,g:'T'}, 'y')
40;
41; @history
42; Sebastien Masson (smasson\@lodyc.jussieu.fr)
43;
44; @version
45; $Id$
46;
47;-
48;
49FUNCTION grad, field, direc
50;
51  compile_opt idl2, strictarrsubs
52;
53@cm_4cal   ; for jpt
54@cm_4data  ; for varname, vargrid, vardate, varunit, valmask
55@cm_4mesh
56;------------------------------------------------------------
57;
58  IF finite(glamu[0])*finite(gphiu[0])*finite(glamv[0])*finite(gphiv[0]) EQ 0 THEN $
59     return, report(['This version of grad is based on Arakawa C-grid.' $
60                     , 'U and V grids must therefore be defined'])
61;
62  res = litchamp(field)
63  szres = size(res)
64  grille, mask, glam, gphi, gdep, nx, ny, nz $
65          , firstx, firsty, firstz, lastx, lasty, lastz
66;
67  if n_elements(valmask) EQ 0 then valmask = 1.e20
68  varname = 'grad of '+varname
69  varunit = varunit+'/m'
70  case strupcase(vargrid) of
71    'T':BEGIN
72      case direc of
73        'x':BEGIN
74          divi = e1u[firstx:lastx, firsty:lasty]
75          newmask = (umask())[firstx:lastx, firsty:lasty, firstz:lastz]
76          vargrid = 'U'
77          firstxu = firstxt & lastxu = lastxt & nxu = nxt
78          firstyu = firstyt & lastyu = lastyt & nyu = nyt
79        END
80        'y':BEGIN
81          divi = e2v[firstx:lastx, firsty:lasty]
82          newmask = (vmask())[firstx:lastx, firsty:lasty, firstz:lastz]
83          vargrid = 'V'
84          firstxv = firstxt & lastxv = lastxt & nxv = nxt
85          firstyv = firstyt & lastyv = lastyt & nyv = nyt
86        END
87        'z':BEGIN
88          divi = e3w[firstz:lastz]
89          newmask = mask
90          vargrid = 'W'
91          firstzw = firstzt & lastzw = lastzt & nzw = nzt
92        END
93        ELSE:return, report('Bad definition of direction argument')
94      ENDCASE
95    END
96    'W':BEGIN
97      case direc of
98        'x':BEGIN
99          divi = e1u[firstx:lastx, firsty:lasty]
100          newmask = (umask())[firstx:lastx, firsty:lasty, firstz:lastz]
101          vargrid = 'U'
102          firstxu = firstxt & lastxu = lastxt & nxu = nxt
103          firstyu = firstyt & lastyu = lastyt & nyu = nyt
104        END
105        'y':BEGIN
106          divi = e2v[firstx:lastx, firsty:lasty]
107          newmask = (vmask())[firstx:lastx, firsty:lasty, firstz:lastz]
108          vargrid = 'V'
109          firstxv = firstxt & lastxv = lastxt & nxv = nxt
110          firstyv = firstyt & lastyv = lastyt & nyv = nyt
111        END
112        'z':BEGIN
113          divi = e3t[firstz:lastz]
114          newmask = mask
115          vargrid = 'T'
116          firstzt = firstzw & lastzt = lastzw & nzt = nzw
117        END
118        ELSE:return, report('Bad definition of direction argument')
119      endcase
120    END
121    'U':BEGIN
122      case direc of
123        'x':BEGIN
124          divi = (shift(e1t, -1, 0))[firstx:lastx, firsty:lasty]
125          newmask = tmask[firstx:lastx, firsty:lasty, firstz:lastz]
126          vargrid = 'T'
127          firstxt = firstxu & lastxt = lastxu & nxt = nxu
128          firstyt = firstyu & lastyt = lastyu & nyt = nyu
129        END
130        'y':BEGIN
131          divi = e2f[firstx:lastx, firsty:lasty]
132          newmask = (fmask())[firstx:lastx, firsty:lasty, firstz:lastz]
133          vargrid = 'F'
134          firstxf = firstxu & lastxf = lastxu & nxf = nxu
135          firstyf = firstyu & lastyf = lastyu & nyf = nyu
136        END
137        'z':BEGIN
138          divi = e3w[firstz:lastz]
139          newmask = mask
140          vargrid = 'W'
141          firstzw = firstzt & lastzw = lastzt & nzw = nzt
142        END
143        ELSE:return, report('Bad definition of direction argument')
144      endcase
145    END
146    'V':BEGIN
147      case direc of
148        'x':BEGIN
149          divi = e1f[firstx:lastx, firsty:lasty]
150          newmask = (fmask())[firstx:lastx, firsty:lasty, firstz:lastz]
151          vargrid = 'F'
152          firstxf = firstxv & lastxf = lastxv & nxf = nxv
153          firstyf = firstyv & lastyf = lastyv & nyf = nyv
154        END
155        'y':BEGIN
156          divi = (shift(e2t, 0, -1))[firstx:lastx, firsty:lasty]
157          newmask = tmask[firstx:lastx, firsty:lasty, firstz:lastz]
158          vargrid = 'T'
159          firstxt = firstxv & lastxt = lastxv & nxt = nxv
160          firstyt = firstyv & lastyt = lastyv & nyt = nyv
161        END
162        'z':BEGIN
163          divi = e3w[firstz:lastz]
164          newmask = mask
165          vargrid = 'W'
166          firstzw = firstzt & lastzw = lastzt & nzw = nzt
167        END
168        ELSE:return, report('Bad definition of direction argument')
169      endcase
170    END
171    'F':BEGIN
172;          case direc of
173;             'x':divi = (shift(e1v, -1, 0))[firstx:lastx, firsty:lasty]
174;             'y':divi = (shift(e2u, 0, -1))[firstx:lastx, firsty:lasty]
175;             'z':divi = e3w[firstz:lastz]
176;             ELSE:return, report('Bad definition of direction argument')
177;          endcase
178      return, report('F grid: case not coded, please contact SAXO team...')
179    END
180    ELSE:return, report('Bad definition of vargrid')
181  ENDCASE
182  res = fitintobox(temporary(res))
183  IF n_elements(res) EQ 1 AND res[0] EQ -1 THEN return, res
184  case 1 of
185;----------------------------------------------------------------------------
186;xy
187;----------------------------------------------------------------------------
188    szres[0] EQ 2:BEGIN
189      land = where((temporary(mask))[*, *, firstz] EQ 0)
190      if land[0] NE -1 then res[temporary(land)] = !values.f_nan
191      case direc of
192        'x':BEGIN
193          res = (shift(res, -1, 0)-res)/temporary(divi)
194          if key_periodic EQ 0 OR nx NE jpi THEN res[nx-1, *] = !values.f_nan
195          if vargrid EQ 'T' OR vargrid EQ 'V' then res = shift(temporary(res), 1, 0)
196        END
197        'y':BEGIN
198          res = (shift(res, 0, -1)-res)/temporary(divi)
199          res[*, ny-1] = !values.f_nan
200          if vargrid EQ 'T' OR vargrid EQ 'U' then res = shift(temporary(res), 0, 1)
201        END
202        ELSE:return,  report('Bad definition of direction argument for the type of array')
203      ENDCASE
204      land = where((temporary(newmask))[*, *, firstz] EQ 0)
205      if land[0] NE -1 then res[temporary(land)] = valmask
206    END
207;----------------------------------------------------------------------------
208;xyt
209;----------------------------------------------------------------------------
210    szres[0] EQ 3 AND jpt NE 1:BEGIN
211      land = where((temporary(mask))[*, *, firstz] EQ 0, cnt)
212      if land[0] NE -1 then BEGIN
213        land = (temporary(land))#replicate(1L, jpt) + replicate(1L, cnt)#(nx*ny*lindgen(jpt))
214        res[temporary(land)] = !values.f_nan
215      ENDIF
216      divi = (temporary(divi))[*]#replicate(1., jpt)
217      case direc of
218        'x':BEGIN
219          res = (shift(res, -1, 0, 0)-res)/temporary(divi)
220          if key_periodic EQ 0 OR nx NE jpi THEN res[nx-1, *, *] = !values.f_nan
221          if vargrid EQ 'T' OR vargrid EQ 'V' then res = shift(temporary(res), 1, 0, 0)
222        END
223        'y':BEGIN
224          res = (shift(res, 0, -1, 0)-res)/temporary(divi)
225          res[*, ny-1, *] = !values.f_nan
226          if vargrid EQ 'T' OR vargrid EQ 'U' then res = shift(temporary(res), 0, 1, 0)
227        END
228        ELSE:return,  report('Bad definition of direction argument for the type of array')
229      ENDCASE
230      land = where((temporary(newmask))[*, *, firstz] EQ 0, cnt)
231      if land[0] NE -1 then BEGIN
232        land = (temporary(land))#replicate(1L, jpt) + replicate(1L, cnt)#(nx*ny*lindgen(jpt))
233        res[temporary(land)] = valmask
234      ENDIF
235    END
236;----------------------------------------------------------------------------
237;xyz
238;----------------------------------------------------------------------------
239    szres[0] EQ 3 AND jpt EQ 1:BEGIN
240      land = where(mask EQ 0)
241      if land[0] NE -1 then res[temporary(land)] = !values.f_nan
242      case direc OF
243        'x':BEGIN
244          divi = (temporary(divi))[*]#replicate(1., nz)
245          res = (shift(res, -1, 0, 0)-res)/temporary(divi)
246          if key_periodic EQ 0 OR nx NE jpi THEN res[nx-1, *, *] = !values.f_nan
247          if vargrid EQ 'T' OR vargrid EQ 'V' then res = shift(temporary(res), 1, 0, 0)
248        END
249        'y':BEGIN
250          divi = (temporary(divi))[*]#replicate(1., nz)
251          res = (shift(res, 0, -1, 0)-res)/temporary(divi)
252          res[*, ny-1, *] = !values.f_nan
253          if vargrid EQ 'T' OR vargrid EQ 'U' then res = shift(temporary(res), 0, 1, 0)
254        END
255        'z':BEGIN
256          divi = replicate(1., nx*ny)#(temporary(divi))[*]
257          if nx EQ 1 OR ny EQ 1 then res = reform(res, nx, ny, nz, /overwrite)
258          if vargrid EQ 'W' THEN BEGIN
259            res = (shift(res, 0, 0, 1)-res)/temporary(divi)
260            res[*, *, 0] = !values.f_nan
261          ENDIF ELSE BEGIN
262            res = (res-shift(res, 0, 0, -1))/temporary(divi)
263            res[*, *, nz-1] = !values.f_nan
264          ENDELSE
265        END
266      ENDCASE
267      land = where(temporary(newmask) EQ 0)
268      if land[0] NE -1 then res[temporary(land)] = valmask
269    END
270;----------------------------------------------------------------------------
271;xyzt
272;----------------------------------------------------------------------------
273    szres[0] EQ 4:BEGIN
274      land = where(temporary(mask) EQ 0, cnt)
275      if land[0] NE -1 then BEGIN
276        land = (temporary(land))#replicate(1L, jpt) + replicate(1L, cnt)#(nx*ny*nz*lindgen(jpt))
277        res[temporary(land)] = !values.f_nan
278      ENDIF
279      case direc OF
280        'x':BEGIN
281          divi = (temporary(divi))[*]#replicate(1., nz*jpt)
282          res = (shift(res, -1, 0, 0, 0)-res)/temporary(divi)
283          if key_periodic EQ 0 OR nx NE jpi THEN res[nx-1, *, *, *] = !values.f_nan
284          if vargrid EQ 'T' OR vargrid EQ 'V' then res = shift(temporary(res), 1, 0, 0, 0)
285        END
286        'y':BEGIN
287          divi = (temporary(divi))[*]#replicate(1., nz*jpt)
288          res = (shift(res, 0, -1, 0, 0)-res)/temporary(divi)
289          res[*, ny-1, *, *] = !values.f_nan
290          if vargrid EQ 'T' OR vargrid EQ 'U' then res = shift(temporary(res), 0, 1, 0, 0)
291        END
292        'z':BEGIN
293          divi = replicate(1., nx*ny)#(temporary(divi))[*]
294          divi = (temporary(divi))[*]#replicate(1L, jpt)
295          if nx EQ 1 OR ny EQ 1 then res = reform(res, nx, ny, nz, jpt, /overwrite)
296          if vargrid EQ 'W' THEN BEGIN
297            res = (shift(res, 0, 0, 1, 0)-res)/temporary(divi)
298            res[*, *, 0, *] = !values.f_nan
299          ENDIF ELSE BEGIN
300            res = (res-shift(res, 0, 0, -1, 0))/temporary(divi)
301            res[*, *, nz-1, *] = !values.f_nan
302          ENDELSE
303        END
304      ENDCASE
305      land = where(newmask EQ 0, cnt)
306      if land[0] NE -1 then BEGIN
307        land = (temporary(land))#replicate(1L, jpt) + replicate(1L, cnt)#(nx*ny*nz*lindgen(jpt))
308        res[temporary(land)] = valmask
309      ENDIF
310    END
311    ELSE:return, report('input array must have 2, 3 or 4 dimensions')
312  ENDCASE
313  return, res
314END
Note: See TracBrowser for help on using the repository browser.