source: trunk/SRC/ToBeReviewed/PLOTS/DIVERS/checkfield.pro @ 163

;+
; @file_comments 
; 
; 
; @categories
; 
; 
; @param TYPE {in}{required}{type=string}
; A string of two characters specifying the type of plot we do
;
; @param N1 {in}{required}{type=integer}
; Number of elements in the first dimension
;
; @param N2 {in}{required}{type=integer}
; Number of elements in the second dimension
;
; @param NAME {in}{optional}{type=string}
; It gives the name of the file to be opened. If NAME
; does not contain the separating character of directories ('/' under
; unix for example), the file will be looked for in the current directory.
;
; @returns
; 
; 
; @restrictions
; 
; 
; @examples
;
;
; @history
; 
;
; @version
; $Id$
;-
FUNCTION err_1d, type, n1, name, n2
;
  compile_opt idl2, strictarrsubs
;
  return, report(['Error in "' + type + '" type plot with a 1D input array:' $
                  , 'the number of elements of the input vector ('+strtrim(n1, 1)+') ' $
                  , 'is not equal to ' + name + ' ('+strtrim(n2, 1)+')'], /simple)
END
;
;+
; @file_comments 
; 
; 
; @categories
; 
; 
; @param TYPE {in}{required}{type=string}
; A string of two characters specifying the type of plot we do
;
; @param SZ {in}{optional}{default=defined by grille.pro} 
; 
; @param NX {in}{optional}{default=defined by grille.pro} 
; 
; @param NY {in}{optional}{default=defined by grille.pro}  
; 
; @param NZ
; 
; 
; @returns
; 
; 
; @restrictions
; 
; 
; @examples
;
;
; @history
; 
;
; @version
; $Id$
;-
FUNCTION err_2d, type, sz, nx, ny, nz
;
  compile_opt idl2, strictarrsubs
;
  @cm_4mesh
  @cm_4cal
  return, report(['Error in "' + type + '" type plot with a 2D input array:' $
                  , 'the array dimensions ' + tostr(sz[1:2]) + ' are incompatible' $
                  , 'with the the domain dimensions ' $
                  , '[jpi/nx, jpj/ny, jpk/nz, jpt] = [' $
                  + strtrim(jpi, 1) + '/' + strtrim(nx, 1) $
                  + ', ' + strtrim(jpj, 1) + '/' + strtrim(ny, 1) $
                  + ', ' + strtrim(jpk, 1) + '/' + strtrim(nz, 1) $
                  + ', ' + strtrim(jpt, 1) + ']'], /simple)
END
;
;+
; @file_comments 
; 
; 
; @categories
; 
; 
; @param TYPE {in}{required}{type=string}
; A string of two characters specifying the type of plot we do
;
; @param SZ {in}{optional}{default=defined by grille.pro} 
; 
; @param NX {in}{optional}{default=defined by grille.pro} 
; 
; @param NY {in}{optional}{default=defined by grille.pro}  
; 
; @param NZ
; 
; 
; @returns
; 
; 
; @restrictions
; 
; 
; @examples
;
;
; @history
; 
;
; @version
; $Id$
;-
FUNCTION err_3d, type, sz, nx, ny, nz
;
  compile_opt idl2, strictarrsubs
;
  @cm_4mesh
  @cm_4cal
  return, report(['Error in "' + type + '" type plot with a 3D input array:' $
                  , 'the array dimensions ' + tostr(sz[1:3]) + ' are incompatible' $
                  , 'with the the domain dimensions ' $
                  , '[jpi/nx, jpj/ny, jpk/nz, jpt] = [' $
                  + strtrim(jpi, 1) + '/' + strtrim(nx, 1) $
                  + ', ' + strtrim(jpj, 1) + '/' + strtrim(ny, 1) $
                  + ', ' + strtrim(jpk, 1) + '/' + strtrim(nz, 1) $
                  + ', ' + strtrim(jpt, 1) + ']'], /simple)
END
;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
;+
;
; @file_comments
; In input of plt, pltz, pltt and plt1d, it check that the field give 
; a size compatible with the domain and, if needed, average to give us 
; a 2d array if we make a plot of the type: 'xy', 'xz', 'xt', 'yz', 'yt'
; , 'zt' or a 1d array if we make a plot of the type: 'x', 'y', 'z', 't'.
;
; @categories
; Graphics
; 
; @param FIELD {in}{required}{type=field}
; It respect litchamp.pro's criterions. See IDL>xhelp,'litchamp'
;
; @param PROCEDURE {in}{required}
;
; 
; @keyword TYPE
;
;
; @keyword NOQUESTION
;
;
; @keyword BOXZOOM {type=vector}
; Vector indicating the geographic zone on which we want to cut the map. 
;  If BOXZOOM has :
; 1 element : The extraction is made on [lon1, lon2, lat1, lat2, 0.,boxzoom[0]]
; 2 elements: The extraction is made on [lon1, lon2, lat1, lat2, boxzoom[0],boxzoom[1]]
; 4 elements: The extraction is made on [Boxzoom, 0, max([gdept, gdepw])]
; 5 elements: The extraction is made on [Boxzoom[0:3], 0, Boxzoom[4]]
; 6 elements: The extraction is made on Boxzoom
;
; Where lon1, lon2,lat1,lat2 are global variables defined at the last domdef!
;
; @keyword WDEPTH
; to specify that the field is at W depth instead of T 
; depth (automatically activated if vargrid eq 'W')
; 
; @keyword VECTEUR{type=vetcor}
; It is a structure composed by 2 elements containing the 2 fields U
; and V of values of the zonal and meridian component of the vector of the fields
; to draw. These fields can be an array or a structure.
;       For example: vecteur={matriceu:lec('unsurface'),matricev:lec('vnsurface')}
;       Comment: name of elements of vectors are inconsequential.
;       vecteur={u:lec('unsurface'),v:lec('vnsurface')} is also appropriated.
;
; @keyword _EXTRA
; used to pass your keywords
;
; @keyword DIREC   
;
;
; @uses 
; common.pro
;
; @history
; Sebastien Masson (smasson\@lodyc.jussieu.fr)
;                      08/02/2000
;
; @version
; $Id$
;
; @todo seb: mettre les param 
;
;-
;------------------------------------------------------------
;------------------------------------------------------------
;--------------------------------------------------------------
;
FUNCTION checkfield, field, procedure, TYPE = type, BOXZOOM = boxzoom, DIREC = direc, NOQUESTION = noquestion, VECTEUR = vecteur, WDEPTH = wdepth, _EXTRA = ex
;--------------------------------------------------------------
;
  compile_opt idl2, strictarrsubs
;
; include commons
@cm_4mesh
@cm_4cal
@cm_4data
  IF NOT keyword_set(key_forgetold) THEN BEGIN
@updatenew
@updatekwd
  ENDIF
;--------------------------------------------------------------
; I1) Reading of the field
;--------------------------------------------------------------
  if n_elements(field) EQ 0 then return, report('field undefined')
  arr = litchamp(field)
; first check
  IF n_elements(arr) EQ 1 THEN BEGIN
    if arr EQ -1 then $
      return, report('Error: input array = -1. Maybe the reading did ont perform well...', /simple) $
    ELSE return, report('Error: input array is a scalar', /simple)     
  ENDIF
  nan = total(finite(arr, /nan)) < 1
;---------------------------------------------------------------
; redefinition of the domain
;---------------------------------------------------------------
  minprof = 0.
  profdefault = 200.
;
  Case n_elements(boxzoom) OF
    0:
    1:localbox = [minprof, boxzoom[0]]
    2:localbox = boxzoom
    4:if strpos(type, 'z') NE -1 THEN $
      localbox = [boxzoom, minprof, profdefault] ELSE localbox = boxzoom
    5:localbox = [Boxzoom[0:3], minprof, Boxzoom[4]]
    6:localbox = boxzoom
    Else: return, report('Bad definition of boxzoom')
  ENDCASE
;
  if keyword_set(localbox) then BEGIN
    if keyword_set(vecteur) then grillechoice = [vargrid, 'T', 'U', 'V'] $
    ELSE grillechoice = [vargrid, 'T']
    if keyword_set(wdepth) then grillechoice = [grillechoice, 'W']
    domdef, localbox, GRIDTYPE = grillechoice, _extra = ex
  ENDIF
;
; The procedure domdef determine elements which are inside the boxzoom. 
; 
  if strpos(type, 'z') NE -1 THEN BEGIN
    if NOT keyword_set(localbox) then BEGIN 
      localbox = [minprof, profdefault]
      if keyword_set(wdepth) then grillechoice = 'W' $
      ELSE grillechoice = vargrid
      domdef, localbox, GRIDTYPE = grillechoice
    END
    nelbox = n_elements(localbox)
;we keep yranges (z axis) before changing the boxzoom.
    !y.range = [localbox[nelbox-1], localbox[nelbox-2]] 
    if vargrid EQ 'W' OR keyword_set(wdepth) then BEGIN
      firstzw = 0 > (firstzw-1)
      lastzw = (lastzw+1) < (jpk-1)
      nzw = lastzw - firstzw + 1
    ENDIF ELSE BEGIN
      firstzt = 0 > (firstzt-1)
      lastzt = (lastzt+1) < (jpk-1)
      nzt = lastzt - firstzt + 1
    ENDELSE
    @updateold
  ENDIF
; make the automatic definition of type for pltz if type is not specified.
  IF type EQ 'z' AND procedure EQ 'pltz' THEN $
    if (lon2-lon1) gt (lat2-lat1) then type = 'xz' else type = 'yz'
; make the automatic definition of type for pltt if type is not specified.
  IF type EQ 'unkownpltt' AND procedure EQ 'pltt' THEN $
    if (lon2-lon1) gt (lat2-lat1) then type = 'xt' else type = 'yt'
;--------------------------------------------------------------
; verification of the input array size and the value of the type
;--------------------------------------------------------------
  grille, -1, -1, -1, -1, nx, ny, nz, firstx, firsty $
    , firstz, lastx, lasty, lastz, WDEPTH = wdepth
;--------------------------------------------------------------
; basic checks
;--------------------------------------------------------------
  CASE 1 OF
    nx EQ 1: IF strpos(type, 'x') NE -1 THEN return, report('Error: impossible to make a "' + type + '" type plot with nx = 1 ', /simple)
    ny EQ 1: IF strpos(type, 'y') NE -1 THEN return, report('Error: impossible to make a "' + type + '" type plot with ny = 1 ', /simple)
    nz EQ 1: IF strpos(type, 'z') NE -1 THEN return, report('Error: impossible to make a "' + type + '" type plot with nz = 1 ', /simple)
    jpt EQ 1: IF strpos(type, 't') NE -1 THEN return, report('Error: impossible to make a "' + type + '" type plot with jpt = 1 ', /simple)
    ELSE:
  ENDCASE
;--------------------------------------------------------------
; is the size of the array compatible with teh domain?
;--------------------------------------------------------------
  arr = fitintobox(temporary(arr), nx, ny, nz, firstx, firsty $
    , firstz, lastx, lasty, lastz)
;--------------------------------------------------------------
  sz = size(arr)
  case sz[0] of
;--------------------------------------------------------------
    0:return, arr
;--------------------------------------------------------------
    1:BEGIN
      nele = n_elements(arr)
      case type of
        't':if jpt NE nele THEN return, err_1d(type, nele, 'jpt', jpt)
        'x':IF  nx NE nele THEN return, err_1d(type, nele,  'nx',  nx)
        'y':IF  ny NE nele THEN return, err_1d(type, nele,  'ny',  ny)
        'z':IF  nz NE nele THEN return, err_1d(type, nele,  'nz',  nx)
        ELSE:return, report(['Error: ' $
                            , 'Impossible to make a "'+type+'" plot with a 1D array'], /simple)
      ENDCASE
    END 
;--------------------------------------------------------------
    2:BEGIN
      case type of
        'x':BEGIN
          case 1 of
            sz[1] EQ nx AND sz[2] EQ ny:direc = 'y' ; xy array
            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz:direc = 'z' ; x(y)z array
            sz[1] EQ nx AND sz[2] EQ jpt:direc = 't' ; xt array
            ELSE:return, err_2d(type, sz, nx, ny, nz)
          endcase
        end
        'y':BEGIN
          case 1 of
            sz[1] EQ nx AND sz[2] EQ ny:direc = 'x' ; xy array
            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz:direc = 'z' ; (x)yz array
            sz[1] EQ ny AND sz[2] EQ jpt:direc = 't' ; yt array
            ELSE:return, err_2d(type, sz, nx, ny, nz)
          endcase
        END
        'z':BEGIN
          case 1 of
            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz:direc = 'x' ; x(y)z array
            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz:direc = 'y' ; (x)yz array
            sz[1] EQ nz AND sz[2] EQ jpt:direc = 't' ; zt array
            ELSE:return, err_2d(type, sz, nx, ny, nz)
          endcase
        END
        't':BEGIN
          case 1 OF
            sz[1] EQ nx AND sz[2] EQ jpt:direc = 'x' ; xt array
            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ jpt:direc = 'y' ; (x)yt array
            nx EQ 1 AND ny EQ 1 AND sz[1] EQ nz AND sz[2] EQ jpt:direc = 'z' ; (x)(y)zt array
            ELSE:return, err_2d(type, sz, nx, ny, nz)
          ENDCASE
        END
        'xy':IF sz[1] NE nx OR sz[2] ne  ny THEN return, err_2d(type, sz, nx, ny, nz) ; xy array
        'xz':IF sz[1] NE nx OR sz[2] ne  nz THEN return, err_2d(type, sz, nx, ny, nz) ; xz array
        'yz':IF sz[1] NE ny OR sz[2] NE  nz THEN return, err_2d(type, sz, nx, ny, nz) ; yz array
        'xt':IF sz[1] NE nx OR sz[2] NE jpt THEN return, err_2d(type, sz, nx, ny, nz) ; xt array
        'yt':IF sz[1] NE ny OR sz[2] NE jpt THEN return, err_2d(type, sz, nx, ny, nz) ; yt array
        'zt':IF sz[1] NE nz OR sz[2] NE jpt THEN return, err_2d(type, sz, nx, ny, nz) ; zt array
      ENDCASE
    END 
;--------------------------------------------------------------
    3:BEGIN
      case type of
        'x':BEGIN
          case 1 of
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ nz:direc = 'yz' ; xyz array
            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'zt' ; x(y)zt array
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 'yt' ; xyt array
            ELSE:return, err_3d(type, sz, nx, ny, nz)
          endcase
        END
        'y':BEGIN
          case 1 of
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ nz:direc = 'xz' ; xyz array
            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'zt' ; (x)yzt array
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 'xt' ; xyt array
            ELSE:return, err_3d(type, sz, nx, ny, nz)
          endcase
        END
        'z':BEGIN
          case 1 of
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ nz:direc = 'xy' ; xyz array
            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'yt' ; (x)yzt array
            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'xt' ; x(y)zt array
            ELSE:return, err_3d(type, sz, nx, ny, nz)
          endcase
        END
        't':BEGIN
          case 1 of
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 'xy' ; xyt array
            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'yz' ; (x)yzt array
            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'xz' ; x(y)zt array
            ELSE:return, err_3d(type, sz, nx, ny, nz)
          endcase
        END
        'xy':BEGIN
          case 1 OF
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ  nz:direc = 'z' ; xyz array
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 't' ; xyt array
            ELSE:return, err_3d(type, sz, nx, ny, nz)
          endcase
        END
        'xz':BEGIN
          case 1 of
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ  nz:direc = 'y' ; xyz array
            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 't' ; x(y)zt
            ELSE:return, err_3d(type, sz, nx, ny, nz)
          endcase
        END
        'yz':BEGIN
          case 1 of
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ  nz:direc = 'x' ; xyz array
            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 't' ; (x)yzt
            ELSE:return, err_3d(type, sz, nx, ny, nz) 
          endcase
        END
        'xt':BEGIN
          case 1 of
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 'y' ; xyt array
            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'z' ; x(y)zt array
            ELSE:return, err_3d(type, sz, nx, ny, nz) 
          endcase
        END
        'yt':BEGIN
          case 1 of
            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 'x' ; xyt array
            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'z' ; (x)yzt array
            ELSE:return, err_3d(type, sz, nx, ny, nz) 
          endcase
        END
        'zt':BEGIN
          case 1 of
            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'x' ; x(y)zt array
            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'y' ; (x)yzt array
            ELSE:return, err_3d(type, sz, nx, ny, nz) 
          ENDCASE
        END 
      ENDCASE 
    END 
;--------------------------------------------------------------
    4:BEGIN 
      CASE type OF
        'x':direc = 'yzt'
        'y':direc = 'xzt'
        'z':direc = 'xyt'
        't':direc = 'xyz'
        'xy':direc = 'zt'
        'xz':direc = 'yt'
        'yz':direc = 'xt'
        'xt':direc = 'yz'
        'yt':direc = 'xz'
        'zt':direc = 'xy'
      ENDCASE 
    END
  ENDCASE
;--------------------------------------------------------------
  IF keyword_set(direc) THEN BEGIN
    IF strpos(direc, 't') NE -1 OR strpos(type, 't') NE -1 THEN $
      arr = grossemoyenne(temporary(arr), direc, boxzoom = localbox $
                          , NAN = nan, /NODOMDEF, WDEPTH = wdepth, _extra = ex) $
    ELSE arr = moyenne(temporary(arr), direc, boxzoom = localbox $
                       , NAN = nan, /NODOMDEF, WDEPTH = wdepth, _extra = ex)
  ENDIF
;--------------------------------------------------------------
;--------------------------------------------------------------
;--------------------------------------------------------------
;--------------------------------------------------------------
  RETURN, arr
END