source: trunk/SRC/Grid/computegrid.pro @ 232

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

improvements/corrections of some *.pro headers

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 46.0 KB
Line 
1;+
2;
3; @file_comments
4; compute the grid parameters (cm_4mesh) common
5;
6; domains sizes:
7; ---------------
8; jpi, jpj, jpk, jpiglo, jpjglo, jpkglo, jpidta, jpjdta, jpkdta
9;
10; domains positions regarding to the original grid:
11; --------------------------------------------------
12; ixminmesh, ixmaxmesh, iyminmesh, iymaxmesh, izminmesh, izmaxmesh
13; ixmindta, ixmaxdta, iymindta, iymaxdta, izmindta, izmaxdta
14;
15; horizontal parameters:
16; ----------------------
17; glamt, glamf, gphit, gphit, e1t, e2t
18;
19; additional horizontal parameters if FULLCGRID keyword is defined:
20; -----------------------------------------------------------------
21; glamu, glamv, gphiu, gphiv, e1u, e1v, e1f, e2u, e2v, e2f
22;
23; verticals parameters:
24; ---------------------
25; gdept, gdepw, e3t, e3w
26;
27; masks:
28; ------
29; tmask
30;
31; additional masks if FULLCGRID keyword is defined:
32; -------------------------------------------------
33; umaskred, vmaskred, fmaskredx, fmaskredy
34;
35; triangles_list:
36; ---------------
37; triangulation
38;
39; key_* variables:
40; ----------------
41; key_onearth, key_periodic, key_shift, key_stride, key_partialstep,
42; key_yreverse, key_zreverse, key_gridtype
43;
44; xxx related variables:
45; ----------------------
46; ccmeshparameters, ccreadparameters
47;
48; @categories
49; Grid
50;
51; @param startx {in}{optional}{type=scalar}
52;       x starting point, optional if [XY]AXIS keyword is used
53;
54; @param starty {in}{optional}{type=scalar}
55;       y starting point, optional if [XY]AXIS keyword is used
56;
57; @param stepxin {in}{optional}{type=scalar or vector}
58;       x direction step, optional if [XY]AXIS keyword is used, must be > 0
59;       if stepxin is a vector nx is not used
60;
61; @param stepyin {in}{optional}{type=scalar or vector}
62;       y direction step, optional if [XY]AXIS keyword is used,
63;       could be > 0 (south to north) or < 0 (north to south)
64;       if stepyin is a vector ny is not used
65;
66; @param nxin {in}{optional}{type=scalar}
67;       number of points in x direction,
68;       optional if [XY]AXIS keyword is used or stepxin is a vector
69;
70; @param nyin {in}{optional}{type=scalar}
71;       number of points in y direction,
72;       optional if [XY]AXIS keyword is used or stepyin is a vector
73;
74; @keyword FULLCGRID {default=0}{type=scalar: 0 or 1}
75;       Activate to specify that you want to compute all the C grid parameters:
76;       definition of glam[uv], gphi[uv], e1[uvf], e2[uvf], [uv]maskred and
77;       fmaskred[xy] will be add to the default computations
78;
79; @keyword GLAMBOUNDARY {default=those defined in the file}{type=2 elements vector}
80;       Longitude boundaries that should be used to visualize the data.
81;         lon2 > lon1
82;         lon2 - lon1 le 360
83;       By default, the common (cm_4mesh) variable key_shift will be automatically
84;       defined according to GLAMBOUNDARY.
85;
86; @keyword MASK {default=array of 1}{type=2D or 3D array}
87;       Specify the land(0)/sea(1) mask
88;
89; @keyword ONEARTH {default=1}{type=scalar: 0 or 1}
90;       Force the manual definition of data localization on the earth or not
91;          0) if the data are not on the earth
92;          1) if the data are on earth (in that case we can for example use
93;             the labels 'longitude', 'latitude' in plots).
94;       The resulting value will be stored in the common (cm_4mesh) variable key_onearth
95;       ONEARTH = 0 forces PERIODIC = 0, SHIFT = 0 and is cancelling GLAMBOUNDARY
96;
97; @keyword PERIODIC {default=computed by using the first line of glamt}{type=scalar: 0 or 1}
98;       Force the manual definition of the grid zonal periodicity.
99;       The resulting value will be stored in the common (cm_4mesh) variable key_periodic
100;       PERIODIC = 0 forces SHIFT = 0
101;
102; @keyword PLAIN {default=0}{type=scalar: 0 or 1}
103;       Force PERIODIC = 0, SHIFT = 0, STRIDE = [1, 1, 1] and
104;       suppress the automatic redefinition of the domain in case of
105;       x periodicity overlap, y periodicity overlap (ORCA type only)
106;       and mask border to 0.
107;
108; @keyword SHIFT {default=computed according to glamboundary}{type=scalar}
109;       Force the manual definition of the zonal shift that must be apply to the data.
110;       The resulting value will be stored in the common (cm_4mesh) variable key_shift
111;       Note that if key_periodic=0 then in any case key_shift = 0.
112;
113; @keyword STRCALLING {type=string}
114;       a string containing the calling command used to
115;       call computegrid (this is used by <pro>xxx</pro>)
116;
117; @keyword STRIDE {default=[1, 1, 1]}{type=3 elements vector}
118;       Specify the stride in x, y and z direction. The resulting
119;       value will be stored in the common (cm_4mesh) variable key_stride
120;
121; @keyword XAXIS {type=1D or 2D array}
122;       Specify longitudes in this case startx, stepx and nx are not used but
123;       could be necessary if the y axis is not defined with yaxis. It must be
124;       possible to sort the first line of xaxis in the increasing order by
125;       shifting its elements.
126;
127; @keyword YAXIS {type=1D or 2D array}
128;       Specify latitudes in this case starty, stepy and ny are not used but
129;       starty and stepy could be necessary if the x axis is not defined with
130;       xaxis. It must be sorted in the increasing or deceasing order (along each column if 2d array).
131;
132; @keyword XYINDEX activate to specify that the horizontal grid should
133;       be simply defined by using the index of the points
134;          (xaxis = findgen(nx) and yaxis = findgen(ny))
135;       using this keyword forces key_onearth=0
136;
137; @keyword XMINMESH {default=0L}{type=scalar}
138;       Define common (cm_4mesh) variables ixminmesh used to define the localization
139;       of the first point of the grid along the x direction in a zoom of the original grid
140;
141; @keyword YMINMESH {default=0L}{type=scalar}
142;       Define common (cm_4mesh) variables iyminmesh used to define the localization
143;       of the first point of the grid along the y direction in a zoom of the original grid
144;
145; @keyword ZMINMESH {default=0L}{type=scalar}
146;       Define common (cm_4mesh) variables izminmesh used to define the localization
147;       of the first point of the grid along the z direction in a zoom of the original grid
148;
149; @keyword XMAXMESH {default=jpiglo-1}{type=scalar}
150;       Define common (cm_4mesh) variables ixmaxmesh used to define the localization
151;       of the last point of the grid along the x direction in a zoom of the original grid
152;       Note that if XMAXMESH < 0 then ixmaxmesh is defined as ixmaxmesh = jpiglo -1 + xmaxmesh
153;
154; @keyword YMAXMESH {default=jpjglo-1}{type=scalar}
155;       Define common (cm_4mesh) variables iymaxmesh used to define the localization
156;       of the last point of the grid along the y direction in a zoom of the original grid
157;       Note that if YMAXMESH < 0 then iymaxmesh is defined as iymaxmesh = jpjglo -1 + ymaxmesh
158;
159; @keyword ZMAXMESH {default=jpkglo-1}{type=scalar}
160;       Define common (cm_4mesh) variables izmaxmesh used to define the localization
161;       of the last point of the grid along the z direction in a zoom of the original grid
162;       Note that if ZMAXMESH < 0 then izmaxmesh is defined as izmaxmesh = jpkglo -1 + maxmesh
163;
164; @keyword FBASE2TBASE
165;       Activate when the model is a C grid based on a F point
166;       (with a F point at the bottom-left corner and a T point at the
167;       upper-right corner). In this case, we ignore
168;         - the first line of F and V points
169;         - the last  line of T and U points
170;         - if the grid is not x-periodic, the first column of F and U points
171;         - if the grid is not x-periodic, the last  column of T and V points.
172;       => we are back to a C grid based on T point as for OPA model.
173;       Note that in that case, key_gridtype = 'c_f' and not 'c' (-> used in read_ncdf)
174;       Note that activate FBASE2TBASE forces FULLCGRID=1
175;
176; @keyword UBASE2TBASE
177;       Activate when the model is a C grid based on a U point
178;       (with a U point at the bottom-left corner and a T point at the
179;       upper-right corner). In this case, we ignore
180;         - if the grid is not x-periodic, the first column of F and U points
181;         - if the grid is not x-periodic, the last  column of T and V points.
182;       => we are back to a C grid based on T point as for OPA model.
183;       Note that in that case, key_gridtype = 'c_u' and not 'c' (-> used in read_ncdf)
184;       Note that activate UBASE2TBASE forces FULLCGRID=1
185;
186; @keyword VBASE2TBASE
187;       Activate when the model is a C grid based on a V point
188;       (with a V point at the bottom-left corner and a T point at the
189;       upper-right corner). In this case, we ignore
190;         - the first line of F and V points
191;         - the last  line of T and U points
192;       => we are back to a C grid based on T point as for OPA model.
193;       Note that in that case, key_gridtype = 'c_v' and not 'c' (-> used in read_ncdf)
194;       Note that activate VBASE2TBASE forces FULLCGRID=1
195;
196; @keyword ROMSH {type=2D array}
197;       This array is the final bathymetry at RHO-points. It is stored in the common
198;       variable (cm_4mesh) romszinfos.h
199;       Used when the model is a ROMS C-grid with one more point
200;       in longitude for T and V grid and one more point in latitude
201;       for T and U grid. In this case, we ignore
202;         - the last line of T and U points
203;         - the last column of T and V points.
204;      => we are back to a C grid based on T point as for OPA model.
205;       Note that activate ROMSH forces FULLCGRID=1
206;
207; @keyword STRCALLING {type=scalar string}
208;       Used by xxx...
209;
210; @keyword ZAXIS {type=1D}
211;       Specify the vertical axis. Must be sorted in the increasing or deceasing order
212;
213; @keyword _EXTRA
214;    (not used in the present case...)
215;
216; @uses cm_4mesh cm_4data cm_4cal
217;
218; @restrictions if the grid has x/y periodicity overlap and/or if
219;    the mask has 0 everywhere at the border (like a close sea) and
220;    if (we did not activate /plain and xminmesh, xmaxmesh, yminmesh,
221;    ymaxmesh keywords are defined to their default values), we redefine
222;    xminmesh, xmaxmesh, yminmesh, ymaxmesh in order to reove the
223;    overlapping part and/or to open the domain (avoid ti be forced
224;    to use cell_fill = 1).
225;
226; @restrictions FUV points definition is not exact if the grid is irregular
227;
228; @history
229; Sebastien Masson (smasson\@lodyc.jussieu.fr)
230;                      2000-04-20
231;  Sept 2004, several bug fix to suit C grid type...
232;  Aug 2005, rewritte almost everything...
233;
234; @version
235; $Id$
236;
237;-
238;
239PRO computegrid, startx, starty, stepxin, stepyin, nxin, nyin $
240                 , XAXIS = xaxis, YAXIS = yaxis, ZAXIS = zaxis $
241                 , MASK = mask, GLAMBOUNDARY = glamboundary $
242                 , XMINMESH = xminmesh, XMAXMESH = xmaxmesh $
243                 , YMINMESH = yminmesh, YMAXMESH = ymaxmesh $
244                 , ZMINMESH = zminmesh, ZMAXMESH = zmaxmesh $
245                 , ONEARTH = onearth, PERIODIC = periodic $
246                 , PLAIN = plain, SHIFT = shift, STRIDE = stride $
247                 , FULLCGRID = fullcgrid, XYINDEX = xyindex $
248                 , UBASE2TBASE = ubase2tbase, VBASE2TBASE = vbase2tbase, FBASE2TBASE = fbase2tbase $
249                 , STRCALLING = strcalling, ROMSH = romsh, _EXTRA = ex
250;
251  compile_opt idl2, strictarrsubs
252;
253@cm_4mesh
254@cm_4data
255@cm_4cal
256  IF NOT keyword_set(key_forgetold) THEN BEGIN
257@updatenew
258@updatekwd
259  ENDIF
260;---------------------------------------------------------
261;------------------------------------------------------------
262  time1 = systime(1)            ; for key_performance
263;------------------------------------------------------------
264;
265;====================================================
266; Check input parameters
267;====================================================
268;
269; xaxis related parameters
270;
271  if n_elements(xaxis) NE 0 then BEGIN
272    CASE (size(xaxis))[0] OF
273      0:nx = 1L
274      1:nx = (size(xaxis))[1]
275      2:nx = (size(xaxis))[1]
276    ENDCASE
277  ENDIF ELSE BEGIN
278    IF n_elements(startx) EQ 0 THEN BEGIN
279      dummy = report('If xaxis is not given, startx must be defined')
280      return
281    ENDIF
282    CASE n_elements(stepxin) OF
283      0:BEGIN
284        dummy = report('If xaxis is not given, stepxin must be defined')
285        return
286      END
287      1:BEGIN
288        IF n_elements(nxin) EQ 0 THEN BEGIN
289          dummy = report('If xaxis is not given and stepxin has only one element, nx must be defined')
290          return
291        ENDIF ELSE nx = nxin
292      END
293      ELSE:nx = n_elements(stepxin)
294    ENDCASE
295  ENDELSE
296;
297; yaxis related parameters
298;
299  if n_elements(yaxis) NE 0 then BEGIN
300    CASE (size(yaxis))[0] OF
301      0:ny = 1L
302      1:ny = (size(yaxis))[1]
303      2:ny = (size(yaxis))[2]
304    ENDCASE
305  ENDIF ELSE BEGIN
306    IF n_elements(starty) EQ 0 THEN BEGIN
307      dummy = report('If yaxis is not given, starty must be defined')
308      return
309    ENDIF
310    CASE n_elements(stepyin) OF
311      0:BEGIN
312        dummy = report('If yaxis is not given, stepyin must be defined')
313        return
314      END
315      1:BEGIN
316        IF n_elements(nyin) EQ 0 THEN BEGIN
317          dummy = report('If yaxis is not given and stepyin has only one element, ny must be defined')
318          return
319        ENDIF ELSE ny = nyin
320      END
321      ELSE:ny = n_elements(stepyin)
322    ENDCASE
323  ENDELSE
324;
325; zaxis related parameters
326;
327  if n_elements(zaxis) NE 0 then BEGIN
328    CASE (size(zaxis))[0] OF
329      0:nz = 1L
330      1:nz = (size(zaxis))[1]
331      ELSE:BEGIN
332        print, 'not coded'
333        stop
334      END
335    ENDCASE
336  ENDIF ELSE nz = 1L
337;
338;====================================================
339; Others automatic definitions...
340;====================================================
341;
342  jpiglo = long(nx)
343  jpjglo = long(ny)
344  jpkglo = long(nz)
345  IF keyword_set(romsh) THEN BEGIN
346    jpiglo = jpiglo - 1
347    jpjglo = jpjglo - 1
348    fullcgrid = 1
349  ENDIF
350;
351; impact of plain keyword:
352;
353  IF keyword_set(plain) THEN BEGIN
354    periodic = 0
355    shift = 0
356    stride = [1, 1, 1]
357  ENDIF
358;
359  IF n_elements(xminmesh) NE 0 THEN ixminmesh = long(xminmesh[0]) ELSE ixminmesh  = 0l
360  IF n_elements(xmaxmesh) NE 0 THEN ixmaxmesh = long(xmaxmesh[0]) ELSE ixmaxmesh  = jpiglo-1
361  IF n_elements(yminmesh) NE 0 THEN iyminmesh = long(yminmesh[0]) ELSE iyminmesh  = 0l
362  IF n_elements(ymaxmesh) NE 0 THEN iymaxmesh = long(ymaxmesh[0]) ELSE iymaxmesh  = jpjglo-1
363  IF n_elements(zminmesh) NE 0 THEN izminmesh = long(zminmesh[0]) ELSE izminmesh  = 0l
364  IF n_elements(zmaxmesh) NE 0 THEN izmaxmesh = long(zmaxmesh[0]) ELSE izmaxmesh  = jpkglo-1
365;
366  CASE 1 OF
367    keyword_set(fbase2tbase):key_gridtype = 'c_f'
368    keyword_set(ubase2tbase):key_gridtype = 'c_u'
369    keyword_set(vbase2tbase):key_gridtype = 'c_v'
370    else:key_gridtype = 'c'
371  ENDCASE
372  IF key_gridtype EQ 'c_v' OR key_gridtype EQ 'c_f' THEN BEGIN
373    iymaxmesh = iymaxmesh-1
374  ENDIF
375  IF strlen(key_gridtype) EQ 3 THEN fullcgrid = 1
376;
377  IF ixmaxmesh LT 0 THEN ixmaxmesh = jpiglo -1 + ixmaxmesh
378  IF iymaxmesh LT 0 THEN iymaxmesh = jpjglo -1 + iymaxmesh
379  IF izmaxmesh LT 0 THEN izmaxmesh = jpkglo -1 + izmaxmesh
380; avoid basics errors...
381  ixmaxmesh = 0 > ixmaxmesh < (jpiglo-1)
382  ixminmesh = 0 > ixminmesh < ixmaxmesh
383  iymaxmesh = 0 > iymaxmesh < (jpjglo-1)
384  iyminmesh = 0 > iyminmesh < iymaxmesh
385  izmaxmesh = 0 > izmaxmesh < (jpkglo-1)
386  izminmesh = 0 > izminmesh < izmaxmesh
387;
388  jpi = ixmaxmesh-ixminmesh+1
389  jpj = iymaxmesh-iyminmesh+1
390  jpk = izmaxmesh-izminmesh+1
391;
392  jpidta = jpiglo
393  jpjdta = jpjglo
394  jpkdta = jpkglo
395  ixmindta = 0
396  ixmaxdta = jpidta-1
397  iymindta = 0
398  iymaxdta = jpjdta-1
399  izmindta = 0
400  izmaxdta = jpkdta-1
401;
402  key_partialstep = 0
403  if n_elements(stride) eq 3 then key_stride = stride $
404  ELSE key_stride = [1, 1, 1]
405;
406; check xyindex and its consequences
407;
408  if keyword_set(xyindex) then onearth = 0
409;
410; check onearth and its consequences
411;
412  IF n_elements(onearth) EQ 0 THEN key_onearth = 1b $
413  ELSE key_onearth = keyword_set(onearth)
414  IF NOT key_onearth THEN BEGIN
415    periodic = 0
416    shift = 0
417  ENDIF
418
419  r = 6371000.
420;
421;====================================================
422; X direction : glamt
423;====================================================
424;
425; def of glamt
426;
427  if n_elements(xaxis) NE 0 then BEGIN
428    if keyword_set(xyindex) THEN glamt = findgen(jpiglo) ELSE glamt = xaxis
429  ENDIF ELSE BEGIN
430    if keyword_set(xyindex) THEN stepx = 1. ELSE stepx = stepxin
431    CASE 1 OF
432      n_elements(stepx):glamt = startx + findgen(jpiglo)*stepx
433      size(stepx, /n_dimensions):glamt = startx + total(stepx, /cumulative)
434      ELSE:BEGIN
435        dummy = report('Wrong definition of stepx...')
436        return
437      END
438    ENDCASE
439  ENDELSE
440;
441; apply glamboundary
442;
443  IF keyword_set(glamboundary) AND key_onearth THEN BEGIN
444    IF glamboundary[0] GE glamboundary[1] THEN stop
445    IF glamboundary[1]-glamboundary[0] GT 360 THEN stop
446    glamt = glamt MOD 360
447    smaller = where(glamt LT glamboundary[0])
448    if smaller[0] NE -1 then glamt[smaller] = glamt[smaller]+360.
449    bigger = where(glamt GE glamboundary[1])
450    if bigger[0] NE -1 then glamt[bigger] = glamt[bigger]-360.
451  ENDIF
452;
453; force glamt to have 2 dimensions
454;
455  CASE size(reform(glamt), /n_dimensions) OF
456    0:glamt = replicate(glamt, jpi, jpj)
457    1:glamt = glamt[ixminmesh:ixmaxmesh]#replicate(1, jpj)
458    2:glamt = glamt[ixminmesh:ixmaxmesh, iyminmesh:iymaxmesh]
459  ENDCASE
460; keep 2d array even with degenerated dimension
461  IF jpj EQ 1 THEN glamt = reform(glamt, jpi, jpj, /over)
462;
463;====================================================
464; Y direction : gphit
465;====================================================
466;
467; def of gphit
468;
469  if n_elements(yaxis) NE 0 THEN BEGIN
470    if keyword_set(xyindex) THEN gphit = findgen(jpjglo) ELSE gphit = yaxis
471  ENDIF ELSE BEGIN
472    if keyword_set(xyindex) THEN stepy = 1. ELSE stepy = stepyin
473    CASE 1 OF
474      n_elements(stepy):gphit = starty + findgen(jpjglo)*stepy
475      size(stepy, /n_dimensions):gphit = starty + total(stepy, /cumulative)
476      ELSE:BEGIN
477        dummy = report('Wrong definition of stepy...')
478        return
479      END
480    ENDCASE
481  ENDELSE
482;
483; force gphit to have 2 dimensions
484;
485  CASE size(reform(gphit), /n_dimensions) OF
486    0:gphit = replicate(gphit, jpi, jpj)
487    1:gphit = replicate(1, jpi)#gphit[iyminmesh:iymaxmesh]
488    2:gphit = gphit[ixminmesh:ixmaxmesh, iyminmesh:iymaxmesh]
489  ENDCASE
490; keep 2d array even with degenerated dimension
491  IF jpj EQ 1 THEN gphit = reform(gphit, jpi, jpj, /over)
492;
493;====================================================
494; check y periodicity... Only according to ORCA grid
495;====================================================
496; check the peridicity if iyminmesh and iymaxmesh have the default definitions...
497  IF NOT keyword_set(plain) AND key_onearth EQ 1 AND key_stride[1] EQ 1 $
498    AND iyminmesh EQ 0l AND iymaxmesh eq jpjglo-1 AND jpj GE 3 AND jpi GE 2 THEN BEGIN
499
500    CASE 1 OF
501      ixminmesh EQ 0l AND ixmaxmesh eq jpiglo-1 $
502        AND array_equal(gphit[1:*, jpj-1], reverse(gphit[1:*, jpj-3])) EQ 1:BEGIN
503; T pivot
504        ymaxmesh = -1
505        recall = 1
506      END
507      ixminmesh EQ 1l AND ixmaxmesh eq jpiglo-2 $
508         AND array_equal(gphit[*, jpj-1], reverse(shift(gphit[*, jpj-3], -1))) EQ 1:BEGIN
509; T pivot
510        ymaxmesh = -1
511        recall = 1
512      END
513      ixminmesh EQ 0l AND ixmaxmesh eq jpiglo-1 $
514       AND array_equal(gphit[*, jpj-1], reverse(gphit[*, jpj-2])) EQ 1:BEGIN
515; F pivot
516        ymaxmesh = -1
517        recall = 1
518      END
519      ixminmesh EQ 1l AND ixmaxmesh eq jpiglo-2 $
520         AND array_equal(gphit[*, jpj-1], reverse(gphit[*, jpj-2])) EQ 1:BEGIN
521; F pivot
522        ymaxmesh = -1
523        recall = 1
524      END
525      ELSE:
526    ENDCASE
527  ENDIF
528;
529;====================================================
530; check x periodicity...
531;====================================================
532IF n_elements(periodic) NE 0 THEN forcenoperio = 1 - keyword_set(periodic)
533; check the peridicity if ixminmesh and ixmaxmesh have the default definitions...
534  IF NOT keyword_set(plain) AND NOT keyword_set(forcenoperio) AND key_onearth EQ 1 $
535     AND key_stride[0] EQ 1 AND ixminmesh EQ 0l AND ixmaxmesh eq jpiglo-1 AND jpi GE 3 THEN BEGIN
536    CASE 0 OF
537      total((glamt[0, *] - glamt[jpi-2, *]) MOD 360) $
538      + total((glamt[1, *] - glamt[jpi-1, *]) MOD 360):BEGIN
539        xminmesh = 1
540        xmaxmesh = -1
541        recall = 1
542      END
543      total((glamt[0, *] - glamt[jpi-2, *]) MOD 360):BEGIN
544        xminmesh = 1
545        recall = 1
546      END
547      total((glamt[1, *] - glamt[jpi-1, *]) MOD 360):BEGIN
548        xmaxmesh = -1
549        recall = 1
550      END
551      ELSE:
552    ENDCASE
553  ENDIF
554;====================================================
555; recall computegrid if needed...
556;====================================================
557  IF keyword_set(recall) THEN BEGIN
558    computegrid, XAXIS = glamt, YAXIS = gphit, ZAXIS = zaxis $
559                 , MASK = mask, GLAMBOUNDARY = glamboundary $
560                 , XMINMESH = xminmesh, XMAXMESH = xmaxmesh $
561                 , YMINMESH = yminmesh, YMAXMESH = ymaxmesh $
562                 , ZMINMESH = zminmesh, ZMAXMESH = zmaxmesh $
563                 , PERIODIC = periodic, SHIFT = shift, STRIDE = stride $
564                 , FULLCGRID = fullcgrid, XYINDEX = xyindex $
565                 , STRCALLING = strcalling $
566                 , ROMSH = romsh, _extra = ex
567    return
568  ENDIF
569;
570;====================================================
571; def key_yreverse
572;====================================================
573;
574  IF jpj GT 1 THEN BEGIN
575    IF total(gphit[0, 1:jpj-1] LT gphit[0, 0:jpj-2]) GT jpj/2 THEN BEGIN
576      key_yreverse = 1
577      gphit = reverse(gphit, 2)
578      glamt = reverse(glamt, 2)
579    ENDIF ELSE key_yreverse = 0
580  ENDIF ELSE key_yreverse = 0
581;
582;====================================================
583; def of key_shift
584;====================================================
585;
586; definition of key_shift by shifting the array to have the min
587; values of glamt[*, 0] in glamt[0, 0]
588;
589  IF n_elements(shift) EQ 0 THEN BEGIN
590    IF jpi GT 1 then BEGIN
591      xtest = glamt[*, 0]
592      key_shift = (where(xtest EQ min(xtest)))[0]
593      IF key_shift NE 0 THEN key_shift = jpi - key_shift
594    ENDIF ELSE key_shift = 0
595  ENDIF ELSE key_shift = shift
596;
597;====================================================
598; def of key_periodic
599;====================================================
600;
601  IF n_elements(periodic) EQ 0 THEN BEGIN
602    IF jpi GT 1 THEN BEGIN
603      xtest = shift(glamt[*, 0], key_shift)
604; check that xtest is now sorted in the increasing order
605      IF array_equal(sort(xtest), lindgen(jpi)) EQ 0 THEN BEGIN
606        print, 'WARNING: we cannot sort the xaxis with a simple shift...'
607        print, 'we force key_periodic = 0 and key_shift = 0'
608        print, 'only horizontal plot may be ok...'
609        key_periodic = 0
610        xnotsorted = 1
611      ENDIF ELSE BEGIN
612        key_periodic = (xtest[jpi-1]+2*(xtest[jpi-1]-xtest[jpi-2])) $
613                       GE (xtest[0]+360)
614      ENDELSE
615    ENDIF ELSE key_periodic = 0
616  ENDIF ELSE key_periodic = keyword_set(periodic)
617;
618; update key_shift
619;
620  key_shift = key_shift * (key_periodic EQ 1)
621;
622  IF (key_gridtype EQ 'c_u' OR key_gridtype EQ 'c_f') AND NOT keyword_set(key_periodic) THEN BEGIN
623    ixmaxmesh = ixmaxmesh-1
624    jpi = jpi-1
625  ENDIF
626;
627;====================================================
628; apply key_shift
629;====================================================
630;
631  if keyword_set(key_shift) then BEGIN
632    glamt = shift(glamt, key_shift, 0)
633    gphit = shift(gphit, key_shift, 0)
634    IF jpj EQ 1 THEN BEGIN
635      glamt = reform(glamt, jpi, jpj, /over)
636      gphit = reform(gphit, jpi, jpj, /over)
637    ENDIF
638  ENDIF
639;
640;====================================================
641; Are we using a "regular" grid (that can be described
642; with x vector and y vector)?
643;====================================================
644;
645; to get faster, we first test the most basic cases before
646; testing the full array.
647;
648  CASE 1 OF
649    keyword_set(xyindex):key_irregular = 0b
650    jpi EQ 1 OR jpj EQ 1:key_irregular = 0b
651    n_elements(xaxis) EQ 0 AND n_elements(yaxis) EQ 0:key_irregular = 0b
652    size(reform(xaxis), /n_dimensions) EQ 1 AND size(reform(xaxis), /n_dimensions) EQ 1:key_irregular = 0b
653    n_elements(xaxis) EQ 0 AND size(reform(yaxis), /n_dimensions) EQ 1:key_irregular = 0b
654    n_elements(yaxis) EQ 0 AND size(reform(xaxis), /n_dimensions) EQ 1:key_irregular = 0b
655    array_equal(glamt[*, 0], glamt[*, jpj-1]) EQ 0:key_irregular = 1b
656    array_equal(gphit[0, *], gphit[jpi-1, *]) EQ 0:key_irregular = 1b
657    array_equal(glamt, glamt[*, 0]#replicate(1, jpj)) EQ 0:key_irregular = 1b
658    array_equal(gphit, replicate(1, jpi)#(gphit[0, *])[*]) EQ 0:key_irregular = 1b
659    ELSE:key_irregular = 0b
660  ENDCASE
661;
662;====================================================
663; def of glamf: defined as the middle of T(i,j) T(i+1,j+1)
664;====================================================
665;
666  IF jpi GT 1 THEN BEGIN
667; we must compute stepxf: x distance between T(i,j) T(i+1,j+1)
668    CASE 1 OF
669      n_elements(stepx):stepxf = stepx
670      size(stepx, /n_dimensions):stepxf = stepx#replicate(1, jpj)
671      ELSE:BEGIN
672        if (keyword_set(key_onearth) AND keyword_set(xnotsorted)) $
673          OR (keyword_set(key_periodic) AND key_irregular) then BEGIN
674          stepxf = (glamt + 720) MOD 360
675          IF jpj EQ 1 THEN stepxf = reform(stepxf, jpi, jpj, /over)
676          stepxf = shift(stepxf, -1, -1) - stepxf
677          stepxf = [ [[stepxf]], [[stepxf + 360]], [[stepxf - 360]] ]
678          stepxf = min(abs(stepxf), dimension = 3)
679          IF NOT keyword_set(key_periodic) THEN $
680            stepxf[jpi-1, *] = stepxf[jpi-2, *]
681        ENDIF ELSE BEGIN
682          stepxf = shift(glamt, -1, -1) - glamt
683          IF keyword_set(key_periodic) THEN $
684            stepxf[jpi-1, *] = 360 + stepxf[jpi-1, *] $
685          ELSE stepxf[jpi-1, *] = stepxf[jpi-2, *]
686        ENDELSE
687        IF jpj GT 1 THEN BEGIN
688          stepxf[*, jpj-1] = stepxf[*, jpj-2]
689          stepxf[jpi-1, jpj-1] = stepxf[jpi-2, jpj-2]
690        ENDIF
691      END
692    ENDCASE
693    glamf = glamt + 0.5 * stepxf
694  ENDIF ELSE glamf = glamt + 0.5
695;
696  IF keyword_set(key_periodic) AND (max(glamf)-min(glamt)) GE 360 THEN BEGIN
697    IF NOT keyword_set(glamboundary) THEN BEGIN
698      bigger = where(glamf GE min(glamt)+360)
699      glamf[bigger] = glamf[bigger]-360.
700    ENDIF ELSE glamf = glamboundary[0] > temporary(glamf) < glamboundary[1]
701  ENDIF
702;
703  IF jpj EQ 1 THEN glamf = reform(glamf, jpi, jpj, /over)
704;
705;====================================================
706; def of gphif: defined as the middle of T(i,j) T(i+1,j+1)
707;====================================================
708;
709  IF jpj GT 1 THEN BEGIN
710; we must compute stepyf: y distance between T(i,j) T(i+1,j+1)
711    CASE 1 OF
712      n_elements(stepy):stepyf = stepy
713      size(stepy, /n_dimensions):stepyf = replicate(1, jpi)#stepy
714      ELSE:BEGIN
715        stepyf = shift(gphit, -1, -1) - gphit
716        stepyf[*, jpj-1] = stepyf[*, jpj-2]
717        IF jpi GT 1 THEN BEGIN
718          if NOT keyword_set(key_periodic) THEN $
719            stepyf[jpi-1, *] = stepyf[jpi-2, *]
720          stepyf[jpi-1, jpj-1] = stepyf[jpi-2, jpj-2]
721        ENDIF
722      END
723    ENDCASE
724    gphif = gphit + 0.5 * stepyf
725  ENDIF ELSE gphif = gphit + 0.5
726  IF key_onearth THEN gphif = -90. > gphif < 90.
727;
728  IF jpj EQ 1 THEN gphif = reform(gphif, jpi, jpj, /over)
729;
730;====================================================
731; e1t: x distance between U(i-1,j) and U(i,j)
732;====================================================
733;
734; *-|-*---|---*---|
735;
736  IF jpi GT 1 THEN BEGIN
737    IF n_elements(stepx) NE 1 THEN BEGIN
738      IF keyword_set(irregular) THEN BEGIN
739; we must compute stepxu: x distance between T(i,j) T(i+1,j)
740        IF keyword_set(key_periodic) THEN BEGIN
741          stepxu = (glamt + 720) MOD 360
742          stepxu = shift(stepxu, -1, 0) - stepxu
743          stepxu = [ [[stepxu]], [[stepxu + 360]], [[stepxu - 360]] ]
744          stepxu = min(abs(stepxu), dimension = 3)
745        ENDIF ELSE BEGIN
746          stepxu = shift(glamt, -1, 0) - glamt
747          stepxu[jpi-1, *] = stepxf[jpi-2, *]
748        ENDELSE
749      ENDIF ELSE stepxu = stepxf
750      IF jpj EQ 1 THEN stepxu = reform(stepxu, jpi, jpj, /over)
751      e1t = 0.5*(stepxu+shift(stepxu, 1, 0))
752      IF NOT keyword_set(key_periodic) THEN $
753        e1t[0, *] = e1t[1, *]
754    ENDIF ELSE e1t = replicate(stepx, jpi, jpj)
755  ENDIF ELSE e1t = replicate(1b, jpi, jpj)
756;
757  IF jpj EQ 1 THEN e1t = reform(e1t, jpi, jpj, /over)
758;
759;====================================================
760; e2t: y distance between V(i,j-1) and V(i,j)
761;====================================================
762;
763  IF jpj GT 1 THEN BEGIN
764; we must compute stepyv: y distance between T(i,j) T(i,j+1)
765    IF n_elements(stepy) NE 1 THEN BEGIN
766      IF keyword_set(key_irregular) THEN BEGIN
767        stepyv = shift(gphit, 0, -1) - gphit
768        stepyv[*, jpj-1] = stepyv[*, jpj-2]
769      ENDIF ELSE stepyv = stepyf
770      e2t = 0.5*(stepyv+shift(stepyv, 0, 1))
771      e2t[*, 0] = e2t[*, 1]
772    ENDIF ELSE e2t = replicate(stepy, jpi, jpj)
773  ENDIF ELSE e2t = replicate(1b, jpi, jpj)
774;
775  IF key_onearth THEN e2t = r * !pi/180. * temporary(e2t)
776;
777  IF jpj EQ 1 THEN e2t = reform(e2t, jpi, jpj, /over)
778;
779;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
780  IF keyword_set(fullcgrid) THEN BEGIN
781;
782;====================================================
783; def of glamu: defined as the middle of T(i,j) T(i+1,j)
784;====================================================
785;
786    IF keyword_set(irregular) THEN BEGIN
787      glamu = glamt + 0.5 * stepxu
788      IF keyword_set(glamboundary) AND key_onearth THEN $
789        glamu = glamboundary[0] > temporary(glamu) < glamboundary[1]
790    ENDIF ELSE glamu = glamf
791;
792    IF jpj EQ 1 THEN glamu = reform(glamu, jpi, jpj, /over)
793;
794;====================================================
795; def of gphiu: defined as the middle of T(i,j) T(i+1,j)
796;====================================================
797;
798    IF jpi GT 1 THEN BEGIN
799 ; we must compute stepyu: y distance between T(i+1,j) T(i,j)
800      IF keyword_set(key_irregular) THEN BEGIN
801       stepyu = shift(gphit, -1, 0) - gphit
802        IF NOT keyword_set(key_periodic) THEN $
803          stepyu[jpi-1, *] = stepyu[jpi-2, *]
804        gphiu = gphit + 0.5 * stepyu
805      ENDIF ELSE gphiu = gphit
806    ENDIF ELSE gphiu = gphit
807  IF key_onearth THEN gphiu = -90. > gphiu < 90.
808;
809  IF jpj EQ 1 THEN gphiu = reform(gphiu, jpi, jpj, /over)
810;
811;====================================================
812; def of glamv: defined as the middle of T(i,j) T(i,j+1)
813;====================================================
814;
815    IF jpj GT 1 THEN BEGIN
816 ; we must compute stepxv: x distance between T(i,j) T(i,j+1)
817      IF keyword_set(irregular) THEN BEGIN
818        IF keyword_set(key_periodic) THEN BEGIN
819          stepxv = (glamt + 720) MOD 360
820          stepxv = shift(stepxv, 0, -1) - stepxv
821          stepxv = [ [[stepxv]], [[stepxv + 360]], [[stepxv - 360]] ]
822          stepxv = min(abs(stepxv), dimension = 3)
823        ENDIF ELSE stepxv = shift(glamt, 0, -1) - glamt
824        stepxv[*, jpj-1] = stepxv[*, jpj-2]
825        glamv = glamt + 0.5 * stepxv
826        IF keyword_set(glamboundary) AND key_onearth THEN $
827          glamv = glamboundary[0] > temporary(glamv) < glamboundary[1]
828      ENDIF ELSE glamv = glamt
829    ENDIF ELSE glamv = glamt
830;
831;====================================================
832; def of gphiv: defined as the middle of T(i,j) T(i,j+1)
833;====================================================
834;
835    IF keyword_set(key_irregular) THEN $
836      gphiv = gphit + 0.5 * stepyv $
837    ELSE gphiv = gphif
838    IF key_onearth THEN gphiv = -90. > gphiv < 90.
839;
840    IF jpj EQ 1 THEN gphiv = reform(gphiv, jpi, jpj, /over)
841;
842;====================================================
843; e1u: x distance between T(i,j) and T(i+1,j)
844;====================================================
845;
846    IF jpi GT 1 AND n_elements(stepx) NE 1 THEN $
847      e1u = stepxu ELSE e1u = e1t
848;
849;====================================================
850; e2u: y distance between F(i,j-1) and F(i,j)
851;====================================================
852;
853    IF keyword_set(key_irregular) THEN BEGIN
854      e2u = gphif - shift(gphif, 0, 1)
855      e2u[*, 0] = e2u[*, 1]
856      IF key_onearth THEN e2u = r * !pi/180. * temporary(e2u)
857    ENDIF ELSE e2u = e2t
858;
859    IF jpj EQ 1 THEN e2u = reform(e2u, jpi, jpj, /over)
860;
861;====================================================
862; e1v: x distance between F(i-1,j) and F(i,j)
863;====================================================
864;
865    IF keyword_set(irregular) THEN BEGIN
866      IF keyword_set(key_periodic) THEN BEGIN
867        e1v = (glamf + 720) MOD 360
868        e1v = e1v - shift(e1v, 1, 0)
869        e1v = [ [[e1v]], [[e1v + 360]], [[e1v - 360]] ]
870        e1v = min(abs(e1v), dimension = 3)
871      ENDIF ELSE BEGIN
872        e1v = glamf - shift(glamf, 1, 0)
873        e1v[0, *] = stepxf[1, *]
874      ENDELSE
875    ENDIF ELSE e1v = e1t
876;
877    IF jpj EQ 1 THEN e1v = reform(e1v, jpi, jpj, /over)
878;
879;====================================================
880; e2v: y distance between T(i,j) and T(i+1,j)
881;====================================================
882;
883    IF jpj GT 1 and n_elements(stepy) NE 1 THEN BEGIN
884      e2v = stepyv
885      IF key_onearth THEN e2v = r * !pi/180. * temporary(e2v)
886    ENDIF ELSE e2v = e2t
887;
888;====================================================
889; e1f: x distance between V(i,j) and V(i+1,j)
890;====================================================
891;
892    IF keyword_set(irregular) THEN BEGIN
893      IF keyword_set(key_periodic) THEN BEGIN
894        e1f = (glamv + 720) MOD 360
895        e1f = shift(e1f, -1, 0) - e1f
896        e1f = [ [[e1f]], [[e1f + 360]], [[e1f - 360]] ]
897        e1f = min(abs(e1f), dimension = 3)
898      ENDIF ELSE BEGIN
899        e1f = shift(glamv, -1, 0) - glamt
900        e1f[jpi-1, *] = stepxf[jpi-2, *]
901      ENDELSE
902    ENDIF ELSE e1f = e1u
903;
904    IF jpj EQ 1 THEN e1f = reform(e1f, jpi, jpj, /over)
905;
906;====================================================
907; e2f: y distance between U(i,j) and U(i,j+1)
908;====================================================
909;
910    IF keyword_set(key_irregular) THEN BEGIN
911      e2f = shift(gphiu, 0, -1) - gphiu
912      e2f[*, jpj-1] = e2f[*, jpj-2]
913      IF key_onearth THEN e2f = r * !pi/180. * temporary(e2f)
914    ENDIF ELSE e2f = e2v
915;
916    IF jpj EQ 1 THEN e2f = reform(e2f, jpi, jpj, /over)
917;
918  ENDIF
919;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
920;
921;
922;====================================================
923; e1[tuvf] from degree to meters
924;====================================================
925;
926  IF keyword_set(key_onearth)  THEN BEGIN
927    e1t = r * !pi/180. * temporary(e1t) * cos(!pi/180.*gphit)
928    IF keyword_set(fullcgrid) THEN BEGIN
929      e1u = r * !pi/180. * temporary(e1u) * cos(!pi/180.*gphiu)
930      e1v = r * !pi/180. * temporary(e1v) * cos(!pi/180.*gphiv)
931      e1f = r * !pi/180. * temporary(e1f) * cos(!pi/180.*gphif)
932    ENDIF
933  ENDIF
934;
935  IF jpj EQ 1 THEN BEGIN
936    e1t = reform(e1t, jpi, jpj, /over)
937    IF keyword_set(fullcgrid) THEN BEGIN
938      e1u = reform(e1u, jpi, jpj, /over)
939      e1v = reform(e1v, jpi, jpj, /over)
940      e1f = reform(e1f, jpi, jpj, /over)
941    ENDIF
942  ENDIF
943;
944;====================================================
945; if not fullcgrid: make sure we don't use glam[uv], gphi[uv], e[12][uvf]
946;====================================================
947;
948  IF NOT keyword_set(fullcgrid) THEN BEGIN
949    glamu = !values.f_nan & glamv = !values.f_nan
950    gphiu = !values.f_nan & gphiv = !values.f_nan
951    e1u = !values.f_nan & e1v = !values.f_nan & e1f = !values.f_nan
952    e2u = !values.f_nan & e2v = !values.f_nan & e2f = !values.f_nan
953    firstxu = !values.f_nan & lastxu = !values.f_nan & nxu = !values.f_nan
954    firstyu = !values.f_nan & lastyu = !values.f_nan & nyu = !values.f_nan
955    firstxv = !values.f_nan & lastxv = !values.f_nan & nxv = !values.f_nan
956    firstyv = !values.f_nan & lastyv = !values.f_nan & nyv = !values.f_nan
957  ENDIF
958;
959;====================================================
960; Z direction
961;====================================================
962;
963; z axis
964;
965    CASE n_elements(zaxis) OF
966      0:BEGIN
967        gdept = 0.
968        key_zreverse = 0
969      END
970      1:BEGIN
971        gdept = zaxis
972        key_zreverse = 0
973      END
974      ELSE:BEGIN
975        gdept = zaxis[izminmesh:izmaxmesh]
976        IF jpk GT 1 THEN BEGIN
977          if gdept[0] GT gdept[1] then begin
978            gdept = reverse(gdept)
979            key_zreverse = 1
980          ENDIF ELSE key_zreverse = 0
981        ENDIF ELSE key_zreverse = 0
982      END
983    ENDCASE
984;
985    if n_elements(gdept) GT 1 then BEGIN
986      stepz = shift(gdept, -1)-gdept
987      stepz[jpk-1] = stepz[jpk-2]
988      gdepw = 0. > (gdept-stepz/2.)
989    ENDIF ELSE BEGIN
990      stepz = 1.
991      gdepw = gdept
992    ENDELSE
993    IF keyword_set(romsh) THEN gdepw = gdept
994;
995;====================================================
996; e3[tw]:
997;====================================================
998;
999    e3t = stepz
1000    IF n_elements(stepz) GT 1 THEN BEGIN
1001      e3w = 0.5*(stepz+shift(stepz, 1))
1002      e3w[0] = 0.5*e3t[0]
1003    ENDIF ELSE e3w = e3t
1004;
1005;====================================================
1006; Mask
1007;====================================================
1008;
1009; default mask eq 1
1010  if NOT keyword_set(mask) then tmask = -1 ELSE tmask = mask
1011;
1012  if tmask[0] NE -1 then BEGIN
1013    IF keyword_set(romsh) THEN tmask = tmask[0:jpiglo-1, 0:jpjglo-1]
1014    IF n_elements(mask) EQ jpiglo*jpjglo AND jpkglo GT 1 THEN BEGIN
1015      tmask = tmask[*]#replicate(1, jpkglo)
1016      tmask = reform(tmask, jpiglo, jpjglo, jpkglo, /overwrite)
1017    ENDIF
1018    IF jpiglo EQ 1 OR jpjglo EQ 1 THEN tmask = reform(tmask, jpiglo, jpjglo, jpkglo, /overwrite)
1019    tmask = byte(tmask[ixminmesh:ixmaxmesh, iyminmesh:iymaxmesh, izminmesh:izmaxmesh])
1020    tmask = reform(tmask, jpi, jpj, jpk, /over)
1021    if key_shift NE 0 then tmask = shift(tmask, key_shift, 0, 0)
1022; because tmask = reverse(tmask, 2) is not working if the 3rd
1023; dimension of tmask = 1, we call reform.
1024    IF jpk EQ 1 THEN tmask = reform(tmask, /over)
1025    IF key_yreverse EQ 1 THEN tmask = reverse(tmask, 2)
1026    IF jpk EQ 1 THEN tmask = reform(tmask, jpi, jpj, jpk, /over)
1027    IF key_zreverse EQ 1 THEN tmask = reverse(tmask, 3)
1028    IF jpk EQ 1 THEN tmask = reform(tmask, jpi, jpj, jpk, /over)
1029    IF keyword_set(fullcgrid) THEN BEGIN
1030      IF keyword_set(key_periodic) THEN BEGIN
1031        msk = tmask*shift(tmask, -1, 0, 0)
1032        umaskred = msk[jpi-1, *, *]
1033      ENDIF ELSE umaskred = tmask[jpi-1, *, *]
1034      vmaskred = tmask[*, jpj-1, *]
1035      fmaskredy = tmask[jpi-1, *, *]
1036      fmaskredx = tmask[*, jpj-1, *]
1037    ENDIF
1038  ENDIF ELSE BEGIN
1039    tmask = replicate(1b, jpi, jpj, jpk)
1040    IF keyword_set(fullcgrid) THEN BEGIN
1041      umaskred  = replicate(1b, jpj, jpk)
1042      vmaskred  = replicate(1b, jpi, jpk)
1043      fmaskredy = replicate(1b, jpj, jpk)
1044      fmaskredx = replicate(1b, jpi, jpk)
1045    ENDIF
1046  ENDELSE
1047;
1048  IF jpi GT 2 AND jpj GT 2 AND NOT keyword_set(plain) $
1049     AND ixminmesh EQ 0l AND ixmaxmesh eq jpiglo-1 $
1050     AND iyminmesh EQ 0l AND iymaxmesh eq jpjglo-1 $
1051     AND total(tmask[*, 0, *]) EQ 0 AND total(tmask[*, jpj-1, *]) EQ 0 $
1052     AND total(tmask[0, *, *]) EQ 0 AND total(tmask[jpi-1, *, *]) EQ 0 THEN BEGIN
1053        xminmesh = 1
1054        xmaxmesh = -1
1055        yminmesh = 1
1056        ymaxmesh = -1
1057        computegrid, XAXIS = glamt, YAXIS = gphit, ZAXIS = zaxis $
1058                     , MASK = mask, GLAMBOUNDARY = glamboundary $
1059                     , XMINMESH = xminmesh, XMAXMESH = xmaxmesh $
1060                     , YMINMESH = yminmesh, YMAXMESH = ymaxmesh $
1061                     , ZMINMESH = zminmesh, ZMAXMESH = zmaxmesh $
1062                     , ONEARTH = onearth, PERIODIC = periodic $
1063                     , PLAIN = plain, SHIFT = shift, STRIDE = stride $
1064                     , FULLCGRID = fullcgrid, XYINDEX = xyindex $
1065                     , UBASE2TBASE = ubase2tbase, VBASE2TBASE = vbase2tbase $
1066                     , FBASE2TBASE = fbase2tbase, STRCALLING = strcalling $
1067                     , ROMSH = romsh, _extra = ex
1068        return
1069  ENDIF
1070;
1071  IF NOT keyword_set(fullcgrid) THEN BEGIN
1072    umaskred = !values.f_nan
1073    vmaskred = !values.f_nan
1074    fmaskredy = !values.f_nan
1075    fmaskredx = !values.f_nan
1076  ENDIF
1077;
1078;====================================================
1079; stride...
1080;====================================================
1081;
1082  IF total(key_stride) GT 3 THEN BEGIN
1083    IF key_shift NE 0 THEN BEGIN
1084; for explanation, see header of read_ncdf_varget.pro
1085      jpiright = key_shift
1086      jpileft = jpi - key_shift - ( (key_stride[0]-1)-((key_shift-1) MOD key_stride[0]) )
1087      jpi = ((jpiright-1)/key_stride[0]+1) + ((jpileft-1)/key_stride[0]+1)
1088    ENDIF ELSE jpi = (jpi-1)/key_stride[0]+1
1089    jpj = (jpj-1)/key_stride[1]+1
1090    jpk = (jpk-1)/key_stride[2]+1
1091;
1092    glamt = (temporary(glamt))[0:*:stride[0], 0:*:stride[1]]
1093    gphit = (temporary(gphit))[0:*:stride[0], 0:*:stride[1]]
1094    e1t = (temporary(e1t))[0:*:stride[0], 0:*:stride[1]]
1095    e2t = (temporary(e2t))[0:*:stride[0], 0:*:stride[1]]
1096    tmask = (temporary(tmask))[0:*:stride[0], 0:*:stride[1], 0:*:stride[2]]
1097    gdept = gdept[0:*:stride[2]]
1098    gdepw = gdepw[0:*:stride[2]]
1099    e3t = e3t[0:*:stride[2]]
1100    e3w = e3w[0:*:stride[2]]
1101; we must recompute glamf and gphif...
1102    IF jpi GT 1 THEN BEGIN
1103      if (keyword_set(key_onearth) AND keyword_set(xnotsorted)) $
1104        OR (keyword_set(key_periodic) AND key_irregular) then BEGIN
1105        stepxf = (glamt + 720) MOD 360
1106        stepxf = shift(stepxf, -1, -1) - stepxf
1107        stepxf = [ [[stepxf]], [[stepxf + 360]], [[stepxf - 360]] ]
1108        stepxf = min(abs(stepxf), dimension = 3)
1109        IF NOT keyword_set(key_periodic) THEN $
1110          stepxf[jpi-1, *] = stepxf[jpi-2, *]
1111      ENDIF ELSE BEGIN
1112        stepxf = shift(glamt, -1, -1) - glamt
1113        IF keyword_set(key_periodic) THEN $
1114          stepxf[jpi-1, *] = 360 + stepxf[jpi-1, *] $
1115          ELSE stepxf[jpi-1, *] = stepxf[jpi-2, *]
1116      ENDELSE
1117      IF jpj GT 1 THEN BEGIN
1118        stepxf[*, jpj-1] = stepxf[*, jpj-2]
1119        stepxf[jpi-1, jpj-1] = stepxf[jpi-2, jpj-2]
1120      ENDIF
1121      glamf = glamt + 0.5 * stepxf
1122    ENDIF ELSE glamf = glamt + 0.5
1123    IF jpj GT 1 THEN BEGIN
1124; we must compute stepyf: y distance between T(i,j) T(i+1,j+1)
1125      stepyf = shift(gphit, -1, -1) - gphit
1126      stepyf[*, jpj-1] = stepyf[*, jpj-2]
1127      IF jpi GT 1 THEN BEGIN
1128        if NOT keyword_set(key_periodic) THEN $
1129          stepyf[jpi-1, *] = stepyf[jpi-2, *]
1130        stepyf[jpi-1, jpj-1] = stepyf[jpi-2, jpj-2]
1131      ENDIF
1132      gphif = gphit + 0.5 * stepyf
1133    ENDIF ELSE gphif = gphit + 0.5
1134;
1135    IF jpj EQ 1 THEN BEGIN
1136      glamt = reform(glamt, jpi, jpj, /over)
1137      gphit = reform(gphit, jpi, jpj, /over)
1138      glamf = reform(glamf, jpi, jpj, /over)
1139      gphif = reform(gphif, jpi, jpj, /over)
1140      e1t = reform(e1t, jpi, jpj, /over)
1141      e2t = reform(e2t, jpi, jpj, /over)
1142    ENDIF
1143;
1144    IF keyword_set(fullcgrid) THEN BEGIN
1145      glamu = (temporary(glamu))[0:*:stride[0], 0:*:stride[1]]
1146      gphiu = (temporary(gphiu))[0:*:stride[0], 0:*:stride[1]]
1147      e1u = (temporary(e1u))[0:*:stride[0], 0:*:stride[1]]
1148      e2u = (temporary(e2u))[0:*:stride[0], 0:*:stride[1]]
1149      glamv = (temporary(glamv))[0:*:stride[0], 0:*:stride[1]]
1150      gphiv = (temporary(gphiv))[0:*:stride[0], 0:*:stride[1]]
1151      e1v = (temporary(e1v))[0:*:stride[0], 0:*:stride[1]]
1152      e2v = (temporary(e2v))[0:*:stride[0], 0:*:stride[1]]
1153      e1f = (temporary(e1f))[0:*:stride[0], 0:*:stride[1]]
1154      e2f = (temporary(e2f))[0:*:stride[0], 0:*:stride[1]]
1155      umaskred = (temporary(umaskred))[0, 0:*:stride[1], 0:*:stride[2]]
1156      vmaskred = (temporary(vmaskred))[0:*:stride[0], 0, 0:*:stride[2]]
1157      fmaskredy = (temporary(fmaskredy))[0, 0:*:stride[1], 0:*:stride[2]]
1158      fmaskredx = (temporary(fmaskredx))[0:*:stride[0], 0, 0:*:stride[2]]
1159      IF jpj EQ 1 THEN BEGIN
1160        glamu = reform(glamu, jpi, jpj, /over)
1161        gphiu = reform(gphiu, jpi, jpj, /over)
1162        e1u = reform(e1u, jpi, jpj, /over)
1163        e2u = reform(e2u, jpi, jpj, /over)
1164        glamv = reform(glamv, jpi, jpj, /over)
1165        gphiv = reform(gphiv, jpi, jpj, /over)
1166        e1v = reform(e1v, jpi, jpj, /over)
1167        e2v = reform(e2v, jpi, jpj, /over)
1168        e1f = reform(e1f, jpi, jpj, /over)
1169        e2f = reform(e2f, jpi, jpj, /over)
1170      ENDIF
1171    ENDIF
1172  ENDIF
1173;
1174;====================================================
1175; apply all the grid parameters
1176;====================================================
1177;
1178  @updateold
1179  domdef
1180;
1181;====================================================
1182; Triangulation
1183;====================================================
1184;
1185  IF total(tmask) EQ jpi*jpj*jpk $
1186    AND NOT keyword_set(key_irregular) THEN triangles_list = -1 $
1187  ELSE BEGIN
1188; are we using ORCA2 ?
1189    IF jpiglo EQ 182 AND jpi EQ 181 AND jpjglo EQ 149 AND jpj EQ 148 THEN $
1190       triangles_list = triangule() ELSE triangles_list = triangule(/keep_cont)
1191  ENDELSE
1192;
1193;====================================================
1194; time axis (default definition)
1195;====================================================
1196;
1197  IF n_elements(time) EQ 0 OR n_elements(jpt) EQ 0 THEN BEGIN
1198    jpt = 1
1199    time = 0
1200  ENDIF
1201;
1202  IF NOT keyword_set(key_forgetold) THEN BEGIN
1203@updateold
1204  ENDIF
1205;====================================================
1206; grid parameters used by xxx
1207;====================================================
1208;
1209  IF NOT keyword_set(strcalling) THEN BEGIN
1210    IF n_elements(ccmeshparameters) EQ 0 THEN strcalling = 'computegrid' $
1211    ELSE strcalling = ccmeshparameters.filename
1212  ENDIF
1213  IF n_elements(glamt) GE 2 THEN BEGIN
1214    glaminfo = moment(glamt)
1215    IF finite(glaminfo[2]) EQ 0 THEN glaminfo = glaminfo[0:1]
1216    gphiinfo = moment(gphit)
1217    IF finite(gphiinfo[2]) EQ 0 THEN gphiinfo = gphiinfo[0:1]
1218  ENDIF ELSE BEGIN
1219    glaminfo = glamt
1220    gphiinfo = gphit
1221  ENDELSE
1222  IF keyword_set(romsh) THEN $
1223     romszinfos = {h:romsh[ixminmesh:ixmaxmesh, iyminmesh:iymaxmesh], zeta:replicate(0., jpi, jpj), theta_s:-1, theta_b:-1, hc:-1} $
1224  ELSE romszinfos = {h:-1, zeta:-1, theta_s:-1, theta_b:-1, hc:-1}
1225
1226  ccmeshparameters = {filename:strcalling  $
1227          , glaminfo:float(string(glaminfo, format = '(E11.4)')) $
1228          , gphiinfo:float(string(gphiinfo, format = '(E11.4)')) $
1229          , jpiglo:jpiglo, jpjglo:jpjglo, jpkglo:jpkglo $
1230          , jpi:jpi, jpj:jpj, jpk:jpk $
1231          , ixminmesh:ixminmesh, ixmaxmesh:ixmaxmesh $
1232          , iyminmesh:iyminmesh, iymaxmesh:iymaxmesh $
1233          , izminmesh:izminmesh, izmaxmesh:izmaxmesh $
1234          , key_shift:key_shift, key_periodic:key_periodic $
1235          , key_stride:key_stride, key_gridtype:key_gridtype $
1236          , key_yreverse:key_yreverse, key_zreverse:key_zreverse $
1237          , key_partialstep:key_partialstep, key_onearth:key_onearth}
1238
1239  ccreadparameters = {funclec_name:'read_ncdf' $
1240          , jpidta:jpidta, jpjdta:jpjdta, jpkdta:jpkdta $
1241          , ixmindta:ixmindta, ixmaxdta:ixmaxdta $
1242          , iymindta:iymindta, iymaxdta:iymaxdta $
1243          , izmindta:izmindta, izmaxdta:izmaxdta}
1244;------------------------------------------------------------
1245  IF keyword_set(key_performance) EQ 1 THEN $
1246    print, 'time computegrid', systime(1)-time1
1247;------------------------------------------------------------
1248  return
1249end
Note: See TracBrowser for help on using the repository browser.