source: trunk/SRC/ToBeReviewed/TRIANGULATION/completecointerre.pro @ 157

;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
;+
;
; @file_comments
;
;
; @categories
; Graphics
;
; @param LONS 
;
;
; @param LATS
;
;
; @param SEUIL
;
;
; @keyword _EXTRA
; Used to pass your keywords 
;
; @keyword CONT_COLOR
; The color of the continent. defaut value is
; (!d.n_colors - 1) < 255 => white
;
; @uses
; common.pro
;
; @history
; Sebastien Masson (smasson\@lodyc.jussieu.fr)
;                      01/10/1999
;
; @version
; $Id$
;
;-
;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
PRO draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
;
  compile_opt idl2, strictarrsubs
;
@cm_4mesh
; the triangle must not be out of the domain
  IF min(lons, max = maxlon) GE lon1 AND maxlon LE lon2 $
    AND min(lats, max = maxlat) GE lat1 AND maxlat LE lat2 then BEGIN
; the triangle must not be too big 
    z = convert_coord(lons, lats, /data, /to_normal) 
    alldist = [(z[0, 2]-z[0, 0])^2 + (z[1, 2]-z[1, 0])^2 $
               , (z[0, 0]-z[0, 1])^2 + (z[1, 0]-z[1, 1])^2 $
               , (z[0, 1]-z[0, 2])^2 + (z[1, 1]-z[1, 2])^2]
    IF max(alldist) LT seuil^2 THEN polyfill, lons, lats $
      , color = cont_color, _extra = ex
    return
  ENDIF 
end
;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
;+
;
; @file_comments
; To color cleanly continents
;
; @categories
; Graphics
;
; @keyword _EXTRA
; Used to pass your keywords 
;
; @keyword CONT_COLOR
; The color of the continent. defaut value is
; (!d.n_colors - 1) < 255 => white
;
; @keyword COINMONTE
; It is an array. To obtain the array of "ascending land corner" 
; to be treated with completecointerre.pro in the variable array 
; instead of make it pass by the global variable twin_corners_up.
;
; @keyword COINDESCEND
; It is an array. See COINMONTE
;
; @keyword INDICEZOOM
; The zoom's index
;
; @uses
; common.pro
;
; @history
; Sebastien Masson (smasson\@lodyc.jussieu.fr)
;                      01/10/1999
;
; @version
; $Id$
;
;-
;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
PRO completecointerre, COINMONTE = coinmonte, COINDESCEND = coindescend $
                       , CONT_COLOR = cont_color, INDICEZOOM = indicezoom $
                       , _extra = ex
;
  compile_opt idl2, strictarrsubs
;
@common
;------------------------------------------------------------
;   if NOT keyword_set(coinmonte) then return
;   if NOT keyword_set(coindescend) then return
;   if NOT keyword_set(indicezoom) then return
  tempsun = systime(1)          ; For key_performance
;------------------------------------------------------------
; definitions of vectors coinmont and coindesc
;------------------------------------------------------------
  if keyword_set(coinmonte) then coinmont = coinmonte $
  ELSE coinmont = twin_corners_up
  if keyword_set(coindescend) then coindesc = coindescend $
  ELSE coindesc = twin_corners_dn
  IF NOT keyword_set(cont_color) THEN cont_color = (!d.n_colors-1) <  255
;------------------------------------------------------------
; definition of coordinates of points numbered 1,2,3,4,5,6 (see figures below)
;------------------------------------------------------------
  tempdeux = systime(1)         ; For key_performance =2
  if coinmont[0] NE -1 OR coindesc[0] NE -1 then BEGIN
    if keyword_set(indicezoom) then BEGIN
; if we use key_stide, the t, u, v and f points are no more related to
; the same cell because glamf and gphif has be recomputed to be in the
; middle of two t points
      IF total(key_stride) EQ 3 AND finite(glamv[0]*gphiv[0]) NE 0 THEN BEGIN
        long1 = glamv[indicezoom] & lati1 = gphiv[indicezoom]
      ENDIF ELSE BEGIN 
        long1 = glamt[indicezoom] & lati1 = gphif[indicezoom]
      ENDELSE
      IF total(key_stride) EQ 3 AND finite(glamu[0]*gphiu[0]) NE 0 THEN BEGIN
        long2 = glamu[indicezoom] & lati2 = gphiu[indicezoom]
      ENDIF ELSE BEGIN
        long2 = glamf[indicezoom] & lati2 = gphit[indicezoom]
      ENDELSE
      long3 = glamf[indicezoom] & lati3 = gphif[indicezoom]
    ENDIF ELSE BEGIN 
      IF total(key_stride) EQ 3 AND finite(glamv[0]*gphiv[0]) NE 0 THEN BEGIN
        long1 = glamv & lati1 = gphiv
      ENDIF ELSE BEGIN 
        long1 = glamt & lati1 = gphif
      ENDELSE
      IF total(key_stride) EQ 3 AND finite(glamu[0]*gphiu[0]) NE 0 THEN BEGIN
        long2 = glamu & lati2 = gphiu
      ENDIF ELSE BEGIN 
        long2 = glamf & lati2 = gphit
      ENDELSE
      long3 = glamf & lati3 = gphif
    ENDELSE 
;
    nx = (size(long1, /dimensions))[0]
    ny = (size(long1, /dimensions))[1]
    seuil = 5 < (min([nx, ny])-2)
    seuil = min([(!p.position[2]-!p.position[0])/seuil $
                 , (!p.position[3]-!p.position[1])/seuil])
;
  ENDIF
;
  IF testvar(var = key_performance) EQ 2 THEN $
    print, 'temps completecointerre: positions des points', systime(1)-tempdeux
;
;
; Case land corner in ascent:
;      2 land points in diagonal ascending with 2 ocean points on the descendant diagonal.
;
;                     4    
;     t(i+nx)=1    u(i+nx)       t(i+nx+1)=0
;                     |    \
;                     |        \
;         1         3 |            \   5
;       v(i)---------f(i)------------v(i+1)
;           \         |
;              \      |
;                 \   |
;      t(i)=0       2 u(i)          t(i+1)=1
;
;
  if coinmont[0] NE -1 then BEGIN
    tempdeux = systime(1)       ; For key_performance =2
    for id = 0, n_elements(coinmont)-1 do BEGIN
      i = coinmont[id]
      ii = i MOD nx
      ij = i/nx
; bottom triangle
      lons = [long1[i], long2[i], long3[i]]
      lats = [lati1[i], lati2[i], lati3[i]]
      draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
; upper triangle
      IF ii NE nx-1 AND ij NE ny-1 THEN BEGIN
        lons = [long3[i], long1[i+1], long2[i+nx]]
        lats = [lati3[i], lati1[i+1], lati2[i+nx]]
        draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
      ENDIF 
    ENDFOR 
    IF testvar(var = key_performance) EQ 2 THEN $
      print, 'temps completecointerre: trace de cointerremonte', systime(1)-tempdeux
  ENDIF
;------------------------------------------------------------
; Case land corner in descent:
;      2 land points in diagonal descending with 2 ocean points on the ascendant diagonal.
; 
;                     4
;     t(i+nx)=1    u(i+nx)       t(i+nx+1)=0
;                /    |       
;             /       |          
;          /        3 |                5
;       v(i)---------f(i)------------v(i+1)
;         1           |            /
;                     |         /
;                     |      /
;      t(i)=0      2 u(i)          t(i+1)=1
;
  if coindesc[0] NE -1 then begin
    tempdeux = systime(1)       ; For key_performance =2
    for id = 0, n_elements(coindesc)-1 do BEGIN
      i = coindesc[id]
      ii = i MOD nx
      ij = i/nx
      IF ii NE nx-1 AND ij NE ny-1 THEN BEGIN
; left triangle
        lons = [long1[i], long3[i], long2[i+nx]]
        lats = [lati1[i], lati3[i], lati2[i+nx]]
        draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
; right triangle
        lons = [long3[i], long2[i], long1[i+1]]
        lats = [lati3[i], lati2[i], lati1[i+1]]
        draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
      ENDIF
    ENDFOR
    IF testvar(var = key_performance) EQ 2 THEN $
      print, 'temps completecointerre: trace de cointerredescend', systime(1)-tempdeux
  ENDIF

;------------------------------------------------------------
  IF keyword_set(key_performance) THEN print, 'temps completecointerre', systime(1)-tempsun 
;------------------------------------------------------------
  return
end