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

Last change on this file since 487 was 465, checked in by smasson, 13 years ago

bugfix for roms

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