Index: tags/start/CALCULS/curl.pro
===================================================================
--- tags/start/CALCULS/curl.pro	(revision 5)
+++ tags/start/CALCULS/curl.pro	(revision 5)
@@ -0,0 +1,318 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:curl
+;
+; PURPOSE:calcule la composante verticale du rotationnel d''un champ
+; de vecteur horizontaux
+;
+; CATEGORY:calcule sur les matrices
+;
+; CALLING SEQUENCE:res=curl(u,v)
+;
+; INPUTS:
+;       u et v deux matrices representant les coordonnes d''un
+;       champ de vecteur
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:res: une matrice 2d
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+; les matrices u et v peuvent de 2 a 4 dimensions.
+; attention pour distinger les differents configurations de u et v
+; (xy, xyz, xyt, xyzt), on regarde la variable du common 
+;        -time qui contient le calendrier en jour julien d''IDL auquel
+;        se rapportent u et v ansi que la variable 
+;        -jpt qui est le nombre de pas de temps a considerer ds time.
+; les tableaux u et v sont decoupes sur le meme domaine
+; geographique. A cause du decalage des grilles T, U, V et F il est
+; possiible que ces 2 tableaux n''aient pas la meme taille et se
+; repportent a des indices differents. Si tel est le cas les tableaux
+; sont redecoupes sur les indices qu'ils ont en commun et le dommaine
+; est redefinit pour qu'il colle a ces indices communs.
+; pour eviter ces redecoupes utiliser le mot cles /memeindice ds
+; domdef.pro
+;
+;
+; les points sur le bord du dessin sont mis a !values.f_nan 
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Guillaume Roullet (grlod@ipsl.jussieu.fr)
+; 
+;                      Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      adaptation pour marcher avec un domaine reduit
+;
+;                      21/5/1999: valeurs manquantes a !values.f_nan
+;periodicite 
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION curl, uu, vv
+@common
+   tempsun = systime(1)         ; pour key_performance
+;
+   u = litchamp(uu)
+   v = litchamp(vv)
+
+   date1 = time[0]
+   if n_elements(jpt) EQ 0 then date2 = date1 ELSE date2 = time[jpt-1]
+   if (size(u))[0] NE (size(v))[0] then return,  -1
+
+;------------------------------------------------------------
+; on trouve les points que u et v ont en communs
+;------------------------------------------------------------
+   indicexu = (lindgen(jpi))[premierxu:premierxu+nxu-1]
+   indicexv = (lindgen(jpi))[premierxv:premierxv+nxv-1]
+   indicex = inter(indicexu, indicexv)
+   indiceyu = (lindgen(jpj))[premieryu:premieryu+nyu-1]
+   indiceyv = (lindgen(jpj))[premieryv:premieryv+nyv-1]
+   indicey = inter(indiceyu, indiceyv)
+   nx = n_elements(indicex) 
+   ny = n_elements(indicey)
+   case 1 of
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xyz
+;----------------------------------------------------------------------------
+      (size(u))[0] EQ 3 AND date1 EQ date2 :BEGIN 
+         indice2d = lindgen(jpi, jpj)
+         indice2d = indice2d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1]
+;------------------------------------------------------------
+; extraction de u et v sur le domaine qui convient
+;------------------------------------------------------------
+         case 1 of
+            (size(u))[0] NE 3 OR (size(v))[0] NE 3: return,  -1
+            (size(u))[1] EQ nxu AND (size(u))[2] EQ nyu AND $
+             (size(v))[1] EQ nxv AND (size(v))[2] EQ nyv:BEGIN 
+            case 1 of
+               nxu NE nx:if indicex[0] EQ premierxu then u = u[0:nx-1, *, *] ELSE u = u[1: nx, *, *]
+               nxv NE nx:if indicex[0] EQ premierxv then v = v[0:nx-1, *, *] ELSE v = v[1: nx, *, *]
+               nyu NE ny:if indicey[0] EQ premieryu then u = u[*, 0:ny-1, *] ELSE u = u[*, 1: ny, *]
+               nyv NE ny:if indicey[0] EQ premieryv then v = v[*, 0:ny-1, *] ELSE v = v[*, 1: ny, *]
+               ELSE :
+            endcase
+            END
+            (size(u))[1] EQ jpi AND (size(u))[2] EQ jpj AND $
+             (size(v))[1] EQ jpi AND (size(v))[2] EQ jpj:BEGIN 
+               u = u[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, *]
+               v = v[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, *]
+            END
+            ELSE:return,  -1
+         endcase
+;------------------------------------------------------------
+; calcul du rotationnel
+;------------------------------------------------------------
+         coefu = (e1u[indice2d])[*]#replicate(1, nzt)
+         coefu = reform(coefu, nx, ny, nzt, /over)
+         coefu = coefu*(umask())[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, premierzt:dernierzt]
+         terreu = where(coefu EQ 0)
+         if terreu[0] NE -1 then coefu[temporary(terreu)] = !values.f_nan
+         
+         coefv = (e2v[indice2d])[*]#replicate(1, nzt)
+         coefv = reform(coefv, nx, ny, nzt, /over)
+         coefv = coefv*(vmask())[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, premierzt:dernierzt]
+         terrev = where(coefv EQ 0)
+         if terrev[0] NE -1 then coefv[temporary(terrev)] = !values.f_nan
+
+         tabf = (fmask())[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, premierzt:dernierzt]
+         div = (e1f[indice2d]*e2f[indice2d])[*]#replicate(1, nzt)
+         div = reform(div, nx, ny, nzt, /over)
+         tabf = tabf/div
+;
+         zu = u*temporary(coefu)
+         zv = v*temporary(coefv)
+
+         psi =  (shift(zv, -1, 0, 0)-zv) + (zu-shift(zu, 0, -1, 0))
+         psi = tabf*psi
+;------------------------------------------------------------
+; mise a !values.f_nan de la bordure
+;------------------------------------------------------------
+         if NOT keyword_set(key_periodique)  OR nx NE jpi then begin
+            psi(0, *, *) = !values.f_nan
+            psi(nx-1, *, *) = !values.f_nan
+         endif
+         psi(*, 0, *) = !values.f_nan
+         psi(*, ny-1, *) = !values.f_nan
+;
+         if n_elements(valmask) EQ 0 THEN valmask = 1e20
+         terref =  where(tabf EQ 0)
+         if terref[0] NE -1 then psi[temporary(terref)] = valmask
+;------------------------------------------------------------
+; pour le trace graphique
+;------------------------------------------------------------
+         domdef, (glamt[indice2d])[0, 0], (glamu[indice2d])[nx-1, 0],(gphit[indice2d])[0, 0], (gphiv[indice2d])[0, ny-1], prof1, prof2, grille = ['t', 'f']
+         if keyword_set(direc) then psi = moyenne(psi,direc,/nan, boite = boite)
+
+;----------------------------------------------------------------------------
+      END
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xyt
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+      date1 NE date2 AND (size(u))[0] EQ 3 :BEGIN 
+         indice2d = lindgen(jpi, jpj)
+         indice2d = indice2d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1]
+;------------------------------------------------------------
+; extraction de u et v sur le domaine qui convient
+;------------------------------------------------------------
+         case 1 of
+            (size(u))[1] EQ nxu AND (size(u))[2] EQ nyu AND $
+             (size(v))[1] EQ nxv AND (size(v))[2] EQ nyv:BEGIN 
+               if nxu NE nx then $
+                if indicex[0] EQ premierxu then u = u[0:nx-1, *, *] ELSE u = u[1: nx, *, *] 
+               IF nxv NE nx THEN $
+                if indicex[0] EQ premierxv then v = v[0:nx-1, *, *] ELSE v = v[1: nx, *, *]
+               IF nyu NE ny THEN $
+                if indicey[0] EQ premieryu then u = u[*, 0:ny-1, *] ELSE u = u[*, 1: ny, *] 
+               IF nyv NE ny THEN $
+                if indicey[0] EQ premieryv then v = v[*, 0:ny-1, *] ELSE v = v[*, 1: ny, *]
+            END
+            (size(u))[1] EQ jpi AND (size(u))[2] EQ jpj AND $
+             (size(v))[1] EQ jpi AND (size(v))[2] EQ jpj:BEGIN 
+               u = u[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, *]
+               v = v[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, *]
+            END
+            ELSE:BEGIN 
+               print, 'problemes d''adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs'
+               return, -1
+            end
+         endcase
+;----------------------------------------------------------------------------
+; calcul du rotationnel
+;----------------------------------------------------------------------------
+         coefu = e1u[indice2d]*(umask())[indice2d+jpi*jpj*premierzt]
+         terreu = where(coefu EQ 0)
+         if terreu[0] NE -1 then coefu[temporary(terreu)] = !values.f_nan
+         coefu = temporary(coefu[*])#replicate(1, jpt)
+         coefu = reform(coefu, nx, ny, jpt, /over)
+;
+         coefv = e2v[indice2d]*(vmask())[indice2d+jpi*jpj*premierzt]
+         terrev = where(coefv EQ 0)
+         if terrev[0] NE -1 then coefv[temporary(terrev)] = !values.f_nan
+         coefv = temporary(coefv[*])#replicate(1, jpt)
+         coefv = reform(coefv, nx, ny, jpt, /over)
+;
+         tabf = (fmask())[indice2d+jpi*jpj*premierzt]/(e1f[indice2d]*e2f[indice2d])
+         tabf = temporary(tabf[*])#replicate(1, jpt)
+         tabf = reform(tabf, nx, ny, jpt, /over)
+;------------------------------------------------------------
+; calcul du rotationnel
+;------------------------------------------------------------
+         zu = u*temporary(coefu)
+         zv = v*temporary(coefv)
+;
+         psi =  (shift(zv, -1, 0, 0)-zv) + (zu-shift(zu, 0, -1, 0))
+         psi = tabf*psi
+;------------------------------------------------------------
+; mise a !values.f_nan de la bordure
+;------------------------------------------------------------
+         if NOT keyword_set(key_periodique) OR nx NE jpi then begin
+            psi(0, *, *) = !values.f_nan
+            psi(nx-1, *, *) = !values.f_nan
+         endif
+         psi(*, 0, *) = !values.f_nan
+         psi(*, ny-1, *) = !values.f_nan
+         if n_elements(valmask) EQ 0 THEN valmask = 1e20
+         terref =  where(tabf EQ 0)
+         if terref[0] NE -1 then psi[temporary(terref)] = valmask
+;----------------------------------------------------------------------------
+         domdef, (glamt[indice2d])[0, 0], (glamu[indice2d])[nx-1, 0],(gphit[indice2d])[0, 0], (gphiv[indice2d])[0, ny-1], prof1, prof2, grille = ['t', 'f']
+         if keyword_set(direc) then psi = grossemoyenne(psi,direc,/nan, boite = boite)
+;----------------------------------------------------------------------------
+      END
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xyzt
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+      date1 NE date2 AND (size(u))[0] EQ 4:BEGIN 
+         return, report('non code!')
+      END
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xy
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+      ELSE:BEGIN                ;xy
+         indice2d = lindgen(jpi, jpj)
+         indice2d = indice2d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1]
+;------------------------------------------------------------
+; extraction de u et v sur le domaine qui convient
+;------------------------------------------------------------
+         case 1 of
+            (size(u))[0] NE 2 OR (size(v))[0] NE 2: return,  -1
+            (size(u))[1] EQ nxu AND (size(u))[2] EQ nyu AND $
+             (size(v))[1] EQ nxv AND (size(v))[2] EQ nyv:BEGIN 
+               if nxu NE nx then $
+                if indicex[0] EQ premierxu then u = u[0:nx-1, *] ELSE u = u[1: nx, *] 
+               IF nxv NE nx THEN $
+                if indicex[0] EQ premierxv then v = v[0:nx-1, *] ELSE v = v[1: nx, *]
+               IF nyu NE ny THEN $
+                if indicey[0] EQ premieryu then u = u[*, 0:ny-1] ELSE u = u[*, 1: ny] 
+               IF nyv NE ny THEN $
+                if indicey[0] EQ premieryv then v = v[*, 0:ny-1] ELSE v = v[*, 1: ny]
+            END
+            (size(u))[1] EQ jpi AND (size(u))[2] EQ jpj AND $
+             (size(v))[1] EQ jpi AND (size(v))[2] EQ jpj:BEGIN 
+               u = u[indice2d]
+               v = v[indice2d]
+            END
+            ELSE:return,  -1
+         endcase
+;------------------------------------------------------------
+; calcul du rotationnel
+;------------------------------------------------------------
+         coefu = e1u[indice2d]*(umask())[indice2d+jpi*jpj*premierzt]
+         terreu = where(coefu EQ 0)
+         if terreu[0] NE -1 then coefu[temporary(terreu)] = !values.f_nan
+         coefv = e2v[indice2d]*(vmask())[indice2d+jpi*jpj*premierzt]
+         terrev = where(coefv EQ 0)
+         if terrev[0] NE -1 then coefv[temporary(terrev)] = !values.f_nan
+         tabf = (fmask())[indice2d+jpi*jpj*premierzt]/(e1f[indice2d]*e2f[indice2d])
+;
+         zu = u*temporary(coefu)
+         zv = v*temporary(coefv)
+
+         psi =  (shift(zv, -1, 0)-zv) + (zu-shift(zu, 0, -1))
+         psi = tabf*psi
+
+;------------------------------------------------------------
+; mise a !values.f_nan de la bordure
+;------------------------------------------------------------
+         if  NOT keyword_set(key_periodique) OR nx NE jpi then begin
+            psi(0, *) = !values.f_nan
+            psi(nx-1, *) = !values.f_nan
+         endif
+         psi(*, 0) = !values.f_nan
+         psi(*, ny-1) = !values.f_nan
+;
+         if n_elements(valmask) EQ 0 THEN valmask = 1e20
+         terref =  where(tabf EQ 0)
+         if terref[0] NE -1 then psi[temporary(terref)] = valmask
+;------------------------------------------------------------
+; pour le trace graphique
+;------------------------------------------------------------
+         domdef, (glamt[indice2d])[0, 0], (glamf[indice2d])[nx-1, 0],(gphit[indice2d])[0, 0], (gphif[indice2d])[0, ny-1], prof1, prof2, grille = ['t', 'f']
+         if keyword_set(direc) then psi = moyenne(psi,direc,/nan, boite = boite)
+
+
+      END
+;----------------------------------------------------------------------------
+   endcase
+;------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps curl', systime(1)-tempsun 
+;------------------------------------------------------------
+   vargrid = 'F'
+   varname = 'vorticity'
+   return, psi
+end
Index: tags/start/CALCULS/depth2floatlevel.pro
===================================================================
--- tags/start/CALCULS/depth2floatlevel.pro	(revision 5)
+++ tags/start/CALCULS/depth2floatlevel.pro	(revision 5)
@@ -0,0 +1,74 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:depth2floatlevel
+;
+; PURPOSE: assez comparable a depth2level mais ici le niveau calcule
+; est en float. Par ex le niveau 5.4 correspond a une profondeur egale
+; a gdep[5]+.4*(gdep[6]-gdep[5])
+;
+; CATEGORY: SANS BOUCLE
+;
+; CALLING SEQUENCE:res=depth2floatlevel(depth2d)
+; 
+; INPUTS: depth2d tableau 2d de profondeur (ou une structure repondant
+; aux criteres de litchamp)
+;
+; KEYWORD PARAMETERS: 
+;       /NOMASK: pour ne pas masquer les points terres
+;
+; OUTPUTS: un tableau 2d de float contenant les valeurs des niveaux.
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:accepte les vcaleurs a !values.f_nan et masque les
+; points terres a valmask.
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+;    IDL> a=(jpk-1)/(1.*jpi*jpj)*findgen(jpi,jpj)
+;    IDL> plt, 1e6*(a-floatlevel2depth(depth2floatlevel(a))),/nocontour
+;
+;  ->champ nul a 1e-6 pres
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      15/06/2000
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION depth2floatlevel, tab, NOMASK = nomask
+   tempsun = systime(1)         ; pour key_performance
+@common
+;------------------------------------------------------------
+   depthin = litchamp(tab)
+;
+   levelup = depth2level(depthin, /UPPER, /nomask)
+   depthup = level2depth(levelup, /nomask)
+;
+   levellow = depth2level(depthin, /lower, /nomask)
+   depthlow = level2depth(levellow, /nomask)
+; calcule de la distance depthlow-depthup et gestion du cas ou cette
+; distance est nulle ou egale a !values.f_nan
+   divi = depthlow-depthup
+   nan = where(finite(divi) EQ 0)
+   if nan[0] NE -1 then divi[nan] = 0
+   nan = where(divi EQ 0)
+   if nan[0] NE -1 then divi[nan] = !values.f_nan
+; calcule du resultat
+   res = levelup+(depthin-depthup)/divi
+; on masque les points terre a valmask
+   if NOT keyword_set(nomask) then begin
+      grille,mask
+      if n_elements(valmask) EQ 0 then valmask = 1e20
+      terre = where((temporary(mask))[*, *, 0] EQ 0)
+      if terre[0] NE -1 then res[terre] = valmask
+   endif
+;------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps depth2floatlevel', systime(1)-tempsun 
+;
+   return, res
+end
Index: tags/start/CALCULS/depth2level.pro
===================================================================
--- tags/start/CALCULS/depth2level.pro	(revision 5)
+++ tags/start/CALCULS/depth2level.pro	(revision 5)
@@ -0,0 +1,122 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: depth2level
+;
+; PURPOSE: permet de passer d''un tableau 2d de profondeur au tableau
+; 2d correspondant de niveaux.
+;
+; CATEGORY: SANS BOUCLE
+;
+; CALLING SEQUENCE: res=depth2level(depth2d)
+;
+; INPUTS: depth2d tableau 2d de profondeur (ou une structure repondant
+; aux criteres de litchamp)
+;
+; KEYWORD PARAMETERS:
+;
+;      /UPPER: (active par defaut) on selectionne le niveau
+;      directement au dessus de la profondeur
+;
+;      /LOWER: on selectionne le niveau directement au dessous de la
+;      profondeur 
+;
+;      /CLOSER: on selectionne le niveau le plus proche de la
+;      profondeur 
+;
+;      /NOMASK: pour ne pas masquer les points terres
+;
+; OUTPUTS: un tableau 2d contenant les valeurs des niveaux.
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:pour les profondeurs hors des valeurs de gdep, la
+; valeur !values.f_nan est retournee.
+; Si la profondeur est superieur a celle du fond, on retourne
+; jpk-1dans le cas upper, et !values.f_nan ds le cas lower.
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       17/6/1999
+;                       15/6/2000 accepte !values.f_nan
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION depth2level, tab, LOWER = lower, UPPER = upper, CLOSER = closer $
+                      , NOMASK = nomask, _extra = ex
+   tempsun = systime(1)         ; pour key_performance
+@common
+;------------------------------------------------------------
+   upper = 1
+   if keyword_set(lower) THEN upper = 0
+;------------------------------------------------------------
+; lecture du champ d''entree et recuperation de la taille du sous
+; domaine utilise
+;------------------------------------------------------------
+   in = litchamp(tab)
+   grille,mask,glam,gphi,gdep,nx,ny,nz,premierx,premiery,premierz,dernierx,derniery,dernierz
+   glam = 1
+   gphi = 1
+;---------------------------------------------------------------
+; verification de la coherence entre la taille du tableau et le domaine definit par domdef
+;---------------------------------------------------------------
+   IF ny EQ 1 THEN in = reform(in, nx, ny, /over)
+   taille = size(in)
+   if taille[0] NE 2 then return, report('le champ en entree doit contenir un tableau 2d')
+   case 1 of
+      taille[1] eq jpi and taille[2] eq jpj:in=in[premierx:dernierx, premiery:derniery]
+      taille[1] eq  nx and taille[2] eq  ny:
+      else:return, report('Probleme d''adequation entre les tailles du domaine et celle du champ.')
+   endcase
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; vire les points a !values.f_nan
+   notanumber = where(finite(in, /nan) EQ 1)
+   if notanumber[0] NE -1 then in[notanumber] = 0
+;------------------------------------------------------------
+; on transforme le tableau 2d de profondeur en tableau 2d de niveaux
+; correspondant aux profondeurs
+;------------------------------------------------------------
+; on passe en tableaux qui ont la taille des tableaux 3d
+   prof=replicate(1,nx*ny)#gdep[premierz:dernierz] 
+   in = in[*]#replicate(1, nz)
+;
+   mask01 = (prof[*] LT in[*])
+   mask01 = reform(mask01, nx, ny, nz)
+   levels = total(mask01, 3)
+   notvalid = where(levels EQ nz)
+   if keyword_set(upper) then begin
+      levels = levels-1
+      notvalid = where(levels EQ 0)
+   ENDIF ELSE notvalid = where(levels EQ nz)
+   IF notvalid[0] NE -1 THEN levels[notvalid] = !values.f_nan
+
+; si closer est active
+   if keyword_set(closer) then begin
+      test = [ [[litchamp(tab)-level2depth(levels)]] $
+               , [[level2depth( (levels+1)<(jpk-1) )-litchamp(tab)]] ]
+      test = test[*, *, 0]-test[*, *, 1]
+      changer = where(test GE 0)
+      if changer[0] NE -1 then levels[changer] = (levels[changer]+1) < (jpk-1)
+   endif
+;------------------------------------------------------------
+; on replace les points a !values.f_nan
+   if notanumber[0] NE -1 then levels[notanumber] = !values.f_nan
+; on masque les points terres a valmask
+   if NOT keyword_set(nomask) then begin
+      if n_elements(valmask) EQ 0 then valmask = 1e20
+      terre = where(mask[*, *, 0] EQ 0)
+      if terre[0] NE -1 then levels[terre] = valmask
+   endif
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps depth2level', systime(1)-tempsun 
+   return, levels
+end
Index: tags/start/CALCULS/depth2mask.pro
===================================================================
--- tags/start/CALCULS/depth2mask.pro	(revision 5)
+++ tags/start/CALCULS/depth2mask.pro	(revision 5)
@@ -0,0 +1,64 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: depth2mask
+;
+; PURPOSE: permet de passer d''un tableau 2d de profondeur seuil au
+; tableau 3d de mask avec des 1 ds les niveaux au dessus de la
+; profondeur seuil et des 0 en dessous.
+;
+; CATEGORY: SANS BOUCLE
+;
+; CALLING SEQUENCE: res=depth2mask(depht2d)
+;
+; INPUTS: depht2d tableau 2d de profondeur seuil (ou une structure repondant
+; aux criteres de litchamp)
+;
+; KEYWORD PARAMETERS:
+;
+;      /UPPER: (active par defaut) on selectionne le niveau
+;      directement au dessus de la profondeur
+;
+;      /LOWER: on selectionne le niveau directement au dessous de la
+;      profondeur 
+;
+;      /CLOSER: on selectionne le niveau le plus proche de la
+;      profondeur 
+;
+; OUTPUTS: un tableau 3d contenant le mask associe au tableau 2d de
+; profondeurs seuil
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       17/6/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION depth2mask, tab, _extra = ex
+;------------------------------------------------------------
+   tempsun = systime(1)         ; pour key_performance
+@common
+;------------------------------------------------------------
+; on transforme le tableau 2d de profondeur en tableau 2d de niveaux
+; correspondant aux profondeurs
+;------------------------------------------------------------
+   niveaux = depth2level(tab, _extra = ex)
+   IF niveaux[0] EQ -1 THEN return,  -1
+;------------------------------------------------------------
+; on transforme le tableau 2d de niveaux en tableau 3d de mask
+;------------------------------------------------------------
+   mask = level2mask(niveaux)
+;------------------------------------------------------------
+   if keyword_set(key_performance) NE 0 THEN print, 'temps depth2mask', systime(1)-tempsun 
+   return, mask
+end
Index: tags/start/CALCULS/div.pro
===================================================================
--- tags/start/CALCULS/div.pro	(revision 5)
+++ tags/start/CALCULS/div.pro	(revision 5)
@@ -0,0 +1,311 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:div
+;
+; PURPOSE:calcule la divergence d'un champ 2D
+;
+; CATEGORY:calcule sur les matrices
+;
+; CALLING SEQUENCE:res=div(u,v)
+;
+; INPUTS:
+;       u et v deux matrices representant les coordonnes d''un
+;       champ de vecteur
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:res: une matrice 2d
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+; les matrices u et v peuvent de 2 a 4 dimensions.
+; attention pour distinger les differents configurations de u et v
+; (xy, xyz, xyt, xyzt), on regarde la variable du common 
+;        -time qui contient le calendrier en jour julien d''IDL auquel
+;        se rapportent u et v ansi que la variable 
+;        -jpt qui est le nombre de pas de temps a considerer ds time.
+; les tableaux u et v sont decoupes sur le meme domaine
+; geographique. A cause du decalage des grilles T, U, V et F il est
+; possiible que ces 2 tableaux n''aient pas la meme taille et se
+; repportent a des indices differents. Si tel est le cas les tableaux
+; sont redecoupes sur les indices qu'ils ont en commun et le dommaine
+; est redefinit pour qu'il colle a ces indices communs.
+; pour eviter ces redecoupes utiliser le mot cles /memeindice ds
+; domdef.pro
+;
+; les points sur le bord du dessin sont mis a !values.f_nan
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Guillaume Roullet (grlod@ipsl.jussieu.fr)
+;                      Creation : printemps 1998
+;                      Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      adaptation pour marcher avec un domaine reduit
+;                      12/1/2000
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION div, uu, vv
+   tempsun = systime(1)         ; pour key_performance
+@common
+   u = uu
+   v = vv
+
+   date1 = time[0]
+   if n_elements(jpt) EQ 0 then date2 = date1 ELSE date2 = time[jpt-1]
+   if (size(u))[0] NE (size(v))[0] then return,  -1
+
+;------------------------------------------------------------
+; on trouve les points que u et v ont en communs
+;------------------------------------------------------------
+   indicexu = (lindgen(jpi))[premierxu:premierxu+nxu-1]
+   indicexv = (lindgen(jpi))[premierxv:premierxv+nxv-1]
+   indicex = inter(indicexu, indicexv)
+   indiceyu = (lindgen(jpj))[premieryu:premieryu+nyu-1]
+   indiceyv = (lindgen(jpj))[premieryv:premieryv+nyv-1]
+   indicey = inter(indiceyu, indiceyv)
+   nx = n_elements(indicex) 
+   ny = n_elements(indicey)
+   indice2d = lindgen(jpi, jpj)
+   indice2d = indice2d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1]
+   case 1 of
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xyz
+;----------------------------------------------------------------------------
+      (size(u))[0] EQ 3 AND date1 EQ date2 :BEGIN 
+;------------------------------------------------------------
+; extraction de u et v sur le domaine qui convient
+;------------------------------------------------------------
+         case 1 of
+            (size(u))[0] NE 3 OR (size(v))[0] NE 3: return,  -1
+            (size(u))[1] EQ nxu AND (size(u))[2] EQ nyu AND $
+             (size(v))[1] EQ nxv AND (size(v))[2] EQ nyv:BEGIN 
+               case 1 of
+                  nxu NE nx:if indicex[0] EQ premierxu then u = u[0:nx-1, *, *] ELSE u = u[1: nx, *, *]
+                  nxv NE nx:if indicex[0] EQ premierxv then v = v[0:nx-1, *, *] ELSE v = v[1: nx, *, *]
+                  nyu NE ny:if indicey[0] EQ premieryu then u = u[*, 0:ny-1, *] ELSE u = u[*, 1: ny, *]
+                  nyv NE ny:if indicey[0] EQ premieryv then v = v[*, 0:ny-1, *] ELSE v = v[*, 1: ny, *]
+                  ELSE :
+               endcase
+            END
+            (size(u))[1] EQ jpi AND (size(u))[2] EQ jpj AND $
+             (size(v))[1] EQ jpi AND (size(v))[2] EQ jpj:BEGIN 
+               u = u[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, *]
+               v = v[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, *]
+            END
+            ELSE:BEGIN 
+               zdiv = -1
+               GOTO, sortie
+            end
+            
+         endcase
+;------------------------------------------------------------
+; calcul de la divergence
+;------------------------------------------------------------
+         zu = (e2u[indice2d])[*]#replicate(1, nzt)
+         zu = reform(zu, nx, ny, nzt, /over)
+         zu = temporary(u)*temporary(zu) $
+          *(umask())[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, premierzt:dernierzt]
+         terreu = where(zu EQ 0)
+         if terreu[0] NE -1 then zu[temporary(terreu)] = !values.f_nan
+;
+         zv = (e1v[indice2d])[*]#replicate(1, nzt)
+         zv = reform(zv, nx, ny, nzt, /over)
+         zv = temporary(v)*temporary(zv) $
+          *(vmask())[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, premierzt:dernierzt]
+         terrev = where(zv EQ 0)
+         if terrev[0] NE -1 then zv[temporary(terrev)] = !values.f_nan
+;
+         zdiv = 1e6/(e1t[indice2d]*e2t[indice2d])
+         zdiv = (zdiv)[*]#replicate(1, nzt)
+         zdiv = reform(zdiv, nx, ny, nzt, /over)
+         zdiv = temporary(zdiv)*(zu-shift(zu, 1, 0, 0)+zv-shift(zv, 0, 1, 0)) $
+          *tmask[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, premierzt:dernierzt]
+;------------------------------------------------------------
+; mise a !values.f_nan de la bordure
+;------------------------------------------------------------
+         if  NOT keyword_set(key_periodique) OR nx NE jpi then begin
+            zdiv(0, *, *) = !values.f_nan
+            zdiv(nx-1, *, *) = !values.f_nan
+         endif
+         zdiv(*, 0, *) = !values.f_nan
+         zdiv(*, ny-1, *) = !values.f_nan
+;
+         zdiv = temporary(zdiv)
+;
+         if n_elements(valmask) EQ 0 THEN valmask = 1e20
+         terre =  where(tmask[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, premierzt:dernierzt] EQ 0)
+         if terre[0] NE -1 then zdiv[temporary(terre)] = valmask
+;------------------------------------------------------------
+; pour le trace graphique
+;------------------------------------------------------------
+         vargrid = 'T'
+         varname = 'div'
+         varunits = '1e6*s-1'
+         domdef, (glamt[indice2d])[0, 0], (glamu[indice2d])[nx-1, 0],(gphit[indice2d])[0, 0], (gphiv[indice2d])[0, ny-1], prof1, prof2, grille = ['t']
+         if keyword_set(direc) then  zdiv = moyenne(zdiv,direc,/nan, boite = boite)
+      END
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xyt
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+      date1 NE date2 AND (size(u))[0] EQ 3 :BEGIN 
+;------------------------------------------------------------
+; extraction de u et v sur le domaine qui convient
+;------------------------------------------------------------
+         case 1 of
+            (size(u))[0] NE 3 OR (size(v))[0] NE 3: return,  -1
+            (size(u))[1] EQ nxu AND (size(u))[2] EQ nyu AND $
+             (size(v))[1] EQ nxv AND (size(v))[2] EQ nyv:BEGIN 
+               case 1 of
+                  nxu NE nx:if indicex[0] EQ premierxu then u = u[0:nx-1, *, *] ELSE u = u[1: nx, *, *]
+                  nxv NE nx:if indicex[0] EQ premierxv then v = v[0:nx-1, *, *] ELSE v = v[1: nx, *, *]
+                  nyu NE ny:if indicey[0] EQ premieryu then u = u[*, 0:ny-1, *] ELSE u = u[*, 1: ny, *]
+                  nyv NE ny:if indicey[0] EQ premieryv then v = v[*, 0:ny-1, *] ELSE v = v[*, 1: ny, *]
+                  ELSE :
+               endcase
+            END
+            (size(u))[1] EQ jpi AND (size(u))[2] EQ jpj AND $
+             (size(v))[1] EQ jpi AND (size(v))[2] EQ jpj:BEGIN 
+               u = u[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, *]
+               v = v[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, *]
+            END
+            ELSE:return,  -1
+         endcase
+;------------------------------------------------------------
+; calcul de la divergence
+;------------------------------------------------------------
+         zu = e2u[indice2d]*(umask())[indice2d+jpi*jpj*premierzt]
+         terreu = where(zu EQ 0)
+         if terreu[0] NE -1 then zu[temporary(terreu)] = !values.f_nan
+         zu = (zu)[*]#replicate(1, jpt)
+         zu = reform(zu, nx, ny, jpt, /over)
+         zu = temporary(u)*temporary(zu)
+;
+         zv = e1v[indice2d]*(vmask())[indice2d+jpi*jpj*premierzt]
+         terrev = where(zv EQ 0)
+         if terrev[0] NE -1 then zv[temporary(terrev)] = !values.f_nan
+         zv = (zv)[*]#replicate(1, jpt)
+         zv = reform(zv, nx, ny, jpt, /over)
+         zv = temporary(v)*temporary(zv)
+;
+         zdiv = 1e6*tmask[indice2d+jpi*jpj*premierzt]/(e1t[indice2d]*e2t[indice2d])
+         zdiv = (zdiv)[*]#replicate(1, jpt)
+         zdiv = reform(zdiv, nx, ny, jpt, /over)
+         terre =  where(zdiv EQ 0)
+         zdiv = temporary(zdiv)*(zu-shift(zu, 1, 0, 0)+zv-shift(zv, 0, 1, 0))
+;------------------------------------------------------------
+; mise a !values.f_nan de la bordure
+;------------------------------------------------------------
+         if  NOT keyword_set(key_periodique) OR nx NE jpi then begin
+            zdiv(0, *, *) = !values.f_nan
+            zdiv(nx-1, *, *) = !values.f_nan
+         endif
+         zdiv(*, 0, *) = !values.f_nan
+         zdiv(*, ny-1, *) = !values.f_nan
+;
+         if n_elements(valmask) EQ 0 THEN valmask = 1e20
+         if terre[0] NE -1 then zdiv[temporary(terre)] = valmask
+;------------------------------------------------------------
+; pour le trace graphique
+;------------------------------------------------------------
+         vargrid = 'T'
+         varname = 'div'
+         varunits = '1e6*s-1'
+         domdef, (glamt[indice2d])[0, 0], (glamu[indice2d])[nx-1, 0],(gphit[indice2d])[0, 0], (gphiv[indice2d])[0, ny-1], prof1, prof2, grille = ['t']
+         if keyword_set(direc) then  zdiv = grossemoyenne(zdiv,direc,/nan, boite = boite)
+      END
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xyzt
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+      date1 NE date2 AND (size(u))[0] EQ 4:BEGIN 
+         return, report('non code!')
+      END
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xy
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+      ELSE:BEGIN                ;xy
+         indice3d = lindgen(jpi, jpj, jpk)
+         indice3d = indice3d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, niveau -1]
+;------------------------------------------------------------
+; extraction de u et v sur le domaine qui convient
+;------------------------------------------------------------
+         case 1 of
+            (size(u))[0] NE 2 OR (size(v))[0] NE 2: BEGIN 
+               zdiv = -1
+               GOTO, sortie
+            end
+            (size(u))[1] EQ nxu AND (size(u))[2] EQ nyu AND $
+             (size(v))[1] EQ nxv AND (size(v))[2] EQ nyv:BEGIN 
+               case 1 of
+                  nxu NE nx:if indicex[0] EQ premierxu then u = u[0:nx-1, *] ELSE u = u[1: nx, *]
+                  nxv NE nx:if indicex[0] EQ premierxv then v = v[0:nx-1, *] ELSE v = v[1: nx, *]
+                  nyu NE ny:if indicey[0] EQ premieryu then u = u[*, 0:ny-1] ELSE u = u[*, 1: ny]
+                  nyv NE ny:if indicey[0] EQ premieryv then v = v[*, 0:ny-1] ELSE v = v[*, 1: ny]
+                  ELSE :
+               endcase
+            END
+            (size(u))[1] EQ jpi AND (size(u))[2] EQ jpj AND $
+             (size(v))[1] EQ jpi AND (size(v))[2] EQ jpj:BEGIN 
+               u = u[indice2d]
+               v = v[indice2d]
+            END
+            ELSE:return,  -1
+         endcase
+;------------------------------------------------------------
+; calcul de la divergence
+;------------------------------------------------------------
+         zu = temporary(u)*e2u[indice2d]*(umask())[indice3d]
+         terreu = where(zu EQ 0)
+         if terreu[0] NE -1 then zu[temporary(terreu)] = !values.f_nan
+         zv = temporary(v)*e1v[indice2d]*(vmask())[indice3d]
+         terrev = where(zv EQ 0)
+         if terrev[0] NE -1 then zv[temporary(terrev)] = !values.f_nan
+         zdiv = zu-shift(zu, 1, 0)+zv-shift(zv, 0, 1)
+         zdiv = temporary(zdiv)*tmask[indice3d]/(e1t[indice2d]*e2t[indice2d])
+;------------------------------------------------------------
+; mise a !values.f_nan de la bordure
+;------------------------------------------------------------
+         if  NOT keyword_set(key_periodique) OR nx NE jpi then begin
+            zdiv(0, *) = !values.f_nan
+            zdiv(nx-1, *) = !values.f_nan
+         endif
+         zdiv(*, 0) = !values.f_nan
+         zdiv(*, ny-1) = !values.f_nan
+;
+         zdiv = temporary(zdiv)*1e6
+;
+         if n_elements(valmask) EQ 0 THEN valmask = 1e20
+         terre =  where(tmask[indice3d] EQ 0)
+         if terre[0] NE -1 then zdiv[temporary(terre)] = valmask
+;------------------------------------------------------------
+; pour le trace graphique
+;------------------------------------------------------------
+         vargrid = 'T'
+         varname = 'div'
+         varunits = '1e6*s-1'
+         domdef, (glamt[indice2d])[0, 0], (glamu[indice2d])[nx-1, 0],(gphit[indice2d])[0, 0], (gphiv[indice2d])[0, ny-1], prof1, prof2, grille = ['t']
+         if keyword_set(direc) then  zdiv = moyenne(zdiv,direc,/nan, boite = boite)
+
+      END
+   endcase
+   
+;------------------------------------------------------------
+sortie:
+   if keyword_set(key_performance) THEN print, 'temps div', systime(1)-tempsun 
+   
+   return, zdiv
+end
Index: tags/start/CALCULS/floatlevel2depth.pro
===================================================================
--- tags/start/CALCULS/floatlevel2depth.pro	(revision 5)
+++ tags/start/CALCULS/floatlevel2depth.pro	(revision 5)
@@ -0,0 +1,69 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:floatlevel2depth
+;
+; PURPOSE: assez comparable a level2depth. C'est la fonction inverse
+; de depth2floatlevel
+;
+; CATEGORY:SANS BOUCLE
+;
+; CALLING SEQUENCE:res=floatlevel2depth(niveau)
+; 
+; INPUTS: tableau 2d de niveaux seuil (ou une structure repondant aux
+; criteres de litchamp)
+;
+; KEYWORD PARAMETERS:
+;       /NOMASK: pour ne pas masquer les points terres
+;
+; OUTPUTS: un tableau 2d contenant des profondeurs
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+;    IDL> a=gdept[jpk-1]/(1.*jpi*jpj)*findgen(jpi,jpj)
+;    IDL> plt, 1e6*(a-floatlevel2depth(depth2floatlevel(a))),/nocontour
+;
+;  ->champ nul a 1e-6 pres
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      15/6/2000
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION floatlevel2depth, tab, NOMASK = nomask
+   tempsun = systime(1)         ; pour key_performance
+@common
+;------------------------------------------------------------
+   flevelin = litchamp(tab)
+; on vire les points a !values.f_nan
+   notanumber = where(finite(flevelin, /nan) EQ 1)
+   if notanumber[0] NE -1 then flevelin[notanumber] = 0
+; on seuil (vire les points terres a valmask par ex)
+   flevelin = 0 > flevelin < (jpk-1)
+; on calcule la profondeur 
+   depthup = level2depth(floor(flevelin), /nomask)
+   depthlow= level2depth(ceil(flevelin), /nomask)
+   weight = flevelin-floor(flevelin)
+   res = depthup+weight*(depthlow-depthup)
+; on replace les points a !values.f_nan
+   if notanumber[0] NE -1 then res[notanumber] = !values.f_nan
+; on masque les points terres a valmask
+   if NOT keyword_set(nomask) then begin
+      grille,mask
+      if n_elements(valmask) EQ 0 then valmask = 1e20
+      terre = where((temporary(mask))[*, *, 0] EQ 0)
+      if terre[0] NE -1 then res[terre] = valmask
+   endif
+;------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps floatlevel2depth', systime(1)-tempsun 
+;
+   return, res
+end
Index: tags/start/CALCULS/grad.pro
===================================================================
--- tags/start/CALCULS/grad.pro	(revision 5)
+++ tags/start/CALCULS/grad.pro	(revision 5)
@@ -0,0 +1,259 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:
+;
+; PURPOSE:
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:
+; 
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION grad, field, direc
+@common
+;------------------------------------------------------------
+   res = litchamp(field)
+   taille=size(res)
+   grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery, dernierz     
+   if n_elements(valmask) EQ 0 then valmask = 1e20
+   case strupcase(vargrid) of
+      'T':BEGIN
+         case direc of
+            'x':BEGIN 
+               divi = e1u[premierx:dernierx, premiery:derniery]
+               newmask = (umask())[premierx:dernierx, premiery:derniery, premierz:dernierz]
+               vargrid = 'U'
+               domdef, glamt[premierx, 0], glamu[dernierx, 0] $
+                , gphit[0, premiery], gphiu[0, derniery], grille = ['T','U']
+            END
+            'y':BEGIN
+               divi = e2v[premierx:dernierx, premiery:derniery]
+               newmask = (vmask())[premierx:dernierx, premiery:derniery, premierz:dernierz]
+               vargrid = 'V'
+               domdef, glamt[premierx, 0], glamv[dernierx, 0] $
+                , gphit[0, premiery], gphiv[0, derniery], grille = ['T','V']
+            END
+            'z':BEGIN
+               divi = e3w[premierz:dernierz]
+               newmask = mask
+               vargrid = 'W'
+            END
+            ELSE:return, report('Bad definition of direction argument')
+         ENDCASE
+      END
+      'W':BEGIN
+         case direc of
+            'x':divi = e1u[premierx:dernierx, premiery:derniery]
+            'y':divi = e2v[premierx:dernierx, premiery:derniery]
+            'z':BEGIN
+               divi = e3t[premierz:dernierz]
+               newmask = mask
+               vargrid = 'T'
+            END
+            ELSE:return, report('Bad definition of direction argument')
+         endcase
+      END
+      'U':BEGIN
+         case direc of
+            'x':BEGIN
+               divi = (shift(e1t, -1, 0))[premierx:dernierx, premiery:derniery]
+               newmask = tmask[premierx:dernierx, premiery:derniery, premierz:dernierz]
+               vargrid = 'T'
+               domdef, glamt[premierx, 0], glamu[dernierx] $
+                , gphit[0, premiery], gphiu[0, derniery], grille = ['T','U']
+            END
+            'y':BEGIN
+               divi = e2f[premierx:dernierx, premiery:derniery]
+               newmask = (fmask())[premierx:dernierx, premiery:derniery, premierz:dernierz]
+               vargrid = 'F'
+               domdef, glamu[premierx, 0], glamf[dernierx, 0] $
+                , gphiu[0, premiery], gphif[0, derniery], grille = ['U','F']
+            END
+            'z':BEGIN
+               divi = e3w[premierz:dernierz]
+               newmask = mask
+               vargrid = 'W'
+            END
+            ELSE:return, report('Bad definition of direction argument')
+         endcase
+      END
+      'V':BEGIN
+         case direc of
+            'x':BEGIN
+               divi = e1f[premierx:dernierx, premiery:derniery]
+               newmask = (fmask())[premierx:dernierx, premiery:derniery, premierz:dernierz]
+               vargrid = 'F'
+               domdef, glamv[premierx, 0], glamf[dernierx, 0] $
+                , gphiv[0, premiery], gphif[0, derniery], grille = ['V','F']
+            END
+            'y':BEGIN
+               divi = (shift(e2t, 0, -1))[premierx:dernierx, premiery:derniery]
+               newmask = tmask[premierx:dernierx, premiery:derniery, premierz:dernierz]
+               vargrid = 'T'
+               domdef, glamt[premierx, 0], glamv[dernierx, 0] $
+                , gphit[0, premiery], gphiv[0, derniery], grille = ['T','V']
+            END
+            'z':BEGIN
+               divi = e3w[premierz:dernierz]
+               newmask = mask
+               vargrid = 'W'
+            END
+            ELSE:return, report('Bad definition of direction argument')
+         endcase
+      END
+;       'F':BEGIN
+;          case direc of
+;             'x':divi = (shift(e1v, -1, 0))[premierx:dernierx, premiery:derniery]
+;             'y':divi = (shift(e2u, 0, -1))[premierx:dernierx, premiery:derniery]
+;             'z':divi = e3w[premierz:dernierz]
+;             ELSE:return, report('Bad definition of direction argument')
+;          endcase
+;       END
+      ELSE:return, report('Bad definition of vargrid')
+   ENDCASE
+   res = fitintobox(res)
+   case 1 of
+;----------------------------------------------------------------------------
+;xy
+;----------------------------------------------------------------------------
+      taille[0] EQ 2:BEGIN
+         earth = where(mask[*, *, premierz] EQ 0)
+         if earth[0] NE -1 then res[earth] = !values.f_nan
+         case direc of
+            'x':BEGIN 
+               res = (shift(res, -1, 0)-res)/divi
+               if key_periodique EQ 0 OR nx NE jpi THEN res[nx-1, *] = !values.f_nan
+               if vargrid EQ 'T' OR vargrid EQ 'V' then res = shift(res, 1, 0)
+            END
+            'y':BEGIN 
+               res = (shift(res, 0, -1)-res)/divi
+               res[*, ny-1] = !values.f_nan
+               if vargrid EQ 'T' OR vargrid EQ 'U' then res =   shift(res, 0, 1)           
+            END
+            ELSE:return,  report('Bad definition of direction argument for the type of array')
+         ENDCASE
+         earth = where(newmask[*, *, premierz] EQ 0)
+         if earth[0] NE -1 then res[earth] = valmask
+      END
+;----------------------------------------------------------------------------
+;xyt
+;----------------------------------------------------------------------------
+      taille[0] EQ 3 AND jpt NE 1:BEGIN
+         earth = where(mask[*, *, premierz] EQ 0)
+         if earth[0] NE -1 then BEGIN
+            earth = earth#replicate(1, jpt)+replicate(1, n_elements(earth))#(nx*ny*lindgen(jpt))
+            res[earth[*]] = !values.f_nan
+         ENDIF
+         divi = divi[*]#replicate(1, jpt)
+         case direc of
+            'x':BEGIN 
+               res = (shift(res, -1, 0, 0)-res)/divi
+               if key_periodique EQ 0 OR nx NE jpi THEN res[nx-1, *, *] = !values.f_nan
+               if vargrid EQ 'T' OR vargrid EQ 'V'  then res = shift(res, 1, 0, 0)
+            END
+            'y':BEGIN 
+               res = (shift(res, 0, -1, 0)-res)/divi
+               res[*, ny-1, *] = !values.f_nan
+               if vargrid EQ 'T' OR vargrid EQ 'U'  then res = shift(res, 0, 1, 0)        
+            END
+            ELSE:return,  report('Bad definition of direction argument for the type of array')
+         ENDCASE
+         earth = where(newmask[*, *, premierz] EQ 0)
+         if earth[0] NE -1 then BEGIN 
+            earth = earth#replicate(1, jpt)+replicate(1, n_elements(earth))#(nx*ny*lindgen(jpt))
+            res[earth] = valmask
+         ENDIF
+      END
+;----------------------------------------------------------------------------
+;xyz
+;----------------------------------------------------------------------------
+      taille[0] EQ 3 AND jpt EQ 1:BEGIN
+         earth = where(mask EQ 0)
+         if earth[0] NE -1 then res[earth] = !values.f_nan
+         case direc OF
+            'x':BEGIN 
+               divi = divi[*]#replicate(1, nz)
+               res = (shift(res, -1, 0, 0)-res)/divi
+               if key_periodique EQ 0 OR nx NE jpi THEN res[nx-1, *, *] = !values.f_nan
+               if vargrid EQ 'T' OR vargrid EQ 'V' then res = shift(res, 1, 0, 0)
+            END
+            'y':BEGIN 
+               divi = divi[*]#replicate(1, nz)
+               res = (shift(res, 0, -1, 0)-res)/divi
+               res[*, ny-1, *] = !values.f_nan
+               if vargrid EQ 'T' OR vargrid EQ 'U'  then res = shift(res, 0, 1, 0)        
+            END
+            'z':BEGIN
+               divi = reform(replicate(1, nx*ny)#divi, nx, ny, nz)
+               if nx EQ 1 OR ny EQ 1 then res = reform(res, nx, ny, nz)
+               if vargrid EQ 'W' THEN BEGIN 
+                  res = (shift(res, 0, 0, 1)-res)/divi
+                  res[*, *, 0] = !values.f_nan
+               ENDIF ELSE BEGIN
+                  res = (res-shift(res, 0, 0, -1))/divi
+                  res[*, *, nz-1] = !values.f_nan
+               ENDELSE
+               if earth[0] NE -1 then res[earth] = valmask
+            END
+         ENDCASE
+      END
+;------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xyzt
+;----------------------------------------------------------------------------
+      taille[0] EQ 4:BEGIN
+         earth = where((mask[*]#replicate(1, jpt)) EQ 0)
+         if earth[0] NE -1 then res[earth] = !values.f_nan
+         case direc OF
+            'z':BEGIN
+               divi = replicate(1, nx*ny)#divi
+               divi = reform(divi[*]#replicate(1, jpt), nx, ny, nz, jpt, /over)
+               if nx EQ 1 OR ny EQ 1 then res = reform(res, nx, ny, nz, jpt)
+               if vargrid EQ 'W' THEN BEGIN 
+                  res = (shift(res, 0, 0, 1, 0)-res)/divi
+                  res[*, *, 0, *] = !values.f_nan
+               ENDIF ELSE BEGIN
+                  res = (res-shift(res, 0, 0, -1, 0))/divi
+                  res[*, *, nz-1, *] = !values.f_nan
+               ENDELSE
+               if earth[0] NE -1 then res[earth] = valmask
+            END
+         ENDCASE
+      END
+;------------------------------------------------------------
+;------------------------------------------------------------
+   endcase
+   varname = 'grad of '+varname
+   varunit = varunit+'/m'
+
+
+;------------------------------------------------------------
+   return, res
+end
+
+
+
+
+
+
Index: tags/start/CALCULS/grossemoyenne.pro
===================================================================
--- tags/start/CALCULS/grossemoyenne.pro	(revision 5)
+++ tags/start/CALCULS/grossemoyenne.pro	(revision 5)
@@ -0,0 +1,491 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: grossemoyenne
+;
+; PURPOSE:  averages a 3- or 4-d time serie field over a selected
+;           geographical area or along the time axis. For one ore more
+;	    selected axes (x, y, z, t)
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE: result = grossemoyenne(tab,'direc',BOITE=boite)
+;
+; INPUTS:	tab = 3 or 4d field
+;		direc ='x' 'y' 'z' 't' 'xy' 'xz' 'yz' 'xyz' 'xt' 'yt' 'zt'
+;		'xyt' 'xzt' 'yzt' or 'xyzt' 
+;
+; KEYWORD PARAMETERS:
+;
+;		boite = [xmin,xmax,ymin,ymax (,(zmin,)zmax)] pour plus
+;		de detail cf domdef
+;               boite peut prendre 5 formes: 
+;               [prof2], [prof1, prof2],[lon1, lon2, lat1, lat2],  
+;               [lon1, lon2, lat1, lat2, prof2],[lon1, lon2, lat1, lat2, prof1,prof2]
+;             
+;               NAN: not a number, a activer si l''on peut faire veut
+;               faire une moyenne sans tenir compte de certaines
+;               valeurs masques de tab.
+;               si les valeurs masques de tab sont la valeur consacree
+;               par IDL (!values.f_nan), il suffit de mettre /NAN.
+;               si les valeurs masques de tab on pour valeur a (a doit
+;               etre differente de 1 (correspond a nan =
+;               !values.f_nan) et de 0 (qui desactive nan).
+;               Il faut mettre NAN=a. 
+;               Rq: en sorties les points de result qui sont NAN
+;               auront pour valeur a ou !values.f_nan.
+;            
+;               NODOMDEF: activer si l''on ne veut pas passer ds
+;               domdef bien que le mot cle boite soit present (comme
+;               c''est le cas qd grossemoyenne est appelee via
+;               checkfield)
+;
+;               INTEGRATION: pour faire une integrale plutot qu''une moyenne
+;            
+; OUTPUTS: 
+;
+; COMMON BLOCKS:   result:un tableau 
+;	common    domdef
+;
+; SIDE EFFECTS: met les valeurs correspondants a la terre a 1e20
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Jerome Vialard (jv@lodyc.jussieu.fr)
+;			2/7/98
+;                       Sebastien Masson (smasson@lodyc.jussieu.fr)
+; adaptation pour les tableaux comportants une dimension temporelle
+;                       14/8/98
+;                       15/1/98
+;                       12/3/99 adaptation pour NAN et utilisation de TEMPORARY
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; PLAN DU PROGRAMME:
+;------------------------------------------------------------
+;------------------------------------------------------------
+;I) preliminaires
+;   I.1) determination des directions de moyennes d''apres direc
+;   I.2) verification de la taille du tableau d''entree
+;   I.3) obtention des facteurs d''echelles et du masque sur le sous
+;   domaine concerne par la moyenne 
+;II) moyennes pour les tableaux 3d (x,y,t)
+;   II.1) verification de la coherence de la taille du tableau a
+;   moyenner 
+;   II.2) renvoie sur moyenne qd une moyenne sur t est demandee
+;   II.3) differents types de moyennes possibles
+;III) moyennes pour les tableaux 4d (x,y,z,t)
+;   III.1) verification de la coherence de la taille du tableau a
+;   moyenner 
+;   III.2) differents types de moyennes possibles
+;IV ) finitions
+;   IV.1) on masque les terres par une valeur a 1e+20
+;   IV.2) on remplace, quand nan ne 1, !values.f_nan par nan
+;   IV.3) on revient au sous domaine initial.
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+function grossemoyenne ,tab,direc,BOITE=boite, INTEGRATION=integration $
+                        , NAN = nan, NODOMDEF = nodomdef, _extra = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;------------------------------------------------------------
+;I) preliminaires
+;------------------------------------------------------------
+   dirt = 0
+   dirx = 0
+   diry = 0
+   dirz = 0
+   dim  = 'aa'
+;------------------------------------------------------------
+; I.1) direction(s) suivants lesquelles on integre
+;------------------------------------------------------------
+   if ( strpos(direc,'t') ge 0 ) then dirt = 1
+   if ( strpos(direc,'x') ge 0 ) then dirx = 1
+   if ( strpos(direc,'y') ge 0 ) then diry = 1
+   if ( strpos(direc,'z') ge 0 ) then dirz = 1
+;------------------------------------------------------------
+; I.2) verification de la taille du tableau d'entree
+;------------------------------------------------------------
+   taille = size(tab)
+   case 1 of
+      taille[0] eq 1 :return,  report('Le tableau n''a qu''une dimension, cas non traite!')
+      taille[0] eq 2 :return,  report('Le tableau n''a qu''deux dimension, cas non traite!')
+      taille[0] eq 3 :BEGIN 
+         dim = '3d'
+         if dirx eq 0 and diry eq 0 and dirt eq 0 then return, tab
+      END
+      taille[0] eq 4 :BEGIN 
+         dim = '4d'
+         if dirx eq 0 and diry eq 0 and dirz eq 0 and dirt eq 0 then return, tab
+      END
+      else : return, report('Le tableau d entree doit etre a 3 ou 4 dimensions s''il ne contient pas de dim temporelle utiliser moyenne')
+   endcase
+;------------------------------------------------------------
+;   I.4) obtention des facteurs d''echelles et du masque sur le sous
+;   domaine concerne par la moyenne 
+; redefinition du domaine ajuste a boite (a 6 elements)
+; ceci va nous permetre de faire les calcules que sur le sous domaine
+; comcerne par la moyenne. domdef, suivit de grille nous donne tous
+; les tableaux de la grille sur le sous domaine 
+;------------------------------------------------------------
+   if keyword_set(boite) then BEGIN 
+      Case 1 Of
+         N_Elements(Boite) Eq 1: bte = [lon1, lon2, lat1, lat2, 0.,boite[0]]
+         N_Elements(Boite) Eq 2: bte = [lon1, lon2, lat1, lat2, boite[0],boite[1]]
+         N_Elements(Boite) Eq 4: bte = [Boite,prof1, prof2]
+         N_Elements(Boite) Eq 5: bte = [Boite[0:3], 0, Boite[4]]
+         N_Elements(Boite) Eq 6: bte = Boite
+         Else: return, report('Mauvaise Definition de Boite')
+      endcase
+      oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+      if NOT keyword_set(nodomdef) then domdef, bte,GRILLE=vargrid, _extra = ex
+   ENDIF 
+;---------------------------------------------------------------
+; attribution du mask et des tableaux de longitude et latitude...
+;---------------------------------------------------------------
+   grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz, dernierx, derniery, dernierz,e1,e2,e3
+;------------------------------------------------------------
+; I.3) si dirt eq 1 on fait la moyenne temporelle et on envoie ds moyenne
+;------------------------------------------------------------
+   if dirt EQ 1 then begin
+      if dim EQ 3d then BEGIN 
+      case 1 of
+         taille[1] eq jpi and taille[2] eq jpj and taille[3] eq jpt: $
+          res = tab[premierx:premierx+nx-1 $
+                    ,premiery:premiery+ny-1, *]
+         taille[1] EQ  nx and taille[2] eq  ny and taille[3] eq jpt:res=tab
+         else:return, report('Probleme d''adequation entre les tailles du domaine nx*ny*jpt '+strtrim(nx, 1)+'*'+strtrim(ny, 1)+'*'+strtrim(jpt, 1)+' et du tableau '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+      ENDCASE
+         divi = finite(res)
+         divi = total(temporary(divi),3, nan = keyword_set(nan))
+         notanum = where(divi EQ 0)
+         if keyword_set(integration) then begin
+            res = total(res,3, nan = nan)
+         ENDIF ELSE BEGIN
+            if keyword_set(nan) then BEGIN
+               res = total(res,3, nan = keyword_set(nan))/ (1 > divi)
+            ENDIF ELSE res = total(res,3)/(1.*taille[3]) 
+         ENDELSE
+      ENDIF ELSE BEGIN
+      case 1 of
+         taille[1] eq jpi and taille[2] eq jpj and taille[3] eq jpk and taille[4] eq jpt: $
+          res =tab[premierx:dernierx,premiery:derniery,premierz:dernierz, *]
+         taille[1] eq jpi and taille[2] eq jpj and taille[3] eq nz and taille[4] eq jpt: $
+          res =tab[premierx:dernierx,premiery:derniery,*, *]
+         taille[1] EQ  nx and taille[2] eq  ny and taille[3] eq nz and taille[4] eq jpt:res=tab
+         taille[1] EQ  nx and taille[2] eq  ny and taille[3] eq jpk and taille[4] eq jpt: $
+          res=tab[*, *, premierz:dernierz, *]
+         else:return, report('Probleme d''adequation entre les tailles du domaine nx*ny*nz*jpt ' $
+                             +strtrim(nx, 1)+'*'+strtrim(ny, 1)+'*'+strtrim(nz, 1)+'*' $
+                             +strtrim(jpt, 1)+' et du tableau '+strtrim(taille[1], 1)+'*' $
+                             +strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1)+'*' $
+                             +strtrim(taille[4], 1))
+      endcase
+         divi = finite(res)
+         divi = total(temporary(divi),4, nan = keyword_set(nan))
+         notanum = where(divi EQ 0)
+         if keyword_set(integration) then begin
+            res = total(res,4, nan = nan)
+         ENDIF ELSE BEGIN
+            if keyword_set(nan) then begin
+               res = total(res,4, /nan)/(1 > divi)
+            ENDIF ELSE res = total(res,4)/(1.*taille[4])
+         ENDELSE
+      ENDELSE
+      if notanum[0] NE -1 then res[temporary(notanum)] = !values.f_nan
+      return,  moyenne(temporary(res), direc, BOITE = boite, NAN = nan, INTEGRATION = integration, _extra = ex)
+   endif
+;------------------------------------------------------------
+;------------------------------------------------------------
+; II) Cas serie tableaux 2d (tab3d)
+;------------------------------------------------------------
+;------------------------------------------------------------
+   if (dim eq '3d') then begin
+;---------------------------------------------------------------
+;   II.1) verification de la coherence de la taille du tableau a
+;   moyenner 
+; verification de la coherence entre la taille du tableau et le
+; domaine definit par domdef
+; le tableau en entree doit avoir soit la taille du domaine total
+; (jpi,jpj,jpt) soit celle du domaine reduit (nx,ny,jpt)
+;---------------------------------------------------------------
+      case 1 of
+         taille[1] eq jpi and taille[2] eq jpj and taille[3] eq jpt: $
+          res = tab[premierx:premierx+nx-1 $
+                    ,premiery:premiery+ny-1, *]
+         taille[1] EQ  nx and taille[2] eq  ny and taille[3] eq jpt:res=tab
+         else:return, report('Probleme d''adequation entre les tailles du domaine nx*ny*jpt '+strtrim(nx, 1)+'*'+strtrim(ny, 1)+'*'+strtrim(jpt, 1)+' et du tableau '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+      endcase
+      if keyword_set(nan) NE 0 then BEGIN 
+         if nan NE 1 then BEGIN ; si nan n''est pas !values.f_nan 
+; on le met a !values.f_nan
+            if abs(nan) LT 1e6 then notanumber = where(res EQ nan) $
+            ELSE notanumber = where(abs(res) GT abs(nan)/10.)
+            if notanumber[0] NE -1 then res[temporary(notanumber)] = !values.f_nan
+         ENDIF
+      ENDIF
+;---------------------------------------------------------------
+; rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER = 1, ET
+; S'ASSURER QU'ELLE EXISTE BIEN. D'OU LES reform(...,nx,ny,...) QUI
+; PEUVENT SEMBLER INUTILE AU DEPART
+;---------------------------------------------------------------
+      if nx EQ 1 OR ny EQ 1 OR jpt EQ 1 then res=reform(res,nx,ny,jpt, /over)
+      if nx EQ 1 OR ny EQ 1 then BEGIN 
+         mask =  reform(mask, nx, ny, nz, /over)
+         e1 =  reform(e1, nx, ny, /over)
+         e2 =  reform(e2, nx, ny, /over)
+      endif
+;---------------------------------------------------------------
+; II.3) differents types de moyennes
+;---------------------------------------------------------------
+      if keyword_set(nan) NE 0 then begin
+         msknan = replicate(1., nx, ny, jpt)
+         notanumber = where(finite(res) EQ 0)
+         if notanumber[0] NE -1 then msknan[temporary(notanumber)] = !values.f_nan
+      ENDIF ELSE msknan = 1
+      if nz eq jpk then mask = mask[*, *,niveau-1] ELSE mask = mask[*, *,nz-1]
+      case 1 of
+         (dirx eq 1) and (diry eq 0) : begin
+            e = temporary(e1)*temporary(mask)
+            if nx EQ 1 OR ny EQ 1 then e = reform(e, nx, ny, /over)
+            echelle = temporary(e[*])#replicate(1, jpt)
+            echelle = reform(echelle, nx, ny, jpt, /over)
+            if keyword_set(integration) then divi=1 $
+            ELSE divi = total(echelle*msknan,1, nan = nan)
+            res=total(temporary(res)*echelle,1, nan = nan)/(divi > 1.)
+            if keyword_set(nan) then begin
+               testnan = finite(temporary(msknan))+(temporary(echelle) EQ 0)
+               testnan = total(testnan,1)
+            endif
+         end
+         (dirx eq 0) and (diry eq 1) : begin
+            e = temporary(e2)*temporary(mask)
+            if nx EQ 1 OR ny EQ 1 then e = reform(e, nx, ny, /over)
+            echelle = temporary(e[*])#replicate(1, jpt)
+            echelle = reform(echelle, nx, ny, jpt, /over)
+            if keyword_set(integration) then divi=1 $
+            ELSE divi = total(echelle*msknan,2, nan = nan)
+            res=total(temporary(res)*echelle,2, nan = nan)/(divi > 1.)
+            if keyword_set(nan) then begin
+               testnan = finite(temporary(msknan))+(temporary(echelle) EQ 0)
+               testnan = total(testnan,2)
+            endif
+         end
+         (dirx eq 1) and (diry eq 1) : begin
+            echelle=(temporary(e1)*temporary(e2)*temporary(mask))[*]#replicate(1,jpt)
+            echelle=reform(echelle,nx,ny,jpt, /over)
+            if keyword_set(integration) then divi=1 $
+            ELSE divi = total(temporary(total(echelle*msknan,1, nan = nan)),1, nan = nan)
+            res = total(temporary(total(temporary(res)*echelle,1, nan=nan)),1, nan=nan)/(divi > 1.)
+            if keyword_set(nan) then begin
+               testnan = finite(temporary(msknan))+(temporary(echelle) EQ 0)
+               testnan = total(total(testnan,1),1)
+            endif
+         end
+      endcase
+   endif
+;------------------------------------------------------------
+;------------------------------------------------------------
+; III) Cas serie tableaux 3d (tab4d)
+;------------------------------------------------------------
+   if (dim eq '4d') then begin
+;---------------------------------------------------------------
+; III.1) verification de la coherence de la taille du tableau a
+; moyenner 
+; verification de la coherence entre la taille du tableau et le
+; domaine definit par domdef 
+; le tableau en entree doit avoir soit la taille du domaine total
+; (jpi,jpj,jpk,jpt) soit celle du domaine reduit (nx,ny,ny,jpt)
+;---------------------------------------------------------------
+      case 1 of
+         taille[1] eq jpi and taille[2] eq jpj and taille[3] eq jpk and taille[4] eq jpt: $
+          res =tab[premierx:dernierx,premiery:derniery,premierz:dernierz, *]
+         taille[1] eq jpi and taille[2] eq jpj and taille[3] eq nz and taille[4] eq jpt: $
+          res =tab[premierx:dernierx,premiery:derniery,*, *]
+         taille[1] EQ  nx and taille[2] eq  ny and taille[3] eq nz and taille[4] eq jpt:res=tab
+         taille[1] EQ  nx and taille[2] eq  ny and taille[3] eq jpk and taille[4] eq jpt: $
+          res=tab[*, *, premierz:dernierz, *]
+         else:return, report('Probleme d''adequation entre les tailles du domaine nx*ny*nz*jpt ' $
+                             +strtrim(nx, 1)+'*'+strtrim(ny, 1)+'*'+strtrim(nz, 1)+'*' $
+                             +strtrim(jpt, 1)+' et du tableau '+strtrim(taille[1], 1)+'*' $
+                             +strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1)+'*' $
+                             +strtrim(taille[4], 1))
+      endcase
+      if nx EQ 1 OR ny EQ 1 OR nz EQ 1 OR jpt EQ 1 then res=reform(res,nx,ny,nz,jpt, /over)
+      if keyword_set(nan) NE 0 then BEGIN 
+         if nan NE 1 then BEGIN ; si nan n''est pas !values.f_nan 
+; on le met a !values.f_nan
+            if abs(nan) LT 1e6 then notanumber = where(res EQ nan) $
+            ELSE notanumber = where(abs(res) GT abs(nan)/10.)
+            if notanumber[0] NE -1 then res[temporary(notanumber)] = !values.f_nan
+         ENDIF
+      ENDIF
+;---------------------------------------------------------------
+; rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER = 1, ET
+; S'ASSURER QU'ELLE EXISTE BIEN. D'OU LES reform(...,nx,ny,...) QUI
+; PEUVENT SEMBLER INUTILE AU DEPART
+;---------------------------------------------------------------
+      if nx EQ 1 OR ny EQ 1 OR nz EQ 1 OR jpt EQ 1 then res=reform(res,nx,ny,nz,jpt, /over)
+      if nx EQ 1 OR ny EQ 1 OR nz EQ 1 then mask =  reform(mask, nx, ny, nz, /over)
+;---------------------------------------------------------------
+; III.2) differents types de moyennes
+;---------------------------------------------------------------
+      IF keyword_set(nan) NE 0 then begin
+         msknan = replicate(1., nx, ny, nz, jpt)
+         notanumber = where(finite(res) EQ 0)
+         if notanumber[0] NE -1 then msknan[temporary(notanumber)] = !values.f_nan
+      ENDIF ELSE msknan = 1
+      case 1 of
+         (dirx eq 1) and (diry eq 0) and (dirz eq 0) : begin
+            e13 = temporary(e1[*])#replicate(1.,nz)
+            e13 = reform(e13,nx,ny,nz, /over)
+            echelle = (temporary(e13)*temporary(mask))[*]#replicate(1, jpt)
+            echelle = reform(echelle, nx, ny, nz, jpt, /over)
+            if keyword_set(integration) then divi=1 $
+            ELSE begin 
+               if keyword_set(nan) then divi = echelle*msknan ELSE divi = echelle
+               divi = total(temporary(divi),1, nan = nan)
+            endelse
+            res = temporary(res)*echelle
+            res = total(temporary(res),1, nan = nan)/(divi > 1)
+            if keyword_set(nan) then begin
+               testnan = finite(temporary(msknan))+(temporary(echelle) EQ 0)
+               testnan = total(testnan,1)
+            endif
+         end
+         (dirx eq 0) and (diry eq 1) and (dirz eq 0) : begin
+            e23 = temporary(e2[*])#replicate(1.,nz)
+            e23 = reform(e23,nx,ny,nz, /over)
+            echelle = (temporary(e23)*temporary(mask))[*]#replicate(1, jpt)
+            echelle = reform(echelle, nx, ny, nz, jpt, /over)
+            if keyword_set(integration) then divi=1 $
+            ELSE begin 
+               if keyword_set(nan) then divi = echelle*msknan ELSE divi = echelle
+               divi = total(temporary(divi), 2, nan = nan)
+            endelse
+            res = total(temporary(res)*echelle,2, nan = nan)/(divi > 1)
+            if keyword_set(nan) then begin
+               testnan = finite(temporary(msknan))+(temporary(echelle) EQ 0)
+               testnan = total(testnan,2)
+            endif
+         end
+         (dirx eq 0) and (diry eq 0) and (dirz eq 1) : begin
+            e33 = replicate(1,1.*nx*ny)#e3
+            e33 = reform(e33,nx,ny,nz, /over)
+            echelle =(temporary(e33)*temporary(mask))[*]#replicate(1, jpt)
+            echelle = reform(echelle, nx, ny, nz, jpt, /over)
+            if keyword_set(integration) then divi=1 $
+            ELSE begin 
+               if keyword_set(nan) then divi = echelle*msknan ELSE divi = echelle
+               divi = total(temporary(divi), 3, nan = nan)
+            endelse
+            res = total(temporary(res)*echelle,3, nan = nan)/(divi > 1)
+            if keyword_set(nan) then begin
+               testnan = finite(temporary(msknan))+(temporary(echelle) EQ 0)
+               testnan = total(testnan,3)
+            endif
+         end
+         (dirx eq 1) and (diry eq 1) and (dirz eq 0) : begin
+            e13 = e1[*]#replicate(1.,nz)
+            e13 = reform(e13,nx,ny,nz, /over)
+            e23 = e2[*]#replicate(1.,nz)
+            e23 = reform(e23,nx,ny,nz, /over)
+            echelle = (temporary(e13)*temporary(e23)*temporary(mask))[*]#replicate(1, jpt)
+            echelle = reform(echelle,nx,ny,nz,jpt, /over)
+            if keyword_set(integration) then divi=1 $
+            ELSE begin 
+               if keyword_set(nan) then divi = echelle*msknan ELSE divi = echelle
+               divi = total(total(temporary(divi),1, nan = nan),1, nan = nan)
+            endelse
+            res =total(total(temporary(res)*echelle,1, nan = nan),1, nan = nan)/(divi > 1)
+            if keyword_set(nan) then begin
+               testnan = finite(temporary(msknan))+(temporary(echelle) EQ 0)
+               testnan = total(total(testnan,1),1)
+            endif
+         end
+         (dirx eq 1) and (diry eq 0) and (dirz eq 1) : begin
+            e133 = e1[*]#e3
+            echelle = (temporary(e133[*])*temporary(mask[*]))#replicate(1, jpt)
+            echelle = reform(echelle,nx,ny,nz,jpt, /over)
+            if keyword_set(integration) then divi=1 $
+            ELSE begin 
+               if keyword_set(nan) then divi = echelle*msknan ELSE divi = echelle
+               divi = total(total(temporary(divi),1, nan = nan),2, nan = nan)
+            endelse
+            res = total(total(temporary(res)*echelle,1, nan = nan),2, nan = nan)/(divi > 1)
+            if keyword_set(nan) then begin
+               testnan = finite(temporary(msknan))+(temporary(echelle) EQ 0)
+               testnan = total(total(testnan,1),2)
+            endif
+         end
+         (dirx eq 0) and (diry eq 1) and (dirz eq 1) : begin
+            e233 = e2[*]#e3
+            echelle = (temporary(e233[*])*temporary(mask[*]))#replicate(1, jpt)
+            echelle = reform(echelle,nx,ny,nz,jpt, /over)
+            if keyword_set(integration) then divi=1 $
+            ELSE begin 
+               if keyword_set(nan) then divi = echelle*msknan ELSE divi = echelle
+               divi = total(total(temporary(divi),2, nan = nan),2,nan=nan)
+            endelse
+            res =total(total(temporary(res)*echelle,2, nan = nan),2, nan = nan)/(divi > 1)
+            if keyword_set(nan) then begin
+               testnan = finite(temporary(msknan))+(temporary(echelle) EQ 0)
+               testnan = total(total(testnan,2),2)
+            endif
+         end
+         (dirx eq 1) and (diry eq 1) and (dirz eq 1) : begin
+            e1233 = (e1[*]*e2[*])#e3
+            echelle=(temporary(e1233[*])*temporary(mask[*]))#replicate(1,jpt)
+            echelle=reform(echelle,nx,ny,nz,jpt, /over)
+            if keyword_set(integration) then divi=1 $
+            ELSE begin 
+               if keyword_set(nan) then divi = echelle*msknan ELSE divi = echelle
+               divi = total(total(total(temporary(divi), 1,nan=nan), 1,nan=nan), 1,nan=nan)
+            endelse
+            res =total(total(total(temporary(res)*echelle, 1,nan=nan), 1,nan=nan), 1,nan=nan)/(divi > 1)
+            if keyword_set(nan) then begin
+               testnan = finite(temporary(msknan))+(temporary(echelle) EQ 0)
+               testnan = total(total(total(testnan,1),1),1)
+            endif
+         end
+      endcase
+   endif
+;------------------------------------------------------------
+;------------------------------------------------------------
+;IV ) finitions
+;------------------------------------------------------------
+;------------------------------------------------------------
+; IV.1) on masque les terres par une valeur a 1e+20
+;------------------------------------------------------------
+   valmask = 1e+20
+   terre = where(divi EQ 0)
+   IF terre[0] NE -1 THEN BEGIN 
+      res(temporary(terre)) = 1e+20
+   ENDIF 
+;------------------------------------------------------------
+; IV.2) on remplace, quand nan ne 1, !values.f_nan par nan
+;------------------------------------------------------------
+   if keyword_set(nan) NE 0 then BEGIN 
+      puttonan = where(temporary(testnan) EQ 0)
+      if puttonan[0] NE -1 then res[temporary(puttonan)] = !values.f_nan
+      if nan NE 1 then BEGIN 
+         notanumber = where(finite(res) eq 0)
+         if notanumber[0] NE -1 then res[temporary(notanumber)] = nan
+      ENDIF
+   ENDIF
+;------------------------------------------------------------
+; IV.3) on se remplace ds le sous domaine qui etait definit a l''entree de
+; moyenne 
+;------------------------------------------------------------
+   if keyword_set(boite) AND NOT keyword_set(nodomdef) then domdef, oldboite,GRILLE=vargrid
+;------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps grossemoyenne', systime(1)-tempsun 
+   return, res
+;------------------------------------------------------------
+;------------------------------------------------------------
+end
Index: tags/start/CALCULS/hdyn.pro
===================================================================
--- tags/start/CALCULS/hdyn.pro	(revision 5)
+++ tags/start/CALCULS/hdyn.pro	(revision 5)
@@ -0,0 +1,164 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:hdyn
+;
+; PURPOSE:calcule la hauteur dynamique par rapport a un etat de
+; reference pour une profondeur de reference. Cf les mots cles pour
+; les differentes possibilites. 
+; Par defaut l''etat de reference est
+; rho=1020 et la profondeur de reference est gdepw[ka] avec ka le
+; premier niveau W directement au dessus de 1000 m. 
+;
+; CATEGORY: calculs de post-traitement
+;
+; CALLING SEQUENCE:res=hdyn(sn,tn)
+;
+; INPUTS:sn et tn sont des tableaux de meme taille representant la
+; salinite et la temperature.
+;
+; KEYWORD PARAMETERS:
+;
+;        GILL: activer cette cle si on veut faire le calcul de la
+;        hauteur dynamique comme ds le GILL page 215 cad par rapport a
+;        un etat de reference qui varie en profondeur et qui est
+;        determine par une temperature de reference tref a 0 degre et
+;        une salinite de reference sref a 35psu
+;
+;        LEVEL: C''est le niveau de reference a prendre. Ce niveau est
+;        definit tel que gdepw[level] est la profondeur de reference
+;
+;        SREF: donner une valeur a ce mot cle pour changer la salinite
+;        de reference utiliser ds le calcul lorsque GILL est active.
+;   
+;        TREF: donner une valeur a ce mot cle pour changer la temperature
+;        de reference utiliser ds le calcul lorsque GILL est active.
+;
+;        PROFREF: donner a ce mot cle une profondeur qui sera prise comme
+;        la profondeur de reference (ds ce cas LEVEL n'' a aucun
+;        effet). le calcul sera alors effectue jusqu''a cette
+;        profondeur en effectuant une interpolation entre le dernier
+;        niveau W au dessus de PROFREF et PROFREF.
+;
+;        SURFACE_LEVEL: C''est le niveau auquel on veut calculer la
+;        hauteur dynamique. Par defaut c''est le niveau 0.
+;
+; OUTPUTS:un tableau de la meme taille que sn et tn representant la
+; hauteur dynamique calculee a partir d''une profondeur de reference
+; et par rapport a un etat de reference.
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+; les points pour lesquels on nje peut calcule la hauteur dynamique
+; (dont la batymetrie est moins profonde que la profondeur de
+; reference) sont mis a la valeur !values.f_nan
+;
+; RESTRICTIONS:approximation: la pression en decibars est egale a la
+; profondeur en metres (la pression augmente de 1bar tous les 10m)
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION hdyn,  tabsn, tabtn, TREF = tref,  SREF = sref, PROFREF = profref, LEVEL = level, GILL = gill, SURFACE_LEVEL = surface_level
+   tempsun = systime(1)         ; pour key_performance
+@common
+
+   if NOT keyword_set(surface_level) then surface_level = 0
+; utile si GILL est active
+   if NOT keyword_set(tref) then tref = 0.
+   if NOT keyword_set(sref) then sref = 35.
+; on determine si besoin est la profondeur de reference et le niveau
+; W situe directement au dessus.
+   if keyword_set(profref) then begin
+      rien = where(gdepw LE profref, level)
+      level = level-1
+      za = gdepw[level]
+   ENDIF ELSE BEGIN 
+      if NOT keyword_set(level) then BEGIN 
+         rien = where(gdepw LE 1000., level)
+         level = level-1
+      ENDIF
+      profref = gdepw[level]
+      za = profref
+   ENDELSE 
+   tailles = size(tabsn)
+   taillet = size(tabtn)
+   if total(tailles[0:tailles[0]] NE taillet[0:taillet[0]]) NE 0 then $
+    return,  report('Les tableaux sn et tn doivent avoir la meme taille')
+   if tailles[3] NE jpk then return, report('La dim verticale des tableaux sn et tn doit etre egalre a jpk')
+   nx = nxt
+   ny = nyt
+   case (size(tabsn))[0] OF
+      3:BEGIN 
+         case 1 of
+            tailles[1] eq jpi and tailles[2] eq jpj: BEGIN
+               sn = tabsn[premierxt:dernierxt, premieryt:dernieryt, *]
+               tn = tabtn[premierxt:dernierxt, premieryt:dernieryt, *]
+            end
+            tailles[1] eq  nx and tailles[2] eq  ny:BEGIN 
+               sn = tabsn
+               tn = tabtn
+            end
+            else:return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         ENDCASE
+         if keyword_set(gill) then $
+          rhonref = rhon(replicate(sref,nx, ny, jpk),replicate(tref,nx, ny, jpk), /insitu) $
+         ELSE rhonref = 1020.
+         vol=(rhonref-rhon(sn,tn, /insitu))/rhonref
+         e33d = replicate(1, nx*ny)#e3t
+         e33d = reform(e33d, nx, ny, jpk, /over)
+         terre = where(tmask[premierxt:dernierxt, premieryt:dernieryt, *] EQ 0)
+         if terre[0] NE -1 then vol[terre] = !values.f_nan
+         case level of
+            0:hdyn =100.*(profref-gdepw[0])*vol[*, *, 0]
+            1:hdyn =100.*(vol*e33d)[*, *, 0]+(profref-gdepw[1])*vol[*, *, 1]
+            ELSE:hdyn =100.*total( (vol*e33d)[*, *, surface_level: level-1], 3) $
+             +(profref-gdepw[level])*vol[*, *, level]
+         endcase
+      END
+      4:BEGIN 
+         case 1 of
+            tailles[1] eq jpi and tailles[2] eq jpj AND tailles[4] EQ jpt: BEGIN
+               sn = tabsn[premierxt:dernierxt, premieryt:dernieryt, *, *]
+               tn = tabtn[premierxt:dernierxt, premieryt:dernieryt, *, *]
+            end
+            tailles[1] eq  nx and tailles[2] eq  ny AND tailles[4] EQ jpt:BEGIN 
+               sn = tabsn
+               tn = tabtn
+            end
+            else:return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         endcase
+         if keyword_set(gill) then $
+          rhonref = rhon(replicate(sref,nx, ny, jpk, jpt),replicate(tref,nx, ny, jpk, jpt), /insitu) $
+         ELSE rhonref = 1020.
+         vol=(rhonref-rhon(sn,tn, /insitu))/rhonref
+         e33d = replicate(1, nx*ny)#e3t
+         e33d = e33d[*]#replicate(1, jpt)
+         e33d = reform(e33d, nx, ny, jpk, jpt, /over)
+         mask = tmask[premierxt:dernierxt, premieryt:dernieryt, *]
+         mask = mask[*]#replicate(1, jpt)
+         terre = where(mask EQ 0)
+         if terre[0] NE -1 then vol[terre] = !values.f_nan
+         case level of
+            0:hdyn =100.*(profref-gdepw[0])*vol[*, *, 0, *]
+            1:hdyn =100.*(vol*e33d)[*, *, 0, *]+(profref-gdepw[1])*vol[*, *, 1, *]
+            ELSE:hdyn =100.*total( (vol*e33d)[*, *, surface_level: level-1, *], 3) $
+             +(profref-gdepw[level])*vol[*, *, level, *]
+         endcase
+      END
+      ELSE: return,  report('cas non code')
+   ENDCASE
+   varunit = 'cm'
+   varname = 'Dynamic Height (href='+strtrim(round(profref), 1)+'m)'
+   IF keyword_set(key_performance) THEN print, 'temps hdyn', systime(1)-tempsun 
+
+   return, hdyn
+end
Index: tags/start/CALCULS/level2depth.pro
===================================================================
--- tags/start/CALCULS/level2depth.pro	(revision 5)
+++ tags/start/CALCULS/level2depth.pro	(revision 5)
@@ -0,0 +1,77 @@
+;
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:level2depht
+;
+; PURPOSE: permet de passer d''un tableau 2d de niveau au
+; tableau 2d de profondeur correspondant a ces niveaux
+;
+; CATEGORY: SANS BOUCLE
+;
+; CALLING SEQUENCE: res=level2depth(niveau)
+;
+; INPUTS: niveau tableau 2d de niveaux seuil (ou une structure repondant
+; aux criteres de litchamp)
+;
+; KEYWORD PARAMETERS:
+;       /NOMASK: pour ne pas masquer les points terres
+;
+; OUTPUTS: un tableau 2d contenant des profondeurs
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       17/6/1999
+;                       14/6/2000 accepte !values.f_nan
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION level2depth, tab, NOMASK = nomask
+   tempsun = systime(1)         ; pour key_performance
+@common
+;------------------------------------------------------------
+; lecture du champ d''entree et recuperation de la taille du sous
+; domaine utilise
+;------------------------------------------------------------
+   niveaux = litchamp(tab)
+   grille,mask,glam,gphi,gdep,nx,ny,nz,premierx,premiery,premierz,dernierx,derniery,dernierz
+;---------------------------------------------------------------
+; verification de la coherence entre la taille du tableau et le domaine definit par domdef
+;---------------------------------------------------------------
+   taille = size(niveaux)
+   if taille[0] NE 2 then return, report('le champ en entree doit contenir un tableau 2d')
+   case 1 of
+      taille[1] eq jpi and taille[2] eq jpj:niveaux=niveaux[premierx:dernierx, premiery:derniery]
+      taille[1] eq  nx and taille[2] eq  ny:
+      else:return, report('Probleme d''adequation entre les tailles du domaine et celle du champ.')
+   endcase
+;---------------------------------------------------------------
+
+   wherenan = where(finite(niveaux, /nan) EQ 1)
+   if wherenan[0] NE -1 then niveaux[wherenan] = 0
+   niveaux = 0 > niveaux < (jpk-1)
+;---------------------------------------------------------------
+   gdep = replicate(1, nx*ny)#gdep
+   niveaux = lindgen(nx*ny)+(nx*ny)*niveaux
+   gdep = reform(gdep[niveaux], nx, ny)
+;
+   if wherenan[0] NE -1 then gdep[wherenan] = !values.f_nan
+   if NOT keyword_set(nomask) then begin
+      if n_elements(valmask) EQ 0 then valmask = 1e20
+      terre = where(mask[*, *, 0] EQ 0)
+      if terre[0] NE -1 then gdep[terre] = valmask
+   endif
+;
+   if keyword_set(key_performance) THEN print, 'temps level2depth', systime(1)-tempsun 
+   return, gdep
+end
Index: tags/start/CALCULS/level2index.pro
===================================================================
--- tags/start/CALCULS/level2index.pro	(revision 5)
+++ tags/start/CALCULS/level2index.pro	(revision 5)
@@ -0,0 +1,53 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:level2index
+;
+; PURPOSE: on veut ds une matrice 3d extraire un tableau 2d (x,y) dont
+; chacun des elements a ete extrait a un niveau specifie par le
+; tableau 2d level (typiquement, on veut obtenir la salinite le long
+; d''une isopycne que l''on a reperee par son niveau).
+; level2index est une fonction qui donne en fonction de level un
+; tableau 2d d'indice qui permettra d''extraire le tableau 2d du
+; tableau 3d...
+;
+; CATEGORY: SANS BOUCLE
+;
+; CALLING SEQUENCE: index=level2index(level)
+; 
+; INPUTS:level: un tableau 2d de niveaux
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS: untableau 2d d''indices
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      24/11/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION level2index, level
+; un elements de tableau 3d (dont les 2 premieres dimensions sont nx et
+; ny) dont les coordonnes sont i, j et k a pour indice ds le meme
+; tableau 3d  i + j*nx + k*(nx*ny)
+; level etant donne, pour chaque points de level on connait i, j et k,
+; on peut donc calculer l''indice.
+   taille = size(level)
+   nx = taille[1]
+   ny = taille[2]
+; tableau k*(nx*ny)
+   tabknxny = (nx*ny)*long(level)
+;
+;
+   return, lindgen(nx, ny)+tabknxny
+end
Index: tags/start/CALCULS/level2mask.pro
===================================================================
--- tags/start/CALCULS/level2mask.pro	(revision 5)
+++ tags/start/CALCULS/level2mask.pro	(revision 5)
@@ -0,0 +1,71 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:level2mask
+;
+; PURPOSE: permet de passer d''un tableau 2d de niveau seuil au
+; tableau 3d de mask avec des 1 ds les niveaux au dessus (et sur) du
+; niveau seuil et des 0 en dessous.
+;
+; CATEGORY: SANS BOUCLE
+;
+; CALLING SEQUENCE: res=level2mask(niveau)
+;
+; INPUTS: niveau tableau 2d de niveaux seuil (ou une structure repondant
+; aux criteres de litchamp)
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS: un tableau 3d contenant le mask associe au tableau 2d de
+; niveaux seuil
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       17/6/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION level2mask, tab
+;------------------------------------------------------------
+   tempsun = systime(1)         ; pour key_performance
+@common
+;------------------------------------------------------------
+; lecture du champ d''entree et recuperation de la taille du sous
+; domaine utilise
+;------------------------------------------------------------
+   niveaux = litchamp(tab)
+   grille,maskterre,glam,gphi,gdep,nx,ny,nz,premierx,premiery,premierz,dernierx,derniery,dernierz
+;---------------------------------------------------------------
+; verification de la coherence entre la taille du tableau et le domaine definit par domdef
+;---------------------------------------------------------------
+   IF ny EQ 1 THEN niveaux = reform(niveaux, nx, ny, /over)
+   taille = size(niveaux)
+   if taille[0] NE 2 then return, report('le champ en entree doit contenir un tableau 2d')
+   case 1 of
+      taille[1] eq jpi and taille[2] eq jpj:niveaux=niveaux[premierx:dernierx, premiery:derniery]
+      taille[1] eq  nx and taille[2] eq  ny:
+      else:return, report('Probleme d''adequation entre les tailles du domaine et celle du champ.')
+   endcase
+;------------------------------------------------------------
+;------------------------------------------------------------
+; on transforme le tableau 2d de niveaux en tableau 3d de mask
+;------------------------------------------------------------
+   mask = reform( niveaux[*]#(1./(indgen(nz)+1)), nx, ny, nz )
+   mask = floor(temporary(mask)) < 1
+   mask = temporary(mask)*temporary(maskterre)
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps level2mask', systime(1)-tempsun 
+   return, mask
+end
Index: tags/start/CALCULS/moyenne.pro
===================================================================
--- tags/start/CALCULS/moyenne.pro	(revision 5)
+++ tags/start/CALCULS/moyenne.pro	(revision 5)
@@ -0,0 +1,493 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: moyenne
+;
+; PURPOSE:  averages a 2- or 3-d field over a selected
+;           geographical area and along one ore more
+;	    selected axes (x, y or z)
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE: result = moyenne(tab,'direc',BOITE=boite)
+;
+; INPUTS:	tab = 2 or 3d field
+;		direc = 'x' 'y' 'z' 'xy' 'xz' 'yz' or 'xyz'
+;
+; KEYWORD PARAMETERS:
+;
+;		BOITE = [xmin,xmax,ymin,ymax (,(zmin,)zmax)] pour plus
+;		de detail cf domdef.
+;               boite peut prendre 5 formes: 
+;               [prof2], [prof1, prof2],[lon1, lon2, lat1, lat2],  
+;               [lon1, lon2, lat1, lat2, prof2],[lon1, lon2, lat1,
+;               lat2, prof1,prof2]
+;
+;               NAN: not a number, a activer si l''on peut faire veut
+;               faire une moyenne sans tenir compte de certaines
+;               valeurs masques de tab.
+;               si les valeurs masques de tab sont la valeur consacree
+;               par IDL (!values.f_nan), il suffit de mettre /NAN.
+;               si les valeurs masques de tab on pour valeur a (a doit
+;               etre differente de 1 (correspond a nan =
+;               !values.f_nan) et de 0 (qui desactive nan)
+;               il faut mettre NAN=a. 
+;               Rq: en sorties les points de result qui sont NAN
+;               auront pour valeur a ou !values.f_nan.
+;
+;               NODOMDEF: activer si l''on ne veut pas passer ds
+;               domdef bien que le mot cle boite soit present (comme
+;               c''est le cas qd moyenne est appelee via checkfield) 
+;            
+;               INTEGRATION: pour faire une integrale plutot qu''une moyenne
+;            
+; OUTPUTS:  result:un tableau 
+;
+; COMMON BLOCKS:
+;	common   domdef
+;
+; SIDE EFFECTS:met les valeurs correspondants a la terre a 1e20
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Jerome Vialard (jv@lodyc.jussieu.fr)
+;			2/7/98
+;                       Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       mise au propre de certains truc (les terres...)
+;                       14/8/98
+;                       15/1/98
+;                       11/3/99 adaptation pour NAN
+;                       28/7/99 moyennes tableaux 1d
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+; PLAN DU PROGRAMME:
+;------------------------------------------------------------
+;------------------------------------------------------------
+;I) preliminaires
+;   I.1) determination des directions de moyennes d''apres direc
+;   I.2) verification de la taille du tableau d''entree
+;   I.3) obtention des facteurs d''echelles et du masque sur le sous
+;   domaine concerne par la moyenne 
+;  ) moyennes pour les tableaux 1d (x,y)
+;II) moyennes pour les tableaux 2d (x,y)
+;   II.1) verification de la coherence de la taille du tableau a
+;   moyenner 
+;   II.2) differents types de moyennes possibles
+;III) moyennes pour les tableaux 3d (x,y,z)
+;   III.1) verification de la coherence de la taille du tableau a
+;   moyenner 
+;   III.2) differents types de moyennes possibles
+;IV ) finitions
+;   IV.1) on masque les terres par une valeur a 1e+20
+;   IV.2) on remplace, quand nan ne 1, !values.f_nan par nan
+;   IV.3) on revient au sous domaine initial.
+;------------------------------------------------------------
+;------------------------------------------------------------
+function moyenne ,tab,direc,BOITE=boite, INTEGRATION=integration $
+                  , NAN = nan, NODOMDEF = nodomdef, _extra = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;------------------------------------------------------------
+;I) preliminaires
+;------------------------------------------------------------
+   dirt = 0
+   dirx = 0
+   diry = 0
+   dirz = 0
+;------------------------------------------------------------
+; I.1) direction(s) suivants lesquelles on integre
+;------------------------------------------------------------
+   if ( strpos(direc,'t') ge 0 ) then dirt = 1
+   if ( strpos(direc,'x') ge 0 ) then dirx = 1
+   if ( strpos(direc,'y') ge 0 ) then diry = 1
+   if ( strpos(direc,'z') ge 0 ) then dirz = 1
+   if (dirx eq 0 and diry eq 0 and dirz eq 0) then BEGIN 
+      IF keyword_set(bavard) then $
+       IF dirt NE 1 THEN ras = report('MOYENNE: aucune valeur de direc ne convient, le champ reste inchange')
+      return, tab
+   ENDIF 
+;------------------------------------------------------------
+; I.2) verification de la taille du tableau d'entree
+;------------------------------------------------------------
+   taille = size(tab)
+   case 1 of
+      taille[0] eq 1 :dim = '1d'
+      taille[0] eq 2 :BEGIN
+         dim = '2d'
+         if dirx eq 0 and diry eq 0 then return, tab
+      END
+      taille[0] eq 3 :BEGIN
+         dim = '3d'
+         if dirx eq 0 and diry eq 0 and dirz eq 0 then return, tab
+      END
+      else : return, report('Le tableau d''entree doit etre a 2 ou 3 dimensions s''il contient une dim temporelle utiliser grossemoyenne')
+   endcase
+;------------------------------------------------------------
+;   I.3) obtention des facteurs d''echelles et du masque sur le sous
+;   domaine concerne par la moyenne 
+; redefinition du domaine ajuste a boite (a 6 elements)
+; ceci va nous permetre de faire les calcules que sur le sous domaine
+; comcerne par la moyenne. domdef, suivit de grille nous donne tous
+; les tableaux de la grille sur le sous domaine 
+;------------------------------------------------------------
+   if keyword_set(boite) then BEGIN 
+      Case 1 Of
+         N_Elements(Boite) Eq 1:bte=[lon1, lon2, lat1, lat2, 0.,boite[0]]
+         N_Elements(Boite) Eq 2:bte=[lon1, lon2, lat1, lat2, boite[0],boite[1]]
+         N_Elements(Boite) Eq 4:bte=[Boite, prof1, prof2]
+         N_Elements(Boite) Eq 5:bte=[Boite[0:3], 0, Boite[4]]
+         N_Elements(Boite) Eq 6:bte=Boite
+         Else: return, report('Mauvaise Definition de Boite')
+      endcase
+      oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+      if NOT keyword_set(nodomdef) then domdef, bte,GRILLE=vargrid, _extra = ex
+   ENDIF 
+;---------------------------------------------------------------
+; attribution du mask et des tableaux de longitude et latitude...
+;---------------------------------------------------------------
+   grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery, dernierz,e1,e2,e3
+;------------------------------------------------------------
+;------------------------------------------------------------
+; II) Cas du tableau 1d
+;------------------------------------------------------------
+;------------------------------------------------------------
+   if dim EQ '1d' then BEGIN
+      if n_elements(tab) NE nx*ny AND n_elements(tab) NE nx*ny*nz then $
+       return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+      case 1 of
+         nx EQ 1 AND ny EQ 1:BEGIN ;vecteur suivant z
+            case n_elements(tab) of
+               jpk:res = tab[premierz:dernierz]
+               nz:res = tab
+               ELSE:return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+            ENDCASE
+            if dirz EQ 1 then BEGIN 
+               dim = '3d' 
+               taille = size(reform(res, nx, ny, nz))
+            ENDIF ELSE return, res
+         END
+         ny EQ 1:BEGIN          ;vecteur suivant x
+            case n_elements(tab) of
+               jpi:res = tab[premierx:dernierx]
+               nx:res = tab
+               ELSE:return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+            ENDCASE
+            if dirx EQ 1 then BEGIN 
+               dim = '2d' 
+               taille = size(reform(res, nx, ny))
+            ENDIF ELSE return, res
+         END
+         nx EQ 1:BEGIN          ;vecteur suivant y
+            case n_elements(tab) of
+               jpj:res = tab[premiery:derniery]
+               ny:res = tab
+               ELSE:return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+            ENDCASE
+            if diry EQ 1 then BEGIN
+               dim = '2d'
+               taille = size(reform(res, nx, ny))
+            ENDIF ELSE return, res
+         END
+      endcase
+   endif
+;------------------------------------------------------------
+;------------------------------------------------------------
+; II) Cas du tableau 2d
+;------------------------------------------------------------
+;------------------------------------------------------------
+   if (dim eq '2d') then begin
+;---------------------------------------------------------------
+;   II.1) verification de la coherence de la taille du tableau a
+;   moyenner 
+; verification de la coherence entre la taille du tableau et le
+; domaine definit par domdef
+; le tableau en entree doit avoir soit la taille du domaine total
+; (jpi,jpj) soit celle du domaine reduit (nx,ny)
+;---------------------------------------------------------------
+      case 1 of
+         taille[1] eq jpi and taille[2] eq jpj: $
+          res = tab[premierx:dernierx, premiery:derniery]
+         taille[1] eq  nx and taille[2] eq  ny:res = tab
+         else:return, report('Probleme d''adequation entre les tailles du domaine nx*ny '+strtrim(nx, 1)+'*'+strtrim(ny, 1)+' et du tableau '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+      ENDCASE
+      if keyword_set(nan) NE 0 then BEGIN 
+         if nan NE 1 then BEGIN ; si nan n''est pas !values.f_nan 
+; on le met a !values.f_nan
+            if abs(nan) LT 1e6 then notanumber = where(res EQ nan) $
+            ELSE notanumber = where(abs(res) GT abs(nan)/10.)
+            if notanumber[0] NE -1 then res[temporary(notanumber)] = !values.f_nan
+         ENDIF
+      ENDIF
+;---------------------------------------------------------------
+; rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER = 1, ET
+; S'ASSURER QU'ELLE EXISTE BIEN. D'OU LES reform(...,nx,ny,...) QUI
+; PEUVENT SEMBLER INUTILE AU DEPART
+;---------------------------------------------------------------
+      if nx EQ 1 OR ny EQ 1 then BEGIN 
+         res = reform(res, nx, ny, /over)
+         mask =  reform(mask, nx, ny, nz, /over)
+         e1 =  reform(e1, nx, ny, /over)
+         e2 =  reform(e2, nx, ny, /over)
+      endif
+;---------------------------------------------------------------
+; II.3) differents types de moyennes
+;---------------------------------------------------------------
+      if nz eq jpk then mask = mask[*, *,niveau-1] ELSE mask = mask[*, *,nz-1]
+      if keyword_set(nan) NE 0 then begin
+         msknan = replicate(1., nx, ny)
+         notanumber = where(finite(res) EQ 0)
+         if notanumber[0] NE -1 then msknan[notanumber] = !values.f_nan
+      ENDIF ELSE msknan = 1
+      case 1 of
+         (dirx eq 1) and (diry eq 0) : begin
+            e = e1*mask
+            if keyword_set(integration) then divi=1 $
+            else begin 
+               divi = e*msknan
+               if ny EQ 1 then divi = reform(divi,nx,ny, /over)
+               divi = total(divi,1, nan = nan)
+            endelse
+            res = res*e
+            if ny EQ 1 then res = reform(res,nx,ny, /over)
+            res = total(res,1, nan = nan)/(divi > 1.)
+            if keyword_set(nan) then begin
+               testnan  = finite(msknan)+(1-mask)
+               if ny EQ 1 then testnan  = reform(testnan,nx,ny, /over)
+               testnan = total(testnan,1)
+            endif
+         end
+         (dirx eq 0) and (diry eq 1) : begin
+            e = e2*mask
+            if keyword_set(integration) then divi=1 $
+            else begin 
+               divi = e*msknan
+               if ny EQ 1 then divi = reform(divi,nx,ny, /over)
+               divi = total(divi,2, nan = nan)
+            endelse
+            res = res*e
+            if ny EQ 1 then res = reform(res,nx,ny, /over)
+            res = total(res,2, nan = nan)/(divi > 1.)
+            if keyword_set(nan) then begin
+               testnan  = finite(msknan)+(1-mask)
+               if ny EQ 1 then testnan  = reform(testnan,nx,ny, /over)
+               testnan = total(testnan,2)
+            endif
+         end
+         (dirx eq 1) and (diry eq 1) : begin
+            if keyword_set(integration) then divi=1 else divi = total(e1*e2*mask*msknan, nan = nan)
+            res = total(res*e1*e2*mask, nan = nan)/(divi > 1.)
+            if keyword_set(nan) then begin
+               testnan  = finite(msknan)+(1-mask)
+               testnan = total(testnan)
+            endif
+         end
+      endcase
+   endif
+;------------------------------------------------------------
+;------------------------------------------------------------
+; III) Cas du tableau 3d
+;------------------------------------------------------------
+;------------------------------------------------------------
+   if (dim eq '3d') then begin
+;---------------------------------------------------------------
+; III.1) verification de la coherence de la taille du tableau a
+; moyenner 
+; verification de la coherence entre la taille du tableau et le
+; domaine definit par domdef 
+; le tableau en entree doit avoir soit la taille du domaine total
+; (jpi,jpj,jpk) soit celle du domaine reduit (nx,ny,ny)
+;---------------------------------------------------------------
+      case 1 of
+         taille[1] eq jpi and taille[2] eq jpj and taille[3] eq jpk: $
+          res=tab[premierx:dernierx, premiery:derniery, premierz:dernierz]
+         taille[1] eq jpi and taille[2] eq jpj and taille[3] eq nz: $
+          res=tab[premierx:dernierx, premiery:derniery, *]
+         taille[1] EQ  nx and taille[2] eq  ny and taille[3] eq nz :res=tab
+         taille[1] EQ  nx and taille[2] eq  ny and taille[3] eq jpk : $
+          res=tab[*, *, premierz:dernierz]
+         else:return, report('Probleme d''adequation entre les tailles du domaine nx*ny*nz '+strtrim(nx, 1)+'*'+strtrim(ny, 1)+'*'+strtrim(nz, 1)+' et du tableau '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+      endcase
+      if keyword_set(nan) NE 0 then BEGIN 
+         if nan NE 1 then BEGIN ; si nan n''est pas !values.f_nan 
+; on le met a !values.f_nan
+            if abs(nan) LT 1e6 then notanumber = where(res EQ nan) $
+            ELSE notanumber = where(abs(res) GT abs(nan)/10.)
+            if notanumber[0] NE -1 then res[temporary(notanumber)] = !values.f_nan
+         ENDIF
+      ENDIF
+;---------------------------------------------------------------
+; rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER = 1, ET
+; S'ASSURER QU'ELLE EXISTE BIEN. D'OU LES reform(...,nx,ny,...) QUI
+; PEUVENT SEMBLER INUTILE AU DEPART
+;---------------------------------------------------------------
+      if nx EQ 1 OR ny EQ 1 OR nz EQ 1 then BEGIN 
+         res = reform(res, nx, ny, nz, /over)
+         mask =  reform(mask, nx, ny, nz, /over)
+         e1 =  reform(e1, nx, ny, /over)
+         e2 =  reform(e2, nx, ny, /over)
+      endif
+;---------------------------------------------------------------
+; III.2) differents types de moyennes
+;---------------------------------------------------------------
+      if keyword_set(nan) NE 0 then begin
+         msknan = replicate(1., nx, ny, nz)
+         notanumber = where(finite(res) EQ 0)
+         if notanumber[0] NE -1 then msknan[notanumber] = !values.f_nan
+      ENDIF ELSE msknan = 1
+      case 1 of
+         (dirx eq 1) and (diry eq 0) and (dirz eq 0) : begin
+            e13 = e1[*]#replicate(1.,nz)
+            e13 = reform(e13,nx,ny,nz, /over)
+            if keyword_set(integration) then divi = 1 else begin
+               divi = e13*mask*msknan
+               if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
+               divi = total(divi,1, nan = nan)
+            endelse
+            res = res*e13*mask
+            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
+            res = total(res,1, nan = nan)/(divi > 1.)
+            e13 = 1
+            if keyword_set(nan) then begin
+               testnan  = finite(msknan)+(1-mask)
+               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
+               testnan = total(testnan,1)
+            endif
+         end
+         (dirx eq 0) and (diry eq 1) and (dirz eq 0) : begin
+            e23 = e2[*]#replicate(1.,nz)
+            e23 = reform(e23,nx,ny,nz, /over)
+            if keyword_set(integration) then divi =1 else begin
+               divi = e23*mask*msknan
+               if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
+               divi = total(divi,2, nan = nan)
+            endelse
+            res = res*e23*mask
+            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
+            res = total(res,2, nan = nan)/(divi > 1.)
+            e23 = 1
+            if keyword_set(nan) then begin
+               testnan  = finite(msknan)+(1-mask)
+               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
+               testnan = total(testnan,2)
+            endif
+         end
+         (dirx eq 0) and (diry eq 0) and (dirz eq 1) : begin
+            e33 = replicate(1,1.*nx*ny)#e3
+            e33 = reform(e33,nx,ny,nz, /over)
+            if keyword_set(integration) then divi =1 else begin
+               divi = e33*mask*msknan
+               if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
+               divi = total(divi,3, nan = nan)
+            endelse
+            res = res*e33*mask
+            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
+            res = total(res,3, nan = nan)/(divi > 1.)
+            e33 = 1
+            if keyword_set(nan) then begin
+               testnan  = finite(msknan)+(1-mask)
+               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
+               testnan = total(testnan,3)
+            endif
+         end
+         (dirx eq 1) and (diry eq 1) and (dirz eq 0) : begin
+            e123 = (e1*e2)[*]#replicate(1.,nz)
+            e123 = reform(e123,nx,ny,nz, /over)
+            if keyword_set(integration) then divi =1 else $
+             divi = e123*mask*msknan
+            if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
+            divi = total(total(divi,1, nan = nan),1, nan = nan)
+            res = res*e123*mask
+            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
+            res = total(total(res,1, nan = nan),1, nan = nan) / (divi > 1.)
+            e123 = 1
+            if keyword_set(nan) then begin
+               testnan  = finite(msknan)+(1-mask)
+               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
+               testnan = total(total(testnan,1),1)
+            endif
+         end
+         (dirx eq 1) and (diry eq 0) and (dirz eq 1) : begin
+            e133 = e1[*]#e3
+            e133 = reform(e133,nx,ny,nz, /over)
+            divi = e133*mask*msknan
+            if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
+            if keyword_set(integration) then divi =1 else $
+             divi = total(total(divi,1, nan = nan),2, nan = nan)
+            res = res*e133*mask
+            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
+            res = total(total(res,1, nan = nan),2, nan = nan) / (divi > 1.)
+            e133 = 1
+            if keyword_set(nan) then begin
+               testnan  = finite(msknan)+(1-mask)
+               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
+               testnan = total(total(testnan,1),2)
+            endif
+         end
+         (dirx eq 0) and (diry eq 1) and (dirz eq 1) : begin
+            e233 = e2[*]#e3
+            e233 = reform(e233,nx,ny,nz, /over)
+            divi = e233*mask*msknan
+            if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
+            if keyword_set(integration) then divi =1 else $
+             divi = total(total(divi,2, nan = nan),2, nan = nan)
+            res = res*e233*mask
+            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
+            res = total(total(res,2, nan = nan),2, nan = nan) / (divi > 1.)
+            e233 = 1
+            if keyword_set(nan) then begin
+               testnan  = finite(msknan)+(1-mask)
+               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
+               testnan = total(total(testnan,2),2)
+            endif
+         end
+         (dirx eq 1) and (diry eq 1) and (dirz eq 1) : begin
+            e1233 = (e1*e2)[*]#e3
+            e1233 = reform(e1233,nx,ny,nz, /over)
+            if keyword_set(integration) then divi =1 else divi = total(e1233*mask*msknan, nan = nan)
+            res = total(res*e1233*mask, nan = nan) / (divi > 1.)
+            e1233 = 1
+            if keyword_set(nan) then begin
+               testnan  = finite(msknan)+(1-mask)
+               testnan = total(testnan)
+            endif
+         end
+      endcase
+   endif
+;------------------------------------------------------------
+;------------------------------------------------------------
+;IV ) finitions
+;------------------------------------------------------------
+;------------------------------------------------------------
+; IV.1) on masque les terres par une valeur a 1e+20
+;------------------------------------------------------------
+   valmask = 1e+20
+   terre = where(divi EQ 0)
+   IF terre[0] NE -1 THEN BEGIN
+      res(terre) = 1e+20
+   ENDIF  
+;------------------------------------------------------------
+; IV.2) on remplace, quand nan ne 1, !values.f_nan par nan
+;------------------------------------------------------------
+   if keyword_set(nan) NE 0 then BEGIN 
+      puttonan = where(testnan EQ 0)
+      if puttonan[0] NE -1 then res[puttonan] = !values.f_nan
+      if nan NE 1 then BEGIN 
+         notanumber = where(finite(res) eq 0)
+         if notanumber[0] NE -1 then res[notanumber] = nan
+      ENDIF
+   ENDIF
+;------------------------------------------------------------
+; IV.3) on se remplace ds le sous domaine qui etait definit a l''entree de
+; moyenne 
+;------------------------------------------------------------
+   if keyword_set(boite) AND NOT keyword_set(nodomdef) then domdef, oldboite,GRILLE=vargrid
+;------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps moyenne', systime(1)-tempsun 
+   return, res
+;------------------------------------------------------------
+;------------------------------------------------------------
+end
Index: tags/start/CALCULS/norme.pro
===================================================================
--- tags/start/CALCULS/norme.pro	(revision 5)
+++ tags/start/CALCULS/norme.pro	(revision 5)
@@ -0,0 +1,431 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:norme
+;
+; PURPOSE: calcule la norme d''un champ de vecteurs, puis fait une
+; moyenne eventuelle.
+;          Rq1: le champ de vecteur peut etre, 2d:xy, 3d: xyz ou xyt,
+;          4d: xyzt
+;          Rq2: le calcul de la norme est fait avant l''eventuelle
+;          moyenne spatiale ou temporelle car la moyenne de la norme
+;          n''est pas egale a la norme des moyennes.
+;
+; CATEGORY: calcul de post traitement
+;
+; CALLING SEQUENCE:res=norme(champ_de_vecteurs)
+;
+; INPUTS:un tableau 2d, 3d ou 4d
+;
+; KEYWORD PARAMETERS:
+;
+;       BOITE: boite sur laquelle moyenner (par defaut le domaine
+;       selectionner par le dernier domdef effectue)
+;
+;       DIREC:'t' 'x' 'y' 'z' 'xy' 'xz' 'yz' 'xyz' 'xt' 'yt' 'zt' 'xyt'
+;       'xzt' 'yzt' 'xyzt' directions selon lesquelles effectuer les
+;       moyennes 
+;
+; OUTPUTS:tableau a tracer avec plt, pltz ou pltt.
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+;      La norme est calculee aux points T. Pour faire ce calcul, on
+;      moyenne les champs U et V aux points T avant de calculer la norme.
+;      Au bord des cotes et du domaine, on ne peut pas calculer les
+;      champs U et V aux points T, ces points sont donc a la valeur
+;      !values.f_nan. 
+; 
+;      lorsqu''on fait le calcul sur un domaine geographique reduit,
+;      les champs U et V ne comprennent pas forcement le meme nombre
+;      de points. Dans ce cas on redecoupe U et V pour ne garder que
+;      les points en commun. Au passage on refait un domdef qui
+;      redefinit un domaine geographique sur lequel les champs U et V
+;      sont extraits sur les meme points.
+;
+; RESTRICTIONS:
+;
+;      pour savoir a quel type de tableau on a a faire, on teste la
+;      taille de celui-ci et les dates donnees par time[0] et
+;      time[jpt-1] pour savoir si il y a une dimension
+;      temporelle. Avant de lancer norme s''assurer que time et jpt
+;      sont bien definis comme il faut! 
+;
+; EXAMPLE:
+;
+;     pour calculer la moyenne de la norme des courants sur tout le
+;     dommaine entre 0 et 50:
+;      IDL> res=norme(un,vn,boite=[0,50],dir='xyz')
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       9/6/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION norme,composanteu, composantev, BOITE=boite,DIREC=direc
+@common
+   tempsun = systime(1)         ; pour key_performance
+;------------------------------------------------------------
+   if NOT keyword_set(direc) then direc = 0
+; construction de u et v aux pts T
+   u = litchamp(composanteu)
+   v = litchamp(composantev)
+   date1 = time[0]
+   if n_elements(jpt) EQ 0 then date2 = date1 ELSE date2 = time[jpt-1]
+
+   if (size(u))[0] NE (size(v))[0] then return,  -1
+
+   vargrid='T'
+   varname = 'norme '
+   valmask = 1e20
+;
+   grilleu = litchamp(composanteu, /grid)
+   if grilleu EQ '' then grilleu = 'U'
+   grillev = litchamp(composantev, /grid)
+   if grillev EQ '' then grillev = 'V'
+   IF grilleu EQ 'V' AND grillev EQ 'U' THEN inverse = 1
+   IF grilleu EQ 'T' AND grillev EQ 'T' THEN BEGIN 
+      interpolle  = 0 
+      return, report('cas non code mais facile a faire!')
+   ENDIF ELSE interpolle = 1
+   if keyword_set(inverse) then begin
+      rien = u
+      u = v
+      v = rien
+   endif
+
+
+;------------------------------------------------------------
+; on trouve les points que u et v ont en communs
+;------------------------------------------------------------
+   indicexu = (lindgen(jpi))[premierxu:premierxu+nxu-1]
+   indicexv = (lindgen(jpi))[premierxv:premierxv+nxv-1]
+   indicex = inter(indicexu, indicexv)
+   indiceyu = (lindgen(jpj))[premieryu:premieryu+nyu-1]
+   indiceyv = (lindgen(jpj))[premieryv:premieryv+nyv-1]
+   indicey = inter(indiceyu, indiceyv)
+   nx = n_elements(indicex) 
+   ny = n_elements(indicey)
+;----------------------------------------------------------------------------
+   case 1 of
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xyz
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+      (size(u))[0] EQ 3 AND date1 EQ date2 :BEGIN 
+;----------------------------------------------------------------------------
+         indice2d = lindgen(jpi, jpj)
+         indice2d = indice2d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1]
+         indice3d = lindgen(jpi, jpj, jpk)
+         indice3d = indice3d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1,premierzt:dernierzt]
+;------------------------------------------------------------
+; extraction de u et v sur le domaine qui convient
+;------------------------------------------------------------
+         case 1 of
+            (size(u))[1] EQ nxu AND (size(u))[2] EQ nyu AND $
+             (size(v))[1] EQ nxv AND (size(v))[2] EQ nyv:BEGIN 
+               case (size(u))[3] OF
+                  nzt:BEGIN 
+                     if nxu NE nx then $
+                      if indicex[0] EQ premierxu then u = u[0:nx-1,*,*] ELSE u = u[1: nx, *,*] 
+                     IF nxv NE nx THEN $
+                      if indicex[0] EQ premierxv then v = v[0:nx-1,*,*] ELSE v = v[1: nx, *,*]
+                     IF nyu NE ny THEN $
+                      if indicey[0] EQ premieryu then u = u[*,0:ny-1,*] ELSE u = u[*, 1: ny,*] 
+                     IF nyv NE ny THEN $
+                      if indicey[0] EQ premieryv then v = v[*,0:ny-1,*] ELSE v = v[*, 1: ny,*]
+                  end
+                  jpk:BEGIN 
+                     if nxu NE nx then $
+                      if indicex[0] EQ premierxu then u = u[0:nx-1, *,premierzt:dernierzt] ELSE u = u[1: nx, *,premierzt:dernierzt] 
+                     IF nxv NE nx THEN $
+                      if indicex[0] EQ premierxv then v = v[0:nx-1, *,premierzt:dernierzt] ELSE v = v[1: nx, *,premierzt:dernierzt]
+                     IF nyu NE ny THEN $
+                      if indicey[0] EQ premieryu then u = u[*, 0:ny-1,premierzt:dernierzt] ELSE u = u[*, 1: ny,premierzt:dernierzt] 
+                     IF nyv NE ny THEN $
+                      if indicey[0] EQ premieryv then v = v[*, 0:ny-1,premierzt:dernierzt] ELSE v = v[*, 1: ny,premierzt:dernierzt]
+                  end
+                  ELSE: return, report('problemes d''adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs')
+               endcase
+            END
+            (size(u))[1] EQ jpi AND (size(u))[2] EQ jpj AND (size(u))[3] EQ jpk AND $
+             (size(v))[1] EQ jpi AND (size(v))[2] EQ jpj AND (size(u))[3] EQ jpk :BEGIN 
+               u = u[indice3d]
+               v = v[indice3d]
+            END
+            ELSE: return, report('problemes d''adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs')
+         endcase
+;------------------------------------------------------------------
+; on reform u et v pour s'assurer qu'aucune dimension n'a ete ecrasee
+;------------------------------------------------------------------
+         if nzt EQ 1 then begin
+            u = reform(u, nx, ny, nzt, /over)
+            v = reform(v, nx, ny, nzt, /over)
+         endif
+;------------------------------------------------------------------
+; construction de u et v aux pts T
+;-----------------------------------------------------------
+         a=u(0,*,*)
+         u=(u+shift(u,1,0,0))/2.
+         if NOT keyword_set(key_periodique) OR nx NE jpi then u(0,*,*)=a
+         a=v(*,0,*)
+         v=(v+shift(v,0,1,0))/2.
+         if NOT keyword_set(key_periodique) OR nx NE jpi then v(*,0,*)=a
+;----------------------------------------------------------------------------
+; attribution du mask et des tableau de longitude et latitude
+;----------------------------------------------------------------------------
+         mask = tmask[indice3d]
+         if nzt EQ 1 then mask = reform(mask, nx, ny, nzt, /over)
+;-----------------------------------------------------------
+         if n_elements(valmask) EQ 0 THEN valmask = 1e20
+         landu = where(u GE valmask/10)
+         if landu[0] NE -1 then u[landu] = 0
+         landv = where(v GE valmask/10)
+         if landv[0] NE -1 then v[landv] = 0
+         res=sqrt(u^2+v^2)
+         if NOT keyword_set(key_periodique) OR nx NE jpi then res(0,*, *)=!values.f_nan
+         res(*,0, *)=!values.f_nan
+         mask = where(mask eq 0)
+         IF mask[0] NE -1 THEN res(mask) = valmask
+; moyennes en tous genres
+         oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+         domdef, (glamt[indice2d])[0, 0], (glamu[indice2d])[nx-1, 0],(gphit[indice2d])[0, 0], (gphiv[indice2d])[0, ny-1], prof1, prof2, /meme
+         if keyword_set(direc) then res = moyenne(res,direc,/nan, boite = boite)
+;-----------------------------------------------------------
+      END
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xyt
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+      date1 NE date2 AND (size(u))[0] EQ 3 :BEGIN 
+         indice2d = lindgen(jpi, jpj)
+         indice2d = indice2d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1]
+;------------------------------------------------------------
+; extraction de u et v sur le domaine qui convient
+;------------------------------------------------------------
+         case 1 of
+            (size(u))[1] EQ nxu AND (size(u))[2] EQ nyu AND $
+             (size(v))[1] EQ nxv AND (size(v))[2] EQ nyv:BEGIN 
+               if nxu NE nx then $
+                if indicex[0] EQ premierxu then u = u[0:nx-1, *, *] ELSE u = u[1: nx, *, *] 
+               IF nxv NE nx THEN $
+                if indicex[0] EQ premierxv then v = v[0:nx-1, *, *] ELSE v = v[1: nx, *, *]
+               IF nyu NE ny THEN $
+                if indicey[0] EQ premieryu then u = u[*, 0:ny-1, *] ELSE u = u[*, 1: ny, *] 
+               IF nyv NE ny THEN $
+                if indicey[0] EQ premieryv then v = v[*, 0:ny-1, *] ELSE v = v[*, 1: ny, *]
+            END
+            (size(u))[1] EQ jpi AND (size(u))[2] EQ jpj AND $
+             (size(v))[1] EQ jpi AND (size(v))[2] EQ jpj:BEGIN 
+               u = u[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, *]
+               v = v[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1, *]
+            END
+            ELSE:return, report('problemes d''adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs')
+         endcase
+;------------------------------------------------------------------
+; construction de u et v aux pts T
+;-----------------------------------------------------------
+         a=u(0,*,*)
+         u=(u+shift(u,1,0,0))/2.
+         if NOT keyword_set(key_periodique) OR nx NE jpi then u(0,*,*)=a
+         a=v(*,0,*)
+         v=(v+shift(v,0,1,0))/2.
+         if NOT keyword_set(key_periodique) OR nx NE jpi then v(*,0,*)=a
+;----------------------------------------------------------------------------
+; attribution du mask et des tableau de longitude et latitude
+; on recupere la grille complette pour etablir un grand mask etendu ds les 4
+; directions pour couvrir les points pour lesquels un pt terre a ete pris en
+; compte (faire un petit dessin...)
+;----------------------------------------------------------------------------
+         mask = tmask[indice2d+jpi*jpj*(niveau-1)]
+         if ny EQ 1 then mask = reform(mask, nx, ny, /over)
+;-----------------------------------------------------------
+; construction de terre qui contient tous les point a masquer
+;-----------------------------------------------------------
+         if n_elements(valmask) EQ 0 THEN valmask = 1e20
+         landu = where(u GE valmask/10)
+         if landu[0] NE -1 then u[landu] = 0
+         landv = where(v GE valmask/10)
+         if landv[0] NE -1 then v[landv] = 0
+         res=sqrt(u^2+v^2)
+         if NOT keyword_set(key_periodique) OR nx NE jpi then res(0,*, *)=!values.f_nan
+         res(*,0, *)=!values.f_nan
+         mask = where(mask eq 0)
+         IF mask[0] NE -1 THEN BEGIN 
+            coeftps = lindgen(jpt)*nx*ny
+            coeftps = replicate(1, n_elements(mask))#coeftps
+            mask = (temporary(mask))[*]#replicate(1, jpt)
+            mask =temporary(mask[*]) + temporary(coeftps[*])
+            res(temporary(mask)) = valmask
+         ENDIF
+; moyennes en tous genres
+         domdef, (glamt[indice2d])[0, 0], (glamu[indice2d])[nx-1, 0],(gphit[indice2d])[0, 0], (gphiv[indice2d])[0, ny-1], prof1, prof2, /meme
+         if keyword_set(direc) then res = grossemoyenne(res,direc,/nan, boite = boite)
+      END
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xyzt
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+      date1 NE date2 AND (size(u))[0] EQ 4:BEGIN 
+         indice2d = lindgen(jpi, jpj)
+         indice2d = indice2d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1]
+         indice3d = lindgen(jpi, jpj, jpk)
+         indice3d = indice3d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1,premierzt:dernierzt]
+;------------------------------------------------------------
+; extraction de u et v sur le domaine qui convient
+;------------------------------------------------------------
+         case 1 of
+            (size(u))[1] EQ nxu AND (size(u))[2] EQ nyu AND $
+             (size(v))[1] EQ nxv AND (size(v))[2] EQ nyv:BEGIN 
+               case (size(u))[3] OF
+                  nzt:BEGIN 
+                     if nxu NE nx then $
+                      if indicex[0] EQ premierxu then u = u[0:nx-1,*,*,*] ELSE u = u[1: nx, *,*,*] 
+                     IF nxv NE nx THEN $
+                      if indicex[0] EQ premierxv then v = v[0:nx-1,*,*,*] ELSE v = v[1: nx, *,*,*]
+                     IF nyu NE ny THEN $
+                      if indicey[0] EQ premieryu then u = u[*,0:ny-1,*,*] ELSE u = u[*, 1: ny,*,*] 
+                     IF nyv NE ny THEN $
+                      if indicey[0] EQ premieryv then v = v[*,0:ny-1,*,*] ELSE v = v[*, 1: ny,*,*]
+                  end
+                  jpk:BEGIN 
+                     if nxu NE nx then $
+                      if indicex[0] EQ premierxu then u = u[0:nx-1, *,premierzt:dernierzt,*] ELSE u = u[1: nx, *,premierzt:dernierzt,*] 
+                     IF nxv NE nx THEN $
+                      if indicex[0] EQ premierxv then v = v[0:nx-1, *,premierzt:dernierzt,*] ELSE v = v[1: nx, *,premierzt:dernierzt,*]
+                     IF nyu NE ny THEN $
+                      if indicey[0] EQ premieryu then u = u[*, 0:ny-1,premierzt:dernierzt,*] ELSE u = u[*, 1: ny,premierzt:dernierzt,*] 
+                     IF nyv NE ny THEN $
+                      if indicey[0] EQ premieryv then v = v[*, 0:ny-1,premierzt:dernierzt,*] ELSE v = v[*, 1: ny,premierzt:dernierzt,*]
+                  end
+                  ELSE: return, report('problemes d''adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs')
+               endcase
+            END
+            (size(u))[1] EQ jpi AND (size(u))[2] EQ jpj AND (size(u))[3] EQ jpk AND $
+             (size(v))[1] EQ jpi AND (size(v))[2] EQ jpj AND (size(u))[3] EQ jpk :BEGIN 
+               u = u[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1,premierzt:dernierzt, *]
+               v = v[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1,premierzt:dernierzt, *]
+            END
+            ELSE: return, report('problemes d''adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs')
+         endcase
+;------------------------------------------------------------------
+; construction de u et v aux pts T
+;-----------------------------------------------------------
+         a=u(0,*,*,*)
+         u=(u+shift(u,1,0,0,0))/2.
+         if NOT keyword_set(key_periodique) OR nx NE jpi then u(0,*,*,*)=a
+         a=v(*,0,*,*)
+         v=(v+shift(v,0,1,0,0))/2.
+         if NOT keyword_set(key_periodique) OR nx NE jpi then v(*,0,*,*)=a
+;----------------------------------------------------------------------------
+; attribution du mask et des tableau de longitude et latitude
+;----------------------------------------------------------------------------
+         mask = tmask[indice3d]
+         if nzt EQ 1 then mask = reform(mask, nx, ny, nzt, /over)
+;-----------------------------------------------------------
+         if n_elements(valmask) EQ 0 THEN valmask = 1e20
+         landu = where(u GE valmask/10)
+         if landu[0] NE -1 then u[landu] = 0
+         landv = where(v GE valmask/10)
+         if landv[0] NE -1 then v[landv] = 0
+         res=sqrt(u^2+v^2)
+         if NOT keyword_set(key_periodique) OR nx NE jpi then res(0,*, *, *)=!values.f_nan
+         res(*,0, *, *)=!values.f_nan
+         mask = where(mask eq 0)
+         IF mask[0] NE -1 THEN BEGIN 
+            coeftps = lindgen(jpt)*nx*ny*nzt
+            coeftps = replicate(1, n_elements(mask))#coeftps
+            mask = (temporary(mask))[*]#replicate(1, jpt)
+            mask =temporary(mask[*]) + temporary(coeftps[*])
+            res(temporary(mask)) = valmask
+         ENDIF
+; moyennes en tous genres
+         domdef, (glamt[indice2d])[0, 0], (glamu[indice2d])[nx-1, 0],(gphit[indice2d])[0, 0], (gphiv[indice2d])[0, ny-1], prof1, prof2, /meme
+         if keyword_set(direc) then res = grossemoyenne(res,direc,/nan, boite = boite)
+      END
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+;xy
+;----------------------------------------------------------------------------
+;----------------------------------------------------------------------------
+      ELSE:BEGIN                ;xy
+         indice2d = lindgen(jpi, jpj)
+         indice2d = indice2d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1]
+;------------------------------------------------------------
+; extraction de u et v sur le domaine qui convient
+;------------------------------------------------------------
+         case 1 of
+            (size(u))[1] EQ nxu AND (size(u))[2] EQ nyu AND $
+             (size(v))[1] EQ nxv AND (size(v))[2] EQ nyv:BEGIN 
+               if nxu NE nx then $
+                if indicex[0] EQ premierxu then u = u[0:nx-1, *] ELSE u = u[1: nx, *] 
+               IF nxv NE nx THEN $
+                if indicex[0] EQ premierxv then v = v[0:nx-1, *] ELSE v = v[1: nx, *]
+               IF nyu NE ny THEN $
+                if indicey[0] EQ premieryu then u = u[*, 0:ny-1] ELSE u = u[*, 1: ny] 
+               IF nyv NE ny THEN $
+                if indicey[0] EQ premieryv then v = v[*, 0:ny-1] ELSE v = v[*, 1: ny]
+            END
+            (size(u))[1] EQ jpi AND (size(u))[2] EQ jpj AND $
+             (size(v))[1] EQ jpi AND (size(v))[2] EQ jpj:BEGIN 
+               u = u[indice2d]
+               v = v[indice2d]
+            END
+            ELSE:return, report('problemes d''adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs')
+         endcase
+;------------------------------------------------------------------
+; on reform u et v pour s'assurer qu'aucune dimension n'a ete ecrasee
+;------------------------------------------------------------------
+         if ny EQ 1 then begin
+            u = reform(u, nx, ny, /over)
+            v = reform(v, nx, ny, /over)
+         endif
+;------------------------------------------------------------------
+; construction de u et v aux pts T
+;-----------------------------------------------------------
+         a=u(0,*)
+         u=(u+shift(u,1,0))/2.
+         if NOT keyword_set(key_periodique) OR nx NE jpi then u(0,*)=a
+         a=v(*,0)
+         v=(v+shift(v,0,1))/2.
+         if NOT keyword_set(key_periodique) OR nx NE jpi then v(*,0)=a
+;----------------------------------------------------------------------------
+; attribution du mask et des tableau de longitude et latitude
+; on recupere la grille complette pour etablir un grand mask etendu ds les 4
+; directions pour couvrir les points pour lesquels un pt terre a ete pris en
+; compte (faire un petit dessin...)
+;----------------------------------------------------------------------------
+         mask = tmask[indice2d+jpi*jpj*(niveau-1)]
+         if nyt EQ 1 THEN mask = reform(mask, nx, ny, /over)
+;-----------------------------------------------------------
+; construction de terre qui contient tous les point a masquer
+;-----------------------------------------------------------
+         if n_elements(valmask) EQ 0 THEN valmask = 1e20
+         landu = where(u GE valmask/10)
+         if landu[0] NE -1 then u[landu] = 0
+         landv = where(v GE valmask/10)
+         if landv[0] NE -1 then v[landv] = 0
+         res=sqrt(u^2+v^2)
+         if NOT keyword_set(key_periodique) OR nx NE jpi then res(0,*)=!values.f_nan
+         res(*,0)=!values.f_nan
+         mask = where(mask eq 0)
+         IF mask[0] NE -1 THEN res(mask) = valmask
+; moyennes en tous genres
+         oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+         domdef, (glamt[indice2d])[0, 0], (glamu[indice2d])[nx-1, 0],(gphit[indice2d])[0, 0], (gphiv[indice2d])[0, ny-1], prof1, prof2, /meme
+         if keyword_set(direc) then res = moyenne(res,direc,/nan, boite = boite)
+      END
+;----------------------------------------------------------------------------
+   endcase
+;------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps norme', systime(1)-tempsun 
+   return, res
+end
Index: tags/start/CALCULS/projectondepth.pro
===================================================================
--- tags/start/CALCULS/projectondepth.pro	(revision 5)
+++ tags/start/CALCULS/projectondepth.pro	(revision 5)
@@ -0,0 +1,109 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:projectondepth
+;
+; PURPOSE: routine permettant de projeter un champ 3d suivant un
+; tableau de profondeurs.
+;
+; CATEGORY: sans boucles
+;
+; CALLING SEQUENCE:res=projectondepth(arrayin, depthin)
+; 
+; INPUTS:
+;       arrayin: un tableau 3d dont la 3eme dimension doit etre egale
+;       a jpk
+;       depthin: un tableau 2d indiquant n chaque point a quel
+;       profondeur projeter
+;       
+; KEYWORD PARAMETERS:none
+;
+; OUTPUTS:res: un tableau 2d projection du tableau 3d suivant les
+; profondeurs indiquees par depthin
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS: points a !values.f_nan qd calcul impossible. points
+; terres masques a Valmask.
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; on contruit un tableau de profondeurs possibles
+;   IDL> a=gdept[jpk-1]/(1.*jpi*jpj)*findgen(jpi,jpj)
+; on contruit un tableau a projeter sur ces profondeurs. pour le test
+; on construit un tableau 3d dont chaque vecteur suivant z est la
+; profondeur. 
+;   IDL> arraytest=replicate(1,jpi*jpj)#gdept
+;   IDL> arraytest=reform(arraytest,jpi,jpj,jpk, /over)
+; on test la projection du tabeau profondeur sur la profondeur...
+;   IDL> plt, 1e6*(a-projectondepth(arraytest,a)),/nocontour
+;   ->champ nul a 1e-6 pres
+; 
+;  verifcation en projettant la temperature sur la profondeur de la 2o
+;  degres par exemple...
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      15/6/2000
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION projectondepth, arrayin, depthin
+   tempsun = systime(1)         ; pour key_performance
+@common
+;------------------------------------------------------------
+   depth = litchamp(depthin)
+   array = litchamp(arrayin)
+; petites verifications
+   tailledepth = size(depth)
+   taillearray = size(array)
+   if tailledepth[0] NE 2 THEN return, report('Depth array must have 2 dimensions')
+   if taillearray[0] NE 3 THEN return, report('Array in must have 3 dimensions')
+; verification de la coherence entre la taille du tableau et le
+; domaine 
+   grille,mask,glam,gphi,gdep,nx,ny,nz,premierx,premiery,premierz,dernierx,derniery,dernierz
+   case 1 of
+      tailledepth[1] eq jpi and tailledepth[2] eq jpj:depth=depth[premierx:dernierx, premiery:derniery]
+      tailledepth[1] eq  nx and tailledepth[2] eq  ny:
+      else:return, report('Probleme d''adequation entre les tailles du domaine et celle du tableau de profondeur')
+   endcase
+   case 1 OF
+      taillearray[3] NE jpk:return, report('Le tableau 3d doit avoir sa 3eme dimension egale a jpk')
+      taillearray[1] eq jpi and taillearray[2] eq jpj:array=array[premierx:dernierx, premiery:derniery, *]
+      taillearray[1] eq  nx and taillearray[2] eq  ny:
+      else:return, report('Probleme d''adequation entre les tailles du domaine et celle du tableau de profondeur')
+   endcase
+;
+; c''est parti
+;
+   flevel = depth2floatlevel(depth)
+; on vire les points a !values.f_nan
+   notanumber = where(finite(flevel, /nan) EQ 1)
+   if notanumber[0] NE -1 then flevel[notanumber] = 0
+; on seuil (vire les points terres a valmask par ex)
+   flevel = 0 > flevel < (jpk-1)
+;
+   indexup = level2index(floor(flevel))
+   indexlow = nx*ny+indexup
+   out = where(indexlow GE nx*ny*jpk-1)
+   if out[0] NE -1 then indexlow[out] = indexlow[out]-nx*ny
+;
+   weight = flevel-floor(flevel)
+   res = array[indexup]
+   res = res+weight*(array[indexlow]-res)
+;
+; on replace les points a !values.f_nan
+   if notanumber[0] NE -1 then res[notanumber] = !values.f_nan
+   if out[0] NE -1 then res[out] = !values.f_nan
+; on masque les points terres a valmask
+   grille,mask
+   if n_elements(valmask) EQ 0 then valmask = 1e20
+   terre = where((temporary(mask))[*, *, 0] EQ 0)
+   if terre[0] NE -1 then res[terre] = valmask
+;------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps projectondepth', systime(1)-tempsun 
+   return, res
+end
Index: tags/start/CALCULS/remplit.pro
===================================================================
--- tags/start/CALCULS/remplit.pro	(revision 5)
+++ tags/start/CALCULS/remplit.pro	(revision 5)
@@ -0,0 +1,221 @@
+FUNCTION remplit, zinput, NAN = nan, NITE = nite, BASIQUE = basique, mask = mask, _extra = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;+
+   ;;
+   ;; Extrapole zinout[jpi,jpj] sur les continents en utilisant les 4
+   ;; plus proches voisins masques oceaniquement et construit un nouveau
+;   masque
+   ;; contenant l'ancien masque oceanique PLUSles points extrapoles.
+   ;; Reitere le processus nite fois.
+   ;; C'est pas clair, essayez !
+   ;;
+   ;;
+;
+;    /Nan: to fill the point which have the value
+;    !values.f_nan. Whitout this keyword, these point are not filling
+;    and stays at !values.f_nan.
+;
+;
+
+
+
+;-
+; les points non remplis sont masques a valmask
+   z = zinput
+   if n_elements(key_gridtype) EQ 0 then key_gridtype = 'c'
+   if keyword_set(basique) then begin
+      oldkey_gridtype = key_gridtype
+      key_gridtype = 'c'
+   endif
+   IF n_elements(nite) EQ 0 THEN nite = 1
+   IF nite EQ 0 THEN return, zinput
+   if keyword_set(basique)  then begin
+      nx = (size(zinput))[1]
+      ny = (size(zinput))[2]
+      if NOT keyword_set(mask) then mmmask = basique ELSE mmmask = mask
+      if  key_gridtype eq 'e' then begin
+         case vargrid of
+            'T':glam = glamt[premierxt:dernierxt, premieryt:dernieryt]
+            'U':glam = glamu[premierxu:dernierxu, premieryu:dernieryu]
+         endcase
+      endif
+   ENDIF ELSE grille, mmmask, glam, gphi, gdep, nx, ny, nz, _extra = ex
+   if keyword_set(mask) then mmmask = mask
+;---------------------------------------------------------------
+   if (size(mmmask))[0] EQ 3 THEN BEGIN 
+      if (size(mmmask))[3] EQ jpk THEN mmmask = mmmask[*, *, niveau-1] $
+      ELSE  mmmask = mmmask[*, *, nz-1]
+   ENDIF
+;
+   if n_elements(mmmask) EQ 1 then mmmask = replicate(1, nx, ny)
+   if keyword_set(nan) then begin
+      nanpoint = where(finite(z) EQ 0)
+      if nanpoint[0] NE -1 then begin
+         mmmask[nanpoint] = 0
+         z[nanpoint] = 0
+      endif
+   endif
+;---------------------------------------------------------------
+; on ajoute un cadre de zero a z, mask, e1, e2
+; comme ca apres on peut faire des shifts ds tous les sens sans se
+; soucier des bords du domaine!
+;---------------------------------------------------------------
+   tempdeux = systime(1)        ; pour key_performance =2
+   nx2 = nx+2
+   case key_gridtype of
+      'c':BEGIN
+         zero = fltarr(nx+2, ny+2)
+         zero[1:nx, 1:ny] = mmmask
+         mmmask = zero
+         zero = fltarr(nx+2, ny+2)
+         zero[1:nx, 1:ny] = z
+         if keyword_set(key_periodique) AND nx EQ jpi then begin
+            zero[0, 1:ny] = z[jpi-1, *]
+            zero[nx+1, 1:ny] = z[0, *]
+         endif
+         z = zero
+      END
+      'e':BEGIN
+         zero = fltarr(nx+2, ny+4)
+         zero[1:nx, 2:ny+1] = mmmask
+         mmmask = zero
+         zero = fltarr(nx+2, ny+4)
+         zero[1:nx, 2:ny+1] = z
+         if keyword_set(key_periodique) AND nx EQ jpi then begin
+            zero[0, 2:ny+1] = z[jpi-1, *]
+            zero[nx+1, 2:ny+1] = z[0, *]
+         endif
+         z = zero
+      END
+   endcase
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps remplit: on ajoute un cadre de zero ', systime(1)-tempdeux
+;---------------------------------------------------------------
+;---------------------------------------------------------------
+; iteration 
+;---------------------------------------------------------------
+;---------------------------------------------------------------
+   FOR n = 1, nite DO BEGIN 
+; on trouve les points cote
+      tempdeux = systime(1)     ; pour key_performance =2
+; les points du bord du cadre ne doivent pas etre dans la cote
+      case key_gridtype of
+         'c':BEGIN
+            mmmask[0, *] = 1
+            mmmask[nx+1, *] = 1
+            mmmask[*, 0] = 1
+            mmmask[*, ny+1] = 1
+            if keyword_set(key_periodique) AND nx EQ jpi then begin
+               mmmask[0,*] = mmmask[nx-2, *]
+               mmmask[nx+1,*] = mmmask[1, *]
+            endif
+         END
+         'e':BEGIN
+            mmmask[0, *] = 1
+            mmmask[nx+1, *] = 1
+            mmmask[*, 0:1] = 1
+            mmmask[*, ny+2:ny+3] = 1
+            if keyword_set(key_periodique) AND nx EQ jpi then begin
+               mmmask[0,*] = mmmask[nx-2, *]
+               mmmask[nx+1,*] = mmmask[1, *]
+            endif
+         END
+      endcase
+; liste des points terre restant
+      terre = where(mmmask EQ 0)
+      if terre[0] EQ -1 then GOTO, fini
+; les points du bord du cadre doivent maintenant etre dans la terre
+      case key_gridtype of
+         'c':BEGIN
+            mmmask[0, *] = 0
+            mmmask[nx+1, *] = 0
+            mmmask[*, 0] = 0
+            mmmask[*, ny+1] = 0
+         END
+         'e':BEGIN
+            mmmask[0, *] = 0
+            mmmask[nx+1, *] = 0
+            mmmask[*, 0:1] = 0
+            mmmask[*, ny+2:ny+3] = 0
+         END
+      endcase
+; liste des voisins mer
+      case key_gridtype of
+         'c':BEGIN
+            voisins = shift(mmmask,-1,0)+shift(mmmask,1,0)+shift(mmmask,0,-1)+shift(mmmask,0,1) $
+             +1./sqrt(2)*(shift(mmmask,-1,-1)+shift(mmmask,1,1)+shift(mmmask,1,-1)+shift(mmmask,-1,1))
+            cote = where(voisins[terre] GT 0)
+; liste des points cote
+            cote = terre[cote]
+            poids = voisins[cote]
+         END
+         'e':BEGIN
+            shifted = glam[0, 0] LT glam[0, 1]
+            oddeven = (terre/nx2+1-shifted) MOD 2
+            voisins = mmmask[terre+1]+mmmask[terre-1] $
+             +mmmask[2*nx2+terre]+mmmask[-2*nx2+terre] $
+             +sqrt(2)*(mmmask[terre-nx2+oddeven]+mmmask[terre+nx2+oddeven] $
+                       +mmmask[terre+(-nx2-1)+oddeven]+mmmask[terre+(nx2-1)+oddeven])
+            cote = where(voisins GT 0)
+            poids = voisins[cote]
+            cote = terre[cote]
+         END
+      endcase
+;
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps remplit: trouver la cote ', systime(1)-tempdeux
+;---------------------------------------------------------------
+; remplissage des points cote
+;---------------------------------------------------------------
+      tempdeux = systime(1)     ; pour key_performance =2
+; on masque z
+      z = z*mmmask
+;
+      case key_gridtype of
+         'c':BEGIN
+            zcote = z[1+cote]+z[-1+cote]+z[nx2+cote]+z[-nx2+cote] $
+             +1./sqrt(2)*(z[nx2+1+cote]+z[nx2-1+cote] $
+                          +z[-nx2+1+cote]+z[-nx2-1+cote])
+         END
+         'e':BEGIN
+            oddeven = (cote/nx2+1-shifted) MOD 2
+            zcote = z[1+cote]+z[-1+cote]+z[2*nx2+cote]+z[-2*nx2+cote] $
+             +sqrt(2)*(z[-nx2+oddeven+cote]+z[-nx2-1+oddeven+cote] $
+                       +z[nx2+oddeven+cote]+z[nx2-1+oddeven+cote])
+         END
+      endcase
+      
+      z[cote] = zcote/poids
+;---------------------------------------------------------------
+; IV) on reduit le masque
+;---------------------------------------------------------------
+      mmmask[cote] = 1
+;
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps remplit: une iteration ', systime(1)-tempdeux
+   ENDFOR 
+fini:
+;
+; on masque les valeurs sur les terres restantes
+;
+   IF n_elements(valmask) EQ 0 then valmask = 1e20
+   z = z*mmmask+valmask*(1-mmmask)
+;---------------------------------------------------------------
+; on redecoupe le tableau pour retirer le cadre!
+;---------------------------------------------------------------
+   case key_gridtype of
+      'c':BEGIN
+         z = z[1:nx, 1:ny]
+      END
+      'e':BEGIN
+         z = z[1:nx, 2:ny+1]
+      END
+   endcase
+;
+   if keyword_set(basique) then key_gridtype = oldkey_gridtype
+;---------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps remplit', systime(1)-tempsun 
+   return, z
+END 
+
Index: tags/start/CALCULS/rhon.pro
===================================================================
--- tags/start/CALCULS/rhon.pro	(revision 5)
+++ tags/start/CALCULS/rhon.pro	(revision 5)
@@ -0,0 +1,147 @@
+FUNCTION rhon, sn, tn, INSITU = insitu, SIGMA_N = sigma_n
+@common
+   tempsun = systime(1)         ; pour key_performance
+;+
+   ;;
+   ;; Calcul de la fonction d'etat (issue de eos.F)
+   ;;
+   ;; Creation : 1997 / G. Roullet
+   ;; adaptation pour les tableaux z,zt,xyz,xyzt
+   ;; par seb.
+   ;;
+;-
+      sn = -1e5 > double(sn) < 1e5
+      tn = -1e5 > double(tn) < 1e5
+
+
+      IF keyword_set(sigma_n) then insitu = 1
+
+   taille = size(sn)
+   case taille[0] of
+      0:BEGIN                   ;z
+         zrhop=0d
+         jkmax = 1
+      END 
+      1:BEGIN                   ;z
+         zrhop=dblarr(taille[1])
+         jkmax = taille[1]
+      END 
+      2:BEGIN                   ;xy (jpt=1) ou zt
+         zrhop=dblarr(taille[1],taille[2])
+         if jpt EQ 1 then jkmax = 1 ELSE jkmax = taille[1]
+      END 
+      3:BEGIN                   ;xyz (jpt=1) ou xyt
+         zrhop=dblarr(taille[1],taille[2],taille[3])
+         if jpt EQ 1 then jkmax = taille[3] ELSE jkmax = 1
+      END 
+      4:BEGIN                   ;xyzt
+         zrhop=dblarr(taille[1],taille[2],taille[3],taille[4] )
+         jkmax = taille[3]
+      END 
+   endcase
+   
+
+
+   FOR jk = 0, jkmax-1 DO BEGIN
+
+      case taille[0] of
+         0:BEGIN                ;z
+            ztt = tn
+            zs = sn
+         END 
+         1:BEGIN                ;z
+            ztt = tn[jk]
+            zs = sn[jk] 
+         END 
+         2:BEGIN                ;xy (jpt=1) ou zt
+            if jpt EQ 1 then begin
+               ztt = tn
+               zs = sn
+            ENDIF ELSE BEGIN
+               ztt = tn[jk, *]
+               zs = sn[jk, *] 
+            ENDELSE
+         END 
+         3:BEGIN                ;xyz (jpt=1) ou xyt
+            if jpt EQ 1 then begin
+               ztt = tn[*, *, jk]
+               zs = sn[*, *,jk] 
+            endif ELSE BEGIN
+               ztt = tn
+               zs = sn
+            ENDELSE
+         END 
+         4:BEGIN                ;xyzt
+            ztt = tn[*, *, jk, *]
+            zs = sn[*, *,jk, *] 
+         END 
+      endcase
+      if n_elements(sigma_n) NE 0 then zh = 1000.*sigma_n ELSE zh = gdept(jk)
+; ...   square root salinity
+      zsr= sqrt(abs(zs))
+; ...   compute density pure water at atm pressure
+      zr1=((((6.536332e-9*ztt-1.120083e-6)*ztt+1.001685e-4)*ztt-9.095290e-3)*ztt+6.793952e-2)*ztt+999.842594
+; ...   seawater density atm pressure
+      zr2= (((5.3875e-9*ztt-8.2467e-7)*ztt+7.6438e-5)*ztt-4.0899e-3)*ztt+0.824493
+      zr3= (-1.6546e-6*ztt+1.0227e-4)*ztt-5.72466e-3
+      zr4= 4.8314e-4
+;
+; ...   potential density (reference to the surface)
+      case taille[0] of
+         0: zrhop    = (zr4*zs + zr3*zsr + zr2)*zs + zr1
+         1: zrhop(jk)= (zr4*zs + zr3*zsr + zr2)*zs + zr1
+         2:BEGIN 
+            if jpt EQ 1 then zrhop = (zr4*zs + zr3*zsr + zr2)*zs + zr1 $
+            ELSE zrhop(jk, *)= (zr4*zs + zr3*zsr + zr2)*zs + zr1
+         END
+         3:BEGIN 
+            if jpt EQ 1 then zrhop(*, *,jk)= (zr4*zs + zr3*zsr + zr2)*zs + zr1 $
+             ELSE zrhop = (zr4*zs + zr3*zsr + zr2)*zs + zr1
+         END
+         4: zrhop(*, *,jk, *)= (zr4*zs + zr3*zsr + zr2)*zs + zr1
+      endcase
+
+      IF n_elements(insitu) EQ 1 THEN BEGIN 
+; ...   add the compression terms
+         ze = (-3.508914e-8*ztt-1.248266e-8)*ztt-2.595994e-6
+         zbw= ( 1.296821e-6*ztt-5.782165e-9)*ztt+1.045941e-4
+         zb = zbw + ze * zs
+;
+         zd = -2.042967e-2
+         zc = (-7.267926e-5*ztt+2.598241e-3)*ztt+0.1571896
+         zaw = ((5.939910e-6*ztt+2.512549e-3)*ztt-0.1028859)*ztt -4.721788
+         za = ( zd*zsr + zc)*zs + zaw
+;
+         zb1= (-0.1909078*ztt+7.390729)*ztt-55.87545
+         za1= ((2.326469e-3*ztt+1.553190)*ztt-65.00517)*ztt+1044.077
+         zkw= (((-1.361629e-4*ztt-1.852732e-2)*ztt-30.41638)*ztt+2098.925)*ztt+190925.6
+         zk0= (zb1*zsr + za1)*zs + zkw
+;
+; ...   masked in situ density
+         case taille[0] of
+            0: zrhop = zrhop / (1.0-zh/(zk0-zh*(za-zh*zb)))
+            1: zrhop(jk) = zrhop(jk) / (1.0-zh/(zk0-zh*(za-zh*zb)))
+            2:BEGIN 
+               if jpt EQ 1 then zrhop = zrhop / (1.0-zh/(zk0-zh*(za-zh*zb))) $
+               ELSE zrhop(jk, *) = zrhop(jk, *) / (1.0-zh/(zk0-zh*(za-zh*zb)))
+            END
+            3:BEGIN 
+               if jpt EQ 1 then zrhop(*, *,jk) = zrhop(*, *,jk) / (1.0-zh/(zk0-zh*(za-zh*zb))) $
+               ELSE zrhop = zrhop / (1.0-zh/(zk0-zh*(za-zh*zb)))
+            END
+            4: zrhop(*, *,jk, *) = zrhop(*, *,jk, *) / (1.0-zh/(zk0-zh*(za-zh*zb)))
+         endcase
+         
+      ENDIF 
+   ENDFOR 
+   
+   terre = where(tn GE 1e6)
+   if terre[0] NE -1 then zrhop[terre] = valmask
+
+   if keyword_set(key_performance) THEN print, 'temps rhon', systime(1)-tempsun 
+
+   
+   return, zrhop
+END 
+
+
Index: tags/start/CALENDRIER/caldat.pro
===================================================================
--- tags/start/CALENDRIER/caldat.pro	(revision 5)
+++ tags/start/CALENDRIER/caldat.pro	(revision 5)
@@ -0,0 +1,173 @@
+; $Id$
+;
+; Copyright (c) 1992-1998, Research Systems, Inc.  All rights reserved.
+;	Unauthorized reproduction prohibited.
+;
+
+;+
+; NAME:
+;	CALDAT
+;
+; PURPOSE:
+;	Return the calendar date and time given julian date.
+;	This is the inverse of the function JULDAY.
+; CATEGORY:
+;	Misc.
+;
+; CALLING SEQUENCE:
+;	CALDAT, Julian, Month, Day, Year, Hour, Minute, Second
+;	See also: julday, the inverse of this function.
+;
+; INPUTS:
+;	JULIAN contains the Julian Day Number (which begins at noon) of the 
+;	specified calendar date.  It should be a long integer.
+;
+; KEYWORD PARAMETERS:
+;
+;       NDAYSPM: developpe par eric, ca veut dire: nombre de jours par mois! 
+;                par defaut c''est 30, sinon le specifier en donnant
+;                une valeur a ndayspm
+;                pour passer a un calendrier avec un nombre de jours constant par
+;                mois. Utilise en particulier ds julday et caldat
+;
+; OUTPUTS:
+;	(Trailing parameters may be omitted if not required.)
+;	MONTH:	Number of the desired month (1 = January, ..., 12 = December).
+;
+;	DAY:	Number of day of the month.
+;
+;	YEAR:	Number of the desired year.
+;
+;	HOUR:	Hour of the day
+;	Minute: Minute of the day
+;	Second: Second (and fractions) of the day.
+;
+; COMMON BLOCKS:
+;	None.
+;
+; SIDE EFFECTS:
+;	None.
+;
+; RESTRICTIONS:
+;	Accuracy using IEEE double precision numbers is approximately
+;	1/10000th of a second.
+;
+; MODIFICATION HISTORY:
+;	Translated from "Numerical Recipies in C", by William H. Press,
+;	Brian P. Flannery, Saul A. Teukolsky, and William T. Vetterling.
+;	Cambridge University Press, 1988 (second printing).
+;
+;	DMS, July 1992.
+;	DMS, April 1996, Added HOUR, MINUTE and SECOND keyword
+;	AB, 7 December 1997, Generalized to handle array input.
+;       Eric Guilyardi, June 1999
+;       Added key_work ndayspm for fixed number of days per months
+;-
+;
+
+
+pro caldat_scalar, Julian, Month, Day, Year, Hour, Minute, Second, NDAYSPM = ndayspm
+  ; Internal variant of CALDAT that does the actual work on a single
+  ; value.
+
+  ON_ERROR, 2		; Return to caller if errors
+
+  IF NOT keyword_set(ndayspm) THEN BEGIN  
+
+     IGREG = 2299161L           ;Beginning of Gregorian calendar
+
+     IF julian GE 0 THEN jul = long(julian + .5d) $ ;Better be long
+      ELSE jul = long(julian - .5d)
+     f = julian + .5d - jul
+     if f ne 0.0 then begin	;Get hours, minutes, seconds.
+        hour = floor(f * 24.)
+        f = f - hour / 24.d
+        minute = floor(f*1440)
+        second = (f - minute/1440.d0) * 86400.0d0
+     endif else begin
+        hour = 0L
+        minute = 0L
+        second = 0L
+     endelse
+     
+     
+     if jul ge igreg then begin
+        jalpha = long(((jul - 1867216) - 0.25d0) / 36524.25)
+        ja = jul + 1 + jalpha - long(0.25d0 * jalpha)
+     endif else ja = jul
+     
+     jb = ja + 1524l
+     jc = long(6680.0 + ((jb-2439870)-122.1d0)/365.25)
+     jd = long(365 * jc + (0.25 * jc))
+     je = long((jb - jd) / 30.6001)
+     
+     day = jb - jd - long(30.6001d * je)
+     month = je -1
+     if (month gt 12) then month = month - 12
+     year = jc - 4715
+     if month gt 2 then year = year - 1
+     if year le 0 then year = year - 1
+
+  ENDIF ELSE BEGIN
+
+     jul = long(julian)
+     f = (jul - floor(jul))
+     IF f NE 0.0 THEN BEGIN	;Get hours, minutes, seconds.
+        hour = floor(f*24.)
+        f = f - hour / 24.d
+        minute = floor(f*1440)
+        second = (f - minute/1440.d0) * 86400.0d0
+     ENDIF ELSE BEGIN
+        hour = 0L
+        minute = 0L
+        second = 0L
+     ENDELSE
+
+     IF ndayspm EQ 1 THEN ndayspm = 30
+
+     Z = floor(julian)
+     X = Z / ndayspm
+     day = Z - X*ndayspm 
+     year = X / 12 
+     month = X - year*12 + 1
+     year = year + 1
+
+  ENDELSE 
+
+end
+
+
+
+
+pro caldat, Julian, Month, Day, Year, Hour, Minute, Second, NDAYSPM = ndayspm
+
+  ON_ERROR, 2		; Return to caller if errors
+
+  ; Determine shape of input and construct longword output variables of
+  ; the same shape.
+
+  s = size(julian)
+  if (s[0] eq 0) then begin
+    ; Julian is scalar. Just call CALDAT_SCALAR and pass our arguments through.
+    caldat_scalar, Julian, Month, Day, Year, Hour, Minute, Second, NDAYSPM = ndayspm
+    return
+  endif
+
+  ; It's an array. Construct result variables
+  ndim = s[0]		; Number or array dimensions
+  n = s[ndim + 2]	; # of elements 
+  s[ndim + 1] = 3	; Change the type to LONG
+  MONTH = (DAY = (YEAR = (HOUR = (MINUTE = (SECOND = MAKE_ARRAY(SIZE=s))))))
+
+  ; Loop over the input
+  for i = 0, n-1 do begin
+    caldat_scalar, julian[i], month_tmp, day_tmp, year_tmp, $
+	hour_tmp, minute_tmp, second_tmp, NDAYSPM = ndayspm
+    month[i]  = month_tmp
+    day[i]    = day_tmp
+    year[i]   = year_tmp
+    hour[i]   = hour_tmp
+    minute[i] = minute_tmp
+    second[i] = second_tmp
+  endfor
+end
Index: tags/start/CALENDRIER/caldat_old.pro
===================================================================
--- tags/start/CALENDRIER/caldat_old.pro	(revision 5)
+++ tags/start/CALENDRIER/caldat_old.pro	(revision 5)
@@ -0,0 +1,173 @@
+; $Id$
+;
+; Copyright (c) 1992-1998, Research Systems, Inc.  All rights reserved.
+;	Unauthorized reproduction prohibited.
+;
+
+;+
+; NAME:
+;	CALDAT
+;
+; PURPOSE:
+;	Return the calendar date and time given julian date.
+;	This is the inverse of the function JULDAY.
+; CATEGORY:
+;	Misc.
+;
+; CALLING SEQUENCE:
+;	CALDAT, Julian, Month, Day, Year, Hour, Minute, Second
+;	See also: julday, the inverse of this function.
+;
+; INPUTS:
+;	JULIAN contains the Julian Day Number (which begins at noon) of the 
+;	specified calendar date.  It should be a long integer.
+;
+; KEYWORD PARAMETERS:
+;
+;       NDAYSPM: developpe par eric, ca veut dire: nombre de jours par mois! 
+;                par defaut c''est 30, sinon le specifier en donnant
+;                une valeur a ndayspm
+;                pour passer a un calendrier avec un nombre de jours constant par
+;                mois. Utilise en particulier ds julday et caldat
+;
+; OUTPUTS:
+;	(Trailing parameters may be omitted if not required.)
+;	MONTH:	Number of the desired month (1 = January, ..., 12 = December).
+;
+;	DAY:	Number of day of the month.
+;
+;	YEAR:	Number of the desired year.
+;
+;	HOUR:	Hour of the day
+;	Minute: Minute of the day
+;	Second: Second (and fractions) of the day.
+;
+; COMMON BLOCKS:
+;	None.
+;
+; SIDE EFFECTS:
+;	None.
+;
+; RESTRICTIONS:
+;	Accuracy using IEEE double precision numbers is approximately
+;	1/10000th of a second.
+;
+; MODIFICATION HISTORY:
+;	Translated from "Numerical Recipies in C", by William H. Press,
+;	Brian P. Flannery, Saul A. Teukolsky, and William T. Vetterling.
+;	Cambridge University Press, 1988 (second printing).
+;
+;	DMS, July 1992.
+;	DMS, April 1996, Added HOUR, MINUTE and SECOND keyword
+;	AB, 7 December 1997, Generalized to handle array input.
+;       Eric Guilyardi, June 1999
+;       Added key_work ndayspm for fixed number of days per months
+;-
+;
+
+
+pro caldat_scalar, Julian, Month, Day, Year, Hour, Minute, Second, NDAYSPM = ndayspm
+  ; Internal variant of CALDAT that does the actual work on a single
+  ; value.
+
+  ON_ERROR, 2		; Return to caller if errors
+
+  IF NOT keyword_set(ndayspm) THEN BEGIN  
+
+     IGREG = 2299161L           ;Beginning of Gregorian calendar
+
+     IF julian GE 0 THEN jul = long(julian + .5d) $ ;Better be long
+      ELSE jul = long(julian - .5d)
+     f = julian + .5d - jul
+     if f ne 0.0 then begin	;Get hours, minutes, seconds.
+        hour = floor(f * 24.)
+        f = f - hour / 24.d
+        minute = floor(f*1440)
+        second = (f - minute/1440.d0) * 86400.0d0
+     endif else begin
+        hour = 0L
+        minute = 0L
+        second = 0L
+     endelse
+     
+     
+     if jul ge igreg then begin
+        jalpha = long(((jul - 1867216) - 0.25d0) / 36524.25)
+        ja = jul + 1 + jalpha - long(0.25d0 * jalpha)
+     endif else ja = jul
+     
+     jb = ja + 1524l
+     jc = long(6680.0 + ((jb-2439870)-122.1d0)/365.25)
+     jd = long(365 * jc + (0.25 * jc))
+     je = long((jb - jd) / 30.6001)
+     
+     day = jb - jd - long(30.6001d * je)
+     month = je -1
+     if (month gt 12) then month = month - 12
+     year = jc - 4715
+     if month gt 2 then year = year - 1
+     if year le 0 then year = year - 1
+
+  ENDIF ELSE BEGIN
+
+     jul = long(julian)
+     f = (jul - floor(jul))
+     IF f NE 0.0 THEN BEGIN	;Get hours, minutes, seconds.
+        hour = floor(f*24.)
+        f = f - hour / 24.d
+        minute = floor(f*1440)
+        second = (f - minute/1440.d0) * 86400.0d0
+     ENDIF ELSE BEGIN
+        hour = 0L
+        minute = 0L
+        second = 0L
+     ENDELSE
+
+     IF ndayspm EQ 1 THEN ndayspm = 30
+
+     Z = floor(julian)
+     X = Z / ndayspm
+     day = Z - X*ndayspm 
+     year = X / 12 
+     month = X - year*12 + 1
+     year = year + 1
+
+  ENDELSE 
+
+end
+
+
+
+
+pro caldat, Julian, Month, Day, Year, Hour, Minute, Second, NDAYSPM = ndayspm
+
+  ON_ERROR, 2		; Return to caller if errors
+
+  ; Determine shape of input and construct longword output variables of
+  ; the same shape.
+
+  s = size(julian)
+  if (s[0] eq 0) then begin
+    ; Julian is scalar. Just call CALDAT_SCALAR and pass our arguments through.
+    caldat_scalar, Julian, Month, Day, Year, Hour, Minute, Second, NDAYSPM = ndayspm
+    return
+  endif
+
+  ; It's an array. Construct result variables
+  ndim = s[0]		; Number or array dimensions
+  n = s[ndim + 2]	; # of elements 
+  s[ndim + 1] = 3	; Change the type to LONG
+  MONTH = (DAY = (YEAR = (HOUR = (MINUTE = (SECOND = MAKE_ARRAY(SIZE=s))))))
+
+  ; Loop over the input
+  for i = 0, n-1 do begin
+    caldat_scalar, julian[i], month_tmp, day_tmp, year_tmp, $
+	hour_tmp, minute_tmp, second_tmp, NDAYSPM = ndayspm
+    month[i]  = month_tmp
+    day[i]    = day_tmp
+    year[i]   = year_tmp
+    hour[i]   = hour_tmp
+    minute[i] = minute_tmp
+    second[i] = second_tmp
+  endfor
+end
Index: tags/start/CALENDRIER/calendriertotem.pro
===================================================================
--- tags/start/CALENDRIER/calendriertotem.pro	(revision 5)
+++ tags/start/CALENDRIER/calendriertotem.pro	(revision 5)
@@ -0,0 +1,87 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: calendriertotem
+;
+; PURPOSE: exemple de fonction calculant un calendrier. Il s''agit ici
+; du calendrier utiliser pour le run totem/ecmwf, c.a.d. un calendrier
+; qui va de 1979 a 1993 dont le pas est de 5 jour et qui ds lequel
+; chaque 1ere sortie d''une nouvelle annee est le 5 janvier (si le mot
+; cle mensuel n''est pas active)
+;
+; CATEGORY: calendrier
+;
+; CALLING SEQUENCE:res=calendriertotem()
+; 
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;       YYYYMMDD: pour que le format des jours fournis par le
+;       calendrier soit du style 19991019. c'est le format par
+;       defaut.
+;
+;       JULIAN_DAY: pour que le calendrier soit exprime en jour julien
+;       d''IDL. 
+;
+;       MENSUEL: pour obtenir un calendier mensuel plutot qu''a 5
+;       jours.
+;
+;       YBEGIN: annee de debut codee sur 2 chiffres
+;
+;       YEND annee de fin codee sur 2 chiffres
+;
+; OUTPUTS: un vecteur de longinteger contenant l''ensemble des dates.
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      ??/??/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION calendriertotem, YYYYMMDD = yyyymmdd, JULIAN_DAY = julian_day, MENSUEL = mensuel, ybegin = ybegin, yend = yend
+; cheking for yyyymmdd and julian_day keywords
+   julian_day = keyword_set(julian_day)*(1-keyword_set(yyyymmdd)) 
+   yyyymmdd = keyword_set(yyyymmdd)*(1-keyword_set(julian_day))+(keyword_set(yyyymmdd) EQ julian_day) 
+;
+   if NOT keyword_set(yend) then yend = 93
+   if NOT keyword_set(ybegin) then ybegin = 79
+   nyear = yend-ybegin+1
+;
+   if keyword_set(mensuel) then begin
+      res = lonarr(12*nyear)
+      for an = 0, nyear-1 do BEGIN
+         for sor = 0, 11 do BEGIN
+            if keyword_set(julian_day) then res[0+an*12+sor] = julday(sor+1, 15, 1900+ybegin+an) $
+            ELSE BEGIN 
+               caldat, julday(sor+1, 15, 1900+ybegin+an), month, day, year
+               if day EQ 15 then day = 0
+               res[0+an*12+sor] = 10000L*year+100L*month+day
+            ENDELSE 
+         endfor
+      ENDFOR
+      return, res
+   endif
+;
+   res = lonarr(73*nyear)
+   for an = 0, nyear-1 do BEGIN
+      if keyword_set(julian_day) then $
+       res[0+an*73:0+(an+1)*73-1] = julday(1, 5, 1900+ybegin+an)+5L*lindgen(73) $
+      ELSE BEGIN 
+         for sor = 0, 72 do begin
+            caldat, julday(1, 5+sor*5, 1900+ybegin+an), month, day, year
+            res[0+an*73+sor] = 10000L*year+100L*month+day
+         endfor
+      ENDELSE 
+   endfor
+
+   return, res
+end
Index: tags/start/CALENDRIER/date2string.pro
===================================================================
--- tags/start/CALENDRIER/date2string.pro	(revision 5)
+++ tags/start/CALENDRIER/date2string.pro	(revision 5)
@@ -0,0 +1,59 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:
+;
+; PURPOSE:
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:
+; 
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION date2string, date
+;
+@common
+;
+   s_date = strtrim(date, 2)
+   length = strlen(s_date)
+   sday = strtrim(fix(strmid(s_date,length-2)), 1)
+   smonth = strmid(s_date,length-4, 2)
+   syear = strmid(s_date, 0 ,length-4)
+;   res = syear+' '+string(format='(C(CMoA0))',31*(fix(smonth)-1))+'
+;   '+sday
+   if n_elements(langage) EQ 0 then langage = 'gb'
+   case langage of
+      'gb':BEGIN
+         truc = long(sday)
+         truc = truc-truc/10*10
+         case truc of
+            2:truc = 'nd'
+            3:truc = 'rd'
+            ELSE:truc = 'th'
+         endcase
+         res = string(format='(C(CMoA0))',31*(fix(smonth)-1))+' the '+sday+truc+' '+syear
+      END
+      ELSE:res = sday+' '+string(format='(C(CMoA0))',31*(fix(smonth)-1))+' '+syear
+   endcase
+   return, res
+end
Index: tags/start/CALENDRIER/def_month.pro
===================================================================
--- tags/start/CALENDRIER/def_month.pro	(revision 5)
+++ tags/start/CALENDRIER/def_month.pro	(revision 5)
@@ -0,0 +1,37 @@
+FUNCTION def_month, timave, date
+;
+; translate month number in string
+;
+   IF strpos(date, '_') GT -1 THEN date = strmid(date, 0, strpos(date, '_'))
+   CASE strmid(timave, 0, 2) OF 
+      '1m': BEGIN
+         CASE strmid(date, strlen(date)-2, 2) OF 
+            '01': mn = 'January'
+            '02': mn = 'February'
+            '03': mn = 'March'
+            '04': mn = 'April'
+            '05': mn = 'May'
+            '06': mn = 'June'
+            '07': mn = 'July'
+            '08': mn = 'August'
+            '09': mn = 'September'
+            '10': mn = 'October'
+            '11': mn = 'November'
+            '12': mn = 'December'
+            ELSE: mn = '???'
+         ENDCASE 
+      END 
+      '3m': BEGIN
+         CASE strmid(date, strlen(date)-2, 2) OF 
+            '01': mn = 'DJF'
+            '02': mn = 'MMA'
+            '03': mn = 'JJA'
+            '04': mn = 'SON'
+            ELSE: mn = '???'
+         ENDCASE 
+      END 
+      ELSE:
+   ENDCASE  
+
+   return, mn
+END 
Index: tags/start/CALENDRIER/jourdsmois.pro
===================================================================
--- tags/start/CALENDRIER/jourdsmois.pro	(revision 5)
+++ tags/start/CALENDRIER/jourdsmois.pro	(revision 5)
@@ -0,0 +1,50 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:jourdsmois
+;
+; PURPOSE:donne le nombre de jours ds le mois month de l'annee year
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:result=jourdsmois()
+;
+; INPUTS:optionnels
+;	 mois et annee
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro	leapyr.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			2/7/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+function jourdsmois, mois,annee
+@common
+;------------------------------------------------------------
+case n_params() of
+  1:month=mois
+  2:begin
+      month=mois
+      year=annee
+    end
+  else:
+endcase
+;------------------------------------------------------------
+days_in_mth = [31,28+leapyr(year),31,30,31,30,31,31,30,31,30,31]
+return, days_in_mth[month-1]
+;------------------------------------------------------------
+end
Index: tags/start/CALENDRIER/juldate.pro
===================================================================
--- tags/start/CALENDRIER/juldate.pro	(revision 5)
+++ tags/start/CALENDRIER/juldate.pro	(revision 5)
@@ -0,0 +1,61 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: juldate
+;
+; PURPOSE:  gives julian date equivalent of a date in vairmer 
+;           ( yymmdd or yyyymmdd ) format 
+;           sets month, day and year to the corresp values
+;
+; CATEGORY: bidouilles dates
+;
+; CALLING SEQUENCE:  date = juldate(930124)
+;
+; INPUTS:date de la forme yymmdd ou yyyymmdd
+;
+; KEYWORD PARAMETERS:
+;
+;       VRAIDATE: pour ne pasa transformer l''annnee 01 en 1901 
+;
+; OUTPUTS:date en jour julien
+;
+; COMONTHON BLOCKS:
+;	common.pro	vraidate
+;
+; SIDE EFFECTS:
+;   l'annee 0 n'existant pas, qd year est nulle on calcule le
+;     jour julien de l'annee -1.
+;   COMPATIBLE AVEC L'AN 2000 !!!: une date de la forme yymmdd est
+;    donvertit sous la forme yyyymmdd a l''aide de vraidate.
+;   Attention, les variables globales year, month day sont attribuees
+;
+; MODIFICATION HISTORY: Jerome Vialard  (jv@lodyc.jussieu.fr)
+;			2/7/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+function juldate, vvdate, _EXTRA = ex
+vdate = vvdate
+vdate = vraidate(vdate, _EXTRA = ex)
+@common
+;------------------------------------------------------------
+   year=vdate/10000
+   month=vdate/100 - year*100
+   day=abs(vdate - year*10000 - month*100)
+   month = abs(month)
+;
+   mm = month & dd = day & yy = year
+;------------------------------------------------------------
+   ndate = n_elements(vdate) 
+   if total(mm EQ 0) EQ ndate then mm[*] = 6
+   if total(dd EQ 0) EQ ndate then dd[*] = 15
+   if total(yy EQ 0) EQ ndate THEN yy[*] = -1
+;------------------------------------------------------------
+   return, julday(mm,dd,yy, _EXTRA = ex)
+;------------------------------------------------------------
+   return, -1
+end
+;------------------------------------------------------------
+
Index: tags/start/CALENDRIER/julday.pro
===================================================================
--- tags/start/CALENDRIER/julday.pro	(revision 5)
+++ tags/start/CALENDRIER/julday.pro	(revision 5)
@@ -0,0 +1,150 @@
+; $Id$
+;
+; Copyright (c) 1988-1998, Research Systems, Inc.  All rights reserved.
+;	Unauthorized reproduction prohibited.
+
+function JULDAY, MONTH, DAY, YEAR, Hour, Minute, Second, NDAYSPM = ndayspm, _extra=ex
+;+
+; NAME:
+;	JULDAY
+;
+; PURPOSE:
+;	Calculate the Julian Day Number for a given month, day, and year.
+;	This is the inverse of the library function CALDAT.
+;	See also caldat, the inverse of this function.
+; CATEGORY:
+;	Misc.
+;
+; CALLING SEQUENCE:
+;	Result = JULDAY(Month, Day, Year)
+;
+; INPUTS:
+;	MONTH:	Number of the desired month (1 = January, ..., 12 = December).
+;
+;	DAY:	Number of day of the month.
+;
+;	YEAR:	Number of the desired year.
+;
+;	HOUR:	Number of the hour of the day.
+;
+;	MINUTE:	Number of the minute of the hour.
+;
+;	SECOND:	
+;
+; OPTIONAL INPUT PARAMETERS:
+;	Hour, Minute, Second = optional time of day.
+;
+; KEYWORD PARAMETERS:
+;
+;       NDAYSPM: developpe par eric, ca veut dire: nombre de jours par mois! 
+;                par defaut c''est 30, sinon le specifier en donnant
+;                une valeur a ndayspm
+;                pour passer a un calendrier avec un nombre de jours constant par
+;                mois. Utilise en particulier ds julday et caldat
+;
+; OUTPUTS:
+;	JULDAY returns the Julian Day Number (which begins at noon) of the 
+;	specified calendar date.  If the time of day (Hr, Min, Sec), is 0,
+;	the result will be a long integer, otherwise the result is a 
+;	double precision floating point number.
+;
+; COMMON BLOCKS:
+;	None.
+;
+; SIDE EFFECTS:
+;	None.
+;
+; RESTRICTIONS:
+;	Accuracy using IEEE double precision numbers is approximately
+;	1/10000th of a second.
+;
+; MODIFICATION HISTORY:
+;	Translated from "Numerical Recipies in C", by William H. Press,
+;	Brian P. Flannery, Saul A. Teukolsky, and William T. Vetterling.
+;	Cambridge University Press, 1988 (second printing).
+;
+;	AB, September, 1988
+;	DMS, April, 1995, Added time of day.
+;
+;       Eric Guilyardi, June 1999
+;       Added key_work ndayspm for fixed number of days per months
+;-
+;
+   ON_ERROR, 2                  ; Return to caller if errors
+
+   MONTHS = ['JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG', $
+             'SEP','OCT','NOV','DEC']
+
+   IF NOT keyword_set(ndayspm)  THEN BEGIN 
+
+; Gregorian Calander was adopted on Oct. 15, 1582
+      GREG = 15L + 31L * (10L + 12L * 1582L)
+
+; Process the input, if all are missing, use todays date.
+      NP = n_params()
+      if NP eq 0 then begin
+         DATE = systime()
+         L_MONTH = long(where(strupcase(strmid(DATE, 4, 3)) eq MONTHS))
+         L_MONTH = L_MONTH[0] + 1 ; Scalarize it...
+         L_DAY = long(strmid(DATE, 8, 2))
+         L_YEAR = long(strmid(DATE, 20, 4))
+      endif else if np ge 3 then begin
+         L_MONTH = LONG(MONTH)
+         L_DAY = LONG(DAY)
+         L_YEAR=LONG(YEAR)
+;
+;***************************************************
+; Change test to allow year 0 for climatological data
+;********************************************************
+;         if (L_YEAR eq 0) then message, 'There is no year zero.'
+      endif else message, 'Wrong number of parameters.'
+;
+;***************************************************
+; Change test to allow year 0 for climatological data
+;********************************************************
+;      if (L_YEAR lt 0) then L_YEAR = L_YEAR + 1
+      if (L_YEAR le 0) then L_YEAR = L_YEAR + 1
+      if (L_MONTH gt 2) then begin
+         JY = L_YEAR
+         JM = L_MONTH + 1
+      endif else begin
+         JY = L_YEAR - 1
+         JM = L_MONTH + 13
+      endelse
+
+      JUL = floor(365.25 * JY) + floor(30.6001 * JM) + L_DAY + 1720995
+; Test whether to change to Gregorian Calandar.
+      if ((L_DAY + 31L * (L_MONTH + 12L * L_YEAR)) ge GREG) then begin
+         JA = long(0.01 * JY)
+         JUL = JUL + 2 - JA + long(0.25 * JA)
+      endif
+
+      if n_elements(Hour) + n_elements(Minute) + n_elements(Second) eq 0 then $
+       return, JUL
+      if n_elements(Hour) eq 0 then Hour = 0
+      if n_elements(Minute) eq 0 then Minute = 0
+      if n_elements(Second) eq 0 then Second = 0
+
+      return, JUL + (Hour / 24.0d0 - .5d0) + (Minute/1440.0d0) + (Second / 86400.0d0)
+
+   ENDIF ELSE BEGIN 
+;
+; Fixed number of days per month (default=30) :
+;
+      IF ndayspm EQ 1 THEN ndayspm = 30
+
+      L_MONTH = LONG(MONTH)
+      L_DAY = LONG(DAY)
+      L_YEAR=LONG(YEAR)
+
+      JUL = ((L_YEAR-1)*12. + (L_MONTH-1))* ndayspm + L_DAY 
+      if n_elements(Hour) + n_elements(Minute) + n_elements(Second) eq 0 then $
+       return, JUL
+      if n_elements(Hour) eq 0 then Hour = 0
+      if n_elements(Minute) eq 0 then Minute = 0
+      if n_elements(Second) eq 0 then Second = 0
+      
+      return, JUL + (Hour / 24.0d0) + (Minute/1440.0d0) + (Second / 86400.0d0)
+
+   ENDELSE 
+end
Index: tags/start/CALENDRIER/julday_old.pro
===================================================================
--- tags/start/CALENDRIER/julday_old.pro	(revision 5)
+++ tags/start/CALENDRIER/julday_old.pro	(revision 5)
@@ -0,0 +1,150 @@
+; $Id$
+;
+; Copyright (c) 1988-1998, Research Systems, Inc.  All rights reserved.
+;	Unauthorized reproduction prohibited.
+
+function JULDAY, MONTH, DAY, YEAR, Hour, Minute, Second, NDAYSPM = ndayspm, _extra=ex
+;+
+; NAME:
+;	JULDAY
+;
+; PURPOSE:
+;	Calculate the Julian Day Number for a given month, day, and year.
+;	This is the inverse of the library function CALDAT.
+;	See also caldat, the inverse of this function.
+; CATEGORY:
+;	Misc.
+;
+; CALLING SEQUENCE:
+;	Result = JULDAY(Month, Day, Year)
+;
+; INPUTS:
+;	MONTH:	Number of the desired month (1 = January, ..., 12 = December).
+;
+;	DAY:	Number of day of the month.
+;
+;	YEAR:	Number of the desired year.
+;
+;	HOUR:	Number of the hour of the day.
+;
+;	MINUTE:	Number of the minute of the hour.
+;
+;	SECOND:	
+;
+; OPTIONAL INPUT PARAMETERS:
+;	Hour, Minute, Second = optional time of day.
+;
+; KEYWORD PARAMETERS:
+;
+;       NDAYSPM: developpe par eric, ca veut dire: nombre de jours par mois! 
+;                par defaut c''est 30, sinon le specifier en donnant
+;                une valeur a ndayspm
+;                pour passer a un calendrier avec un nombre de jours constant par
+;                mois. Utilise en particulier ds julday et caldat
+;
+; OUTPUTS:
+;	JULDAY returns the Julian Day Number (which begins at noon) of the 
+;	specified calendar date.  If the time of day (Hr, Min, Sec), is 0,
+;	the result will be a long integer, otherwise the result is a 
+;	double precision floating point number.
+;
+; COMMON BLOCKS:
+;	None.
+;
+; SIDE EFFECTS:
+;	None.
+;
+; RESTRICTIONS:
+;	Accuracy using IEEE double precision numbers is approximately
+;	1/10000th of a second.
+;
+; MODIFICATION HISTORY:
+;	Translated from "Numerical Recipies in C", by William H. Press,
+;	Brian P. Flannery, Saul A. Teukolsky, and William T. Vetterling.
+;	Cambridge University Press, 1988 (second printing).
+;
+;	AB, September, 1988
+;	DMS, April, 1995, Added time of day.
+;
+;       Eric Guilyardi, June 1999
+;       Added key_work ndayspm for fixed number of days per months
+;-
+;
+   ON_ERROR, 2                  ; Return to caller if errors
+
+   MONTHS = ['JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG', $
+             'SEP','OCT','NOV','DEC']
+
+   IF NOT keyword_set(ndayspm)  THEN BEGIN 
+
+; Gregorian Calander was adopted on Oct. 15, 1582
+      GREG = 15L + 31L * (10L + 12L * 1582L)
+
+; Process the input, if all are missing, use todays date.
+      NP = n_params()
+      if NP eq 0 then begin
+         DATE = systime()
+         L_MONTH = long(where(strupcase(strmid(DATE, 4, 3)) eq MONTHS))
+         L_MONTH = L_MONTH[0] + 1 ; Scalarize it...
+         L_DAY = long(strmid(DATE, 8, 2))
+         L_YEAR = long(strmid(DATE, 20, 4))
+      endif else if np ge 3 then begin
+         L_MONTH = LONG(MONTH)
+         L_DAY = LONG(DAY)
+         L_YEAR=LONG(YEAR)
+;
+;***************************************************
+; Change test to allow year 0 for climatological data
+;********************************************************
+;         if (L_YEAR eq 0) then message, 'There is no year zero.'
+      endif else message, 'Wrong number of parameters.'
+;
+;***************************************************
+; Change test to allow year 0 for climatological data
+;********************************************************
+;      if (L_YEAR lt 0) then L_YEAR = L_YEAR + 1
+      if (L_YEAR le 0) then L_YEAR = L_YEAR + 1
+      if (L_MONTH gt 2) then begin
+         JY = L_YEAR
+         JM = L_MONTH + 1
+      endif else begin
+         JY = L_YEAR - 1
+         JM = L_MONTH + 13
+      endelse
+
+      JUL = floor(365.25 * JY) + floor(30.6001 * JM) + L_DAY + 1720995
+; Test whether to change to Gregorian Calandar.
+      if ((L_DAY + 31L * (L_MONTH + 12L * L_YEAR)) ge GREG) then begin
+         JA = long(0.01 * JY)
+         JUL = JUL + 2 - JA + long(0.25 * JA)
+      endif
+
+      if n_elements(Hour) + n_elements(Minute) + n_elements(Second) eq 0 then $
+       return, JUL
+      if n_elements(Hour) eq 0 then Hour = 0
+      if n_elements(Minute) eq 0 then Minute = 0
+      if n_elements(Second) eq 0 then Second = 0
+
+      return, JUL + (Hour / 24.0d0 - .5d0) + (Minute/1440.0d0) + (Second / 86400.0d0)
+
+   ENDIF ELSE BEGIN 
+;
+; Fixed number of days per month (default=30) :
+;
+      IF ndayspm EQ 1 THEN ndayspm = 30
+
+      L_MONTH = LONG(MONTH)
+      L_DAY = LONG(DAY)
+      L_YEAR=LONG(YEAR)
+
+      JUL = ((L_YEAR-1)*12. + (L_MONTH-1))* ndayspm + L_DAY 
+      if n_elements(Hour) + n_elements(Minute) + n_elements(Second) eq 0 then $
+       return, JUL
+      if n_elements(Hour) eq 0 then Hour = 0
+      if n_elements(Minute) eq 0 then Minute = 0
+      if n_elements(Second) eq 0 then Second = 0
+      
+      return, JUL + (Hour / 24.0d0) + (Minute/1440.0d0) + (Second / 86400.0d0)
+
+   ENDELSE 
+end
Index: tags/start/CALENDRIER/leapyr.pro
===================================================================
--- tags/start/CALENDRIER/leapyr.pro	(revision 5)
+++ tags/start/CALENDRIER/leapyr.pro	(revision 5)
@@ -0,0 +1,46 @@
+;-----------------------------------------------------------------
+	function leapyr,year
+;+
+; NAME:			leapyr
+;
+; PURPOSE:		determine whether the input year is a leap year or not
+;			Very useful for finding number of days in a year.
+;			eg. NUM_DAYS_IN_YR = 365 + leapyr(year)
+;
+; CATEGORY:		Utility
+;
+; CALLING SEQUENCE:	result = leapyr(year)
+;
+; INPUTS:		year	= test if year is a leap year 
+;				  year may be a vector and may be in the  
+;				  form MCDU eg. 1788 else defaults to 19XX
+;
+; OUTPUTS:		result 	= 0 then not a leap year
+;				= 1 then year is a leap year
+;				= (399+(yr mod 400))/400 - (3+(yr mod 4))/4
+;
+; COMMON BLOCKS:
+;	none.
+; SIDE EFFECTS:
+;	none.
+; MODIFICATION HISTORY:
+;	Written by: Trevor Harris, Physics Dept., University of Adelaide,
+;		20/09/88
+;
+;-
+
+;	this function returns with an I*4 value of :-
+;						1  if year is a leap year
+;						0  if year is not a leap year
+;	T.J.H. 20/09/88
+
+;   	Note:  year must be in the form MCDU eg. 1788  else defaults to 19XX
+
+	
+	yr = year
+	tmp = where(yr lt 100,count)
+	if (count gt 0) then yr(tmp) = yr(tmp)+1900 ;make it the 20th century 
+        print,'TOTO'	
+;	return,(399+(yr mod 400))/400 - (3+(yr mod 4))/4
+        return, 0       
+	end
Index: tags/start/CALENDRIER/monthname.pro
===================================================================
--- tags/start/CALENDRIER/monthname.pro	(revision 5)
+++ tags/start/CALENDRIER/monthname.pro	(revision 5)
@@ -0,0 +1,35 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:monthname
+;
+; PURPOSE:gives the name of a month
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:name=monthname(number)
+; 
+; INPUTS: number, the month number (from 1 to 12)
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS: an integer, the month's name
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      1 October 2001
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION monthname,  mm1
+   return, string(format='(C(CMoA0))',31*(mm1-1))
+end
Index: tags/start/CALENDRIER/vairdate.pro
===================================================================
--- tags/start/CALENDRIER/vairdate.pro	(revision 5)
+++ tags/start/CALENDRIER/vairdate.pro	(revision 5)
@@ -0,0 +1,70 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: vairdate
+;
+; PURPOSE:  gives vairmer date equivalent of a date in julian format
+;           sets month, day and year to the corresp values
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:  vdate = vairdate(1755087)
+;
+; INPUTS:jdate=date en jours juliens
+;
+; KEYWORD PARAMETERS:
+;
+;    MENSUEL: a activer si on veut pour  que les dates dont le jour est
+;    15 deviennent avec un jour egale a 0. par ex:
+;    19990115   ->   19990100
+;
+;    ANNUEL: a activer si on veut pour  que les dates dont le mois est
+;    6 et dont le jour est 1 deviennent avec un mois et jour egale a
+;    0. par ex:
+;    19990601   ->   19990000
+;
+; OUTPUTS:vdate=date vairmer
+;	  plus year, month et day
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Jerome Vialard  (jv@lodyc.jussieu.fr)
+;			2/7/98
+;                13/9/1999, Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       ANNUEL,MENSUEL,_EXTRA et possibilite
+;                       d''utiliser vairdate avec des scalaire ou des
+;                       tableaux
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+function vairdate, jdate,  ANNUEL = annuel, MENSUEL = mensuel, _EXTRA = ex
+@common
+;------------------------------------------------------------
+   caldat, jdate, month, day, year, _EXTRA = ex
+   index = where(year eq -1)
+   if index[0] NE -1 then year[index] = 0
+   if keyword_set(mensuel) THEN BEGIN 
+      index = where(day EQ 15)
+      if index[0] NE -1 then day[index] = 0
+   endif
+   if keyword_set(annuel) THEN BEGIN 
+      index = where(day EQ 1 AND month EQ 6)
+      if index[0] NE -1 then BEGIN 
+         day[index] = 0
+         month[index] = 0
+      endif
+   endif
+;------------------------------------------------------------
+   return, 10000L*year+100L*month+day
+;------------------------------------------------------------
+end
+;------------------------------------------------------------
Index: tags/start/CALENDRIER/vraidate.pro
===================================================================
--- tags/start/CALENDRIER/vraidate.pro	(revision 5)
+++ tags/start/CALENDRIER/vraidate.pro	(revision 5)
@@ -0,0 +1,37 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:vraidate
+;
+; PURPOSE:donne la date en long et avec le siecle s'il n'est pas specifie.
+;
+; CATEGORY:compatibile an 2000 bien-sur
+;
+; CALLING SEQUENCE:res=varidate(date)
+;
+; INPUTS:date:une date vairmer du type yymmdd ou yyyymmdd
+;
+; KEYWORD PARAMETERS:
+;       VRAIDATE: pour ne pasa transformer l''annnee 01 en 1901 
+;
+; OUTPUTS:une date vairmer du type yyyymmdd
+;
+; SIDE EFFECTS:si year est nulle ou egale a -1 ne change rien
+;
+; EXAMPLE:vraidate(980703) donne 19980703 qui est un long
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			3/7/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+function vraidate, date, VRAIDATE = vraidate, _EXTRA = ex
+;------------------------------------------------------------
+   date=long(date)
+   annee=date/10000
+   if keyword_set(VRAIDATE) then return, date ELSE $
+   return, date+19000000*(annee ne 0 and annee ne -1 and date lt 1000000 and date GT 0)
+;------------------------------------------------------------
+end
Index: tags/start/COULEURS/color24.pro
===================================================================
--- tags/start/COULEURS/color24.pro	(revision 5)
+++ tags/start/COULEURS/color24.pro	(revision 5)
@@ -0,0 +1,75 @@
+;+
+; NAME:
+;       COLOR24
+;
+; PURPOSE:
+;       The purpose of this function is to convert a RGB color triple
+;       into the equivalent 24-big long integer. 
+;
+; CATEGORY:
+;       Graphics, Color Specification.
+;
+; CALLING SEQUENCE:
+;       color = COLOR24(rgb_triple)
+;
+; INPUTS:
+;       RGB_TRIPLE: A three-element column or row array representing 
+;       a color triple. The values of the elements must be between 
+;       0 and 255.
+;
+; KEYWORD PARAMETERS:
+;       None. 
+;
+; COMMON BLOCKS:
+;       None.
+;
+; SIDE EFFECTS:
+;       None.
+;
+; RESTRICTIONS:
+;       None.
+;
+; EXAMPLE:
+;       To convert the color triple for the color YELLOW, 
+;       (255, 255, 0), to the hexadecimal value '00FFFF'x 
+;       or the decimal number 65535, type:
+;
+;       color = COLOR24([255, 255, 0])
+;       
+;       This routine was written to be used with routines like 
+;       COLORS or GETCOLOR
+;
+; MODIFICATION HISTORY:
+;       Written by:     David Fanning, 3 February 96.
+;-
+
+
+FUNCTION COLOR24, number
+
+   ; This FUNCTION accepts a [red, green, blue] triple that
+   ; describes a particular color and returns a 24-bit long
+   ; integer that is equivalent to that color. The color is
+   ; described in terms of a hexidecimal number (e.g., FF206A)
+   ; where the left two digits represent the blue color, the 
+   ; middle two digits represent the green color, and the right 
+   ; two digits represent the red color.
+   ;
+   ; The triple can be either a row or column vector of 3 elements.
+   
+ON_ERROR, 1
+
+IF N_ELEMENTS(number) NE 3 THEN $
+   MESSAGE, 'Augument must be a three-element vector.'
+
+IF MAX(number) GT 255 OR MIN(number) LT 0 THEN $
+   MESSAGE, 'Argument values must be in range of 0-255'
+
+base16 = [[1L, 16L], [256L, 4096L], [65536L, 1048576L]]
+
+num24bit = 0L
+
+FOR j=0,2 DO num24bit = num24bit + ((number(j) MOD 16) * base16(0,j)) + $
+   (Fix(number(j)/16) * base16(1,j))
+   
+RETURN, num24bit
+END 
Index: tags/start/COULEURS/colorbar.pro
===================================================================
--- tags/start/COULEURS/colorbar.pro	(revision 5)
+++ tags/start/COULEURS/colorbar.pro	(revision 5)
@@ -0,0 +1,309 @@
+;+
+; NAME:
+;   COLORBAR
+;
+; PURPOSE:
+;       The purpose of this routine is to add a color bar to the current
+;       graphics window.
+;
+; CATEGORY:
+;       Graphics, Widgets.
+;
+; CALLING SEQUENCE:
+;       COLORBAR
+;
+; INPUTS:
+;       None.
+;
+; KEYWORD PARAMETERS:
+;
+;       BOTTOM: The lowest color index of the colors to be loaded in
+;                 the bar.
+;
+;       CB_CHARSIZE: The character size of the color bar annotations. Default is 1.0.
+;
+;       CB_CHARTICK: The character thick of the color bar annotations. Default is 1.0.
+;
+;       CB_COLOR:    The color index of the bar outline and characters. Default
+;                 is ncolors - 1 + bottom.
+;
+;       CB_TITLE:    This is title for the color bar. The default is to have
+;                 no title.
+;
+;	DISCRET:  Vecteur contenant les incices des couleurs a tracer en barre
+; de couleur. On obtient ainsi une barre de couleur discrete ne comportant que
+; les couleurs specifiees ds l'ordre ou elles apparaissent ds le vecteur.
+;
+;       DIVISIONS: The number of divisions to divide the bar into. There will
+;                 be (divisions + 1) annotations. The default is 2.
+;
+;       FORMAT:   The format of the bar annotations. Default is '(F6.2)'.
+;
+;       CB_LABEL:    C''est un vecteur qui specifie la valeur des sticks
+;       presents dans la barre de couleur. Il permet qd on utilise
+;       DISCRET d''avoir des couleurs qui ne s''incrementent pas de
+;       facon regulieres.
+;
+;       MAX:      The maximum data value for the bar annotation. Default is
+;                 NCOLORS-1.
+;
+;       MIN:      The minimum data value for the bar annotation. Default is 0.
+;
+;       NCOLORS:  This is the number of colors in the color bar.
+;
+;       NOTITLE:  oblige a ne pas mettre de titre meme si cb_title est declare
+;
+;       POSITION: A four-element array of normalized coordinates in the same
+;                 form as the POSITION keyword on a plot. Default is
+;                 [0.88, 0.15, 0.95, 0.95] for a vertical bar and
+;                 [0.15, 0.88, 0.95, 0.95] for a horizontal bar.
+;
+;       PSCOLOR:  This keyword is only applied if the output is being sent to
+;                 a PostScript file. It indicates that the PostScript device
+;                 is configured for color output. If this keyword is set, then
+;                 the annotation is drawn in the color specified by the COLOR
+;                 keyword. If the keyword is not set, the annotation is drawn
+;                 in the color specified by the !P.COLOR system variable
+;                 (usually this will be the color black). In general, this
+;                 gives better looking output on non-color or gray-scale
+;                 printers. If you are not specifically setting the annotation
+;                 color (with the COLOR keyword), it will probably
+;                 be better NOT to set this keyword either, even if you
+;                 are outputting to a color PostScript printer.
+;
+;       RIGHT:    This puts the labels on the right-hand side of a vertical
+;                 color bar. It applies only to vertical color bars.
+;
+;       TOP:      This puts the labels on top of the bar rather than under it.
+;                 The keyword only applies if a horizontal color bar is rendered.
+;
+;       VERTICAL: Setting this keyword give a vertical color bar. The default
+;                 is a horizontal color bar.
+;
+; COMMON BLOCKS:
+;       None.
+;
+; SIDE EFFECTS:
+;       Color bar is drawn in the current graphics window.
+;
+; RESTRICTIONS:
+;       The number of colors available on the display device (not the
+;       PostScript device) is used unless the NCOLORS keyword is used.
+;
+; EXAMPLE:
+;       To display a horizontal color bar above a contour plot, type:
+;
+;       LOADCT, 5, NCOLORS=100
+;       CONTOUR, DIST(31,41), POSITION=[0.15, 0.15, 0.95, 0.75], $
+;          C_COLORS=INDGEN(25)*4, NLEVELS=25
+;       COLORBAR, NCOLORS=100
+;
+; MODIFICATION HISTORY:
+;       Written by: David Fanning, 10 JUNE 96.
+;       10/27/96: Added the ability to send output to PostScript. DWF
+;       11/4/96: Substantially rewritten to go to screen or PostScript
+;           file without having to know much about the PostScript device
+;           or even what the current graphics device is. DWF
+;       1/27/97: Added the RIGHT and TOP keywords. Also modified the
+;            way the TITLE keyword works. DWF
+;       7/15/97: Fixed a problem some machines have with plots that have
+;            no valid data range in them. DWF
+;       3/3/98:  ajout du keyword discret par
+;		 sebastien (smasson@lodyc.jussieu.fr)
+;-
+
+PRO COLORBAR, BOTTOM=bottom, CB_CHARSIZE=cb_charsize, CB_CHARTHICK=cb_charthick $
+              , CB_COLOR=cb_color, $
+              DIVISIONS=divisions, DISCRET=discret,CB_LABEL = cb_label, $
+              FORMAT=format, POSITION=position, MAX=max, MIN=min, NCOLORS=ncolors, $
+              PSCOLOR=pscolor, CB_TITLE=cb_title, VERTICAL=vertical, TOP=top, RIGHT=right, _extra = ex
+                                ; Is the PostScript device selected?
+
+   postScriptDevice = (!D.NAME EQ 'PS')
+
+                                ; Check and define keywords.
+
+   IF N_ELEMENTS(ncolors) EQ 0 THEN BEGIN
+
+                                ; Most display devices to not use the 256 colors available to
+                                ; the PostScript device. This presents a problem when writing
+                                ; general-purpose programs that can be output to the display or
+                                ; to the PostScript device. This problem is especially bothersome
+                                ; if you don't specify the number of colors you are using in the
+                                ; program. One way to work around this problem is to make the
+                                ; default number of colors the same for the display device and for
+                                ; the PostScript device. Then, the colors you see in PostScript are
+                                ; identical to the colors you see on your display. Here is one way to
+                                ; do it.
+
+      IF postScriptDevice THEN BEGIN
+         oldDevice = !D.NAME
+
+                                ; What kind of computer are we using? SET_PLOT to appropriate
+                                ; display device.
+
+         thisOS = !VERSION.OS_FAMILY
+         thisOS = STRMID(thisOS, 0, 3)
+         thisOS = STRUPCASE(thisOS)
+         CASE thisOS of
+            'MAC': SET_PLOT, thisOS
+            'WIN': SET_PLOT, thisOS
+            ELSE: SET_PLOT, 'X'
+         ENDCASE
+         !p.BACKGROUND=(!d.n_colors-1) < 255
+         !p.color=0
+         if !d.n_colors gt 256 then !p.background='ffffff'x
+
+                                ; Open a window (to make sure !D.N_COLORS is accurate).
+
+         WINDOW, /FREE, /PIXMAP, XSIZE=10, YSIZE=10
+         WDELETE, !D.WINDOW
+
+                                ; Here is how many colors we should use.
+
+         ncolors = !D.N_COLORS
+         SET_PLOT, oldDevice
+         IF oldDevice EQ 'X' OR oldDevice EQ 'MAC' OR oldDevice EQ 'WIN' then BEGIN
+            !p.BACKGROUND=(!d.n_colors-1) < 255
+            !p.color=0
+            if !d.n_colors gt 256 then !p.background='ffffff'x
+         ENDIF
+      ENDIF ELSE ncolors = !D.N_COLORS
+   ENDIF
+   IF N_ELEMENTS(bottom) EQ 0 THEN bottom = 0B
+   IF N_ELEMENTS(cb_charsize) EQ 0 THEN cb_charsize = 1.0
+   IF N_ELEMENTS(cb_charthick) EQ 0 THEN cb_charthick = 1.0
+   IF N_ELEMENTS(format) EQ 0 THEN format = '(F6.2)'
+   IF N_ELEMENTS(cb_color) EQ 0 THEN cb_color = ncolors - 1 + bottom
+   IF N_ELEMENTS(min) EQ 0 THEN min = 0.0
+   IF N_ELEMENTS(max) EQ 0 THEN max = FLOAT(ncolors) - 1
+   IF N_ELEMENTS(divisions) EQ 0 THEN divisions = 2
+   IF N_ELEMENTS(cb_title) EQ 0 THEN cb_title = ''
+   IF N_ELEMENTS(notitle) EQ 1 THEN cb_title = ''
+   pscolor = KEYWORD_SET(pscolor)
+
+   IF KEYWORD_SET(vertical) THEN BEGIN
+      IF KEYWORD_SET(discret) THEN begin
+         facteur=256/n_elements(discret)
+         discret=reform(replicate(1,facteur) # discret,facteur*n_elements(discret), /overwrite) 
+         bar = REPLICATE(1B,10) # discret
+      endif else  bar = REPLICATE(1B,10) # BINDGEN(256)
+      IF N_ELEMENTS(position) EQ 0 THEN position = [0.88, 0.15, 0.95, 0.95]
+   ENDIF ELSE BEGIN
+      IF KEYWORD_SET(discret) THEN begin
+         facteur=256/n_elements(discret)
+         discret=reform(replicate(1,facteur) # discret,facteur*n_elements(discret), /overwrite) 
+         bar =  discret # REPLICATE(1B,10)
+      endif else bar = BINDGEN(256) # REPLICATE(1B, 10)
+      IF N_ELEMENTS(position) EQ 0 THEN position = [0.15, 0.88, 0.95, 0.95]
+   ENDELSE
+
+                                ; Scale the color bar.
+   IF NOT KEYWORD_SET(discret) THEN $
+    bar = BYTSCL(bar, TOP=ncolors-1) + bottom
+
+                                ; Get starting locations in DEVICE coordinates.
+
+   xstart = position(0) * !D.X_VSIZE
+   ystart = position(1) * !D.Y_VSIZE
+
+                                ; Get the size of the bar in DEVICE coordinates.
+
+   xsize = (position(2) - position(0)) * !D.X_VSIZE
+   ysize = (position(3) - position(1)) * !D.Y_VSIZE
+
+                                ; For PostScript output only, draw the annotation in !P.COLOR
+                                ; unless "pscolor" is set. This makes better output on grayscale
+                                ; printers.
+
+   IF postScriptDevice AND (pscolor NE 1) THEN BEGIN
+      oldcolor = cb_color
+      cb_color = !P.COLOR
+   ENDIF
+
+                                ; Display the color bar in the window. Sizing is
+                                ; different for PostScript and regular display.
+
+   IF postScriptDevice THEN BEGIN
+
+      TV, bar, xstart, ystart, XSIZE=xsize, YSIZE=ysize
+
+   ENDIF ELSE BEGIN
+
+      bar = CONGRID(bar, CEIL(xsize), CEIL(ysize), /INTERP)
+      TV, bar, xstart, ystart
+
+   ENDELSE
+
+                                ; Annotate the color bar.
+
+   if keyword_set(cb_label) then begin
+      divisions = n_elements(cb_label)-1
+      for i = 0,divisions DO cb_label = string(cb_label, FORMAT = format)
+      format = ''
+   ENDIF ELSE cb_label = ''
+
+
+   IF KEYWORD_SET(vertical) THEN BEGIN
+
+      IF KEYWORD_SET(right) THEN BEGIN
+
+         PLOT, [min,max], [min,max], /NODATA, XTICKS=1, $
+          YTICKS=divisions, XSTYLE=1, YSTYLE=9, $
+          POSITION=position, COLOR=cb_color, CHARSIZE=cb_charsize, CHARTHICK=cb_charthick $
+          , /NOERASE, $
+          YTICKFORMAT='(A1)', XTICKFORMAT='(A1)', YTICKLEN=0.1 , $
+          YRANGE=[min, max], YTITLE=cb_title
+
+         AXIS, YAXIS=1, YRANGE=[min, max], YTICKFORMAT=format, YTICKS=divisions, $
+          YTICKLEN=0.1, YSTYLE=1, COLOR=cb_color, CHARTHICK=cb_charthick $
+          , CHARSIZE=cb_charsize, xtickname = cb_label
+
+      ENDIF ELSE BEGIN
+
+         PLOT, [min,max], [min,max], /NODATA, XTICKS=1, $
+          YTICKS=divisions, XSTYLE=1, YSTYLE=9, $
+          POSITION=position, COLOR=cb_color, CHARSIZE=cb_charsize $
+          , CHARTHICK=cb_charthick, /NOERASE, $
+          YTICKFORMAT=format, XTICKFORMAT='(A1)', YTICKLEN=0.1 , $
+          YRANGE=[min, max], xtickname = cb_label
+
+         AXIS, YAXIS=1, YRANGE=[min, max], YTICKFORMAT='(A1)', YTICKS=divisions, $
+          YTICKLEN=0.1, YTITLE=cb_title, YSTYLE=1, COLOR=cb_color $
+          , CHARSIZE=cb_charsize, CHARTHICK=cb_charthick
+
+      ENDELSE
+
+   ENDIF ELSE BEGIN
+
+      IF KEYWORD_SET(top) THEN BEGIN
+
+         PLOT, [min,max], [min,max], /NODATA, XTICKS=divisions, $
+          YTICKS=1, XSTYLE=9, YSTYLE=1, $
+          POSITION=position, COLOR=cb_color, CHARSIZE=cb_charsize $
+          , CHARTHICK=cb_charthick, /NOERASE, $
+          YTICKFORMAT='(A1)', XTICKFORMAT='(A1)', XTICKLEN=0.1, $
+          XRANGE=[min, max], XTITLE=cb_title
+
+         AXIS, XTICKS=divisions, XSTYLE=1, COLOR=cb_color $
+          , CHARSIZE=cb_charsize, CHARTHICK=cb_charthick, $
+          XTICKFORMAT=format, XTICKLEN=0.1, XRANGE=[min, max], XAXIS=1, xtickname = cb_label
+
+      ENDIF ELSE BEGIN
+
+         PLOT, [min,max], [min,max], /NODATA, XTICKS=divisions, $
+          YTICKS=1, XSTYLE=1, YSTYLE=1, $
+          POSITION=position, COLOR=cb_color, CHARSIZE=cb_charsize $
+          , CHARTHICK=cb_charthick, /NOERASE, $
+          YTICKFORMAT='(A1)', XTICKFORMAT=format, XTICKLEN=0.1, $
+          XRANGE=[min, max], TITLE=cb_title, xtickname = cb_label
+
+      ENDELSE
+
+   ENDELSE
+                                ; Restore color variable if changed for PostScript.
+
+   IF postScriptDevice AND (pscolor NE 1) THEN cb_color = oldcolor
+
+   return
+END
Index: tags/start/COULEURS/getcolor.pro
===================================================================
--- tags/start/COULEURS/getcolor.pro	(revision 5)
+++ tags/start/COULEURS/getcolor.pro	(revision 5)
@@ -0,0 +1,378 @@
+;+
+; NAME:
+;       GETCOLOR
+;
+; PURPOSE:
+;       The original purpose of this function was to enable the
+;       user to specify one of the 16 colors supported by the
+;       McIDAS color map by name. Over time, however, the function
+;       has become a general purpose function for handling and
+;       supporting drawing colors in a device-independent way.
+;       In particular, I have been looking for ways to write color
+;       handling code that will work transparently on both 8-bit and
+;       24-bit machines. On 24-bit machines, the code should work the
+;       same where color decomposition is turned on or off.
+;
+;       (The 16 supported colors in GETCOLOR come from the McIDAS color
+;       table offered on the IDL newsgroup by Liam Gumley.)
+;
+; CATEGORY:
+;       Graphics, Color Specification.
+;
+; CALLING SEQUENCE:
+;       result = GETCOLOR(color)
+;
+; OPTIONAL INPUT PARAMETERS:
+;       COLOR: A string with the "name" of the color. Valid names are:
+;           black
+;           magenta
+;           cyan
+;           yellow
+;           green
+;           red
+;           blue
+;           navy
+;           gold
+;           pink
+;           aqua
+;           orchid
+;           gray
+;           sky
+;           beige
+;           white
+;
+;           The color YELLOW is returned if the color name can't be resolved.
+;           Case is unimportant.
+;
+;           If the function is called with just this single input parameter,
+;           the return value is either a 1-by-3 array containing the RGB values of
+;           that particular color, or a 24-bit integer that can be "decomposed" into
+;           that particular color, depending upon the state of the TRUE keyword and
+;           upon whether color decomposition is turned on or off. The state of color
+;           decomposition can ONLY be determined if the program is being run in
+;           IDL 5.2 or higher.
+;
+;       INDEX: The color table index where the specified color should be loaded.
+;           If this parameter is passed, then the return value of the function is the
+;           index number and not the color triple. (If color decomposition is turned
+;           on AND the user specifies an index parameter, the color is loaded in the
+;           color table at the proper index, but a 24-bit value is returned to the
+;           user in IDL 5.2 and higher.)
+;
+;       If no positional parameter is present, then the return value is either a 16-by-3
+;       byte array containing the RGB values of all 16 colors or it is a 16-element
+;       long integer array containing color values that can be decomposed into colors.
+;       The 16-by-3 array is appropriate for loading color tables with the TVLCT command:
+;
+;           Device, Decomposed=0
+;           colors = GetColor()
+;           TVLCT, colors, 100
+;
+;
+; INPUT KEYWORD PARAMETERS:
+;
+;       NAMES: If this keyword is set, the return value of the function is
+;              a 16-element string array containing the names of the colors.
+;              These names would be appropriate, for example, in building
+;              a list widget with the names of the colors. If the NAMES
+;              keyword is set, the COLOR and INDEX parameters are ignored.
+;
+;                 listID = Widget_List(baseID, Value=GetColor(/Names), YSize=16)
+;
+;       LOAD:  If this keyword is set, all 16 colors are automatically loaded
+;              starting at the color index specified by the START keyword.
+;              Note that setting this keyword means that the return value of the
+;              function will be a structure, with each field of the structure
+;              corresponding to a color name. The value of each field will be
+;              an index number (set by the START keyword) corresponding to the
+;              associated color, or a 24-bit long integer value that creates the
+;              color on a true-color device. What you have as the field values is
+;              determined by the TRUE keyword or whether color decomposition is on
+;              or off in the absense of the TRUE keyword. It will either be a 1-by-3
+;              byte array or a long integer value.
+;
+;       START: The starting color index number if the LOAD keyword is set. This keyword
+;              value is ignored unless the LOAD keyword is also set. The keyword is also
+;              ignored if the TRUE keyword is set or if color decomposition in on in
+;              IDL 5.2 and higher. The default value for the START keyword is
+;              !D.TABLE_SIZE - 17.
+;
+;       TRUE:  If this keyword is set, the specified color triple is returned
+;              as a 24-bit integer equivalent. The lowest 8 bits correspond to
+;              the red value; the middle 8 bits to the green value; and the
+;              highest 8 bits correspond to the blue value. In IDL 5.2 and higher,
+;              if color decomposition is turned on, it is as though this keyword
+;              were set.
+;
+; COMMON BLOCKS:
+;       None.
+;
+; SIDE EFFECTS:
+;       None.
+;
+; RESTRICTIONS:
+;       The TRUE keyword causes the START keyword to be ignored.
+;       The NAMES keyword causes the COLOR, INDEX, START, and TRUE parameters to be ignored.
+;       The COLOR parameter is ignored if the LOAD keyword is used.
+;       On systems where it is possible to tell the state of color decomposition
+;       (i.e., IDL 5.2 and higher), a 24-bit value (or values) is automatically
+;       returned if color decomposition is ON.
+;
+; EXAMPLE:
+;       To load a yellow color in color index 100 and plot in yellow, type:
+;
+;          yellow = GETCOLOR('yellow', 100)
+;          PLOT, data, COLOR=yellow
+;
+;       or,
+;
+;          PLOT, data, COLOR=GETCOLOR('yellow', 100)
+;
+;       To do the same thing on a 24-bit color system with decomposed color on, type:
+;
+;          PLOT, data, COLOR=GETCOLOR('yellow', /TRUE)
+;
+;       or in IDL 5.2 and higher,
+;
+;          DEVICE, Decomposed=1
+;          PLOT, data, COLOR=GETCOLOR('yellow')
+;
+;       To load all 16 colors into the current color table, starting at
+;       color index 200, type:
+;
+;          TVLCT, GETCOLOR(), 200
+;
+;       To add the color names to a list widget:
+;
+;           listID = Widget_List(baseID, Value=GetColor(/Names), YSize=16)
+;
+;       To load all 16 colors and have the color indices returned in a structure:
+;
+;           DEVICE, Decomposed=0
+;           colors = GetColor(/Load, Start=1)
+;           HELP, colors, /Structure
+;           PLOT, data, COLOR=colors.yellow
+;
+;       To get the direct color values as 24-bit integers in color structure fields:
+;
+;           DEVICE, Decomposed=1
+;           colors = GetColor(/Load)
+;           PLOT, data, COLOR=colors.yellow
+;
+;       Note that the START keyword value is ignored if on a 24-bit device,
+;       so it is possible to write completely device-independent code by
+;       writing code like this:
+;
+;           colors = GetColor(/Load)
+;           PLOT, data, Color=colors.yellow
+;
+; MODIFICATION HISTORY:
+;       Written by: David Fanning, 10 February 96.
+;       Fixed a bug in which N_ELEMENTS was spelled wrong. 7 Dec 96. DWF
+;       Added the McIDAS colors to the program. 24 Feb 99. DWF
+;       Added the INDEX parameter to the program 8 Mar 99. DWF
+;       Added the NAMES keyword at insistence of Martin Schultz. 10 Mar 99. DWF
+;       Reorderd the colors so black is first and white is last. 7 June 99. DWF
+;       Added automatic recognition of DECOMPOSED=1 state. 7 June 99. DWF
+;       Added LOAD AND START keywords. 7 June 99. DWF.
+;-
+
+
+
+FUNCTION COLOR24, number
+
+   ; This FUNCTION accepts a [red, green, blue] triple that
+   ; describes a particular color and returns a 24-bit long
+   ; integer that is equivalent to that color. The color is
+   ; described in terms of a hexidecimal number (e.g., FF206A)
+   ; where the left two digits represent the blue color, the
+   ; middle two digits represent the green color, and the right
+   ; two digits represent the red color.
+   ;
+   ; The triple can be either a row or column vector of 3 elements.
+
+ON_ERROR, 1
+
+IF N_ELEMENTS(number) NE 3 THEN $
+   MESSAGE, 'Augument must be a three-element vector.'
+
+IF MAX(number) GT 255 OR MIN(number) LT 0 THEN $
+   MESSAGE, 'Argument values must be in range of 0-255'
+
+base16 = [[1L, 16L], [256L, 4096L], [65536L, 1048576L]]
+
+num24bit = 0L
+
+FOR j=0,2 DO num24bit = num24bit + ((number(j) MOD 16) * base16(0,j)) + $
+   (Fix(number(j)/16) * base16(1,j))
+
+RETURN, num24bit
+END ; ************************  of COLOR24  ******************************
+
+
+
+FUNCTION GETCOLOR, thisColor, index, TRUE=truecolor, $
+   NAMES=colornames, LOAD=load, START=start
+
+   ; Set up the color vectors.
+
+names  = ['Black', 'Magenta', 'Cyan', 'Yellow', 'Green']
+rvalue = [  0,        255,       0,      255,       0  ]
+gvalue = [  0,          0,     255,      255,     255  ]
+bvalue = [  0,        255,     255,        0,       0  ]
+names  = [names,  'Red', 'Blue', 'Navy', 'Gold', 'Pink']
+rvalue = [rvalue,  255,     0,      0,    255,    255  ]
+gvalue = [gvalue,    0,     0,      0,    187,    127  ]
+bvalue = [bvalue,    0,   255,    115,      0,    127  ]
+names  = [names,  'Aqua', 'Orchid', 'Gray', 'Sky', 'Beige', 'White']
+rvalue = [rvalue,   112,     219,     127,    0,     255,     255  ]
+gvalue = [gvalue,   219,     112,     127,  163,     171,     255  ]
+bvalue = [bvalue,   147,     219,     127,  255,     127,     255  ]
+
+   ; Did the user ask for a specific color? If not, return
+   ; all the colors. If the user asked for a specific color,
+   ; find out if a 24-bit value is required. Return to main
+   ; IDL level if an error occurs.
+
+ON_Error, 1
+np = N_Params()
+IF Keyword_Set(start) EQ 0 THEN start = !D.TABLE_SIZE - 17
+
+   ; User ask for the color names?
+
+IF Keyword_Set(colornames) THEN RETURN, names ELSE names = StrUpCase(names)
+
+   ; If no positional parameter, return all colors.
+
+IF np EQ 0 THEN BEGIN
+
+   ; Did the user want a 24-bit value? If so, call COLOR24.
+
+   IF Keyword_Set(trueColor) THEN BEGIN
+      returnColor = LonArr(16)
+      FOR j=0,15 DO returnColor[j] = Color24([rvalue[j], gvalue[j], bvalue[j]])
+
+         ; If LOAD keyword set, return a color structure.
+
+      IF Keyword_Set(load) THEN BEGIN
+         returnValue = Create_Struct('black', returnColor[0])
+         FOR j=1,15 DO returnValue = Create_Struct(returnValue, names[j], returnColor[j])
+         returnColor = returnValue
+      ENDIF
+
+      RETURN, returnColor
+   ENDIF
+
+   ; If color decomposition is ON, return 24-bit values.
+
+   IF Float(!Version.Release) GE 5.2 THEN BEGIN
+      IF (!D.Name EQ 'X' OR !D.Name EQ 'WIN' OR !D.Name EQ 'MAC') THEN BEGIN
+         Device, Get_Decomposed=decomposedState
+      ENDIF ELSE decomposedState = 0
+      IF decomposedState EQ 1 THEN BEGIN
+         returnColor = LonArr(16)
+         FOR j=0,15 DO returnColor[j] = Color24([rvalue[j], gvalue[j], bvalue[j]])
+         IF Keyword_Set(load) THEN BEGIN
+            returnValue = Create_Struct('black', returnColor[0])
+            FOR j=1,15 DO returnValue = Create_Struct(returnValue, names[j], returnColor[j])
+            RETURN, returnValue
+         ENDIF
+         RETURN, returnColor
+      ENDIF
+
+      IF Keyword_Set(load) THEN BEGIN
+         TVLCT, Reform([rvalue, gvalue, bvalue], 16, 3), start
+         returnValue = Create_Struct('black', start)
+         FOR j=1,15 DO returnValue = Create_Struct(returnValue, names[j], start+j)
+         RETURN, returnValue
+      ENDIF
+
+      returnColor = REFORM([rvalue, gvalue, bvalue], 16, 3)
+      RETURN, returnColor
+
+   ENDIF
+
+   IF Keyword_Set(load) THEN BEGIN
+      TVLCT, Reform([rvalue, gvalue, bvalue], 16, 3), start
+      returnValue = Create_Struct('black', start)
+      FOR j=1,15 DO returnValue = Create_Struct(returnValue, names[j], start+j)
+      RETURN, returnValue
+   ENDIF
+
+   returnColor = REFORM([rvalue, gvalue, bvalue], 16, 3)
+   RETURN, returnColor
+
+ENDIF
+
+   ; Check synonyms of colors.
+
+IF StrUpCase(thisColor) EQ 'GREY' THEN thisColor = 'GRAY'
+IF StrUpCase(thisColor) EQ 'CHARCOAL' THEN thisColor = 'GRAY'
+IF StrUpCase(thisColor) EQ 'AQUAMARINE' THEN thisColor = 'AQUA'
+IF StrUpCase(thisColor) EQ 'SKYBLUE' THEN thisColor = 'SKY'
+
+   ; Make sure the parameter is an uppercase string.
+
+varInfo = SIZE(thisColor)
+IF varInfo(varInfo(0) + 1) NE 7 THEN $
+   MESSAGE, 'The color name must be a string.'
+thisColor = STRUPCASE(thisColor)
+
+   ; Get the color triple for this color.
+
+colorIndex = WHERE(names EQ thisColor)
+
+   ; If you can't find it. Issue an infomational message,
+   ; set the index to a YELLOW color, and continue.
+
+IF colorIndex(0) LT 0 THEN BEGIN
+   MESSAGE, "Can't find color. Returning YELLOW.", /INFORMATIONAL
+   colorIndex = 3
+ENDIF
+
+   ; Get the color triple.
+
+r = rvalue(colorIndex)
+g = gvalue(colorIndex)
+b = bvalue(colorIndex)
+returnColor = REFORM([r, g, b], 1, 3)
+
+   ; Did the user want a 24-bit value? If so, call COLOR24.
+
+IF KEYWORD_SET(trueColor) THEN BEGIN
+   returnColor = COLOR24(returnColor)
+   RETURN, returnColor
+ENDIF
+
+   ; If color decomposition is ON, return 24-bit value.
+
+IF Float(!Version.Release) GE 5.2 THEN BEGIN
+
+      IF (!D.Name EQ 'X' OR !D.Name EQ 'WIN' OR !D.Name EQ 'MAC') THEN BEGIN
+         Device, Get_Decomposed=decomposedState
+      ENDIF ELSE decomposedState = 0
+
+   IF decomposedState EQ 1 THEN BEGIN
+
+         ; Before you change return color, load index if requested.
+
+      IF N_Elements(index) NE 0 THEN BEGIN
+         index = 0 > index < (!D.Table_Size-1)
+         TVLCT, returnColor, index
+      ENDIF
+
+      returnColor = COLOR24(returnColor)
+      RETURN, returnColor
+   ENDIF
+ENDIF
+
+   ; Did the user specify a color index? If so, load it.
+
+IF N_Elements(index) NE 0 THEN BEGIN
+   index = 0 > index < (!D.Table_Size-1)
+   TVLCT, returnColor, index
+   returnColor = index
+ENDIF
+
+RETURN, returnColor
+END
Index: tags/start/COULEURS/lct.pro
===================================================================
--- tags/start/COULEURS/lct.pro	(revision 5)
+++ tags/start/COULEURS/lct.pro	(revision 5)
@@ -0,0 +1,103 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:lct
+;
+; PURPOSE:plus court que de taper loadct,file='palette.tbl'
+;
+; CATEGORY:flemme
+;
+; CALLING SEQUENCE:lct[,numerp_couleur]
+;
+; INPUTS:optionnel: numero de la couleur que l''on veut ds palette.tbl
+;
+; KEYWORD PARAMETERS: ceux de loadct
+;
+; rq: si le mot cle file n''est pas specifie, on cherche un fichier
+; contenant les palette du nom de palette.tbl.
+; Ce fichier peut etre dans n''importe quel repertoire du !path
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       30/3/1999 ajout de _extra, de la recherche
+;                       du nom complet et pour que ca marche aussi en
+;                       mode PS et Z
+;                       6/7/1999: compatibilite mac et windows
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO lct, numero, GET_NAME = get_name, _EXTRA = ex
+@common
+; le mot cle file est passe par l''intermediere de EXTRA?
+; definition du mon du fichier qui contient les palettes de couleur
+   if n_elements(ex) NE 0 then BEGIN 
+      if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then nompal=ex.FILE ELSE nompal='palette.tbl'
+   ENDIF ELSE nompal = 'palette.tbl'
+; quelle est l''adresse complete de nompal?
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   CASE thisOS of
+   'MAC':BEGIN & sep = ':' & pathsep = ',' & end
+   'WIN':BEGIN & sep = '\' & pathsep = ';' & end
+   ELSE: BEGIN & sep = '/' & pathsep = ':' & end
+   ENDCASE
+   cd, current = current
+   if strpos(nompal,sep) lt 0 then BEGIN
+      if rstrpos(current,sep) NE strlen(current)-1 then current = current+sep
+      multipath = str_sep(!path,pathsep)
+      for i = 0, n_elements(multipath)-1 do $
+       if rstrpos(multipath[i],sep) NE strlen(multipath[i])-1 then $
+       multipath[i] = multipath[i] +sep
+      nompal = [current, multipath]+ nompal
+   ENDIF
+; on test tous les noms possibles pour trouver ou est le fichier
+   nfile=n_elements(nompal)
+   n = 0
+   repeat begin
+      res = findfile(nompal[n]) 
+      n = n+1
+   endrep until res[0] NE '' OR n EQ n_elements(nompal) 
+   if res[0] NE '' then BEGIN
+      nompal = nompal[n-1]
+      if n_elements(ex) NE 0 then $ 
+       if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then ex.FILE = nompal
+; si on est en mode POSTSCRIPT, il faut repasser en mode X pour
+; changer la palette de couleur
+      oldname = !d.name
+      if !d.name EQ 'PS' OR !d.name EQ 'Z' then BEGIN 
+         thisOS = !VERSION.OS_FAMILY
+         thisOS = STRMID(thisOS, 0, 3)
+         thisOS = STRUPCASE(thisOS)
+         CASE thisOS of
+            'MAC': SET_PLOT, thisOS
+            'WIN': SET_PLOT, thisOS
+            ELSE: SET_PLOT, 'X'
+         ENDCASE
+         !p.BACKGROUND=(!d.n_colors-1) < 255
+         !p.color=0
+         if !d.n_colors gt 256 then !p.background='ffffff'x
+      ENDIF
+;
+      if arg_present(get_name) then begin
+         if n_elements(numero) EQ 0 then loadct, file=nompal, GET_NAME = get_name, _EXTRA = ex $
+         ELSE loadct,numero, file=nompal, /silent, GET_NAME = get_name,_EXTRA = ex
+      ENDIF ELSE BEGIN 
+         if n_elements(numero) EQ 0 then loadct, file=nompal, _EXTRA = ex $
+         ELSE loadct,numero, file=nompal, /silent, _EXTRA = ex
+      ENDELSE 
+;
+      if oldname EQ 'PS' then BEGIN 
+         tvlct,  rouge,  vert, bleu, /get
+         palit,  coefpalit
+      endif
+      set_plot, oldname
+      IF oldname EQ 'X' OR oldname EQ 'MAC' OR oldname EQ 'WIN' then BEGIN
+         !p.BACKGROUND=(!d.n_colors-1) < 255
+         !p.color=0
+         if !d.n_colors gt 256 then !p.background='ffffff'x
+      ENDIF
+
+   ENDIF ELSE ras = report('le fichier de palettes demande n''existe pas...')
+
+   return
+end
Index: tags/start/COULEURS/newpalette.pro
===================================================================
--- tags/start/COULEURS/newpalette.pro	(revision 5)
+++ tags/start/COULEURS/newpalette.pro	(revision 5)
@@ -0,0 +1,81 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:newpalette
+;
+; PURPOSE:permet de stocker la palette qui est a l''ecran dans un
+; fichier du meme type que celui fournit par defaut dans IDL:
+; 'colors1.tbl'.
+;
+; CATEGORY:pour garder ses jolies palettes perso.
+;
+; CALLING SEQUENCE:newpalette,nom_de_palette
+;
+; INPUTS:nom_de_palette: c'est un string qui contient le nom de la
+; nouvelle palette que l''on veut ecrire.
+;
+; KEYWORD PARAMETERS: 
+;
+; OVER: c''est un entier qui designe le numero de la palette que l''on
+; veut remplacer par la palette a l''ecran.
+; 
+; + ceux de modifyct
+;
+; rq: si le mot cle file n''est pas specifie, on cherche un fichier
+; contenant les palettes du nom de palette.tbl.
+; Ce fichier peut etre dans n''importe quel repertoire du !path
+; Par contre il doit etre en droit d''ecriture
+;
+; MODIFICATION HISTORY: Guillaume Roulet (gr@lodyc.jussieu.fr)
+;                       30/3/1999 s.masson, ajout de _extra, de le
+;                       recherche du nom complet, de OVER et du blabla
+;                       5/5/1999 s.masson, va copie eventuelle du
+;                       fichier contenant les palettes
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro newpalette,nom, OVER = over, _extra = ex
+; le mot cle file est passe par l''intermediere de EXTRA?
+; definition du mon du fichier qui contient les palettes de couleur
+   if n_elements(ex) NE 0 then BEGIN 
+      if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then nompal=ex.FILE ELSE nompal='palette.tbl'
+   ENDIF ELSE nompal = 'palette.tbl'
+   nomcourt = nompal
+; quelle est l''adresse complete de nompal?
+   nompal = find(nompal)
+   if nompal[0] NE 'NOT FOUND' then begin
+      nompal = nompal[0]
+; nompal nous appartient???
+      spawn, 'whoami', login
+      appartient = strpos(nompal, login[0])
+      if appartient EQ -1 then begin
+         ouinon = report('Le fichier '+nompal+' ne vous appartient pas, Voulez-vous copier le fichier '+nomcourt+' dans le repertoire courant: '+current+' ?', /default_no, /question)
+         if ouinon then return ELSE BEGIN 
+            spawn, 'cp '+nompal+' '+nomcourt ; on copie
+            nompal = nomcourt
+            spawn,  'chmod u+w '+nompal ; on se donne les droits d''ecriture
+         ENDELSE
+      endif
+   ENDIF ELSE BEGIN             ; aucun fichier nompal a ete trouve
+      nompal = nomcourt         ; on recupe le nompal d''origine
+      ouinon = report('le fichier de palettes demande '+nompal+' n''existe pas ds les repertoires !path. Voulez-vous cree un fichier '+nompal+' dans le repertoire courant', /default_no, /question)
+      if NOT ouinon then return
+      nomfichsource = filepath('colors1.tbl', subdir=['resource', 'colors']) 
+      spawn,'cp '+nomfichsource+' '+nompal ; on copie
+      spawn,  'chmod u+w '+nompal ; on se donne les droits d''ecriture
+   ENDELSE 
+
+   if n_elements(ex) NE 0 then $ 
+    if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then ex.FILE = nompal
+;
+   tvlct,r,g,b,/get
+   r=congrid(r,256)
+   g=congrid(g,256)
+   b=congrid(b,256)
+   IF n_elements(over) EQ 0 then over = 255
+   modifyct,over,nom,r,g,b,file=nompal, _extra = ex
+;
+   return
+end
Index: tags/start/COULEURS/palit.pro
===================================================================
--- tags/start/COULEURS/palit.pro	(revision 5)
+++ tags/start/COULEURS/palit.pro	(revision 5)
@@ -0,0 +1,21 @@
+PRO palit, coef
+;+
+;  Eclaircit la palette courante en jouant sur la luminosite
+;
+;          coef = regle l'attenuation des couleurs
+;          par defaut divise par 2 la luminosite
+;
+;  coef = 0.1 pour la QMS papier de l'IPSL convient tres bien
+;-
+   @common
+   IF n_elements(coef) EQ 0 THEN coef = 0.5
+   color_convert, rouge, vert, bleu, h, l, s, /rgb_hls
+   l = 1.-coef*(1.-l)
+;
+;  Le noir doit rester bien noir !
+;  toutes mes palettes commencent par du noir et finissent par du blanc
+;
+   l[0] = 0.
+   tvlct, h, l, s, /hls
+   return
+END
Index: tags/start/COULEURS/xlct.pro
===================================================================
--- tags/start/COULEURS/xlct.pro	(revision 5)
+++ tags/start/COULEURS/xlct.pro	(revision 5)
@@ -0,0 +1,607 @@
+; $Id$
+;
+; Copyright (c) 1991-1998, Research Systems, Inc.  All rights reserved.
+;       Unauthorized reproduction prohibited.
+
+PRO XLCT_PSAVE			;Save/Restore our plotting state.
+;  Swaps our state with the current state each time its called.
+
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $
+        updt_callback, updt_cb_data
+
+tmp = { xlct_psave, win: !d.window, x: !x.s, y: !y.s , xtype: !x.type, $
+                         ytype: !y.type, clip: !p.clip }
+
+wset, psave.win
+!x.type = psave.xtype
+!y.type = psave.ytype
+!x.s = psave.x
+!y.s = psave.y
+!p.clip = psave.clip
+psave = tmp
+end
+
+pro xlct_alert_caller
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $
+        updt_callback, p_updt_cb_data
+
+    ErrorStatus = 0
+    CATCH, ErrorStatus
+    if (ErrorStatus NE 0) then begin
+        CATCH, /CANCEL
+        v = DIALOG_MESSAGE(['Unexpected error in XLCT:', $
+                        '!ERR_STRING = ' + !ERR_STRING], $
+                        /ERROR)
+        return
+    endif
+    if (STRLEN(updt_callback) gt 0) then begin
+        if (PTR_VALID(p_updt_cb_data)) then begin
+            CALL_PROCEDURE, updt_callback, DATA=*(p_updt_cb_data)
+        endif else begin
+            CALL_PROCEDURE, updt_callback
+        endelse
+    endif
+end
+
+
+; Redraw the ramp image.
+PRO xlct_show
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $
+        updt_callback, p_updt_cb_data
+
+    cur_win = !D.WINDOW
+    WSET, show_win
+    TV, BYTE((FLOAT(ncolors)*FINDGEN(siz)/FLOAT(siz-1)) # $
+        REPLICATE(1, w_height)) + BYTE(cbot)
+
+    WSET, cur_win
+
+    ; Let the caller of XLCT know that the color table was modified
+    xlct_alert_caller
+END
+
+PRO xlct_draw_cps, i, c
+COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot
+
+tc = color
+if n_elements(c) gt 0 then begin
+	tc = c
+	if c ne 0 then color = c
+	endif
+
+if i[0] eq -1 then j = indgen(n_elements(cps)) else j = i
+
+plots, cps[j], tfun[j], /noclip, color = tc
+plots, cps[j], tfun[j], /noclip, psym=6, color = tc
+end
+
+PRO xlct_transfer, UPDATE=update
+COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot
+
+l = lonarr(ncolors)		;Subscripts
+m = n_elements(cps)
+for i=0, m-2 do begin
+	n = cps[i+1]-cps[i]		;Interval
+	b = (tfun[i+1]-tfun[i])/float(n)
+	l[cps[i]] = findgen(n) * b + (tfun[i] + cbot)
+	endfor
+l[ncolors-1] = tfun[m-1]		;Last point
+if use_values then begin
+  r_curr[cbot] = (r = l[r_orig])
+  g_curr[cbot] = (g = l[g_orig])
+  b_curr[cbot] = (b = l[b_orig])
+endif else begin
+  r_curr[cbot] = (r = r_orig[l])
+  g_curr[cbot] = (g = g_orig[l])
+  b_curr[cbot] = (b = b_orig[l])
+endelse
+
+tvlct, r,g,b, cbot
+if (keyword_set( update )) then $
+  xlct_show
+end
+
+PRO xlct_event, event
+COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $
+        updt_callback, p_updt_cb_data
+
+
+IF event.id eq state.draw THEN BEGIN	;** PROCESS DRAWABLE EVENTS **
+	if event.press ne 0 then begin		;Pressed button?
+		dmin = 1.0e8		;Find closest control pnt
+		xlct_psave		;Remove old
+		p = convert_coord(event.x, event.y, /TO_DATA, /DEVICE)
+		xlct_psave		;Restore old
+		x = fix(p[0])
+		y = fix(p[1])
+		for i=0, n_elements(cps)-1 do begin
+			d = (p[0]-cps[i])^2 + (p[1]-tfun[i])^2  ; dist ^ 2
+			if d lt dmin then begin
+				dmin = d
+				pnt = i
+				endif
+			endfor
+		return
+		endif
+	if event.release ne 0 then begin	;Released button?
+		pnt = -1
+                xlct_transfer, /update
+		return
+		endif
+	if pnt lt 0 then return			;Don't care here...
+
+	xlct_psave				;Remove old
+        ; For visuals with static colormaps, erase plot before drawing new
+        if ((COLORMAP_APPLICABLE(redrawRequired) GT 0) and $
+            (redrawRequired GT 0)) then begin
+           ERASE, color=0
+        endif
+	p = convert_coord(event.x, event.y, /TO_DATA, /DEVICE)	;Coord of mouse
+	n = ncolors -1		;Into range....
+	m = n_elements(cps)-1
+	x = fix(p[0]) > 0 < n
+	if pnt eq 0 then x = 0 else $		;1st & last are fixed
+	if pnt eq m then x = n else $
+	x = x > (cps[pnt-1] + 1) < (cps[pnt+1]-1)  ;Others must be between
+
+	if pnt eq 0 then xlct_draw_cps, [0, 1],0 $  ;Erase old segment
+	else if pnt eq m then xlct_draw_cps, [m-1, m],0 $
+	else xlct_draw_cps, [pnt-1, pnt, pnt+1],0
+	cps[pnt] = x
+	tfun[pnt] = fix(p[1]) > 0 < n
+	xlct_transfer
+
+	b = r_curr * .3 + g_curr * .586 + b_curr * .114 ;Ntsc colors
+	c = max(abs(b-b[cbot]), j)  ; *** J is color index furthest from 0
+
+	if pnt eq 0 then xlct_draw_cps, [0, 1], j $
+	else if pnt eq m then xlct_draw_cps, [m-1, m], j $
+	else xlct_draw_cps, [pnt-1, pnt, pnt+1], j
+
+	xlct_psave		;Remove old
+	return
+	ENDIF
+
+WIDGET_CONTROL, event.id, GET_UVALUE = eventval
+
+abstop = NCOLORS -1
+
+if event.id eq state.name_list then begin
+	LOADCT, silent=silent, event.index, FILE=filename, NCOLORS=ncolors, $
+		BOTTOM=cbot
+	goto, set_gamma
+	ENDIF
+
+CASE eventval OF
+    "TOP":    BEGIN
+		WIDGET_CONTROL, top, GET_VALUE = vtop
+                if lock ne 0 then begin
+                        vbot = (vtop - lock) > 0 < 100
+                        widget_control, bot, SET_VALUE=vbot
+                        endif
+                GOTO, set_gamma
+              END
+
+    "BOTTOM": BEGIN
+		WIDGET_CONTROL, bot, GET_value = vbot
+                if lock ne 0 then begin
+                        vtop = (vbot + lock) > 0 < 100
+                        widget_control, top, SET_VALUE=vtop
+                        ENDIF
+   set_gamma:
+	if use_values then nc = 256 else nc = ncolors
+	s = (nc-1)/100.
+	x0 = vbot * s
+	x1 = vtop * s
+	if x0 ne x1 then s = (nc-1.0)/(x1 - x0) else s = 1.0
+	int = -s * x0
+	if gamma eq 1.0 then s = round(findgen(nc) * s + int > 0.0) $
+	else s = ((findgen(nc) * (s/nc) + (int/nc) > 0.0) ^ gamma) * nc
+	if chop ne 0 then begin
+	    too_high = where(s ge nc, n)
+	    if n gt 0 then s[too_high] = 0L
+	    endif
+	if use_values then begin
+	    s = s < 255L
+	    l = lindgen(ncolors) + cbot
+	    r_curr[cbot] = (r = s[r_orig[l]])
+	    g_curr[cbot] = (g = s[g_orig[l]])
+	    b_curr[cbot] = (b = s[b_orig[l]])
+	endif else begin
+	    s = s + cbot
+	    r_curr[cbot] = (r = r_orig[s])
+	    g_curr[cbot] = (g = g_orig[s])
+	    b_curr[cbot] = (b = b_orig[s])
+ 	endelse
+	tvlct, r,g,b, cbot
+        xlct_show
+	ENDCASE
+
+    "GAMMA": BEGIN
+                WIDGET_CONTROL, g_slider, GET_VALUE = gamma
+                gamma = 10^((gamma/50.) - 1)
+                WIDGET_CONTROL, g_lbl, SET_VALUE = $
+			STRING(gamma, format='(f6.3)')
+		goto, set_gamma
+             ENDCASE
+
+    "GANG" : IF event.value eq 0 then lock = 0 else lock = vtop - vbot
+
+    "CHOP" : BEGIN
+        chop = event.value
+        goto, set_gamma         ;And redraw
+        ENDCASE
+
+    "VALUES": BEGIN
+	use_values = event.value
+	ENDCASE
+
+    "HELP" : XDisplayFile, FILEPATH("xlct.txt", subdir=['help', 'widget']), $
+                TITLE = "Xlct Help", $
+                GROUP = event.top, $
+                WIDTH = 55, $
+                HEIGHT = 16
+
+    "RESTORE" : BEGIN                   ;Restore the original tables
+        r_curr = (r_orig = r0)
+        g_curr = (g_orig = g0)
+        b_curr = (b_orig = b0)
+	tvlct, r_curr, g_curr, b_curr
+        xlct_show
+        ENDCASE
+
+    "OVERWRITE" : BEGIN                 ;overwrite original tables
+	r0 = (r_orig = r_curr)
+	g0 = (g_orig = g_curr)
+	b0 = (b_orig = b_curr)
+    reset_all:
+        WIDGET_CONTROL, top, SET_VALUE = 100
+        WIDGET_CONTROL, bot, SET_VALUE = 0
+        WIDGET_CONTROL, g_slider, SET_VALUE = 50
+	vbot = 0
+	vtop = 100
+	gamma = 1.0
+	GOTO, set_gamma
+	ENDCASE
+
+    "REVERSE" : BEGIN                   ;Reverse the table
+	l = lindgen(ncolors) + cbot
+        r_orig[cbot] = reverse(r_orig[l])
+        g_orig[cbot] = reverse(g_orig[l])
+        b_orig[cbot] = reverse(b_orig[l])
+        goto, set_gamma                 ;And redraw
+        ENDCASE
+
+    "DONE": BEGIN
+        WIDGET_CONTROL, event.top, /DESTROY
+        r0 = 0 & g0 = 0 & b0 = 0  ;Free common
+        if PTR_VALID(p_updt_cb_data) then PTR_FREE, p_updt_cb_data
+        ENDCASE
+
+    "NEWBASE": BEGIN
+	mode = event.value
+	b = ([0, 0, 1])[mode]		;Top base to map: 0 or 1.
+	for i=0,1 do WIDGET_CONTROL, state.bases[i], MAP=i eq b
+	if b eq 0 then begin		;table or option mode?
+	   b = ([2,3,0])[mode]		;bottom base to map (mode eq 0 or 1)
+	   for i=2,3 do WIDGET_CONTROL, state.bases[i], MAP=i eq b
+	   endif
+	if mode eq 2 then begin
+	    reset_all = 1
+	    xlct_psave			;Save old state
+	    plot, [0, ncolors-1], [0, ncolors-1], xstyle=3, $
+		ystyle=3, xmargin = [1,1], ymargin=[1,1], ticklen = -0.03, $
+		/NODATA, $
+		xtickname = replicate(' ', 10), ytickname = replicate(' ', 10)
+	    goto, interp_cps
+	    endif
+	
+	ENDCASE
+
+    "TFUNR": BEGIN
+     reset_tfun:
+	xlct_psave
+	xlct_draw_cps, -1, 0	;Erase all
+	tfun = cps		;Linear ramp
+	goto, interp_cps
+	ENDCASE
+
+    "REMCP": BEGIN
+	n = n_elements(cps)
+	if n gt 2 then begin
+	  xlct_psave
+	  xlct_draw_cps, -1, 0
+	  igap = 0
+	  for i=0, n-2 do $
+		if (cps[i+1] - cps[i]) lt (cps[igap+1]-cps[igap]) then $
+			igap = i
+	  keep = where(indgen(n) ne (igap > 1))
+	  cps = cps[keep]
+	  tfun = tfun[keep]
+	  goto, interp_cps
+	  ENDIF
+	ENDCASE
+    "ADDCP": BEGIN
+	xlct_psave
+	xlct_draw_cps, -1, 0
+	igap = 0			;Find largest gap
+	for i=0, n_elements(cps)-2 do $
+		if (cps[i+1] - cps[i]) gt (cps[igap+1]-cps[igap]) then $
+			igap = i
+	cps = [ cps[0:igap], (cps[igap]+cps[igap+1])/2, cps[igap+1:*]]
+	tfun = [ tfun[0:igap], (tfun[igap]+tfun[igap+1])/2, tfun[igap+1:*]]
+      interp_cps:  xlct_draw_cps, -1  ;Redraw new
+	xlct_transfer, /update
+	xlct_psave		;Restore old points
+	if n_elements(reset_all) then goto, reset_all
+	ENDCASE
+ENDCASE
+
+END
+
+
+;+
+; NAME:
+;       XLCT
+; PURPOSE:
+;       comme xloadct mais plus cour a ecrire et appelle par defaut la
+;       palette palette.tbl qui peut etre situee dans n''importe quel
+;       repertoire de !path.
+;
+; CATEGORY:
+;       Widgets
+; CALLING SEQUENCE:
+;       XLCT
+; INPUTS:
+;       None.
+; KEYWORDS:
+;	FILE:	If this keyword is set, the file by the given name is used
+;		instead of the file colors1.tbl in the IDL directory.  This
+;		allows multiple IDL users to have their own color table file.
+;       GROUP = The widget ID of the widget that calls Xlct.  When 
+;               this ID is specified, a death of the caller results in a 
+;               death of Xlct
+;	NCOLORS = number of colors to use.  Use color indices from BOTTOM
+;		to the smaller of !D.TABLE_SIZE-1 and NCOLORS-1.
+;		Default = !D.TABLE_SIZE = all available colors.
+;	BOTTOM = first color index to use. Use color indices from BOTTOM to
+;		BOTTOM+NCOLORS-1.  Default = 0.
+;       SILENT - Normally, no informational message is printed when
+;               a color map is loaded. If this keyword is present and
+;               zero, this message is printed.
+;	USE_CURRENT: If set, use the current color tables, regardless of
+;		the contents of the COMMON block COLORS.
+;       MODAL:  If set, then XLCT runs in "modal" mode, meaning that
+;               all other widgets are blocked until the user quits XLCT.
+;               A group leader must be specified (via the GROUP keyword)
+;               for the MODAL keyword to have any effect.   The default
+;               is to not run in modal mode.
+;	BLOCK:  Set this keyword to have XMANAGER block when this
+;		application is registered.  By default the Xmanager
+;               keyword NO_BLOCK is set to 1 to provide access to the
+;               command line if active command 	line processing is available.
+;               Note that setting BLOCK for this application will cause
+;		all widget applications to block, not only this
+;		application.  For more information see the NO_BLOCK keyword
+;		to XMANAGER.
+;       UPDATECALLBACK: Set this keyword to a string containing the name of
+;               a user-supplied procedure that will be called when the color
+;               table is updated by XLCT.  The procedure may optionally
+;               accept a keyword called DATA, which will be automatically
+;               set to the value specified by the optional UPDATECBDATA
+;               keyword.
+;       UPDATECBDATA: Set this keyword to a value of any type. It will be
+;               passed via the DATA keyword to the user-supplied procedure
+;               specified via the UPDATECALLBACK keyword, if any. If the
+;               UPDATECBDATA keyword is not set the value accepted by the
+;               DATA keyword to the procedure specified by UPDATECALLBACK
+;               will be undefined.
+;
+; OUTPUTS:
+;       None.
+; COMMON BLOCKS:
+;       None.
+; SIDE EFFECTS:
+;       One of the predefined color maps may be loaded.
+; RESTRICTIONS:
+;       This routine uses the LOADCT user library procedure to
+;       do the actual work.
+; MODIFICATION HISTORY:
+;       5/5/1999 copie de xloadct par Sebastien Masson (smlod@ipsl.jussieu.fr)
+;-
+
+PRO XLct, SILENT=silent_f, GROUP=group, FILE=file, $
+          USE_CURRENT=use_current, NCOLORS = nc, BOTTOM=bottom, $
+          MODAL=modal, BLOCK=block, UPDATECALLBACK=updt_cb_name, $
+          UPDATECBDATA=updt_cb_data
+
+   COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+   COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+    top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+    gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $
+    updt_callback, p_updt_cb_data
+
+
+   IF(XRegistered("xlct") NE 0) THEN return
+
+   IF N_ELEMENTS(block) EQ 0 THEN block=0
+   IF N_ELEMENTS(updt_cb_name) EQ 0 THEN updt_callback="" $
+   ELSE updt_callback=updt_cb_name
+   IF N_ELEMENTS(updt_cb_data) GT 0 THEN p_updt_cb_data=PTR_NEW(updt_cb_data) $
+   ELSE p_updt_cb_data=PTR_NEW()
+
+   values_button = lonarr(2)
+
+   IF KEYWORD_SET(SILENT_f) THEN silent = SILENT_F ELSE silent = 1
+;-----------------------------------------------------------------------------
+; changements effectues par S.Masson
+;-----------------------------------------------------------------------------
+   IF N_ELEMENTS(file) GT 0 THEN filename = file ELSE BEGIN 
+      filename = find('palette.tbl')
+      filename = filename[0]
+      if filename EQ 'NOT FOUND' then filename=filepath('colors1.tbl',subdir=['resource', 'colors'])
+   ENDELSE 
+   file = filename
+;-----------------------------------------------------------------------------
+   siz = 256			;Basic width of tool
+   names = 0
+   LOADCT, GET_NAMES = names, FILE = file ;Get table names
+   w_height = 50                ;Height of ramp
+   cur_win = !D.WINDOW
+   lock = 0
+   chop = 0
+   vbot = 0
+   vtop = 100
+   gamma = 1.0
+   use_values=0
+
+
+; Bases:
+;  0 = slider base  (stretch bottom, stretch top, gamma)
+;  1 = transfer function drawable + buttons
+;  2 = color table list
+;  3 = options base  (sliders. top, stretch)
+
+   state = { bases: lonarr(4), draw: 0L, name_list: 0L }
+
+; DJC - Added modal keyword.
+; Moved "group_leader" keyword from XMANAGER to WIDGET_BASE.
+; Ignore modal keyword if a group leader is not supplied.
+   if (N_ELEMENTS(group) GT 0L) then $
+    base = WIDGET_BASE(TITLE="Xlct", /COLUMN, GROUP_LEADER=group, $
+                       MODAL=KEYWORD_SET(modal)) $
+   else $
+    base = WIDGET_BASE(TITLE="Xlct", /COLUMN)
+
+
+; Setting the managed attribute indicates our intention to put this app
+; under the control of XMANAGER, and prevents our draw widgets from
+; becoming candidates for becoming the default window on WSET, -1. XMANAGER
+; sets this, but doing it here prevents our own WSETs at startup from
+; having that problem.
+   WIDGET_CONTROL, /MANAGED, base
+
+
+   show = WIDGET_DRAW(base, YSIZE=w_height, XSIZE=siz, /FRAME, RETAIN = 2)
+   junk = WIDGET_BASE(base, /ROW)
+   done = WIDGET_BUTTON(junk, VALUE=' Done ', UVALUE = "DONE")
+   junk1 = WIDGET_BUTTON(junk, VALUE=' Help ', UVALUE = "HELP")
+
+   junk = CW_BGROUP(base, /ROW, /EXCLUSIVE, /NO_REL, $
+                    ['Tables', 'Options', 'Function'], $
+                    UVALUE='NEWBASE', SET_VALUE=0)
+
+   junk = widget_base(base)
+   for i=0,1 do state.bases[i] = WIDGET_BASE(junk, /COLUMN)
+
+   sbase=WIDGET_BASE(state.bases[0], /COLUMN)
+   bot = WIDGET_SLIDER(sbase, TITLE = "Stretch Bottom", MINIMUM = 0, $
+                       MAXIMUM = 100, VALUE = 0, /DRAG, UVALUE = "BOTTOM", xsize=siz)
+   top = WIDGET_SLIDER(sbase, TITLE = "Stretch Top", MINIMUM = 0, $
+                       MAXIMUM = 100, VALUE = 100, /DRAG, UVALUE = "TOP", xsize=siz)
+   g_lbl = WIDGET_LABEL(sbase, VALUE = STRING(1.0))
+   g_slider = WIDGET_slider(sbase, TITLE = "Gamma Correction", $
+                            MINIMUM = 0, MAXIMUM = 100, VALUE = 50, UVALUE = "GAMMA", $
+                            /SUPPRESS_VALUE, /DRAG, xsize=siz)
+
+   junk = WIDGET_BASE(sbase)
+   for i=2,3 do state.bases[i] = WIDGET_BASE(junk, /COLUMN)
+   DEVICE, GET_SCREEN = junk
+   if junk[1] le 768 then junk = 8 else junk = 16
+   state.name_list = WIDGET_LIST(state.bases[2], VALUE = names, ysize = junk)
+
+
+;		Drawable for transfer function
+
+   junk = WIDGET_BASE(state.bases[1], /COLUMN, /FRAME)
+   junk1 = WIDGET_BUTTON(junk, VALUE = 'Reset Transfer Function', $
+                         UVALUE='TFUNR')
+   junk1 = WIDGET_BUTTON(junk, VALUE='Add Control Point', UVALUE='ADDCP')
+   junk1 = WIDGET_BUTTON(junk, VALUE='Remove Control Point', UVALUE='REMCP')
+
+   state.draw = WIDGET_DRAW(state.bases[1], xsize = siz, ysize = siz, $
+                            /BUTTON_EVENTS, /MOTION_EVENTS)
+
+
+   opt_id = state.bases[3]
+   junk = CW_BGROUP(opt_id, /ROW, LABEL_LEFT='Sliders:', /EXCLUSIVE, /NO_REL, $
+                    ['Independent', 'Gang'], UVALUE='GANG', SET_VALUE=lock)
+   junk = CW_BGROUP(opt_id, /ROW, LABEL_LEFT = 'Top:',  /EXCLUSIVE, /NO_REL, $
+                    ['Clip', 'Chop'], SET_VALUE=chop, UVALUE='CHOP')
+   junk = CW_BGROUP(opt_id, /ROW, LABEL_LEFT='Stretch:',  /EXCLUSIVE, /NO_REL, $
+                    ['Indices', 'Intensity'], UVALUE='VALUES', $
+                    SET_VALUE=use_values)
+   junk = WIDGET_BUTTON(opt_id, VALUE='Reverse Table', $
+                        UVALUE="REVERSE", /NO_REL)
+   junk = WIDGET_BUTTON(opt_id, VALUE='REPLACE Original Table', $
+                        UVALUE = "OVERWRITE", /NO_REL)
+   junk = WIDGET_BUTTON(opt_id, VALUE='RESTORE Original Table', $
+                        UVALUE="RESTORE", /NO_REL)
+
+   WIDGET_CONTROL, state.bases[1], MAP=0 ;Tfun is not visible
+   WIDGET_CONTROL, state.bases[3], MAP=0 ;options are not visible
+
+   WIDGET_CONTROL, base, /REALIZE
+   WIDGET_CONTROL, state.draw, GET_VALUE=tmp
+
+   if n_elements(bottom) gt 0 then cbot = bottom else cbot = 0
+   ncolors = !d.table_size - cbot
+   if n_elements(nc) gt 0 then ncolors = ncolors < nc
+   if ncolors le 0 then message,'Number of colors is 0 or negative'
+
+   psave = { xlct_psave, win: !d.window, x: !x.s, y: !y.s , xtype: !x.type, $
+             ytype: !y.type, clip: !p.clip }
+;Our initial state
+   wset, tmp			;Initial graph
+   xlct_psave                   ;Save original scaling & window
+   plot, [0, ncolors-1], [0, ncolors-1], xstyle=3, ystyle=3, $
+    xmargin = [1,1], ymargin=[1,1], ticklen = -0.03, /NODATA
+   xlct_psave                   ;Restore original scaling & window
+
+                                ;If no common, use current colors
+   IF KEYWORD_SET(use_current) or N_ELEMENTS(r_orig) LE 0 THEN BEGIN
+      TVLCT, r_orig, g_orig, b_orig, /GET
+      r_curr = r_orig
+      b_curr = b_orig
+      g_curr = g_orig
+   ENDIF
+
+   r0 = r_curr                  ;Save original colors
+   g0 = g_curr
+   b0 = b_curr
+   color = ncolors + cbot -1
+   cps = [0, ncolors-1]
+   tfun = cps
+   pnt = -1
+
+   WIDGET_CONTROL, show, GET_VALUE=show_win
+   WSET, show_win
+
+; DJC - fixed color bar display bug.
+
+;TVSCL, BYTSCL(INDGEN(siz) # REPLICATE(1, w_height), top = ncolors-1)
+   TV, BYTE((FLOAT(ncolors)*FINDGEN(siz)/FLOAT(siz-1)) # $
+            REPLICATE(1, w_height)) + BYTE(cbot)
+
+   WSET, cur_win
+
+; DJC - moved GROUP_LEADER keyword to WIDGET_BASE.
+   XManager, "xlct", base, NO_BLOCK=(NOT(FLOAT(block))), $
+    MODAL=KEYWORD_SET(modal)
+
+END
Index: tags/start/COULEURS/xpal.pro
===================================================================
--- tags/start/COULEURS/xpal.pro	(revision 5)
+++ tags/start/COULEURS/xpal.pro	(revision 5)
@@ -0,0 +1,635 @@
+; $Id$
+;
+; Copyright (c) 1992-1998, Research Systems, Inc.  All rights reserved.
+;       Unauthorized reproduction prohibited.
+;+
+; NAME:
+;       XPAL
+;
+; PURPOSE:
+;       comme xpalette mais plus court a ecrire et possede en plus
+;       une touche save qui (grace a la routine newpalette) permet de
+;       sauver la routine que l''on vient de faire. Rq qd on appuie
+;       sur la touche predefined appelle xlct plutot que xloadct 
+;
+; CATEGORY:
+;       Color tables, widgets.
+;
+; CALLING SEQUENCE:
+;       XPAL
+;
+; INPUTS:
+;       No explicit inputs.  The current color table is used as a starting
+;       point.
+;
+; KEYWORD PARAMETERS:
+;	BLOCK:  Set this keyword to have XMANAGER block when this
+;		application is registered.  By default the Xmanager
+;               keyword NO_BLOCK is set to 1 to provide access to the
+;               command line if active command 	line processing is available.
+;               Note that setting BLOCK for this application will cause
+;		all widget applications to block, not only this
+;		application.  For more information see the NO_BLOCK keyword
+;		to XMANAGER.
+;       UPDATECALLBACK: Set this keyword to a string containing the name of
+;               a user-supplied procedure that will be called when the color
+;               table is updated by XLOADCT.  The procedure may optionally
+;               accept a keyword called DATA, which will be automatically
+;               set to the value specified by the optional UPDATECBDATA
+;               keyword.
+;       UPDATECBDATA: Set this keyword to a value of any type. It will be
+;               passed via the DATA keyword to the user-supplied procedure
+;               specified via the UPDATECALLBACK keyword, if any. If the
+;               UPDATECBDATA keyword is not set the value accepted by the
+;               DATA keyword to the procedure specified by UPDATECALLBACK
+;               will be undefined.
+;
+; OUTPUTS:
+;       None.
+;
+; COMMON BLOCKS:
+;       COLORS: Contains the current RGB color tables.
+;       XP_COM: Private to this module.
+;
+; SIDE EFFECTS:
+;       XPAL uses two colors from the current color table as
+;       drawing foreground and background colors. These are used
+;       for the RGB plots on the left, and the current index marker on
+;       the right. This means that if the user set these two colors
+;       to the same value, the XPAL display could become unreadable
+;       (like writing on black paper with black ink). XPAL minimizes
+;       this possibility by noting changes to the color map and always
+;       using the brightest available color for the foreground color
+;       and the darkest for the background. Thus, the only way
+;       to make XPAL's display unreadable is to set the entire color
+;       map to a single color, which is highly unlikely. The only side
+;       effect of this policy is that you may notice XPAL redrawing
+;       the entire display after you've modified the current color.
+;       This simply means that the change has made XPAL pick new
+;       drawing colors.
+;
+;       The new color tables are saved in the COLORS common and loaded
+;       to the display.
+;
+; PROCEDURE:
+;       The XPAL widget has the following controls:
+;
+;       Left:   Three plots showing the current Red, Green, and Blue vectors.
+;
+;       Center: A status region containing:
+;               1) The total number of colors.
+;               2) The current color. XPAL allows changing
+;                  one color at a time. This color is known as
+;                  the "current color" and is indicated in the
+;                  color spectrum display with a special marker.
+;               3) The current mark index. The mark is used to
+;                  remember a color index. It is established by
+;                  pressing the "Set Mark Button" while the current
+;                  color index is the desired mark index.
+;               4) The current color. The special marker used in
+;                  color spectrum display prevents the user from seeing
+;                  the color of the current index, but it is visible
+;                  here.
+;
+;               A panel of control buttons, which do the following when
+;               pressed:
+;
+;               Done:   Exits XPAL.
+;
+;         Predefined:   Starts XLOADCT to allow selection of one of the
+;                       predefined color tables.
+;
+;               Help:   Supplies help information similar to this header.
+;
+;               Redraw: Completely redraws the display using the current
+;                       state of the color map.
+;
+;             Set Mark: Set the value of the mark index to the
+;                       current index.
+;
+;          Switch Mark: Exchange the mark and the current index.
+;
+;         Copy Current: Every color lying between the current
+;                       index and the mark index (inclusive) is given
+;                       the current color.
+;
+;          Interpolate: The colors lying between the current
+;                       index and the mark index are interpolated linearly
+;                       to lie between the colors of two endpoints.
+;                 save: permet de sauver la palette qui est
+;                       actuellement a l''ecran. Qd on appuie sur ce
+;                       bouton, un widget apparait qui demande:
+;                        1) le nom a donner a la palette que l''on veut sauver
+;                        2) le numero de la palette que l''on veut
+;                        eventuellement ecrase par la nouvelle
+;                        palette.Si aucun numero n''est specifie la
+;                        nouvelle palette estajoutee aux anciennes.
+;                        3) le nom du fichier qui contient les
+;                        palettes. Rq: suivre eventuellement les
+;                        indications fournis au prompteur.
+;                
+;
+;       Three sliders (R, G, and B) that allow the user to modify the
+;       current color.
+;
+;       Right:  A display which shows the current color map as a series of
+;               squares. Color index 0 is at the upper left. The color index
+;               increases monotonically by rows going left to right and top
+;               to bottom.  The current color index is indicated by a special
+;               marker symbol. There are 4 ways to change the current color:
+;                       1) Press any mouse button while the mouse
+;                          pointer is over the color map display.
+;                       2) Use the "By Index" slider to move to
+;                          the desired color index.
+;                       3) Use the "Row" Slider to move the marker
+;                          vertically.
+;                       4) Use the "Column" Slider to move the marker
+;                          horizontally.
+;
+; MODIFICATION HISTORY:
+;          addaptation de xpalette pour ajouter un bouton save par
+;          Gima Nicolas (nglod@ipsl.jussieu.fr) et par Masson
+;          Sebastien (smlod@ipsl.jussieu.fr)
+;-
+
+function XP_NEW_COLORS
+; Choose the best foreground and background colors for the current
+; color maps and set !P appropriately. Returns 1 if the colors changed,
+; 0 otherwise.
+  common xp_com, xpw, state
+
+  res = 0
+  junk = CT_LUMINANCE(dark=dark_col, bright=bright_col)
+
+  if (bright_col ne !p.color) then begin
+    !p.color = bright_col
+    res = 1
+  endif
+
+  if (dark_col ne !p.background) then begin
+    !p.background = dark_col
+    res = 1
+  endif
+
+  return, res
+end
+
+pro XP_ALERT_CALLER
+
+  common xp_com, xpw, state
+
+  ErrorStatus = 0
+  CATCH, ErrorStatus
+  if (ErrorStatus NE 0) then begin
+    CATCH, /CANCEL
+    v = DIALOG_MESSAGE(['Unexpected error in XPAL:', $
+                        '!ERR_STRING = ' + !ERR_STRING], $
+                        /ERROR)
+    return
+  endif
+  if (STRLEN(state.updt_callback) gt 0) then begin
+    if (PTR_VALID(state.p_updt_cb_data)) then begin
+      CALL_PROCEDURE, state.updt_callback, DATA=*(state.p_updt_cb_data)
+    endif else begin
+      CALL_PROCEDURE, state.updt_callback
+    endelse
+  endif
+end
+
+pro XP_XLCTCALLBACK
+  ; For visuals with static colormaps, update the graphics
+  ; after a change by XLOADCT.
+  if ((COLORMAP_APPLICABLE(redrawRequired) GT 0) and $
+        (redrawRequired GT 0)) then begin
+    XP_REDRAW
+  endif
+
+end
+
+pro XP_REDRAW
+
+  common xp_com, xpw, state
+
+  junk = XP_NEW_COLORS()
+  WIDGET_CONTROL, xpw.colorsel, set_value=-1
+  XP_REPLOT, !p.color, 'F'        ; Update the plots of RGB
+  ; Let the caller of XPAL know that the color table was modified
+  XP_ALERT_CALLER
+end
+
+
+
+pro XP_REPLOT, color_index, type
+; Re-draw the RGB plots. Type has the following possible values.
+;;      - 'D': Draw the data part of all three plots
+;       - 'F': draw all three plots
+;       - 'R': Draw the data part of the Red plot
+;       - 'G': Draw the data part of the Green plot
+;       - 'B': Draw the data part of the Blue plot
+
+  common xp_com, xpw, state
+  common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+  common pscale, r_x_s, r_y_s, g_x_s, g_y_s, b_x_s, b_y_s
+
+  ; Update the plots of RGB
+  save_win = !D.WINDOW
+  wset, state.plot_win
+  save_p_region = !p.region
+  save_x_margin = !x.margin
+  save_y_margin = !y.margin
+  save_x_s = !x.s
+  save_y_s = !y.s
+  save_x_type = !x.type 
+  save_y_type = !y.type 
+
+  !y.margin= [2, 2]
+  !x.margin= [6, 2]
+
+  if (type eq 'F') then begin
+    !p.region = [0,.6667, 1, 1]
+    plot,xstyle=2, ystyle=3, yrange=[0, 260], r_curr, title='Red'
+    r_x_s = !x.s
+    r_y_s = !y.s
+
+    !p.region = [0,.333, 1, .6667]
+    plot,/noerase, xstyle=2,ystyle=3, yrange=[0, 260], g_curr, title='Green'
+    g_x_s = !x.s
+    g_y_s = !y.s
+
+    !p.region = [0,0, 1, .333]
+    plot,/noerase, xstyle=2,ystyle=3, yrange=[0, 260], b_curr, title='Blue'
+
+    b_x_s = !x.s
+    b_y_s = !y.s
+  endif else begin
+    if ((type eq 'D') or (type eq 'R')) then begin
+      !p.region = [0,.6667, 1, 1]
+      !x.s = r_x_s
+      !y.s = r_y_s
+      oplot, r_curr, color=color_index
+    endif
+    if ((type eq 'D') or (type eq 'G')) then begin
+      !p.region = [0,.333, 1, .6667]
+      !x.s = g_x_s
+      !y.s = g_y_s
+      oplot, g_curr, color=color_index
+    endif
+    if ((type eq 'D') or (type eq 'B')) then begin
+      !p.region = [0,0, 1, .333]
+      !x.s = b_x_s
+      !y.s = b_y_s
+      oplot, b_curr, color=color_index
+    endif
+  endelse
+
+  empty
+  WSET, save_win
+  !p.region = save_p_region
+  !x.margin = save_x_margin
+  !y.margin = save_y_margin
+  !x.s = save_x_s
+  !y.s = save_y_s
+  !x.type = save_x_type
+  !y.type = save_y_type
+
+end
+
+
+
+
+pro XP_CHANGE_COLOR, type, value
+; Change current color. Type has the following possible values.
+;       - 'R': Change the R part of the current color
+;       - 'G': ...
+;       - 'B': ...
+  common xp_com, xpw, state
+  common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+
+
+  cur_idx = state.cur_idx
+
+  XP_REPLOT, !p.background, type
+
+  if (type eq 'R') then r_curr[cur_idx] = value;
+  if (type eq 'G') then g_curr[cur_idx] = value;
+  if (type eq 'B') then b_curr[cur_idx] = value;
+
+  tvlct, r_curr[cur_idx], g_curr[cur_idx], b_curr[cur_idx], cur_idx
+
+  if (XP_NEW_COLORS()) then begin
+    ; Highlight the current position using the marker
+    WIDGET_CONTROL, xpw.colorsel, set_value=-1  ; Re-initialize
+    XP_REPLOT, !p.color, 'F'
+  endif else begin
+    XP_REPLOT, !p.color, type
+  endelse
+
+  ; For visuals with static colormaps, update the graphics
+  ; of the current color.
+  if ((COLORMAP_APPLICABLE(redrawRequired) GT 0) and $
+        (redrawRequired GT 0)) then begin
+    ; Mark new square
+    tmp = !D.WINDOW
+    wset, state.cur_color_win
+    erase, color=state.cur_idx
+    wset, tmp
+  endif
+
+  ; Let the caller of XPAL know that the color table was modified
+  xp_alert_caller
+
+end
+
+
+
+
+
+
+
+pro XP_BUTTON_EVENT, event
+
+   common xp_com, xpw, state
+   common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+
+                                ; NOTE: The value of these tags depend on the order of the buttons
+                                ;     in the base.
+   case (event.value) of
+
+                                ; DONE
+      0: begin
+         empty
+         r_orig = r_curr & g_orig = g_curr & b_orig = b_curr ;new orig color tbl
+         WIDGET_CONTROL, /DESTROY, event.top
+         !p = state.old_p
+      end
+
+                                ; PREDEFINED
+      1: xlct, /silent, group=xpw.base, UPDATECALLBACK='XP_XLCTCALLBACK'
+
+                                ; HELP
+      2: XDisplayFile, FILEPATH("xpal.txt", subdir=['help', 'widget']), $
+       TITLE = "Xpal Help", GROUP = event.top, WIDTH = 55, HEIGHT = 16
+
+                                ; REDRAW
+      3: XP_REDRAW
+
+                                ; SET MARK
+      4: begin
+         state.mark_idx = state.cur_idx
+         WIDGET_CONTROL, xpw.mark_label, $
+          set_value=strcompress(state.mark_idx, /REMOVE)
+      end
+
+                                ; SWITCH MARK
+      5 : if (state.mark_idx ne state.cur_idx) then begin
+         tmp = state.mark_idx
+         state.mark_idx = state.cur_idx
+         state.cur_idx = tmp
+         WIDGET_CONTROL, xpw.colorsel, set_value=tmp
+         WIDGET_CONTROL, xpw.idx_label, $
+          set_value=strcompress(state.cur_idx, /REMOVE)
+         WIDGET_CONTROL, xpw.mark_label, $
+          set_value=strcompress(state.mark_idx, /REMOVE)
+      endif
+
+                                ; COPY CURRENT
+      6 : begin
+         do_copy:
+         cur_idx = state.cur_idx
+         if (state.mark_idx le cur_idx) then begin
+            s = state.mark_idx
+            e = cur_idx
+         endif else begin
+            s = cur_idx
+            e = state.mark_idx
+         endelse
+         n = e-s+1
+         XP_REPLOT, !p.background, 'D'
+         if (event.value eq 6) then begin
+            r_curr[s:e] = r_curr[cur_idx]
+            g_curr[s:e] = g_curr[cur_idx]
+            b_curr[s:e] = b_curr[cur_idx]
+         endif else begin       ; Interpolate
+            scale = findgen(n)/float(n-1)
+            r_curr[s:e] = r_curr[s] + (fix(r_curr[e]) - fix(r_curr[s])) * scale
+            g_curr[s:e] = g_curr[s] + (fix(g_curr[e]) - fix(g_curr[s])) * scale
+            b_curr[s:e] = b_curr[s] + (fix(b_curr[e]) - fix(b_curr[s])) * scale
+         endelse
+         tvlct, r_curr[s:e], g_curr[s:e], b_curr[s:e], s
+         if (XP_NEW_COLORS()) then begin
+            WIDGET_CONTROL, xpw.colorsel, SET_VALUE=-1
+            XP_REPLOT, !p.color, 'F'
+         endif else begin
+            XP_REPLOT, !p.color, 'D'
+         endelse
+                                ; Let the caller of XPAL know that the color table was modified
+         xp_alert_caller
+      end
+
+      7: goto, do_copy
+      8: BEGIN 
+         COMMON basecommon,  bas212, bas222,  bas232
+         base = WIDGET_BASE(/COLUMN, /FRAME)
+         bas1 = WIDGET_LABEL(base, value = 'Save')
+         bas2 = WIDGET_BASE(base, /COLUMN)
+         bas21 = WIDGET_BASE(bas2, /COLUMN)
+         bas211 = WIDGET_LABEL(bas21, value = 'Palette Name : ')
+         bas212 = WIDGET_TEXT(bas21, value = 'Noname', /editable)
+         bas22 = WIDGET_BASE(bas2, /COLUMN)
+         bas221 = WIDGET_LABEL(bas22, value = ' Overwrite palette number : ')
+         bas222 = WIDGET_TEXT(bas22, value = '', /editable)
+         bas23 = WIDGET_BASE(bas2, /COLUMN)
+         bas231 = WIDGET_LABEL(bas23, value = 'file name : ')
+         bas232 = WIDGET_TEXT(bas23, value = 'palette.tbl', /editable)
+         bas3 = WIDGET_BASE(base, /ROW)
+         ok = WIDGET_BUTTON(bas3, value = 'OK',$
+                            /ALIGN_LEFT, /FRAME, UVALUE = 'ok')
+         cancel = WIDGET_BUTTON(bas3, value = 'CANCEL',$
+                                /ALIGN_RIGHT, /FRAME, UVALUE = 'cancel')
+         WIDGET_CONTROL, base, /REALIZE
+;         WIDGET_CONTROL, base, SET_UVALUE = drawID
+         XMANAGER,  'xp_button_event',  base
+
+
+
+      END
+      else:
+   endcase
+
+end
+
+
+PRO xp_button_event_event, ev
+COMMON basecommon,  bas212, bas222,  bas232
+  WIDGET_CONTROL, ev.id,  GET_UVALUE = uval
+  IF(TAG_NAMES(ev,  /STRUCTURE_NAME) EQ 'WIDGET_BUTTON')$
+  THEN BEGIN
+    CASE uval OF
+     'ok' :BEGIN 
+        WIDGET_CONTROL, bas212, GET_VALUE = palname
+        WIDGET_CONTROL, bas222, GET_VALUE = over
+        WIDGET_CONTROL, bas232, GET_VALUE = fichname
+        if over[0] EQ '' then over = 255 ELSE over = long(over)
+         newpalette,palname[0], OVER = over[0], file = fichname[0]
+         WIDGET_CONTROL,  ev.top,  /DESTROY
+        END
+     'cancel': WIDGET_CONTROL,  ev.top,  /DESTROY
+    ENDCASE
+  ENDIF
+
+END
+
+
+
+
+
+pro XP_EVENT, event
+
+   common xp_com, xpw, state
+   common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+
+   case (event.id) of
+
+      xpw.button_base: XP_BUTTON_EVENT, event
+
+      xpw.rgb_base: begin
+         cur_idx = state.cur_idx
+         if (event.r ne r_curr[cur_idx]) then XP_CHANGE_COLOR, "R", event.r
+         if (event.g ne g_curr[cur_idx]) then XP_CHANGE_COLOR, "G", event.g
+         if (event.b ne b_curr[cur_idx]) then XP_CHANGE_COLOR, "B", event.b
+      end
+
+      xpw.colorsel: begin
+         cur_idx = state.cur_idx
+         new_pos = event.value ne cur_idx
+                                ; Update the RBG sliders
+         if (event.value ne cur_idx) then begin
+            state.cur_idx = (cur_idx = event.value)
+            WIDGET_CONTROL, xpw.idx_label,  $
+             set_value=strcompress(cur_idx, /REMOVE_ALL)
+                                ; Mark new square
+            tmp = !D.WINDOW
+            wset, state.cur_color_win
+            erase, color=cur_idx
+            wset, tmp
+
+            WIDGET_CONTROL, xpw.rgb_base, $
+             set_value=[r_curr[cur_idx], g_curr[cur_idx], b_curr[cur_idx]]
+         endif
+      end
+
+      else:
+   endcase
+
+end
+
+
+
+
+
+
+
+pro XPAL, group=group, BLOCK=block, UPDATECALLBACK=updt_cb_name, $
+        UPDATECBDATA=updt_cb_data
+
+
+  common xp_com, xpw, state
+  common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+
+  IF N_ELEMENTS(updt_cb_name) EQ 0 THEN updt_callback="" $
+                                 ELSE updt_callback=updt_cb_name
+  IF N_ELEMENTS(updt_cb_data) GT 0 THEN p_updt_cb_data=PTR_NEW(updt_cb_data) $
+                                 ELSE p_updt_cb_data=PTR_NEW()
+
+  xpw = { xp_widgets, base:0L, $
+	colorsel:0L, mark_label:0L, idx_label:0L, button_base:0L, rgb_base:0L}
+
+  state = {old_p:!p, $                     ; Original value of !P
+	   mark_idx:0, $                   ; Current mark index
+	   cur_idx:0, $                    ; Current index
+	   cur_color_win:0, $              ; Current Color draw window index
+	   plot_win:0, $                   ; RGB plot draw window index
+	   updt_callback: updt_callback, $ ; user-defined callback (optional)
+	   p_updt_cb_data:p_updt_cb_data}  ; data for callback (optional)
+
+  if (XREGISTERED('XPAL')) then return      ; Only one copy at a time
+
+  IF N_ELEMENTS(block) EQ 0 THEN block=0
+
+  on_error,2              ;Return to caller if an error occurs
+
+  nc = !d.table_size            ;# of colors avail
+  if nc eq 0 then message, "Device has static color tables.  Can't modify."
+  if (nc eq 2) then message, 'Unable to work with monochrome system.'
+
+  state.old_p = !p              ;Save !p
+  !p.noclip = 1                 ;No clipping
+  !p.color = nc -1              ;Foreground color
+  !p.font = 0                   ;Hdw font
+  save_win = !d.window  ;Previous window
+
+  IF N_ELEMENTS(r_orig) LE 0 THEN BEGIN	;If no common, use current colors
+	TVLCT, r_orig, g_orig, b_orig, /GET
+	r_curr = r_orig
+	b_curr = b_orig
+	g_curr = g_orig
+	ENDIF
+
+  ; Create widgets
+  xpw.base=WIDGET_BASE(title='Xpal', /ROW, space=30)
+  ; This is a little tricky. Setting the managed attribute indicates
+  ; our intention to put this app under the control of XMANAGER, and
+  ; prevents our draw widgets from becoming candidates for becoming
+  ; the default window on WSET, -1. XMANAGER sets this, but doing it here
+  ; prevents our own WSETs at startup from having that problem.
+  WIDGET_CONTROL, /MANAGED, xpw.base
+
+  version = WIDGET_INFO(/VERSION)
+  if (version.style='Motif') then junk=510 else junk = 580
+  plot_frame = WIDGET_DRAW(xpw.base, xsize=200, ysize=junk)
+
+  c1 = WIDGET_BASE(xpw.base, /COLUMN, space=20)
+    status = WIDGET_BASE(c1, /COLUMN, /FRAME)
+      ncw = WIDGET_LABEL(WIDGET_BASE(status), /DYNAMIC_RESIZE)
+      xpw.idx_label = CW_FIELD(status, title='Current Index: ', value='0', $
+			       xsize=20, /STRING)
+      xpw.mark_label = CW_FIELD(status, title='Mark Index:    ', value='0', $
+				xsize=20, /STRING)
+      c1_1 = widget_base(status, /ROW)
+	junk = WIDGET_LABEL(c1_1, value="Current Color: ")
+	  cur_color = WIDGET_DRAW(c1_1, xsize = 125, ysize=50, /frame)
+    names = [ 'Done', 'Predefined', 'Help', 'Redraw', 'Set Mark', $
+		'Switch Mark', 'Copy Current', 'Interpolate', 'save']
+    xpw.button_base = CW_BGROUP(c1, names, COLUMN=3, /FRAME)
+    xpw.rgb_base = CW_RGBSLIDER(c1, /FRAME, /DRAG)
+
+    junk = WIDGET_BASE(xpw.base)        ; Responds to YOFFSET
+    if (version.style='Motif') then junk2=30 else junk2 = 50
+    xpw.colorsel = CW_COLORSEL(junk, yoffset=junk2)
+
+
+  state.cur_idx = 0
+  state.mark_idx = 0
+
+  ; Position RGB slider appropriately
+  WIDGET_CONTROL, xpw.rgb_base, SET_VALUE=[r_curr[0], g_curr[0], b_curr[0]]
+  WIDGET_CONTROL, /REALIZE, xpw.base
+
+  WIDGET_CONTROL, ncw, $
+	set_value='Number Of Colors: ' + strcompress(!d.n_colors, /REMOVE_ALL)
+  WIDGET_CONTROL, get_value=tmp, cur_color
+  state.cur_color_win = tmp
+  WIDGET_CONTROL, get_value=tmp, plot_frame
+  state.plot_win = tmp
+
+
+  ; Update the plots of RGB
+  junk = XP_NEW_COLORS()
+  XP_REPLOT, !p.color, 'F'
+
+  WSET, save_win
+
+  XMANAGER, 'Xpal', xpw.base, event_handler='XP_EVENT', group=group, $
+	NO_BLOCK=(NOT(FLOAT(block)))
+end
+
Index: tags/start/GRILLE/changegrid.pro
===================================================================
--- tags/start/GRILLE/changegrid.pro	(revision 5)
+++ tags/start/GRILLE/changegrid.pro	(revision 5)
@@ -0,0 +1,43 @@
+function changegrid, newgrid
+;
+@common
+;
+;
+   if cmpgrid(newgrid) EQ 0 then return, 0
+;
+; update the common paramaters
+;
+   ccmeshparameters = newgrid
+   jpiglo = newgrid.jpiglo
+   jpjglo = newgrid.jpjglo
+   jpkglo = newgrid.jpkglo
+   jpi = newgrid.jpi
+   jpj = newgrid.jpj
+   jpk = newgrid.jpk
+   ixminmesh = newgrid.ixminmesh
+   ixmaxmesh = newgrid.ixmaxmesh
+   iyminmesh = newgrid.iyminmesh
+   iymaxmesh = newgrid.iymaxmesh
+   izminmesh = newgrid.izminmesh
+   izmaxmesh = newgrid.izmaxmesh
+   key_shift = newgrid.key_shift
+   boundary = newgrid.boundary
+;
+; read the new file
+;
+   if newgrid.filetype EQ 'batch file' THEN BEGIN 
+      createpro, '@'+strmid(newgrid.filename[0], 0, strlen(newgrid.filename)-4) $
+          , filename = isadirectory(io = homedir, title = 'Bad definition of Homedir') $
+          +'for_createpro.pro'
+      return, 1
+   ENDIF ELSE BEGIN 
+      readmesh, newgrid.filename, newgrid.filetype, glamboundary = boundary
+   ENDELSE
+;
+;
+   key_periodique = newgrid.key_periodique
+   domdef
+   if newgrid.triangulation EQ 1 then triangles = triangule() ELSE triangles = -1
+;
+   return, 1
+end
Index: tags/start/GRILLE/cmpgrid.pro
===================================================================
--- tags/start/GRILLE/cmpgrid.pro	(revision 5)
+++ tags/start/GRILLE/cmpgrid.pro	(revision 5)
@@ -0,0 +1,37 @@
+FUNCTION cmpgrid, newgrid
+;
+@common
+;
+;
+; newgrid must be a structure
+;
+   if size(newgrid, /type) NE 8 then return, 0
+;
+; does ccmeshparameters exist ?
+;
+   if n_elements(ccmeshparameters) EQ 0 then return, 1
+;
+; we compare the structure which caracterise the grid whith
+; ccmeshparameters
+;
+   case 1 of
+      ccmeshparameters.filename NE newgrid.filename:
+      ccmeshparameters.filetype NE newgrid.filetype:
+      ccmeshparameters.jpiglo NE newgrid.jpiglo:
+      ccmeshparameters.jpjglo NE newgrid.jpjglo:
+      ccmeshparameters.jpkglo NE newgrid.jpkglo:
+      ccmeshparameters.jpi NE newgrid.jpi:
+      ccmeshparameters.jpj NE newgrid.jpj:
+      ccmeshparameters.jpk NE newgrid.jpk:
+      ccmeshparameters.ixminmesh NE newgrid.ixminmesh:
+      ccmeshparameters.ixmaxmesh NE newgrid.ixmaxmesh:
+      ccmeshparameters.iyminmesh NE newgrid.iyminmesh:
+      ccmeshparameters.iymaxmesh NE newgrid.iymaxmesh:
+      ccmeshparameters.izminmesh NE newgrid.izminmesh:
+      ccmeshparameters.izmaxmesh NE newgrid.izmaxmesh:
+      ccmeshparameters.key_shift NE newgrid.key_shift:
+      ELSE:return, 0
+   endcase
+
+   return, 1
+end
Index: tags/start/GRILLE/computegrid.pro
===================================================================
--- tags/start/GRILLE/computegrid.pro	(revision 5)
+++ tags/start/GRILLE/computegrid.pro	(revision 5)
@@ -0,0 +1,108 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:computegrid
+;
+; PURPOSE:calcule les parametres (necessaires aux traces) d''une
+; grille reguliere avec 
+;          - les points T, U et V sont confondus
+;          - un seul niveau vertical.
+;
+; CATEGORY:grille
+;
+; CALLING SEQUENCE:computegrid, departx, departy, pasx, pasy, nx, ny
+; 
+; INPUTS:des saclaires.
+;       departx:la longitude minimum
+;       departy:la latitude minimum
+;       pasx:la pas suivant la longitude
+;       pasy:la pas suivant la latitude
+;       nx:le nombre de points en longitude
+;       ny:le nombre de points en latitude
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:definit aussi les parametres pour les grilles U et V
+; meme si on n''en a pas besoin.
+;
+; RESTRICTIONS:programme vite fait, avec les latitudes qui doivent
+; aller du sud vers le nord.
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      2000-04-20
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO computegrid, departx, departy, pasx, pasy, nx, ny
+@common
+;------------------------------------------------------------
+   jpiglo = long(nx)
+   jpjglo = long(ny)
+   jpkglo = 1l
+;
+   jpi = jpiglo
+   jpj = jpjglo
+   jpk = jpkglo
+;
+   ixminmesh  =0l
+   ixmaxmesh  =long(jpi-1)
+   iyminmesh  =0l
+   iymaxmesh  =long(jpj-1)
+   izminmesh  =0l
+   izmaxmesh  =long(jpk-1)
+;
+   glamt = departx+findgen(jpi)*pasx
+   glamt = glamt#replicate(1, jpj)
+   glamf = glamt+pasx/2.
+   gphit = departy+findgen(jpj)*pasy
+   gphit = replicate(1, jpi)#gphit
+   gphif = gphit+pasy/2.
+   glamu = glamf
+   glamv = glamt
+   gphiu = gphit
+   gphiv = gphif
+   gdept = 5.
+   gdepw = 5.
+;
+   pasx = abs(pasx)
+   pasy = abs(pasy)
+; facteurs d'echelle:
+   r = 6371000. 
+   rprojete = r*cos(gphit[0,*]*!pi/180.)
+   e1t = rprojete*pasx*!pi/180.
+   e1t = reform(replicate(1, jpi)#e1t[*], jpi, jpj)
+   e2t = replicate(r*pasy*!pi/180., jpi, jpj)
+;
+   e1u = e1t
+   e2u = e2t
+;
+   rprojete = r*cos(gphiv[0,*]*!pi/180.)
+   e1v = rprojete*pasx*!pi/180.
+   e1v = reform(replicate(1, jpi)#e1v[*], jpi, jpj)
+   e2v = e2t
+;
+   e1f = e1v
+   e2f = e2t
+;
+   e3t = 10.
+   e3w = 10.
+; mask par defauyt a 1
+   tmask = replicate(1, jpi, jpj)
+   umaskred = replicate(1, jpj)
+   vmaskred = replicate(1, jpi)
+   fmaskredy = replicate(1, jpj)
+   fmaskredx = replicate(1, jpi)
+
+;------------------------------------------------------------
+   return
+end
+
+
Index: tags/start/GRILLE/domdef.pro
===================================================================
--- tags/start/GRILLE/domdef.pro	(revision 5)
+++ tags/start/GRILLE/domdef.pro	(revision 5)
@@ -0,0 +1,537 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: DOMDEF
+;
+; PURPOSE:permet d'extraire un sous domaine d'etude en fournissant les
+; parametres necessaires pour les traces. (cf. outputs)
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:domdef [,lon1, lon2, lat1, lat2[,prof1,prof2]] ou
+;             bien domdef,vecteur
+;
+; INPUTS:(facultatif), [vecteur a] 2, 4 ou 6 elements:;
+; sans l''utilisation des mots cles index,xindex,yindex,zindex:
+; *prof1, prof2: pour un domaine 3D dont la partie horizontale couvre tout
+;  glam et gphi
+; *lon1, lon2, lat1, lat2:
+; definissant les longitudes min. max et les latitudes min, max du  domaine a
+; etudier (tous les niveaux sont selectiones)
+; *lon1,lon2,lat1,lat2,prof1,prof2 pour specifier les profondeurs.
+;
+; KEYWORD PARAMETERS:
+;
+;       FINDALWAYS:oblige a redefinir une boite meme qd auqun point
+;       n''est trouve ds la boite. dans ce cas on selectionne toute la
+;       grille.
+;
+;	GRILLE:un string ou un vecteur de string contennant le nom des
+;	grilles (determinees uniquement par : 'T','U','V','W','F') pour
+;	lesquelles le calcul doit etre fait. par
+;	ex :'T' ou ['T','U']
+;
+;       /MEMEINDICES: il se peut que les points t,u,v et F correspondant a
+;       une meme boite geographique ne concernent pas les memes
+;       indices des tableaux. Ceci pose parfois de pb (ou du moins de
+;       serieuses complications) ds les programmes ou plusieurs types
+;       de grilles interviennent (cf.: norme, curl...). Activer
+;       MEMEINDICES pour forcer domdef a prendre les memes indices -ceux
+;       de la grille T- pour toutes les autres grilles.
+;
+;       /INDEX: activer si on veut specifier que tous les elements
+;       passes en entree de domdef se rapportent aux indices des
+;       tableaux glam, gphi et gdep plutot qu'aux valeurs de ces
+;       tableaux
+;
+;       /xindex: activer si on veut que les elements passes en entrre
+;       de domdef et concernant la dimension en x se rapportent aux
+;       indices des tableaux glam qu'aux valeurs de ces tableaux.
+;
+;       /yindex: cf xindex mais pour y et les gphi
+;
+;       /zindex: cf xindex mais pour z et les gdep
+;
+; OUTPUTS:on recupere pour les 4 grilles t,u,v,f
+;   -nxt,u,v:entier qui contient le nombre de pts en longitude de
+;    la grille reduite au domaine
+;   -nyt,u,v:entier qui contient le nombre de pts en latitude de
+;    la grille reduite au domaine
+;   -nzt,w:entier qui contient le nombre de pts en profondeur de
+;    la grille reduite au domaine 3D
+;   -premierxt,u,v,f: le premier indice qui delimite le sous domaine
+;   suivant x
+;   -premieryt,u,v,f: le premier indice qui delimite le sous domaine
+;   suivant y
+;   -premierzt,w: le premier indice qui delimite le sous domaine
+;   suivant z
+;   -dernierxt,u,v,f: le dernier indice qui delimite le sous domaine
+;   suivant x
+;   -dernieryt,u,v,f: le dernier indice qui delimite le sous domaine
+;   suivant y
+;   -dernierzt,w: le dernier indice qui delimite le sous domaine
+;   suivant z
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			8/2/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro domdef,x1,x2,y1,y2,z1,z2, FINDALWAYS = findalways, GRILLE=grille, MEMEINDICES = memeindices, XINDEX = xindex, YINDEX = yindex, ZINDEX = zindex, INDEX = index, _extra = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;-------------------------------------------------------------------
+; determination en fonction du nombre d''arguments de
+; lon1,lon2,lat1,lat2,prof1,prof2
+;-------------------------------------------------------------------
+   if not keyword_set(grille) then grille=['T', 'U', 'V', 'W', 'F'] ELSE $ 
+    for i = 0, n_elements(grille)-1 do grille[i] = strupcase(grille[i])
+   if keyword_set(memeindices) then grille=['T', grille]
+   CASE N_PARAMS() OF
+      0: BEGIN
+; lon1 et lon2
+         test = 1
+         IF (where(grille eq 'T'))[0] NE -1 THEN test = [test, glamt[*]]
+         IF (where(grille eq 'W'))[0] NE -1 AND (where(grille eq 'T'))[0] EQ -1 THEN $
+          test = [test, glamt[*]]
+         IF (where(grille eq 'U'))[0] NE -1 AND n_elements(glamu) NE 0 THEN test = [test, glamu[*]]
+         IF (where(grille eq 'V'))[0] NE -1 AND n_elements(glamv) NE 0 THEN test = [test, glamv[*]]
+         IF (where(grille eq 'F'))[0] NE -1 AND n_elements(glamf) NE 0 THEN test = [test, glamf[*]]
+         test = test[1:n_elements(test)-1] 
+         lon1=min([test], max = max)
+         lon2=max
+; lat1 et lat2
+         test = 1
+         IF (where(grille eq 'T'))[0] NE -1 THEN test = [test, gphit[*]]
+         IF (where(grille eq 'W'))[0] NE -1 AND (where(grille eq 'T'))[0] EQ -1 THEN $
+          test = [test, gphit[*]]
+         IF (where(grille eq 'U'))[0] NE -1 AND n_elements(gphiu) NE 0 THEN test = [test, gphiu[*]]
+         IF (where(grille eq 'V'))[0] NE -1 AND n_elements(gphiv) NE 0 THEN test = [test, gphiv[*]]
+         IF (where(grille eq 'F'))[0] NE -1 AND n_elements(gphif) NE 0 THEN test = [test, gphif[*]]
+         test = test[1:n_elements(test)-1] 
+         lat1=min([test], max = max)
+         lat2=max
+; prof1 et prof2
+         prof1=0
+         test = 1
+         IF (inter(byte(grille), byte(['T', 'U', 'V', 'F'])))[0] NE -1 THEN test = [test, gdept[jpk-1]]
+         IF (where(grille eq 'W'))[0] NE -1 AND n_elements(gdepw) NE 0 THEN test = [test, gdepw[jpk-1]]
+         test = test[1:n_elements(test)-1] 
+         prof2=max([test])
+      end
+      1: BEGIN
+         xx1 = reform(x1)
+         taille = size(xx1)
+         CASE taille[1] OF
+            2:domdef, xx1[0], xx1[1]                                , FINDALWAYS = findalways,GRILLE=grille, MEMEINDICES = memeindices, XINDEX = xindex, YINDEX = yindex, ZINDEX = zindex, INDEX = index, _extra = ex
+            4:domdef, xx1[0], xx1[1], xx1[2], xx1[3]                , FINDALWAYS = findalways,GRILLE=grille, MEMEINDICES = memeindices, XINDEX = xindex, YINDEX = yindex, ZINDEX = zindex, INDEX = index, _extra = ex
+            6:domdef, xx1[0], xx1[1], xx1[2], xx1[3], xx1[4], xx1[5], FINDALWAYS = findalways,GRILLE=grille, MEMEINDICES = memeindices, XINDEX = xindex, YINDEX = yindex, ZINDEX = zindex, INDEX = index, _extra = ex
+            else: begin
+               ras = report('Mauvais nombre de parametre dans l''appel de DOMDEF')
+               return
+            end
+         ENDCASE
+         return
+      end
+      2: begin
+; lon1 et lon2
+         IF (inter(byte(grille), byte(['T', 'U', 'V', 'F'])))[0] NE -1 THEN BEGIN
+            ouca = where(gdept ge prof1 and gdept le prof2,nzt)
+            if ouca[0] NE -1 then zt=gdept[ouca] ELSE zt = -1
+         ENDIF
+         if (where(grille eq 'W'))[0] NE -1 AND n_elements(gdepw) NE 0 then BEGIN
+            ouca = where(gdepw ge prof1 and gdepw le prof2,nzw)
+            if ouca[0] NE -1 then zw=gdepw[ouca] ELSE zw = -1
+         ENDIF
+         test = 1
+         IF (where(grille eq 'T'))[0] NE -1 THEN test = [test, glamt[*]]
+         IF (where(grille eq 'W'))[0] NE -1 AND (where(grille eq 'T'))[0] EQ -1 THEN $
+          test = [test, glamt[*]]
+         IF (where(grille eq 'U'))[0] NE -1 AND n_elements(glamu) NE 0 THEN test = [test, glamu[*]]
+         IF (where(grille eq 'V'))[0] NE -1 AND n_elements(glamv) NE 0 THEN test = [test, glamv[*]]
+         IF (where(grille eq 'F'))[0] NE -1 AND n_elements(glamf) NE 0 THEN test = [test, glamf[*]]
+         test = test[1:n_elements(test)-1] 
+         lon1=min([test], max = max)
+         lon2=max
+; lat1 et lat2
+         test = 1
+         IF (where(grille eq 'T'))[0] NE -1 THEN test = [test, gphit[*]]
+         IF (where(grille eq 'W'))[0] NE -1 AND (where(grille eq 'T'))[0] EQ -1 THEN $
+          test = [test, gphit[*]]
+         IF (where(grille eq 'U'))[0] NE -1 AND n_elements(gphiu) NE 0 THEN test = [test, gphiu[*]]
+         IF (where(grille eq 'V'))[0] NE -1 AND n_elements(gphiv) NE 0 THEN test = [test, gphiv[*]]
+         IF (where(grille eq 'F'))[0] NE -1 AND n_elements(gphif) NE 0 THEN test = [test, gphif[*]]
+         test = test[1:n_elements(test)-1] 
+         lat1=min([test], max = max)
+         lat2=max
+; prof1 et prof2
+         if keyword_set(zindex) OR keyword_set(index) then BEGIN
+            z1 = x1
+            z2 = x2
+            IF (inter(byte(grille), byte(['T', 'U', 'V', 'F'])))[0] NE -1 THEN prof1 = gdept[z1] ELSE prof1=gdepw[z1]
+            if (where(grille eq 'W'))[0] NE -1 AND n_elements(gdepw) NE 0 then prof2=gdepw[z2] ELSE prof2=gdept[z2]
+         ENDIF ELSE BEGIN
+            prof1=x1
+            prof2=x2
+         ENDELSE 
+      end
+      4: begin 
+; lon1 et lon2
+         if keyword_set(xindex) OR keyword_set(index) then BEGIN
+            if keyword_set(yindex) OR keyword_set(index) then BEGIN
+               if n_elements(glamf) NE 0 then BEGIN
+               lon1 = min([glamt[x1:x2, y1:y2], glamf[x1:x2, y1:y2]], max = lon2)
+               ENDIF ELSE BEGIN 
+               lon1 = min(glamt[x1:x2, y1:y2], max = lon2)
+               ENDELSE
+            ENDIF ELSE BEGIN 
+               lon1 = glamt[x1, 0]
+               if n_elements(glamf) NE 0 then lon2 = glamf[x2, 0] $
+               ELSE lon2 = glamt[x2, 0]
+            ENDELSE
+         ENDIF ELSE BEGIN
+            lon1=x1
+            lon2=x2
+         ENDELSE 
+; lat1 et lat2
+         if keyword_set(yindex) OR keyword_set(index) then BEGIN
+            if keyword_set(xindex) OR keyword_set(index) then begin
+               lat1 = min([gphit[x1, y1], gphit[x2, y1]])
+               if n_elements(gphif) NE 0 then lat2 = max([gphif[x1, y2], gphif[x2, y2]]) $
+               ELSE lat2 = max([gphit[x1, y2], gphit[x2, y2]])
+            ENDIF ELSE BEGIN 
+               lat1 = gphit[0, y1]
+               if n_elements(gphif) NE 0 then lat2 = gphif[0, y2] $
+               ELSE lat2 = gphit[0, y2]
+            ENDELSE
+         ENDIF ELSE BEGIN
+            lat1=y1
+            lat2=y2
+         ENDELSE 
+; prof1 et prof2
+         prof1=0
+         test = 1
+         IF (inter(byte(grille), byte(['T', 'U', 'V', 'F'])))[0] NE -1 THEN test = [test, gdept[jpk-1]]
+         IF (where(grille eq 'W'))[0] NE -1 AND n_elements(gdepw) NE 0 THEN test = [test, gdepw[jpk-1]]
+         test = test[1:n_elements(test)-1] 
+         prof2=max([test])
+      end
+      6: begin 
+; lon1 et lon2
+         if keyword_set(xindex) OR keyword_set(index) then BEGIN
+            if keyword_set(yindex) OR keyword_set(index) then begin
+               lon1 = min([glamt[x1, y1], glamt[x1, y2]])
+               if n_elements(glamf) NE 0 then lon2 = max([glamf[x2, y1], glamf[x2, y2]]) $
+               ELSE lon2 = max([glamt[x2, y1], glamt[x2, y2]])
+            ENDIF ELSE BEGIN 
+               lon1 = glamt[x1, 0]
+               if n_elements(glamf) NE 0 then lon2 = glamf[x2, 0] $
+               ELSE lon2 = glamt[x2, 0]
+            ENDELSE
+         ENDIF ELSE BEGIN
+            lon1=x1
+            lon2=x2
+         ENDELSE 
+; lat1 et lat2
+         if keyword_set(yindex) OR keyword_set(index) then BEGIN
+            if keyword_set(xindex) OR keyword_set(index) then begin
+               lat1 = min([gphit[x1, y1], gphit[x2, y1]])
+               if n_elements(gphif) NE 0 then lat2 = max([gphif[x1, y2], gphif[x2, y2]]) $
+               ELSE lat2 = max([gphit[x1, y2], gphit[x2, y2]])
+            ENDIF ELSE BEGIN 
+               lat1 = gphit[0, y1]
+               if n_elements(gphif) NE 0 then lat2 = gphif[0, y2] $
+               ELSE lat2 = gphit[0, y2]
+            ENDELSE
+         ENDIF ELSE BEGIN
+            lat1=y1
+            lat2=y2
+         ENDELSE 
+; prof1 et prof2
+         if keyword_set(zindex) OR keyword_set(index) then begin
+            IF (inter(byte(grille), byte(['T', 'U', 'V', 'F'])))[0] NE -1 THEN prof1=gdept[z1] ELSE prof1=gdepw[z1]
+            if (where(grille eq 'W'))[0] NE -1 AND n_elements(gdepw) NE 0 then prof2=gdepw[z2] ELSE prof2=gdept[z2]
+         ENDIF ELSE BEGIN
+            prof1=z1
+            prof2=z2
+         ENDELSE 
+      end
+      else: begin
+         ras = report('Mauvais nombre de parametre dans l''appel de DOMDEF')
+         return
+      end
+   endcase  
+;----------------------------------------------------------------------       
+; determination de nzt et nwt
+;----------------------------------------------------------------------       
+   IF (inter(byte(grille), byte(['T', 'U', 'V', 'F'])))[0] NE -1 THEN BEGIN
+      if keyword_set(zindex) OR keyword_set(index) then nzt = z2-z1+1 $
+      ELSE BEGIN 
+         ouca = where(gdept ge prof1 and gdept le prof2,nzt)
+         if ouca[0] NE -1 then zt=gdept[ouca] ELSE zt = -1
+      ENDELSE
+   ENDIF
+   if (where(grille eq 'W'))[0] NE -1 AND n_elements(gdepw) NE 0 then BEGIN
+      if keyword_set(zindex) OR keyword_set(index) then nzw = z2-z1+1 $
+      ELSE BEGIN 
+         ouca = where(gdepw ge prof1 and gdepw le prof2,nzw)
+         if ouca[0] NE -1 then zw=gdepw[ouca] ELSE zw = -1
+      ENDELSE
+   ENDIF
+;----------------------------------------------------------------------       
+; determination de premierzt, dernierzt, premierzw, dernierzw
+;----------------------------------------------------------------------       
+   IF (inter(byte(grille), byte(['T', 'U', 'V', 'F'])))[0] NE -1 THEN BEGIN
+      if keyword_set(zindex) OR keyword_set(index) then BEGIN 
+         premierzt = z1
+         dernierzt = z2
+      ENDIF ELSE BEGIN 
+         if zt[0] NE -1 then begin
+            premierzt = (where(gdept eq zt[0]))[0]
+            dernierzt = (where(gdept eq zt[nzt-1]))[0]
+         ENDIF ELSE BEGIN 
+            premierzt = -1
+            dernierzt = -1
+         ENDELSE
+      ENDELSE
+   endif
+   if (where(grille eq 'W'))[0] NE -1  AND n_elements(gdepw) NE 0 then begin
+      if keyword_set(zindex) OR keyword_set(index) then BEGIN 
+         premierzw = z1
+         dernierzw = z2
+      ENDIF ELSE BEGIN 
+         if zw[0] NE -1 then begin
+            premierzw = (where(gdepw eq zw[0]))[0]
+            dernierzw = (where(gdepw eq zw[nzw-1]))[0]
+         ENDIF ELSE BEGIN 
+            premierzw = -1
+            dernierzw = -1
+         ENDELSE
+      ENDELSE
+   endif
+;-------------------------------------------------------------------
+;-------------------------------------------------------------------
+; calcul pour les pts t et w
+;-------------------------------------------------------------------
+;-------------------------------------------------------------------
+   tempdeux = systime(1)        ; pour key_performance =2
+   if (where(grille eq 'T'))[0] NE -1 or (where(grille EQ 'W'))[0] NE -1 then begin
+      if (keyword_set(xindex) AND keyword_set(yindex)) OR keyword_set(index) then begin
+         premierxt = x1
+         premieryt = y1
+         dernierxt = x2
+         dernieryt = y2
+      ENDIF ELSE BEGIN
+         dom =   where( (glamt ge lon1) $
+                        and (glamt le lon2) $
+                        and (gphit ge lat1) $
+                        and (gphit le lat2) )
+         if (dom[0] eq -1) then BEGIN
+            if keyword_set(findalways) then BEGIN
+               domdef, prof1,prof2, GRILLE=grille, MEMEINDICES = memeindices, _extra = ex
+               return
+            ENDIF ELSE BEGIN
+               ras = report('ATTENTION, la boite ne contient pas de points t')
+               goto, ptu
+            ENDELSE
+         endif 
+         IF testvar(var = key_performance) EQ 2 THEN $
+          print, 'temps domdef: trouver le sous domaine', systime(1)-tempdeux
+;-------------------------------------------------------------------
+; on recupere les abscisses et les ordonees des points selectionnes
+;-------------------------------------------------------------------
+         tempdeux = systime(1)  ; pour key_performance =2
+         ordonnee = dom/jpi
+         abscisse = dom-ordonnee*jpi
+;-------------------------------------------------------------------
+; on les ordonnes et on elimine les elements en double
+;-------------------------------------------------------------------
+         ordonnee = ordonnee
+         abscisse = abscisse
+         ordonnee = ordonnee(uniq(ordonnee, sort(ordonnee)))
+         abscisse = abscisse(uniq(abscisse, sort(abscisse)))
+;-------------------------------------------------------------------
+; indices des bornes du domaine
+;-------------------------------------------------------------------
+         premierxt = abscisse[0]
+         premieryt = ordonnee[0]
+         dernierxt = abscisse[n_elements(abscisse) -1]
+         dernieryt = ordonnee[n_elements(ordonnee) -1]
+      ENDELSE 
+;-------------------------------------------------------------------
+; nombre de points selectionnes
+;-------------------------------------------------------------------
+      nxt = dernierxt-premierxt+1
+      nyt = dernieryt-premieryt+1
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps domdef: calculs de premier, dernier,...', systime(1)-tempdeux
+;-------------------------------------------------------------------
+; la grille est reguliere ou non ??
+;-------------------------------------------------------------------
+      tempdeux = systime(1)     ; pour key_performance =2
+      if (total(glamt[premierxt:dernierxt,premieryt:dernieryt] $
+                NE glamt[premierxt:dernierxt,0]#replicate(1, nyt)) eq 0 $
+          AND total(gphit[premierxt:dernierxt,premieryt:dernieryt] $
+                    NE replicate(1, nxt)#(gphit[0,premieryt:dernieryt])[*]) eq 0 ) $
+       then key_irregular = 0 ELSE key_irregular = 1
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps domdef: la grille est reguliere ou non ', systime(1)-tempdeux
+;-------------------------------------------------------------------
+      if keyword_set(memeindices) then begin
+         premierxu = premierxt & premierxv = premierxt & premierxf = premierxt 
+         dernierxu = dernierxt & dernierxv = dernierxt & dernierxf = dernierxt
+         premieryu = premieryt & premieryv = premieryt & premieryf = premieryt 
+         dernieryu = dernieryt & dernieryv = dernieryt & dernieryf = dernieryt
+         premierzw = premierzt 
+         dernierzw = dernierzt 
+         nxu = nxt & nxv = nxt & nxf = nxt
+         nyu = nyt & nyv = nyt & nyf = nyt
+         nzw = nzt
+         lon1 = glamt[premierxt, 0]
+         lon2 = glamf[dernierxf, 0]
+         lat1 = gphit[0, premieryt]
+         lat2 = gphif[0, dernieryf]
+         return
+      endif
+ptu:
+   endif
+;-------------------------------------------------------------------
+; calcul pour les pts u
+;-------------------------------------------------------------------
+   if (where(grille eq 'U'))[0] NE -1 then begin
+      if (keyword_set(xindex) AND keyword_set(xindex)) OR keyword_set(index) then begin
+         premierxu = x1
+         premieryu = y1
+         dernierxu = x2
+         dernieryu = y2
+      ENDIF ELSE BEGIN
+         dom =   where( (glamu ge lon1) $
+                        and (glamu le lon2) $
+                        and (gphiu ge lat1) $
+                        and (gphiu le lat2) )
+         if (dom[0] eq -1) then begin
+            if keyword_set(findalways) then begin
+               domdef, prof1,prof2, GRILLE=grille, MEMEINDICES = memeindices, _extra = ex
+               return
+            ENDIF ELSE BEGIN
+               ras = report('ATTENTION, la boite ne contient pas de points u')
+               goto, ptv
+            ENDELSE
+         ENDIF
+         ordonnee = dom/jpi
+         abscisse = dom-ordonnee*jpi
+         ordonnee = ordonnee(uniq(ordonnee, sort(ordonnee)))
+         abscisse = abscisse(uniq(abscisse, sort(abscisse)))
+         premierxu = abscisse[0]
+         premieryu = ordonnee[0]
+         dernierxu = abscisse[n_elements(abscisse) -1]
+         dernieryu = ordonnee[n_elements(ordonnee) -1]
+      ENDELSE 
+      nxu = dernierxu-premierxu+1
+      nyu = dernieryu-premieryu+1
+      if (total(glamu[premierxu:dernierxu,premieryu:dernieryu] $
+                NE glamu[premierxu:dernierxu,0]#replicate(1, nyu)) eq 0 $
+          AND total(gphiu[premierxu:dernierxu,premieryu:dernieryu] $
+                    NE replicate(1, nxu)#(gphiu[0,premieryu:dernieryu])[*]) eq 0 ) $
+       then key_irregular = 0 ELSE key_irregular = 1
+ptv:
+   endif
+;-------------------------------------------------------------------
+; calcul pour les pts v
+;-------------------------------------------------------------------
+   if (where(grille eq 'V'))[0] NE -1 then begin
+      if (keyword_set(xindex) AND keyword_set(xindex)) OR keyword_set(index) then begin
+         premierxv = x1
+         premieryv = y1
+         dernierxv = x2
+         dernieryv = y2
+      ENDIF ELSE BEGIN
+         dom =   where( (glamv ge lon1) $
+                        and (glamv le lon2) $
+                        and (gphiv ge lat1) $
+                        and (gphiv le lat2) )
+         if (dom[0] eq -1) then begin
+            if keyword_set(findalways) then begin
+               domdef, prof1,prof2, GRILLE=grille, MEMEINDICES = memeindices, _extra = ex
+               return
+            ENDIF ELSE BEGIN
+               ras = report('ATTENTION, la boite ne contient pas de points v')
+               goto, ptf
+            ENDELSE
+         ENDIF
+         ordonnee = dom/jpi
+         abscisse = dom-ordonnee*jpi
+         ordonnee = ordonnee(uniq(ordonnee, sort(ordonnee)))
+         abscisse = abscisse(uniq(abscisse, sort(abscisse)))
+         premierxv = abscisse[0]
+         premieryv = ordonnee[0]
+         dernierxv = abscisse[n_elements(abscisse) -1]
+         dernieryv = ordonnee[n_elements(ordonnee) -1]
+      ENDELSE 
+      nxv = dernierxv-premierxv+1
+      nyv = dernieryv-premieryv+1
+      if (total(glamv[premierxv:dernierxv,premieryv:dernieryv] $
+                NE glamv[premierxv:dernierxv,0]#replicate(1, nyv)) eq 0 $
+          AND total(gphiv[premierxv:dernierxv,premieryv:dernieryv] $
+                    NE replicate(1, nxv)#(gphiv[0,premieryv:dernieryv])[*]) eq 0 ) $
+       then key_irregular = 0 ELSE key_irregular = 1
+ptf:
+   endif
+;-------------------------------------------------------------------
+; calcul pour les pts f
+;-------------------------------------------------------------------
+   if (where(grille eq 'F'))[0] NE -1 then begin
+      if (keyword_set(xindex) AND keyword_set(xindex)) OR keyword_set(index) then begin
+         premierxf = x1
+         premieryf = y1
+         dernierxf = x2
+         dernieryf = y2
+      ENDIF ELSE BEGIN
+         dom =   where( (glamf ge lon1) $
+                        and (glamf le lon2) $
+                        and (gphif ge lat1) $
+                        and (gphif le lat2) )
+         if (dom[0] eq -1) then begin
+            if keyword_set(findalways) then begin
+               domdef, prof1,prof2, GRILLE=grille, MEMEINDICES = memeindices, _extra = ex
+               return
+            ENDIF ELSE BEGIN
+               ras = report('ATTENTION, la boite ne contient pas de points f')
+               return
+            ENDELSE
+         ENDIF
+         ordonnee = dom/jpi
+         abscisse = dom-ordonnee*jpi
+         ordonnee = ordonnee(uniq(ordonnee, sort(ordonnee)))
+         abscisse = abscisse(uniq(abscisse, sort(abscisse)))
+         premierxf = abscisse[0]
+         premieryf = ordonnee[0]
+         dernierxf = abscisse[n_elements(abscisse) -1]
+         dernieryf = ordonnee[n_elements(ordonnee) -1]
+      ENDELSE
+      nxf = dernierxf-premierxf+1
+      nyf = dernieryf-premieryf+1
+      if (total(glamf[premierxf:dernierxf,premieryf:dernieryf] $
+                NE glamf[premierxf:dernierxf,0]#replicate(1, nyf)) eq 0 $
+          AND total(gphif[premierxf:dernierxf,premieryf:dernieryf] $
+                    NE replicate(1, nxf)#(gphif[0,premieryf:dernieryf])[*]) eq 0 ) $
+       then key_irregular = 0 ELSE key_irregular = 1
+   endif
+;-------------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps domdef', systime(1)-tempsun 
+;-------------------------------------------------------------------
+
+;-------------------------------------------------------------------
+   return
+end
Index: tags/start/GRILLE/f2v.pro
===================================================================
--- tags/start/GRILLE/f2v.pro	(revision 5)
+++ tags/start/GRILLE/f2v.pro	(revision 5)
@@ -0,0 +1,132 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:f2v
+;
+; PURPOSE:permet de passer un champs se rapportant a la grille F sur
+; la grille V, grace a la moyenne: res = 0.5*(res + shift(res, 1, 0))
+;      
+;
+; CATEGORY:grille
+;
+; CALLING SEQUENCE:res=f2v(tab)
+; 
+; INPUTS:tab, un tableau 2, 3 ou 4d
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:res, un tableau 2, 3 ou 4d
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:force les parametres du zoom sur la grille V a etre
+; les memes que ceux sur la grille T.
+;
+; RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la
+; valeur NaN consacree par IDL: !values.f_nan
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:a partir des programmes de Marina Levy
+;                      Sebastien Masson (smasson@lodyc.jussieu.fr):
+;                      inspection des traveuax finis. 5/6/2000
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION f2v, temp
+@common
+   res = temp
+;on force nxt=nxf, etc ...
+   premierxv = premierxf
+   dernierxv = dernierxf
+   premieryv = premieryf
+   dernieryv = dernieryf
+   nxv = nxf
+   nyv = nyf
+   vargrid = 'V'
+   if NOT keyword_set(valmask) then valmask = 1e20
+   lon1 = glamv[premierxv, 0]
+   lon2 = glamf[dernierxf, 0]
+
+; cas sur la taille du tableau et application 
+   taille = size(temp)
+   CASE taille[0] OF 
+      1: res = -1
+      2: BEGIN 
+         case 1 of
+            taille[1] eq nxf and taille[2] eq nyf:
+            taille[1] eq jpi and taille[2] eq jpj: $
+             res=res[premierxf:dernierxf, premieryf:dernieryf]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         endcase
+         mask = (fmask())[premierxf:dernierxf, premieryf:dernieryf, 0]
+         terre = where(mask EQ 0) 
+         IF terre[0] NE -1 THEN res[terre] = !values.f_nan
+         res = 0.5*(res + shift(res, 1, 0))
+         if NOT (keyword_set(key_periodique) AND nxf EQ jpi) then res[0, *] = !values.f_nan
+         mask = (vmask())[premierxf:dernierxf, premieryf:dernieryf, 0]
+         terre = where(mask EQ 0) 
+         IF terre[0] NE -1 THEN res[terre] = valmask
+      END
+      3: BEGIN 
+         case 1 of
+            taille[1] eq nxf and taille[2] eq nyf AND taille[3] EQ nzt:
+            taille[1] eq nxf and taille[2] eq nyf AND taille[3] EQ jpk: $
+             res=res[*, *, premierzt:dernierzt]
+            taille[1] eq nxf and taille[2] eq nyf AND taille[3] EQ jpt:
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpk: $
+             res=res[premierxf:dernierxf, premieryf:dernieryf, premierzt:dernierzt]
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpt: $
+             res=res[premierxf:dernierxf, premieryf:dernieryf, *]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         ENDCASE
+         if taille[3] EQ jpt then begin
+            mask = (fmask())[premierxf:dernierxf, premieryf:dernieryf, dernierzt*(nzt NE jpk)]
+            mask = temporary(mask[*])#replicate(1, jpt)
+            mask = reform(mask, nxf, nyf, jpt, /over)
+         ENDIF ELSE mask = (fmask())[premierxf:dernierxf, premieryf:dernieryf, premierzt:dernierzt]
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = !values.f_nan
+         res = 0.5*(res + shift(res, 1, 0, 0))
+         if NOT (keyword_set(key_periodique) AND nxf EQ jpi) then res[0, *, *] = !values.f_nan
+         if taille[3] EQ jpt then BEGIN
+            mask = tmask[premierxf:dernierxf, premieryf:dernieryf, dernierzt*(nzt NE jpk)]
+            mask = temporary(mask[*])#replicate(1, jpt)
+            mask = reform(mask, nxf, nyf, jpt, /over)
+         ENDIF ELSE mask = (vmask())[premierxf:dernierxf, premieryf:dernieryf, premierzt:dernierzt]
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = valmask
+      END
+      4: BEGIN 
+         case 1 of
+            taille[1] eq nxf and taille[2] eq nyf AND taille[3] EQ nzt AND taille[4] EQ jpt:
+            taille[1] eq nxf and taille[2] eq nyf AND taille[3] EQ jpk AND taille[4] EQ jpt: $
+             res=res[*, *, premierzt:dernierzt, *]
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpk AND taille[4] EQ jpt: $
+             res=res[premierxf:dernierxf, premieryf:dernieryf, premierzt:dernierzt, *]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         ENDCASE
+         mask = (fmask())[premierxf:dernierxf, premieryf:dernieryf, premierzt:dernierzt]
+         mask = temporary(mask[*])#replicate(1, jpt)
+         mask = reform(mask, nxf, nyf, nzt, jpt, /over)
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = !values.f_nan
+         res = 0.5*(res + shift(res, 1, 0, 0, 0))
+         if NOT (keyword_set(key_periodique) AND nxf EQ jpi) then res[0, *, *, *] = !values.f_nan
+         mask = (vmask())[premierxf:dernierxf, premieryf:dernieryf, premierzt:dernierzt]
+         mask = temporary(mask[*])#replicate(1, jpt)
+         mask = reform(mask, nxf, nyf, nzt, jpt, /over)
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = valmask
+      END
+   endcase
+
+   return, res
+END
+
Index: tags/start/GRILLE/fighope.pro
===================================================================
--- tags/start/GRILLE/fighope.pro	(revision 5)
+++ tags/start/GRILLE/fighope.pro	(revision 5)
@@ -0,0 +1,17 @@
+; domdef, 270,285,-10,0
+; plt, a.array, /desstrich, colortrich = 50, petit = [1, 2, 1], /por
+; tracegrille, colortri = 150
+; plt, a.array, /notri, petit = [1, 2, 2], /noerase
+; tracegrille, colortri = 150
+;
+;
+domdef, 20,50,30,50
+lct, 39
+palit,  .2
+plt, a.array,/land,/cont_nofill, nite = 1
+lct, 39
+tracegrille,color=60
+vargrid='U'
+tracegrille,color=20
+vargrid='T'
+tracecote,cont_thick=3
Index: tags/start/GRILLE/fmask.pro
===================================================================
--- tags/start/GRILLE/fmask.pro	(revision 5)
+++ tags/start/GRILLE/fmask.pro	(revision 5)
@@ -0,0 +1,41 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:fmask
+;
+; PURPOSE:calcule fmask
+;
+; CATEGORY:fonction economisatrice de memoire (plus besion de garder
+; fmask)  
+;
+; CALLING SEQUENCE:res=fmask()
+;
+; OUTPUTS:un tableau 3d correspondant a fmask
+;
+; EXAMPLE:s''utilise comme si fmask etait un tableau connu en
+; replacant ds la syntaxe fmask par (fmask()). par ex:
+; au lieu de taper fmask[domainef] il faut taper (fmask())[domainef]
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       11/12/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION fmask
+@common
+   tempsun = systime(1)         ; pour key_performance
+   if jpk EQ 1 then begin
+      res = tmask*shift(tmask, -1, 0)*shift(tmask, 0, -1)*shift(tmask, -1, -1)
+      if NOT keyword_set(key_periodique) then res[jpi-1, *] = fmaskredy
+      res[*, jpj-1] = fmaskredx
+   ENDIF ELSE BEGIN
+      res = tmask*shift(tmask, -1, 0, 0)*shift(tmask, 0, -1, 0)*shift(tmask, -1, -1, 0)
+      if NOT keyword_set(key_periodique) then res[jpi-1, *, *] = fmaskredy
+      res[*, jpj-1, *] = fmaskredx
+   ENDELSE
+   if keyword_set(key_performance) THEN print, 'temps fmask', systime(1)-tempsun 
+
+   return, res
+end
Index: tags/start/GRILLE/grille.pro
===================================================================
--- tags/start/GRILLE/grille.pro	(revision 5)
+++ tags/start/GRILLE/grille.pro	(revision 5)
@@ -0,0 +1,270 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:grille
+;
+; PURPOSE: choisit la grille qui doit etre utilisee pour faire le graphe en
+; fonction de vargrid et renvoie les parametres correspondants calcules ds
+; domdef.pro et reduit au domaine definit par domdef (contrairement a
+; grandegrille.pro)
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:
+;  grille,mask,glam,gphi,gdep,nx,ny,nz,premierx,premiery,premierz,dernierx,derniery,dernierz,e1,e2,e3
+;
+; INPUTS:rien. ATTENTION les choix de la grille se fait a partir de la
+; valeur de la variable globale vargrid, qui peut etre egale a 'T',
+; 'U', 'V', 'W' ou 'F'.
+;
+; KEYWORD PARAMETERS:
+;         TRI si ce mot clef sert a obtenir grace a grille la
+;         triangulation qui se rapporte a la grille mais uniquement
+;         sur la partie du zoom. ce tableau de triangulation reduit
+;         est passe ds la variable que l''on a egalee a tri.par ex:
+;         grille,...,tri=triangulation_reduite. ne mot clef est
+;         utilise dans plt.pro
+;
+;         /FORPLT: ds plt on veut que sur les points terres, glam et
+;         gphi soit egale a glamt et gphit quelle que soit la grille.
+;
+;         /NOTRI: utile seulement qd TRI est active. dans ce cas
+;         grille retourne -1 ds la variable tri meme si la variable du
+;         common triangles est definie et differente de -1
+;
+; OUTPUTS:mask,glam,gphi,gdep,nx,ny,nz,premierx,premiery,premierz,
+;         dernierx,derniery,dernierz,e1,e2,e3
+;
+;         pour leur definition cf domdef et la gestion des sous
+;         domaines sur le web
+;
+;         Rq: ces outputs sont optionnels, si je veux recuperer que
+;         mask, glam et gphi il suffit de taper grille, mask, glam, gphi
+;
+; COMMON BLOCKS:
+;	common.pro	congridseb.pro
+;
+; SIDE EFFECTS: utilise la variable globale vargird
+;
+; RESTRICTIONS: vargrid doit etre 'T', 'W', 'U', 'V' ou 'F'
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			12/2/1999
+;                       10/11/1999 /forplt
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery, dernierz, e1,e2,e3, TRI = tri, NOTRI = notri, TOUT = tout, FORPLT = forplt, _EXTRA = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;------------------------------------------------------------
+   if keyword_set(tout) then begin
+      oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+      domdef, grille = vargrid, _EXTRA = ex
+   endif
+   tempdeux = systime(1)        ; pour key_performance =2
+   CASE 1 OF 
+;------------------------------------------------------------
+; grille T
+;------------------------------------------------------------
+      vargrid eq 'OPAPTDHT' or vargrid eq 'OPAPT3DT' $
+       or vargrid eq 'T': begin
+;scalaires
+         nx=nxt
+         ny=nyt
+         nz=nzt
+         premierx = premierxt
+         premiery = premieryt
+         premierz = premierzt
+         dernierx = dernierxt
+         derniery = dernieryt
+         dernierz = dernierzt
+;vecteurs 2d
+         glam=glamt[premierx:dernierx, premiery:derniery]
+         gphi=gphit[premierx:dernierx, premiery:derniery]
+         e1  =e1t[premierx:dernierx, premiery:derniery]
+         e2  =e2t[premierx:dernierx, premiery:derniery]
+;vecteurs 3d
+         mask=tmask[premierx:dernierx, premiery:derniery, premierz:dernierz]
+      end
+;------------------------------------------------------------
+; grille W
+;------------------------------------------------------------
+      vargrid eq 'OPAPT3DW' or vargrid eq 'W': begin
+;scalaires
+         nx=nxt
+         ny=nyt
+         nz=nzw
+         premierx = premierxt
+         premiery = premieryt
+         premierz = premierzw
+         dernierx = dernierxt
+         derniery = dernieryt
+         dernierz = dernierzw
+;vecteurs 2d
+         terre = where(tmask[*, *, 0] EQ 0)
+         glam=glamt[premierx:dernierx, premiery:derniery]
+         gphi=gphit[premierx:dernierx, premiery:derniery]
+         e1  =e1t[premierx:dernierx, premiery:derniery]
+         e2  =e2t[premierx:dernierx, premiery:derniery]
+;vecteurs 3d
+         mask=tmask[premierx:dernierx, premiery:derniery, premierz:dernierz]
+      end
+;------------------------------------------------------------
+; grille U
+;------------------------------------------------------------
+      vargrid eq 'OPAPTDHU' or vargrid eq 'OPAPT3DU' $
+       or vargrid eq 'U': begin
+;scalaires
+         nx=nxu
+         ny=nyu
+         nz=nzt
+         premierx = premierxu
+         premiery = premieryu
+         premierz = premierzt
+         dernierx = dernierxu
+         derniery = dernieryu
+         dernierz = dernierzt
+;vecteurs 2d
+         glam=glamu[premierx:dernierx, premiery:derniery]
+         gphi=gphiu[premierx:dernierx, premiery:derniery]
+         if keyword_set(forplt) then BEGIN 
+            mask = tmask[premierx:dernierx, premiery:derniery, niveau-1]
+            terre = where(mask EQ 0)
+            if terre[0] NE -1 then begin
+               glam[terre] = (glamt[premierx:dernierx, premiery:derniery])[terre]
+               gphi[terre] = (gphit[premierx:dernierx, premiery:derniery])[terre]
+            endif
+         ENDIF
+         e1  =e1u[premierx:dernierx, premiery:derniery]
+         e2  =e2u[premierx:dernierx, premiery:derniery]
+;vecteurs 3d
+         mask=(umask())[premierx:dernierx, premiery:derniery, premierz:dernierz]
+      end
+;------------------------------------------------------------
+; grille V
+;------------------------------------------------------------
+      vargrid eq 'OPAPTDHV' or vargrid eq 'OPAPT3DV' $
+       or vargrid eq 'V': begin
+;scalaires
+         nx=nxv
+         ny=nyv
+         nz=nzt
+         premierx = premierxv
+         premiery = premieryv
+         premierz = premierzt
+         dernierx = dernierxv
+         derniery = dernieryv
+         dernierz = dernierzt
+;vecteurs 2d
+         glam=glamv[premierx:dernierx, premiery:derniery]
+         gphi=gphiv[premierx:dernierx, premiery:derniery]
+         if keyword_set(forplt) then BEGIN 
+            mask = tmask[premierx:dernierx, premiery:derniery, niveau-1]
+            terre = where(mask EQ 0)
+            if terre[0] NE -1 then begin
+               glam[terre] = (glamt[premierx:dernierx, premiery:derniery])[terre]
+               gphi[terre] = (gphit[premierx:dernierx, premiery:derniery])[terre]
+            endif
+         ENDIF
+         e1  =e1v[premierx:dernierx, premiery:derniery]
+         e2  =e2v[premierx:dernierx, premiery:derniery]
+;vecteurs 3d
+         mask=(vmask())[premierx:dernierx, premiery:derniery, premierz:dernierz]
+      end
+;------------------------------------------------------------
+; grille F
+;------------------------------------------------------------
+      vargrid eq 'OPAPTDHF' or vargrid eq 'OPAPT3DF' $ 
+       or vargrid eq 'F': begin
+;scalaires
+         nx=nxf
+         ny=nyf
+         nz=nzt
+         premierx = premierxf
+         premiery = premieryf
+         premierz = premierzt
+         dernierx = dernierxf
+         derniery = dernieryf
+         dernierz = dernierzt
+;vecteurs 2d
+         glam=glamf[premierx:dernierx, premiery:derniery]
+         gphi=gphif[premierx:dernierx, premiery:derniery]
+         if keyword_set(forplt) then BEGIN 
+            mask = tmask[premierx:dernierx, premiery:derniery, niveau-1]
+            terre = where(mask EQ 0)
+            if terre[0] NE -1 then begin
+               glam[terre] = (glamt[premierx:dernierx, premiery:derniery])[terre]
+               gphi[terre] = (gphit[premierx:dernierx, premiery:derniery])[terre]
+            endif
+         ENDIF
+         e1  =e1f[premierx:dernierx, premiery:derniery]
+         e2  =e2f[premierx:dernierx, premiery:derniery]
+;vecteurs 3d
+         mask=(fmask())[premierx:dernierx, premiery:derniery, premierz:dernierz]
+      END
+;------------------------------------------------------------
+      ELSE:BEGIN 
+         ras = report('Vauvaise definition de la variable vargrid: '+vargrid+'ceete variable doit etre T, U, V, W ou F')
+         stop
+      END
+   ENDCASE
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps grille: attribution des scalaires, vecteurs et tableaux ', systime(1)-tempdeux
+;------------------------------------------------------------
+; Variables se rapportant a la dimension verticale
+;------------------------------------------------------------
+   tempdeux = systime(1)        ; pour key_performance =2
+   if vargrid eq 'OPAPT3DW' or vargrid eq 'W' then begin
+      gdep = gdepw[premierz:dernierz]
+      e3=e3w[premierz:dernierz]
+   endif else begin
+      gdep = gdept[premierz:dernierz]
+      e3=e3t[premierz:dernierz]
+   endelse
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps grille: Variables se rapportant a la dimension verticale ', systime(1)-tempdeux
+;------------------------------------------------------------
+; vecteur triangulation Qd TRI est active
+;------------------------------------------------------------
+   if arg_present(TRI) then $
+    if triangles[0] EQ -1 OR keyword_set(notri) then tri = -1 ELSE BEGIN 
+      tempdeux = systime(1)     ; pour key_performance =2
+      msk = bytarr(jpi, jpj)
+      msk[premierx:dernierx,premiery:derniery] = 1
+      ind = where( msk[triangles[0, *]]*msk[triangles[1, *]]*msk[triangles[2, *]] EQ 1 )
+      tri =triangles[*, ind]-(premierx+premiery*jpi)
+      y = tri/jpi
+      x = tri-y*jpi
+      tri = x+y*nx
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps grille: decoupage de la triangulation ', systime(1)-tempdeux
+   ENDELSE
+;------------------------------------------------------------------
+; pour s'assurer qu'il n'y a pas de dimension degenerees (=1)
+;-------------------------------------------------------------------
+;    mask=reform(mask, /over)
+;    glam=reform(glam, /over)
+;    gphi=reform(gphi, /over)
+;    gdep=reform(gdep, /over)
+;    e1=reform(e1, /over)
+;    e2=reform(e2, /over)
+;    e3=reform(e3, /over)
+
+   if keyword_set(tout) then domdef, oldboite, grille = vargrid
+   if keyword_set(key_performance) THEN print, 'temps grille', systime(1)-tempsun 
+
+   return
+
+end
+
+
+
+
+
+
+
Index: tags/start/GRILLE/meshlec.pro
===================================================================
--- tags/start/GRILLE/meshlec.pro	(revision 5)
+++ tags/start/GRILLE/meshlec.pro	(revision 5)
@@ -0,0 +1,341 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:meshlec
+;
+; PURPOSE: lecture du mask de des sorties d'OPA. les sources se trouvent ds les 
+; repertoires sur maia du type:
+;  /nom_exp/RESTARTS
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:meshmask[,' nomfich']
+;
+; INPUTS:
+;    nomfich: string, c''est le nom du fichier a lire. Par defaut, c''est
+;             meshmask. 
+;
+; KEYWORD PARAMETERS:
+;
+;    GLAMBOUNDARY: un vecteur de 2 elements specifaint le min et le
+;    max qui doivent etre imposes en longitude (obligatoire si le
+;    tableau depasse 360 degres)
+;
+;        /pasblabla: pour suprimer les blablas
+;
+;        /DOUBLE: pour forcer a lire les tableaux en double
+;        precision. ce Mot clef est maintenant active
+;        automatiquement.
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+;  La definition de ixminmesh,ixmaxmesh,iyminmesh,iymaxmesh
+;  ,izminmesh,izmaxmesh doit etre faite avant l''entree dans cette
+;  routine. pour attribuer automatiquement ces valeurs au maximum
+;  possible les mettre toutes a -1 et meshlec les calculera.
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;     Marina Levy : lecture en double precision (cas calcul sur shine)
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro meshlec, nomfich, PASBLABLA = pasblabla,DOUBLE = double, GLAMBOUNDARY = glamboundary, GETDIMENSIONS = GETDIMENSIONS
+@common
+   tempsun = systime(1)         ; pour key_performance
+;---------------------------------------------------------
+;---------------------------------------------------------
+   jpiglo      = 0L
+   jpjglo      = 0L
+   jpkglo      = 0L
+   tab    = 'aaaaa'
+;---------------------------------------------------------
+;  definition du domaine de la grille surlequel sont
+;  effectuees les sorties.les indices des tableaux commencant
+;  a 1: cf le fichier wrivr2.F ds WKOPA sur le cray
+;----------------------------------------------------------
+;	LECTURE DU MASK trouve ds les fichiers restart
+;----------------------------------------------------------
+;----------------------------------------------------------
+;
+;----------------------------------------------------------
+;       constitution de l'adresse s_fichier et
+;     ouverture du fichier a l'adresse s_fichier
+;-------------------------------------------------------
+
+   IF n_params() EQ 0 then nomfich = 'meshmask'
+   s_fichier = isafile(file = nomfich, iodir = iodir)
+   if not keyword_set(pasblabla) then print, ' '
+   if not keyword_set(pasblabla) then print,'adresse du fichier: ',s_fichier
+
+   openr, numlec, s_fichier, /get_lun, /f77_unformatted, /swap_if_little_endian
+   filepamameters = fstat(numlec)
+;---------------------------------------------------------
+;     lecture
+;---------------------------------------------------------
+   readu, numlec, jpiglo, jpjglo, jpkglo
+   if not keyword_set(pasblabla) then print, 'taille de la grille d''origine: ',jpiglo,', ',jpjglo,', ',jpkglo
+;
+   if keyword_set(getdimensions) then begin
+      free_lun,numlec
+      close, numlec
+      return
+   endif
+
+;---------------------------------------------------------
+; on determine si le fichier a ete ecrit en double precision on non...
+   sizenumber = 8l
+   sizefile8 = 4l+3l*4l+4l $
+    +4l*(4l+jpiglo*jpjglo*sizenumber+4l) $
+    +4l*(4l+jpiglo*jpjglo*sizenumber+4l) $
+    +4l*(4l+jpiglo*jpjglo*sizenumber+4l) $
+    +4l*(4l+jpiglo*jpjglo*sizenumber+4l) $
+    +4l*(4l+jpiglo*jpjglo*jpkglo*sizenumber+4l) $
+    +1l*(4l+jpiglo*jpjglo*sizenumber+4l) $
+    +4l*(4l+jpkglo*sizenumber+4l)
+   if filepamameters.size GE sizefile8 THEN double = 1
+;    sizenumber = 4l
+;    sizefile4 = 4l+3l*4l+4l $
+;     +4l*(4l+jpiglo*jpjglo*sizenumber+4l) $
+;     +4l*(4l+jpiglo*jpjglo*sizenumber+4l) $
+;     +4l*(4l+jpiglo*jpjglo*sizenumber+4l) $
+;     +4l*(4l+jpiglo*jpjglo*sizenumber+4l) $
+;     +4l*(4l+jpiglo*jpjglo*jpkglo*sizenumber+4l) $
+;     +1l*(4l+jpiglo*jpjglo*sizenumber+4l) $
+;     +4l*(4l+jpkglo*sizenumber+4l)
+; print, filepamameters.size,  sizefile4,  sizefile8
+;    case filepamameters.size of
+;       sizefile8:double = 1
+;       sizefile4:double = 0
+;       ELSE:BEGIN 
+;          nothing = report('The OPA Mesh file as not the good size!')
+;          free_lun,numlec
+;          close, numlec
+;          return 
+;       END
+;    endcase
+;
+;
+   if n_elements(ixminmesh) EQ 0 THEN ixminmesh = 0
+   if n_elements(ixmaxmesh) EQ 0 then ixmaxmesh = jpiglo-1
+   if ixminmesh EQ -1 THEN ixminmesh = 0
+   IF ixmaxmesh EQ -1 then ixmaxmesh = jpiglo-1
+   if n_elements(iyminmesh) EQ 0 THEN iyminmesh = 0
+   IF n_elements(iymaxmesh) EQ 0 then iymaxmesh = jpjglo-1
+   if iyminmesh EQ -1 THEN iyminmesh = 0
+   IF iymaxmesh EQ -1 then iymaxmesh = jpjglo-1
+   if n_elements(izminmesh) EQ 0 THEN izminmesh = 0
+   IF n_elements(izmaxmesh) EQ 0 then izmaxmesh = jpkglo-1
+   if izminmesh EQ -1 THEN izminmesh = 0
+   IF izmaxmesh EQ -1 then izmaxmesh = jpkglo-1
+;
+;
+
+   jpi    = long(ixmaxmesh-ixminmesh+1)
+   jpj    = long(iymaxmesh-iyminmesh+1)
+   jpk    = long(izmaxmesh-izminmesh+1)
+;-------------------------------------------------------
+; doit-on reellement lire la grille?
+;-------------------------------------------------------
+   meshparameters = {jpiglo:jpiglo, jpjglo:jpjglo, jpkglo:jpkglo $
+                     , jpi:jpi, jpj:jpj, jpk:jpk $
+                     , ixminmesh:ixminmesh, ixmaxmesh:ixmaxmesh $
+                     , iyminmesh:iyminmesh, iymaxmesh:iymaxmesh $
+                     , izminmesh:izminmesh, izmaxmesh:izmaxmesh $
+                     , key_shift:key_shift}
+;
+;-------------------------------------------------------
+   noticebase=xnotice('Lecture du fichier !C '+s_fichier+'!C ...')
+;-------------------------------------------------------
+
+   IF NOT keyword_set(double) THEN BEGIN 
+      z3d    = fltarr(jpiglo, jpjglo, jpkglo)
+      z2d    = fltarr(jpiglo, jpjglo)
+      z1d    = fltarr(jpkglo)
+   ENDIF ELSE BEGIN 
+      z3d    = dblarr(jpiglo, jpjglo, jpkglo)
+      z2d    = dblarr(jpiglo, jpjglo)
+      z1d    = dblarr(jpkglo)
+   ENDELSE 
+
+   if not keyword_set(pasblabla) then print, ' '
+   readu, numlec, tab,z2d
+   GLAMT=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur GLAMT[25,31]: ',GLAMT[25,31]
+   readu, numlec, tab,z2d
+   GLAMU=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur GLAMU[25,31]: ',GLAMU[25,31]
+   readu, numlec, tab,z2d
+   GLAMV=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur GLAMV[25,31]: ',GLAMV[25,31]
+   readu, numlec, tab,z2d
+   GLAMF=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur GLAMF[25,31]: ',z2d[25,31]
+
+   if not keyword_set(pasblabla) then print, ' '
+   readu, numlec, tab, z2d  
+   GPHIT=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur GPHIT[25,31]: ',GPHIT[25,31]
+   readu, numlec, tab, z2d  
+   GPHIU=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur GPHIU[25,31]: ',GPHIU[25,31]
+   readu, numlec, tab, z2d  
+   GPHIV=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur GPHIV[25,31]: ',GPHIV[25,31]
+   readu, numlec, tab, z2d  
+   GPHIF=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur GPHIF[25,31]: ',z2d[25,31]
+
+   if not keyword_set(pasblabla) then print, ' '
+   readu, numlec, tab, z2d
+   E1T=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur E1T[25,5]: ',z2d[25,5]
+   readu, numlec, tab, z2d
+   E1U=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur E1U[25,5]: ',z2d[25,5]
+   readu, numlec, tab, z2d
+   E1V=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur E1V[25,5]: ',z2d[25,5]
+   readu, numlec, tab, z2d
+   E1F=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur E1F[25,5]: ',z2d[25,5]
+
+   if not keyword_set(pasblabla) then print, ' '
+   readu, numlec, tab, z2d
+   E2T=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur E2T[25,5]: ',z2d[25,5]
+   readu, numlec, tab, z2d
+   E2U=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur E2U[25,5]: ',z2d[25,5]
+   readu, numlec, tab, z2d
+   E2V=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur E2V[25,5]: ',z2d[25,5]
+   readu, numlec, tab, z2d
+   E2F=float(z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur E2F[25,5]: ',z2d[25,5]
+
+   if not keyword_set(pasblabla) then print, ' '
+   readu, numlec, tab, z3d     
+   TMASK=byte(z3d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh,izminmesh:izmaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur TMASK[25,5,0]: ',TMASK[25,5,0]
+   readu, numlec, tab, z3d   
+   UMASKred=byte(z3d[ixmaxmesh,iyminmesh:iymaxmesh,izminmesh:izmaxmesh])
+   umaskred = reform(umaskred)
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur UMASK[25,5,0]: ',z3d[25,5,0]
+   readu, numlec, tab, z3d    
+   VMASKred=byte(z3d[ixminmesh:ixmaxmesh,iymaxmesh,izminmesh:izmaxmesh])
+   vmaskred = reform(vmaskred)
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur VMASK[25,5,0]: ',z3d[25,5,0]
+   readu, numlec, tab, z3d    
+   fmaskredy=byte(z3d[ixmaxmesh,iyminmesh:iymaxmesh,izminmesh:izmaxmesh])
+   coast = where(fmaskredy NE 0 and fmaskredy NE 1)
+   IF coast[0] NE -1 THEN fmaskredy[coast] = 0b
+   fmaskredx=byte(z3d[ixminmesh:ixmaxmesh,iymaxmesh,izminmesh:izmaxmesh])
+   coast = where(fmaskredx NE 0 and fmaskredx NE 1)
+   IF coast[0] NE -1 THEN fmaskredx[coast] = 0b
+   fmaskredx = reform(fmaskredx)
+   fmaskredy = reform(fmaskredy)
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur FMASK[25,5,0]: ',z3d[25,5,0]
+;
+   if not keyword_set(pasblabla) then print, ' '
+   readu, numlec, tab, z2d   
+;FF=z2d[ixminmesh:ixmaxmesh,iyminmesh:iymaxmesh]
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur FF[25,5]: ',z2d[25,5]
+   readu, numlec, tab, z1d
+   GDEPT=float(z1d[izminmesh:izmaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur GDEPT[1]: ',GDEPT[1]
+   readu, numlec, tab, z1d    
+   GDEPW=float(z1d[izminmesh:izmaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur GDEPW[1]: ',GDEPW[1]
+   readu, numlec, tab, z1d   
+   E3T=float(z1d[izminmesh:izmaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur E3T[3]: ',E3T[3]
+   readu, numlec, tab, z1d   
+   E3W=float(z1d[izminmesh:izmaxmesh])
+   if not keyword_set(pasblabla) then print, 'tableau: ',tab,' exemple de valeur E3W[3]: ',E3W[3]
+;-------------------------------------------------------
+   free_lun,numlec
+   close, numlec
+;-------------------------------------------------------
+;-------------------------------------------------------
+; bornes de glam qui ne doivent pas depasser 360 degres... 
+;-------------------------------------------------------
+;    minglam = min(glamt, max = maxglam)
+;    if maxglam-minglam GE 360 AND NOT keyword_set(glamboundary) then $
+;     nothing = execute('glamboundary = '+xquestion('What are the longitudes boundary?', '[-180,180]',/chkwidget))
+;-------------------------------------------------------
+   if keyword_set(glamboundary) then begin
+      if glamboundary[0] NE glamboundary[1] then begin
+         glamt = glamt MOD 360
+         smaller = where(glamt LT glamboundary[0])
+         if smaller[0] NE -1 then glamt[smaller] = glamt[smaller]+360
+         bigger = where(glamt GE glamboundary[1])
+         if bigger[0] NE -1 then glamt[bigger] = glamt[bigger]-360
+         glamu = glamu MOD 360
+         smaller = where(glamu LT glamboundary[0])
+         if smaller[0] NE -1 then glamu[smaller] = glamu[smaller]+360
+         bigger = where(glamu GE glamboundary[1])
+         if bigger[0] NE -1 then glamu[bigger] = glamu[bigger]-360
+         glamv = glamv MOD 360
+         smaller = where(glamv LT glamboundary[0])
+         if smaller[0] NE -1 then glamv[smaller] = glamv[smaller]+360
+         bigger = where(glamv GE glamboundary[1])
+         if bigger[0] NE -1 then glamv[bigger] = glamv[bigger]-360
+         glamf = glamf MOD 360
+         smaller = where(glamf LT glamboundary[0])
+         if smaller[0] NE -1 then glamf[smaller] = glamf[smaller]+360
+         bigger = where(glamf GE glamboundary[1])
+         if bigger[0] NE -1 then glamf[bigger] = glamf[bigger]-360
+      endif
+   endif
+;-------------------------------------------------------
+; shift en x
+;-------------------------------------------------------
+   if keyword_set(key_shift) AND jpi NE 1 then begin
+      glamt = shift(glamt,key_shift , 0)
+      gphit = shift(gphit,key_shift , 0)
+      e1t = shift(e1t, key_shift, 0)
+      e2t = shift(e2t,key_shift , 0)
+      glamu = shift(glamu, key_shift, 0)
+      gphiu = shift(gphiu, key_shift, 0)
+      e1u = shift(e1u,key_shift , 0)
+      e2u = shift(e2u, key_shift, 0)
+      glamv = shift(glamv, key_shift, 0)
+      gphiv = shift(gphiv, key_shift, 0)
+      e1v = shift(e1v,key_shift , 0)
+      e2v = shift(e2v, key_shift, 0)
+      glamf = shift(glamf, key_shift, 0)
+      gphif = shift(gphif, key_shift, 0)
+      e1f = shift(e1f, key_shift , 0)
+      e2f = shift(e2f, key_shift, 0)
+      if jpk EQ 1 then begin
+         tmask = shift(tmask, key_shift, 0)
+         vmaskred = shift(vmaskred, key_shift)
+         fmaskredx = shift(fmaskredx, key_shift)
+      ENDIF ELSE BEGIN
+         tmask = shift(tmask, key_shift, 0,0)
+         vmaskred = shift(vmaskred, key_shift, 0)
+         fmaskredx = shift(fmaskredx, key_shift, 0)
+      ENDELSE
+   endif
+;-------------------------------------------------------
+   if not keyword_set(pasblabla) then print,'lecture '+nomfich+' finie'
+   widget_control, noticebase, bad_id = toto, /destroy
+   if keyword_set(key_performance) THEN print, 'temps meshlec', systime(1)-tempsun 
+
+   return
+end
+
+
+
+
Index: tags/start/GRILLE/ncdf_meshlec.pro
===================================================================
--- tags/start/GRILLE/ncdf_meshlec.pro	(revision 5)
+++ tags/start/GRILLE/ncdf_meshlec.pro	(revision 5)
@@ -0,0 +1,328 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:ncdf_meshlec
+;
+; PURPOSE:lit le fichier meshmask au format netcdf cree par OPA ds sa
+; version tout NETCDF!
+;
+; CATEGORY:lecture de grille
+;
+; CALLING SEQUENCE:ncdf_meshlec [,' nomfich']
+; 
+; INPUTS:
+;
+;       nomfich: un string definissant le nom du fichier a lire. Si
+; ce string ne contient pas l''adresse entiere du fichier nomfich est
+; complete par iodir. Par defaut nomfich=iodir+'meshmask.nc'
+;
+; KEYWORD PARAMETERS:
+;
+;    GLAMBOUNDARY: un vecteur de 2 elements specifaint le min et le
+;    max qui doivent etre imposes en longitude (obligatoire si le
+;    tableau depasse 360 degres)
+;
+;    /CHECKDAT: cherche si il existe un ficher du meme nom que le
+;    fichier meshmask mais terminant par .dat au lieu de .dat. 
+;             Si ce fichier n''existe pas, ncdf_meshlec lit le fichier
+;         NetCdf et sauve tous les tableaux lus ds le fichier
+;         ...dat. Rq: Ce fichier est bcp plus petit que le fichier
+;         NetCdf d''origine car par ex on ne sauve pas les tableaux
+;         umask, vmask, fmask mais simplement certains de leurs bords
+;         (cf. umask.pro vmask.pro et fmask.pro) et ces masks sont
+;         sauves en bytes et toues les autres tableaux en
+;         float. Cependant ce fichier .dat est cree en fonction des
+;         parametres rentres ds le init... (ixminmesh.....) et Je ne
+;         sais rien sur la portabilite du fichier .dat.
+;            Si ce fichier .dat existe on le lit avec restore.
+;
+; OUTPUTS:mise a jours des variables de common glam, common
+; gphi,common e12,common mask,common tab (cf. common.pro)
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:prend en compte (si il sont definits) les
+; ixminmesh,...et definit jpiglo,jpi,....
+;
+; RESTRICTIONS:
+;
+;  La definition de ixminmesh,ixmaxmesh,iyminmesh,iymaxmesh
+;  ,izminmesh,izmaxmesh doit etre faite avant l''entree dans cette
+;  routine. pour attribuer automatiquement ces valeurs au maximum
+;  possible les mettre toutes a -1 et ncdf_meshlec les calculera.
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      12/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO ncdf_meshlec, nomfich, GLAMBOUNDARY = glamboundary, GETDIMENSIONS = getdimensions, CHECKDAT = checkdat
+@common
+   tempsun = systime(1)         ; pour key_performance
+;----------------------------------------------------------
+;       constitution de l''adresse s_fichier et
+;     ouverture du fichier a l''adresse s_fichier
+;-------------------------------------------------------
+; def de nomfich par defaut
+   IF n_params() EQ 0 then nomfich = 'meshmask.nc'
+;------------------
+   if keyword_set(CHECKDAT) then begin
+      nomfichdat = strmid(nomfich, 0, strlen(nomfich)-2)+'dat'
+      thisOS = strupcase(strmid(!version.os_family, 0, 3))
+      CASE thisOS OF 
+         'MAC':sep = ':'
+         'WIN':sep = '\'
+         ELSE:sep = '/'
+      ENDCASE
+      if strpos(nomfichdat, sep) EQ -1 then begin
+; si iodir ne finit pas par sep on le rajoute
+         if rstrpos(iodir, sep) NE strlen(iodir)-1 then iodir = iodir+sep
+         nomfichdat = iodir+nomfichdat
+      endif
+      test = findfile(nomfichdat)  ; le nom cherche correspond bien a un fichier?
+      if test[0] NE '' then begin
+         noticebase=xnotice('Lecture du fichier !C '+nomfichdat+'!C ...')
+         restore, nomfichdat
+         widget_control, noticebase, bad_id = nothing, /destroy
+         if keyword_set(key_performance) THEN print, 'temps ncdf_meshlec', systime(1)-tempsun 
+         return
+      ENDIF
+   endif
+;------------------
+   s_fichier = isafile(file = nomfich, iodir = iodir)
+;
+   noticebase=xnotice('Lecture du fichier !C '+s_fichier+'!C ...')
+;
+   cdfid=ncdf_open(s_fichier)
+   contient=ncdf_inquire(cdfid)
+
+;------------------------------------------------------------
+; differentes dimensions
+;------------------------------------------------------------
+   ncdf_diminq,cdfid,'x',name,jpiglo
+   ncdf_diminq,cdfid,'y',name,jpjglo
+   ncdf_diminq,cdfid,'z',name,jpkglo
+;
+   if keyword_set(getdimensions) then begin
+      ncdf_close,  cdfid
+      return
+   endif
+;-------------------------------------------------------
+;-------------------------------------------------------
+   if n_elements(ixminmesh) EQ 0 THEN ixminmesh = 0
+   if n_elements(ixmaxmesh) EQ 0 then ixmaxmesh = jpiglo-1
+   if ixminmesh EQ -1 THEN ixminmesh = 0
+   IF ixmaxmesh EQ -1 then ixmaxmesh = jpiglo-1
+   if n_elements(iyminmesh) EQ 0 THEN iyminmesh = 0
+   IF n_elements(iymaxmesh) EQ 0 then iymaxmesh = jpjglo-1
+   if iyminmesh EQ -1 THEN iyminmesh = 0
+   IF iymaxmesh EQ -1 then iymaxmesh = jpjglo-1
+   if n_elements(izminmesh) EQ 0 THEN izminmesh = 0
+   IF n_elements(izmaxmesh) EQ 0 then izmaxmesh = jpkglo-1
+   if izminmesh EQ -1 THEN izminmesh = 0
+   IF izmaxmesh EQ -1 then izmaxmesh = jpkglo-1
+;
+   ixmindtasauve = testvar(var = ixmindta)
+   iymindtasauve = testvar(var = iymindta)
+   izmindtasauve = testvar(var = izmindta)
+;
+   ixmindta = 0l
+   iymindta = 0l
+   izmindta = 0l
+;
+   jpi    = long(ixmaxmesh-ixminmesh+1)
+   jpj    = long(iymaxmesh-iyminmesh+1)
+   jpk    = long(izmaxmesh-izminmesh+1)
+;
+   if n_elements(key_stride) LE 2 then key_stride = [1, 1, 1]
+   key_stride = 1l > long(key_stride)
+;
+   jpitotal = jpi
+   key_shift = long(testvar(var = key_shift))
+   key = long(key_shift MOD jpitotal)
+   if key LT 0 then key = key+jpitotal
+   ixmin = ixminmesh-ixmindta
+;
+   jpi = jpi/key_stride[0]
+   jpj = jpj/key_stride[1]
+   jpk = jpk/key_stride[2]
+;
+   jpt = 1
+   premiertps = 0
+;
+   premierx = 0
+   dernierx = jpi-1
+   premiery = 0
+   derniery = jpj-1
+   premierz = 0
+   dernierz = jpk-1
+   nx = jpi
+   ny = jpj
+   nz = 1
+   izminmeshsauve = izminmesh
+   izminmesh = 0
+;
+;-------------------------------------------------------
+; tableaux 2d:
+;-------------------------------------------------------
+   if total(key_stride) EQ 3 then $
+    namevar = ['glamt','glamu','glamv','glamf','gphit','gphiu','gphiv','gphif','e1t','e1u','e1v','e1f','e2t','e2u','e2v','e2f'] $
+   ELSE namevar = ['glamt','glamu','glamv','gphit','gphiu','gphiv']
+;
+   for i = 0, n_elements(namevar)-1 do begin
+      varcontient=ncdf_varinq(cdfid, namevar[i])
+      name = varcontient.name
+@read_ncdf_varget
+      commande = namevar[i]+'=float(res)'
+      rien = execute(commande)
+   ENDFOR
+;
+   if total(key_stride) NE 3 then BEGIN
+      glamf = glamt
+      glamf = [glamf, reform(2.*reform(glamt[jpi-1, *])-reform(glamt[jpi-2, *]), 1, jpj)]
+      glamf = [ [glamf], [reform(2*glamf[*, jpj-1]-glamf[*, jpj-2], jpi+1, 1)] ]
+      glamf = glamf+shift(glamf, -1, -1)
+      glamf = .5*glamf[0:jpi-1, 0:jpj-1]
+;
+      gphif = gphit
+      gphif = [gphif, reform(2.*reform(gphit[jpi-1, *])-reform(gphit[jpi-2, *]), 1, jpj)]
+      gphif = [ [gphif], [reform(2*gphif[*, jpj-1]-gphif[*, jpj-2], jpi+1, 1)] ]
+      gphif = gphif+shift(gphif, -1, -1)
+      gphif = .5*gphif[0:jpi-1, 0:jpj-1]
+;
+      e1t = replicate(1, jpi, jpj)
+      e2t = e1t
+      e1u = e1t
+      e2u = e1t
+      e1v = e1t
+      e2v = e1t
+      e1f = e1t
+      e2f = e1t
+   ENDIF
+;-------------------------------------------------------
+; tableaux 3d:
+;-------------------------------------------------------
+   nz = jpk
+   izminmesh = izminmeshsauve
+;
+   varcontient=ncdf_varinq(cdfid,'tmask')
+   name = varcontient.name
+@read_ncdf_varget
+   tmask = byte(res)
+;
+   varcontient=ncdf_varinq(cdfid,'umask')
+   name = varcontient.name
+   nx = 1
+   premierx = jpi-1
+@read_ncdf_varget
+   umaskred = byte(res)
+   umaskred = reform(umaskred, /over)
+;
+   varcontient=ncdf_varinq(cdfid,'vmask')
+   name = varcontient.name
+   nx = jpi
+   premierx = 0
+   ny = 1
+   premiery = jpj-1
+@read_ncdf_varget
+   vmaskred = byte(res)
+   vmaskred = reform(vmaskred, /over)
+;
+   varcontient=ncdf_varinq(cdfid,'fmask')
+   name = varcontient.name
+   nx = 1
+   premierx = jpi-1
+   ny = jpj
+   premiery = 0
+@read_ncdf_varget
+   fmaskredy = byte(res)
+   coast = where(fmaskredy NE 0 and fmaskredy NE 1)
+   IF coast[0] NE -1 THEN fmaskredy[coast] = 0b
+   fmaskredy= reform(fmaskredy, /over)
+   nx = jpi
+   premierx = 0
+   ny = 1
+   premiery = jpj-1
+@read_ncdf_varget
+   fmaskredx = byte(res)
+   coast = where(fmaskredx NE 0 and fmaskredx NE 1)
+   IF coast[0] NE -1 THEN fmaskredx[coast] = 0b
+   fmaskredx = reform(fmaskredx, /over)
+;-------------------------------------------------------
+; tableaux 1d:
+;-------------------------------------------------------
+   namevar = ['e3t','e3w','gdept','gdepw']
+   for i = 0, n_elements(namevar)-1 do begin
+      varcontient=ncdf_varinq(cdfid, namevar[i])
+      if n_elements(varcontient.dim) EQ 4 THEN BEGIN
+         commande = 'ncdf_varget,cdfid,namevar[i],'+namevar[i] $
+          +',offset = [0,0,izminmesh,0], count = [1,1,jpk,1]'
+         if key_stride[2] NE 1 then commande = commande+', stride=[1,1,key_stride[2],1]'
+      ENDIF ELSE BEGIN
+         commande = 'ncdf_varget,cdfid,namevar[i],'+namevar[i] $
+          +',offset = [izminmesh], count = [jpk]'
+         if key_stride[2] NE 1 then commande = commande+', stride=key_stride[2]'
+      ENDELSE
+      rien = execute(commande)
+      commande = namevar[i]+'=float('+namevar[i]+')'
+      rien = execute(commande)
+      commande = namevar[i]+' = reform('+namevar[i]+', /over)'
+      rien = execute(commande)
+   ENDFOR
+;-------------------------------------------------------
+   ncdf_close,  cdfid
+;-------------------------------------------------------
+; bornes de glam qui ne doivent pas depasser 360 degres... 
+;-------------------------------------------------------
+;    minglam = min(glamt, max = maxglam)
+;    if maxglam-minglam GE 360 AND NOT keyword_set(glamboundary) then $
+;     nothing = execute('glamboundary = '+xquestion('What are the longitudes boundary?', '[-180,180]',/chkwidget))
+;-------------------------------------------------------
+   if keyword_set(glamboundary) then BEGIN
+      if glamboundary[0] NE glamboundary[1] then BEGIN
+         glamt = glamt MOD 360
+         smaller = where(glamt LT glamboundary[0])
+         if smaller[0] NE -1 then glamt[smaller] = glamt[smaller]+360
+         bigger = where(glamt GE glamboundary[1])
+         if bigger[0] NE -1 then glamt[bigger] = glamt[bigger]-360
+         glamu = glamu MOD 360
+         smaller = where(glamu LT glamboundary[0])
+         if smaller[0] NE -1 then glamu[smaller] = glamu[smaller]+360
+         bigger = where(glamu GE glamboundary[1])
+         if bigger[0] NE -1 then glamu[bigger] = glamu[bigger]-360
+         glamv = glamv MOD 360
+         smaller = where(glamv LT glamboundary[0])
+         if smaller[0] NE -1 then glamv[smaller] = glamv[smaller]+360
+         bigger = where(glamv GE glamboundary[1])
+         if bigger[0] NE -1 then glamv[bigger] = glamv[bigger]-360
+         glamf = glamf MOD 360
+         smaller = where(glamf LT glamboundary[0])
+         if smaller[0] NE -1 then glamf[smaller] = glamf[smaller]+360
+         bigger = where(glamf GE glamboundary[1])
+         if bigger[0] NE -1 then glamf[bigger] = glamf[bigger]-360
+      endif
+   endif
+;-------------------------------------------------------
+   ixmindta = ixmindtasauve
+   iymindta = iymindtasauve
+   izmindta = izmindtasauve
+;-------------------------------------------------------
+   widget_control, noticebase, bad_id = nothing, /destroy
+;
+   if keyword_set(checkdat) then BEGIN
+   noticebase=xnotice('Ecriture du fichier !C '+nomfichdat+'!C ...')
+;
+      save, jpi, jpj, jpk, ixminmesh, ixmaxmesh, iyminmesh, iymaxmesh, izminmesh, izmaxmesh, glamt,glamu,glamv,glamf,gphit,gphiu,gphiv,gphif,e1t,e1u,e1v,e1f,e2t,e2u,e2v,e2f, tmask, umaskred, vmaskred, fmaskredx, fmaskredy, gdept, gdepw, e3t, e3w, filename = nomfichdat
+;
+      widget_control, noticebase, bad_id = nothing, /destroy
+   endif
+;
+   if keyword_set(key_performance) THEN print, 'temps ncdf_meshlec', systime(1)-tempsun 
+
+;-------------------------------------------------------
+   return
+end
Index: tags/start/GRILLE/t2v.pro
===================================================================
--- tags/start/GRILLE/t2v.pro	(revision 5)
+++ tags/start/GRILLE/t2v.pro	(revision 5)
@@ -0,0 +1,133 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:t2v
+;
+; PURPOSE:permet de passer un champs se rapportant a la grille T sur
+; la grille V, grace a la moyenne: res = 0.5*(res + shift(res, 0, -1))
+;      
+;
+; CATEGORY:grille
+;
+; CALLING SEQUENCE:res=t2v(tab)
+; 
+; INPUTS:tab, un tableau 2, 3 ou 4d
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:res, un tableau 2, 3 ou 4d
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:force les parametres du zoom sur la grille V a etre
+; les memes que ceux sur la grille T.
+;
+; RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la
+; valeur NaN consacree par IDL: !values.f_nan
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Marina Levy
+;                      Sebastien Masson (smasson@lodyc.jussieu.fr):
+;                      inspection des traveuax finis. 5/6/2000
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION t2v, temp
+@common
+   res = temp
+
+;on force nxt=nxv, etc ...
+   premierxv = premierxt
+   dernierxv = dernierxt
+   premieryv = premieryt
+   dernieryv = dernieryt
+   nxv = nxt
+   nyv = nyt
+   vargrid = 'V'
+   if NOT keyword_set(valmask) then valmask = 1e20
+   lat1 = gphit[0, premieryt]
+   lat2 = gphiv[0, dernieryv]
+
+; cas sur la taille du tableau et application 
+   taille = size(temp)
+   CASE taille[0] OF 
+      1: res = -1
+      2: BEGIN 
+         case 1 of
+            taille[1] eq nxt and taille[2] eq nyt:
+            taille[1] eq jpi and taille[2] eq jpj: $
+             res=res[premierxt:dernierxt, premieryt:dernieryt]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         endcase
+         mask = tmask[premierxt:dernierxt, premieryt:dernieryt, 0]
+         terre = where(mask EQ 0) 
+         IF terre[0] NE -1 THEN res[terre] = !values.f_nan
+         res = 0.5*(res + shift(res, 0, -1))
+         res[*, nyt-1] = !values.f_nan
+         mask = (vmask())[premierxt:dernierxt, premieryt:dernieryt, 0]
+         terre = where(mask EQ 0) 
+         IF terre[0] NE -1 THEN res[terre] = valmask
+      END
+      3: BEGIN 
+         case 1 of
+            taille[1] eq nxt and taille[2] eq nyt AND taille[3] EQ nzt:
+            taille[1] eq nxt and taille[2] eq nyt AND taille[3] EQ jpk: $
+             res=res[*, *, premierzt:dernierzt]
+            taille[1] eq nxt and taille[2] eq nyt AND taille[3] EQ jpt:
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpk: $
+             res=res[premierxt:dernierxt, premieryt:dernieryt, premierzt:dernierzt]
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpt: $
+             res=res[premierxt:dernierxt, premieryt:dernieryt, *]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         ENDCASE
+         if taille[3] EQ jpt then begin
+            mask = tmask[premierxt:dernierxt, premieryt:dernieryt, dernierzt*(nzt NE jpk)]
+            mask = temporary(mask[*])#replicate(1, jpt)
+            mask = reform(mask, nxt, nyt, jpt, /over)
+         ENDIF ELSE mask = tmask[premierxt:dernierxt, premieryt:dernieryt, premierzt:dernierzt]
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = !values.f_nan
+         res = 0.5*(res + shift(res, 0, -1, 0))
+         res[*, nyt-1, *] = !values.f_nan
+         if taille[3] EQ jpt then BEGIN
+            mask = (vmask())[premierxt:dernierxt, premieryt:dernieryt, dernierzt*(nzt NE jpk)]
+            mask = temporary(mask[*])#replicate(1, jpt)
+            mask = reform(mask, nxt, nyt, jpt, /over)
+         ENDIF ELSE mask = (vmask())[premierxt:dernierxt, premieryt:dernieryt, premierzt:dernierzt]
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = valmask
+      END
+      4: BEGIN 
+         case 1 of
+            taille[1] eq nxt and taille[2] eq nyt AND taille[3] EQ nzt AND taille[4] EQ jpt:
+            taille[1] eq nxt and taille[2] eq nyt AND taille[3] EQ jpk AND taille[4] EQ jpt: $
+             res=res[*, *, premierzt:dernierzt, *]
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpk AND taille[4] EQ jpt: $
+             res=res[premierxt:dernierxt, premieryt:dernieryt, premierzt:dernierzt, *]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         ENDCASE
+         mask = tmask[premierxt:dernierxt, premieryt:dernieryt, premierzt:dernierzt]
+         mask = temporary(mask[*])#replicate(1, jpt)
+         mask = reform(mask, nxt, nyt, nzt, jpt, /over)
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = !values.f_nan
+         res = 0.5*(res + shift(res, 0, -1, 0, 0))
+         res[*, nyt-1, *, *] = !values.f_nan
+         mask = (vmask())[premierxt:dernierxt, premieryt:dernieryt, premierzt:dernierzt]
+         mask = temporary(mask[*])#replicate(1, jpt)
+         mask = reform(mask, nxt, nyt, nzt, jpt, /over)
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = valmask
+      END
+   endcase
+
+   return, res
+END
+
Index: tags/start/GRILLE/tracegrille.pro
===================================================================
--- tags/start/GRILLE/tracegrille.pro	(revision 5)
+++ tags/start/GRILLE/tracegrille.pro	(revision 5)
@@ -0,0 +1,113 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:tracegrille
+;
+; PURPOSE:dessine la grille
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:tracegrille
+; 
+; INPUTS:none
+;
+; KEYWORD PARAMETERS:
+;
+;        XSTRIDE un entier pour specifier qu''on ne veut tracer
+;        qu''une ligne de i constant tout les xstride points
+;
+;        YSTRIDE un entier pour specifier qu''on ne veut tracer
+;        qu''une ligne de j constant tout les ystride points
+;
+;        OCEAN: pour ne tracer la grille que sur les points oceans
+; 
+;        EARTH: pour ne tracer la grille que sur les points terre
+;
+;        + tous les mots clefs de la procedure PLOTS
+;
+; OUTPUTS:none
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:trace la grille specifiee par vargrid, sur le domaine
+; definit par le dernier domdef.
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+;     IDL> plt,indgen(jpi,jpj),/nocontour,/nocouleur
+;     IDL> tracegrille,/ocean,color=20
+;     IDL> tracegrille,/earth,color=80
+;
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO tracegrille, OCEAN = ocean, EARTH = earth, XSTRIDE = xstride, YSTRIDE = ystride, _extra = extra
+@common
+   tempsun = systime(1)         ; pour key_performance
+   if n_elements(key_gridtype) EQ 0 then key_gridtype = 'c'
+
+   grille, mask, glam, gphi, gdep, nx, ny
+   if (size(mask))[0] EQ 3 then mask = mask[*, *, 0]
+   case 1 of
+      keyword_set(ocean):BEGIN
+         earth = where(mask EQ 0)
+         if earth[0] NE -1 then begin
+            glam[earth] = !values.f_nan
+            gphi[earth] = !values.f_nan
+         endif
+      END
+      keyword_set(earth):BEGIN
+         ocean = where(mask EQ 1)
+         if ocean[0] NE -1 then begin
+            glam[ocean] = !values.f_nan
+            gphi[ocean] = !values.f_nan
+         endif
+      END
+      ELSE:
+   endcase
+   if NOT keyword_set(xstride) then xstride = 1
+   if NOT keyword_set(ystride) then ystride = 1
+   case key_gridtype of
+      'c':BEGIN
+         for i = 0, ny-1, ystride do begin
+            plots,  glam[*, i], gphi[*, i], color = c_cote, _extra = extra
+         endfor
+         for i = 0, nx-1, xstride do begin
+            plots,  glam[i, *], gphi[i, *], color = c_cote, _extra = extra
+         endfor
+      END
+      'e':BEGIN
+         shifted = glam[0, 0] LT glam[0, 1]
+         glam2 = glam+(glam[1]-glam[0])/2.
+         if shifted then begin
+            for i = 0, ny-2 do BEGIN
+               xx = (transpose([[glam[*, i]], [glam2[*, i]]]))[*]
+               yy = (transpose([[gphi[*, i]], [gphi[*, i+1]]]))[*]
+               plots, xx[0:2*nx-2], yy[0:2*nx-2], color = c_cote, _extra = extra
+            ENDFOR
+         ENDIF ELSE BEGIN
+            for i = 1, ny-1 do BEGIN
+               xx = (transpose([[glam[*, i]], [glam2[*, i]]]))[*]
+               yy = (transpose([[gphi[*, i]], [gphi[*, i-1]]]))[*]
+               plots, xx[0:2*nx-2], yy[0:2*nx-2], color = c_cote, _extra = extra
+            ENDFOR
+         ENDELSE
+         for i = 1, (ny-1)/2 do $
+          plots, [glam[0, 2*i-1], glam[0, 2*i]] $
+          , [gphi[0, 2*i-1], gphi[0, 2*i]], color = c_cote, _extra = extra
+         for i = 0, (ny-2)/2 do $
+          plots, [glam[nx-1, 2*i], glam[nx-1, 2*i+1]] $
+          , [gphi[nx-1, 2*i], gphi[nx-1, 2*i+1]], color = c_cote, _extra = extra
+      END
+   endcase
+
+   if keyword_set(key_performance) THEN print, 'temps trace grille', systime(1)-tempsun 
+   return
+end
Index: tags/start/GRILLE/u2t.pro
===================================================================
--- tags/start/GRILLE/u2t.pro	(revision 5)
+++ tags/start/GRILLE/u2t.pro	(revision 5)
@@ -0,0 +1,132 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:u2t
+;
+; PURPOSE:permet de passer un champs se rapportant a la grille U sur
+; la grille T, grace a la moyenne: res = 0.5*(res + shift(res, 1, 0))
+;      
+;
+; CATEGORY:grille
+;
+; CALLING SEQUENCE:res=u2t(tab)
+; 
+; INPUTS:tab, un tableau 2, 3 ou 4d
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:res, un tableau 2, 3 ou 4d
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:force les parametres du zoom sur la grille V a etre
+; les memes que ceux sur la grille T.
+;
+; RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la
+; valeur NaN consacree par IDL: !values.f_nan
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:a partir des programmes de Marina Levy
+;                      Sebastien Masson (smasson@lodyc.jussieu.fr):
+;                      inspection des traveuax finis. 5/6/2000
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION u2t, temp
+@common
+   res = temp
+;on force nxt=nxu, etc ...
+   premierxt = premierxu
+   dernierxt = dernierxu
+   premieryt = premieryu
+   dernieryt = dernieryu
+   nxt = nxu
+   nyt = nyu
+   vargrid = 'T'
+   if NOT keyword_set(valmask) then valmask = 1e20
+   lon1 = glamt[premierxt, 0]
+   lon2 = glamu[dernierxu, 0]
+;
+; cas sur la taille du tableau et application 
+   taille = size(temp)
+   CASE taille[0] OF 
+      1: res = -1
+      2: BEGIN 
+         case 1 of
+            taille[1] eq nxu and taille[2] eq nyu:
+            taille[1] eq jpi and taille[2] eq jpj: $
+             res=res[premierxu:dernierxu, premieryu:dernieryu]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         endcase
+         mask = (umask())[premierxu:dernierxu, premieryu:dernieryu, 0]
+         terre = where(mask EQ 0) 
+         IF terre[0] NE -1 THEN res[terre] = !values.f_nan
+         res = 0.5*(res + shift(res, 1, 0))
+         if NOT (keyword_set(key_periodique) AND nxu EQ jpi) then res[0, *] = !values.f_nan
+         mask = tmask[premierxu:dernierxu, premieryu:dernieryu, 0]
+         terre = where(mask EQ 0) 
+         IF terre[0] NE -1 THEN res[terre] = valmask
+      END
+      3: BEGIN 
+         case 1 of
+            taille[1] eq nxu and taille[2] eq nyu AND taille[3] EQ nzt:
+            taille[1] eq nxu and taille[2] eq nyu AND taille[3] EQ jpk: $
+             res=res[*, *, premierzt:dernierzt]
+            taille[1] eq nxu and taille[2] eq nyu AND taille[3] EQ jpt:
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpk: $
+             res=res[premierxu:dernierxu, premieryu:dernieryu, premierzt:dernierzt]
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpt: $
+             res=res[premierxu:dernierxu, premieryu:dernieryu, *]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         ENDCASE
+         if taille[3] EQ jpt then begin
+            mask = (umask())[premierxu:dernierxu, premieryu:dernieryu, dernierzt*(nzt NE jpk)]
+            mask = temporary(mask[*])#replicate(1, jpt)
+            mask = reform(mask, nxu, nyu, jpt, /over)
+         ENDIF ELSE mask = (umask())[premierxu:dernierxu, premieryu:dernieryu, premierzt:dernierzt]
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = !values.f_nan
+         res = 0.5*(res + shift(res, 1, 0, 0))
+         if NOT (keyword_set(key_periodique) AND nxu EQ jpi) then res[0, *, *] = !values.f_nan
+         if taille[3] EQ jpt then BEGIN
+            mask = tmask[premierxu:dernierxu, premieryu:dernieryu, dernierzt*(nzt NE jpk)]
+            mask = temporary(mask[*])#replicate(1, jpt)
+            mask = reform(mask, nxu, nyu, jpt, /over)
+         ENDIF ELSE mask = tmask[premierxu:dernierxu, premieryu:dernieryu, premierzt:dernierzt]
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = valmask
+      END
+      4: BEGIN 
+         case 1 of
+            taille[1] eq nxu and taille[2] eq nyu AND taille[3] EQ nzt AND taille[4] EQ jpt:
+            taille[1] eq nxu and taille[2] eq nyu AND taille[3] EQ jpk AND taille[4] EQ jpt: $
+             res=res[*, *, premierzt:dernierzt, *]
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpk AND taille[4] EQ jpt: $
+             res=res[premierxu:dernierxu, premieryu:dernieryu, premierzt:dernierzt, *]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         ENDCASE
+         mask = (umask())[premierxu:dernierxu, premieryu:dernieryu, premierzt:dernierzt]
+         mask = temporary(mask[*])#replicate(1, jpt)
+         mask = reform(mask, nxu, nyu, nzt, jpt, /over)
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = !values.f_nan
+         res = 0.5*(res + shift(res, 1, 0, 0, 0))
+         if NOT (keyword_set(key_periodique) AND nxu EQ jpi) then res[0, *, *, *] = !values.f_nan
+         mask = tmask[premierxu:dernierxu, premieryu:dernieryu, premierzt:dernierzt]
+         mask = temporary(mask[*])#replicate(1, jpt)
+         mask = reform(mask, nxu, nyu, nzt, jpt, /over)
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = valmask
+      END
+   endcase
+
+   return, res
+END
+
Index: tags/start/GRILLE/umask.pro
===================================================================
--- tags/start/GRILLE/umask.pro	(revision 5)
+++ tags/start/GRILLE/umask.pro	(revision 5)
@@ -0,0 +1,54 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:umask
+;
+; PURPOSE:calcule umask
+;
+; CATEGORY:fonction economisatrice de memoire (plus besion de garder
+; umask)  
+;
+; CALLING SEQUENCE:res=umask()
+;
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:un tableau 3d correspondant a umask
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:s''utilise comme si umask etait un tableau connu en
+; replacant ds la syntaxe umask par umask(). par ex:
+; au lieu de taper umask[domaineu] il faut taper (umask())[domaineu]
+
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       11/12/98
+;                       ??/6/99 introduction du key_shift
+;                       20/9/99 cas jpk=1 (merci jpblod@ipsl.jussieu.fr)
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION umask
+   tempsun = systime(1)         ; pour key_performance
+@common
+   if jpk EQ 1 then begin
+      res = tmask*shift(tmask, -1, 0)
+      if NOT keyword_set(key_periodique) then res[jpi-1, *] = umaskred
+   ENDIF ELSE BEGIN 
+      res = tmask*shift(tmask, -1, 0, 0)
+      if NOT keyword_set(key_periodique) then res[jpi-1, *, *] = umaskred
+   ENDELSE
+;
+   if keyword_set(key_performance) THEN print, 'temps umask', systime(1)-tempsun 
+;
+   return, res
+end
Index: tags/start/GRILLE/v2t.pro
===================================================================
--- tags/start/GRILLE/v2t.pro	(revision 5)
+++ tags/start/GRILLE/v2t.pro	(revision 5)
@@ -0,0 +1,132 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:v2t
+;
+; PURPOSE:permet de passer un champs se rapportant a la grille V sur
+; la grille T, grace a la moyenne: res = 0.5*(res + shift(res, 0, +1))
+;      
+;
+; CATEGORY:grille
+;
+; CALLING SEQUENCE:res=v2t(tab)
+; 
+; INPUTS:tab, un tableau 2, 3 ou 4d
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:res, un tableau 2, 3 ou 4d
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:force les parametres du zoom sur la grille V a etre
+; les memes que ceux sur la grille T.
+;
+; RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la
+; valeur NaN consacree par IDL: !values.f_nan
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:a partir des programmes de Marina Levy
+;                      Sebastien Masson (smasson@lodyc.jussieu.fr):
+;                      inspection des traveuax finis. 5/6/2000
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION v2t, temp
+@common
+   res = temp
+;on force nxt=nxv, etc ...
+   premierxt = premierxv
+   dernierxt = dernierxv
+   premieryt = premieryv
+   dernieryt = dernieryv
+   nxt = nxv
+   nyt = nyv
+   vargrid = 'T'
+   if NOT keyword_set(valmask) then valmask = 1e20
+   lat1 = gphit[0, premieryt]
+   lat2 = gphiv[0, dernieryv]
+
+; cas sur la taille du tableau et application 
+   taille = size(temp)
+   CASE taille[0] OF 
+      1: res = -1
+      2: BEGIN 
+         case 1 of
+            taille[1] eq nxv and taille[2] eq nyv:
+            taille[1] eq jpi and taille[2] eq jpj: $
+             res=res[premierxv:dernierxv, premieryv:dernieryv]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         endcase
+         mask = (vmask())[premierxv:dernierxv, premieryv:dernieryv, 0]
+         terre = where(mask EQ 0) 
+         IF terre[0] NE -1 THEN res[terre] = !values.f_nan
+         res = 0.5*(res + shift(res, 0, +1))
+         res[*, 0] = !values.f_nan
+         mask = tmask[premierxv:dernierxv, premieryv:dernieryv, 0]
+         terre = where(mask EQ 0) 
+         IF terre[0] NE -1 THEN res[terre] = valmask
+      END
+      3: BEGIN 
+         case 1 of
+            taille[1] eq nxv and taille[2] eq nyv AND taille[3] EQ nzt:
+            taille[1] eq nxv and taille[2] eq nyv AND taille[3] EQ jpk: $
+             res=res[*, *, premierzt:dernierzt]
+            taille[1] eq nxv and taille[2] eq nyv AND taille[3] EQ jpt:
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpk: $
+             res=res[premierxv:dernierxv, premieryv:dernieryv, premierzt:dernierzt]
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpt: $
+             res=res[premierxv:dernierxv, premieryv:dernieryv, *]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         ENDCASE
+         if taille[3] EQ jpt then begin
+            mask = (vmask())[premierxv:dernierxv, premieryv:dernieryv, dernierzt*(nzt NE jpk)]
+            mask = temporary(mask[*])#replicate(1, jpt)
+            mask = reform(mask, nxv, nyv, jpt, /over)
+         ENDIF ELSE mask = (vmask())[premierxv:dernierxv, premieryv:dernieryv, premierzt:dernierzt]
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = !values.f_nan
+         res = 0.5*(res + shift(res, 0, +1, 0))
+         res[*, 0, *] = !values.f_nan
+         if taille[3] EQ jpt then BEGIN
+            mask = tmask[premierxv:dernierxv, premieryv:dernieryv, dernierzt*(nzt NE jpk)]
+            mask = temporary(mask[*])#replicate(1, jpt)
+            mask = reform(mask, nxv, nyv, jpt, /over)
+         ENDIF ELSE mask = tmask[premierxv:dernierxv, premieryv:dernieryv, premierzt:dernierzt]
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = valmask
+      END
+      4: BEGIN 
+         case 1 of
+            taille[1] eq nxv and taille[2] eq nyv AND taille[3] EQ nzt AND taille[4] EQ jpt:
+            taille[1] eq nxv and taille[2] eq nyv AND taille[3] EQ jpk AND taille[4] EQ jpt: $
+             res=res[*, *, premierzt:dernierzt, *]
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] EQ jpk AND taille[4] EQ jpt: $
+             res=res[premierxv:dernierxv, premieryv:dernieryv, premierzt:dernierzt, *]
+            else: $
+             return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
+         ENDCASE
+         mask = (vmask())[premierxv:dernierxv, premieryv:dernieryv, premierzt:dernierzt]
+         mask = temporary(mask[*])#replicate(1, jpt)
+         mask = reform(mask, nxv, nyv, nzt, jpt, /over)
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = !values.f_nan
+         res = 0.5*(res + shift(res, 0, +1, 0, 0))
+         res[*, 0, *, *] = !values.f_nan
+         mask = tmask[premierxv:dernierxv, premieryv:dernieryv, premierzt:dernierzt]
+         mask = temporary(mask[*])#replicate(1, jpt)
+         mask = reform(mask, nxv, nyv, nzt, jpt, /over)
+         terre = where(temporary(mask) EQ 0) 
+         IF terre[0] NE -1 THEN res[temporary(terre)] = valmask
+      END
+   endcase
+
+   return, res
+END
+
Index: tags/start/GRILLE/vmask.pro
===================================================================
--- tags/start/GRILLE/vmask.pro	(revision 5)
+++ tags/start/GRILLE/vmask.pro	(revision 5)
@@ -0,0 +1,40 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:vmask
+;
+; PURPOSE:calcule vmask
+;
+; CATEGORY:fonction economisatrice de memoire (plus besion de garder
+; vmask)  
+;
+; CALLING SEQUENCE:res=vmask()
+;
+; OUTPUTS:un tableau 3d correspondant a vmask
+;
+; EXAMPLE:s''utilise comme si vmask etait un tableau connu en
+; replacant ds la syntaxe vmask par vmask(). par ex:
+; au lieu de taper vmask[domainef] il faut taper vmask()[domainef]
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       11/12/98
+;                       20/9/99 cas jpk=1 (merci jpblod@ipsl.jussieu.fr)
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION vmask
+@common
+   tempsun = systime(1)         ; pour key_performance
+   if jpk EQ 1 then begin
+      res = tmask*shift(tmask, 0, -1)
+      res[*, jpj-1] = vmaskred
+   ENDIF ELSE BEGIN 
+      res = tmask*shift(tmask, 0, -1, 0)
+      res[*, jpj-1, *] = vmaskred
+   ENDELSE 
+   if keyword_set(key_performance) THEN print, 'temps vmask', systime(1)-tempsun 
+;
+   return, res
+end
Index: tags/start/GRILLE/whichgrid.pro
===================================================================
--- tags/start/GRILLE/whichgrid.pro	(revision 5)
+++ tags/start/GRILLE/whichgrid.pro	(revision 5)
@@ -0,0 +1,323 @@
+;*********************************************************************
+PRO readmesh, filename, filetype, _extra = ex
+;
+   case filetype of
+      'OPA C-Grid.Binary IEEE: Meshmask':BEGIN
+         meshlec, filename, /pasblabla, _extra = ex
+      END
+      'OPA C-Grid.Net Cdf: Meshmask':BEGIN
+         ncdf_meshlec, filename, _extra = ex
+      END
+      'Regular 2D.Binary IEEE: mask':
+      'Regular 2D.Net Cdf: mask':
+      'Regular 3D.Binary IEEE: mask+vertical axis':
+      'Regular 3D.Net Cdf: mask+vertical axis':
+      'Gaussian 2D.T30 truncature.Binary IEEE: mask':
+      'Gaussian 2D.T30 truncature.Net Cdf: mask':
+      'Gaussian 2D.T42 truncature.Binary IEEE: mask':
+      'Gaussian 2D.T42 truncature.Net Cdf: mask':
+      'Gaussian 3D.T30 truncature.Binary IEEE: mask':
+      'Gaussian 3D.T30 truncature.Net Cdf: mask':
+      'Gaussian 3D.T42 truncature.Binary IEEE: mask':
+      'Gaussian 3D.T42 truncature.Net Cdf: mask':
+      ELSE :
+   ENDCASE
+;
+   return
+end
+;*********************************************************************
+FUNCTION getgridparameter, top
+@common
+
+   widget_control, widget_info(top, find_by_uname = 'xmesh'), get_value = answer
+   jpiglo = long(answer[0])
+   jpi = long(answer[1])
+   ixminmesh = long(answer[2])
+   ixmaxmesh = long(answer[3])
+   widget_control, widget_info(top, find_by_uname = 'ymesh'), get_value = answer
+   jpjglo = long(answer[0])
+   jpj = long(answer[1])
+   iyminmesh = long(answer[2])
+   iymaxmesh = long(answer[3])
+   widget_control, widget_info(top, find_by_uname = 'zmesh'), get_value = answer
+   jpkglo = long(answer[0])
+   jpk = long(answer[1])
+   izminmesh = long(answer[2])
+   izmaxmesh = long(answer[3])
+   widget_control, widget_info(top, find_by_uname = 'key_shift') $
+    , get_value = answer
+   key_shift = long(answer[0])
+   widget_control, widget_info(top, find_by_uname = 'key_periodique') $
+    , get_value = answer
+   key_periodique = long(answer[0])
+   widget_control, widget_info(top, find_by_uname = 'triangulation') $
+    , get_value = answer
+   triangulation = answer[0] EQ 'y'
+   widget_control, widget_info(top, find_by_uname = 'Glam Boundary') $
+    , get_value = answer
+   rien = execute('boundary = float('+answer[0]+')')
+   res = {jpiglo:jpiglo, jpjglo:jpjglo, jpkglo:jpkglo, jpi:jpi, jpj:jpj, jpk:jpk $
+          , ixminmesh:ixminmesh, ixmaxmesh:ixmaxmesh $
+          , iyminmesh:iyminmesh, iymaxmesh:iymaxmesh $
+          , izminmesh:izminmesh, izmaxmesh:izmaxmesh $
+          , key_shift:key_shift, key_periodique:key_periodique $
+          , triangulation:triangulation, boundary:boundary}
+
+   return, res
+end
+;*********************************************************************
+pro showgridparameter, basetop, EDITABLE = editable, _EXTRA = ex
+;
+@common
+;------------------------------------------------------------
+;
+   widget_control, basetop, update = 0
+   base=widget_base(basetop, /COLUMN, /align_center, _EXTRA = ex)
+   nothing = cw_fourparameter(base, jpiglo, jpi, ixminmesh, ixmaxmesh, 'x', 'mesh', EDITABLE = editable, CLEAR = editable, uname = 'xmesh')
+   nothing = cw_fourparameter(base, jpjglo, jpj, iyminmesh, iymaxmesh, 'y', 'mesh', EDITABLE = editable, CLEAR = editable, uname = 'ymesh')
+   nothing = cw_fourparameter(base, jpkglo, jpk, izminmesh, izmaxmesh, 'z', 'mesh', EDITABLE = editable, CLEAR = editable, uname = 'zmesh')
+   nothing = widget_label(base, value = 'autres parametres ...')
+   basea=widget_base(base, /row, /align_center)
+   nothing = widget_label(basea, value = 'key_shift')
+   if NOT keyword_set(key_shift) then key_shift = 0
+   nothing = widget_text(basea, value = strtrim(key_shift*(1-keyword_set(editable)),1), uname = 'key_shift', xsize = 4, EDITABLE = editable)
+   nothing = widget_label(basea, value = 'key_periodique')
+   if NOT keyword_set(key_periodique) then key_periodique = 0
+   nothing = widget_text(basea, value = strtrim(key_periodique*(1-keyword_set(editable)),1), uname = 'key_periodique', xsize = 4, EDITABLE = editable)
+   baseb=widget_base(base, /row, /align_center)
+   nothing = widget_label(baseb, value = 'use a triangulation (y/n) ?')
+   nothing = widget_text(baseb, value = 'y', uname = 'triangulation', xsize = 4, EDITABLE = editable)
+   if NOT keyword_set(editable) then begin
+      ming = min(glamt, max = maxg)
+      value = tostr([floor(ming), ceil(maxg)])
+   ENDIF ELSE value = tostr([0, 0])
+   nothing = widget_label(baseb, value = 'Glam Boundary')
+   nothing = widget_text(baseb, value = value, uname = 'Glam Boundary', xsize = 10, EDITABLE = editable)
+   nothing = widget_button(base, value = 'Ok, Get the Mesh parameters!', uvalue = {name:'ok finish'})
+   widget_control, basetop, update = 1
+;
+   return
+END
+;*********************************************************************
+FUNCTION give_file_type_choice, type = type
+   if keyword_set(type) then begin
+      case type of
+         'nc':desc = [ '1\File or Grid type: ' , $
+            '0\OPA C-Grid.Net Cdf: Meshmask' , $
+            '0\Regular 2D.Net Cdf: mask' , $
+            '0\Regular 3D.Net Cdf: mask+vertical axis' , $
+            '1\Gaussian 2D' , $
+            '0\T30 truncature.Net Cdf: mask' , $
+            '2\T42 truncature.Net Cdf: mask' , $
+            '1\Gaussian 3D' , $
+            '0\T30 truncature.Net Cdf: mask+vertical axis' , $
+            '2\T42 truncature.Net Cdf: mask+vertical axis' , $
+            '2\No file' ]
+      endcase
+   ENDIF ELSE BEGIN
+         desc = [ '1\File or Grid type: ' , $
+            '0\OPA C-Grid.Binary IEEE: Meshmask' , $
+            '0\Regular 2D.Binary IEEE: mask' , $
+            '0\Regular 3D.Binary IEEE: mask+vertical axis' , $
+            '1\Gaussian 2D' , $
+            '0\T30 truncature.Binary IEEE: mask' , $
+            '2\T42 truncature.Binary IEEE: mask' , $
+            '1\Gaussian 3D' , $
+            '0\T30 truncature.Binary IEEE: mask+vertical axis' , $
+            '2\T42 truncature.Binary IEEE: mask+vertical axis' , $
+            '2\No file' ]
+;    desc = [ '1\File or Grid type: ' , $
+;             '1\OPA C-Grid' , $
+;             '0\Binary IEEE: Meshmask' , $
+;             '2\Net Cdf: Meshmask' , $
+;             '1\Regular 2D' , $
+;             '0\Binary IEEE: mask' , $
+;             '2\Net Cdf: mask' , $
+;             '1\Regular 3D' , $
+;             '0\Binary IEEE: mask+vertical axis' , $
+;             '2\Net Cdf: mask+vertical axis' , $
+;             '1\Gaussian 2D' , $
+;             '1\T30 truncature' , $
+;             '0\Binary IEEE: mask' , $
+;             '2\Net Cdf: mask' , $
+;             '1\T42 truncature' , $
+;             '0\Binary IEEE: mask' , $
+;             '2\Net Cdf: mask' , $
+;             '2\' , $
+;             '1\Gaussian 3D' , $
+;             '1\T30 truncature' , $
+;             '0\Binary IEEE: mask+vertical axis' , $
+;             '2\Net Cdf: mask+vertical axis' , $
+;             '1\T42 truncature' , $
+;             '0\Binary IEEE: mask+vertical axis' , $
+;             '2\Net Cdf: mask+vertical axis' , $
+;             '2\' , $
+;             '2\No file' ]
+ENDELSE
+   return, desc
+end
+;*********************************************************************
+PRO whichgrid_event, event
+@common
+   widget_control, event.id,  get_uvalue = eventuvalue
+   IF chkstru(eventuvalue,'name') EQ 0 THEN return
+   case eventuvalue.name OF
+      'Cancel':BEGIN 
+         widget_control, event.handler, get_uvalue = messenger
+         *messenger = -1
+         widget_control,event.handler,/destroy
+      END
+      'filename':BEGIN
+; on detruit, si il existe deja, ce que l''on va ajouter au widget 
+         typebaseid = widget_info(event.handler, find_by_uname = 'typebase')
+         if typebaseid NE 0 then widget_control,typebaseid,/destroy
+         showgridparameterid = widget_info(event.handler, find_by_uname = 'showgridparameter')
+         if showgridparameterid NE 0 then widget_control,showgridparameterid,/destroy
+;
+         widget_control, event.id, get_value = filename
+         filename = filename[0]
+         filename = isafile(filename = filename)
+         if size(filename, /type) NE 7 then return
+         if rstrpos(filename, '.pro') EQ strlen(filename)-4 then begin
+            createpro, '@'+strmid(filename, 0, strlen(filename)-4) $
+          , filename = isadirectory(io = homedir, title = 'Bad definition of Homedir') $
+          +'for_createpro.pro'
+            showgridparameter, event.handler, group_leader = event.handler,/frame, uname = 'showgridparameter'
+         ENDIF ELSE BEGIN
+            basetype=widget_base(event.handler, /row, /align_center, group_leader = event.handler, uname = 'typebase')
+            type = ''
+            if rstrpos(filename, '.nc') EQ strlen(filename)-3 then type = 'nc'
+            nothing = cw_pdmenu(basetype, give_file_type_choice(type = type), /return_full_name, uname = 'file type choice', uvalue = {name:'file type choice'})
+            nothing = widget_text(basetype, value = '', uname = 'file type', uvalue = {name:'file type'})
+         ENDELSE
+      END
+      'browse filename':BEGIN
+; on detruit, si il existe deja, ce que l''on va ajouter au widget 
+         typebaseid = widget_info(event.handler, find_by_uname = 'typebase')
+         if typebaseid NE 0 then widget_control,typebaseid,/destroy
+         showgridparameterid = widget_info(event.handler, find_by_uname = 'showgridparameter')
+         if showgridparameterid NE 0 then widget_control,showgridparameterid,/destroy
+;
+         filename = isafile()
+         if size(filename, /type) NE 7 then return
+         widget_control, widget_info(event.handler, find_by_uname = 'Filename'), set_value = filename
+         if rstrpos(filename, '.pro') EQ strlen(filename)-4 then begin
+            createpro, '@'+strmid(filename, 0, strlen(filename)-4) $
+          , filename = isadirectory(io = homedir, title = 'Bad definition of Homedir') $
+          +'for_createpro.pro'
+            showgridparameter, event.handler, group_leader = event.handler,/frame, uname = 'showgridparameter'
+         ENDIF ELSE BEGIN
+            basetype=widget_base(event.handler, /row, /align_center, group_leader = event.handler, uname = 'typebase')
+            type = ''
+            if rstrpos(filename, '.nc') EQ strlen(filename)-3 then type = 'nc'
+            nothing = cw_pdmenu(basetype, give_file_type_choice(type = type), /return_full_name, uname = 'file type choice', uvalue = {name:'file type choice'})
+            nothing = widget_text(basetype, value = '', uname = 'file type', uvalue = {name:'file type'})
+         ENDELSE
+      END
+      'file type choice':BEGIN
+         widget_control, widget_info(event.handler,find_by_uname='Filename'), get_value = filename
+         filename = filename[0]
+         filetype = event.value
+         filetype = strmid(filetype, strpos(filetype, '.')+1)
+         widget_control, widget_info(event.handler, find_by_uname = 'file type'), set_value = filetype
+         case filetype of
+            'OPA C-Grid.Binary IEEE: Meshmask':BEGIN
+               meshlec, filename, /pasblabla, /getdimensions
+               showgridparameter, event.handler, /editable, group_leader = event.handler,/frame, uname = 'showgridparameter'
+            END
+            'OPA C-Grid.Net Cdf: Meshmask':BEGIN
+               ncdf_meshlec, filename, /getdimensions
+               showgridparameter, event.handler, /editable, group_leader = event.handler,/frame, uname = 'showgridparameter'
+            END
+            'Regular 2D.Binary IEEE: mask':
+            'Regular 2D.Net Cdf: mask':
+            'Regular 3D.Binary IEEE: mask+vertical axis':
+            'Regular 3D.Net Cdf: mask+vertical axis':
+            'Gaussian 2D.T30 truncature.Binary IEEE: mask':
+            'Gaussian 2D.T30 truncature.Net Cdf: mask':
+            'Gaussian 2D.T42 truncature.Binary IEEE: mask':
+            'Gaussian 2D.T42 truncature.Net Cdf: mask':
+            'Gaussian 3D.T30 truncature.Binary IEEE: mask':
+            'Gaussian 3D.T30 truncature.Net Cdf: mask':
+            'Gaussian 3D.T42 truncature.Binary IEEE: mask':
+            'Gaussian 3D.T42 truncature.Net Cdf: mask':
+            ELSE :
+         endcase
+
+      END
+      'file type':BEGIN
+         help, event, /struct
+      END
+      'ok finish':BEGIN
+         widget_control, widget_info(event.handler,find_by_uname='Filename'),get_value=filename
+         filename = filename[0]
+         typeid = widget_info(event.handler,find_by_uname='file type')
+         if typeid NE 0 then begin
+            widget_control, typeid, get_value=filetype
+            filetype = filetype[0]
+         ENDIF ELSE filetype = 'batch file'
+         widget_control, event.handler, get_uvalue = messenger
+         *messenger = create_struct('filename', filename, 'filetype', filetype, getgridparameter(event.handler))
+;
+         readmesh, filename, filetype[0], glamboundary = (*messenger).boundary
+;
+         widget_control,event.handler,/destroy
+      END      
+      ELSE:
+   endcase
+   return
+END
+;*********************************************************************
+FUNCTION whichgrid, name, IODIRECTORY = iodirectory, PARENT = parent, _EXTRA = ex
+@common
+;
+;
+   if n_elements(name) NE 0 then begin
+      filename = isafile(filename = name)
+      if size(filename, /type) NE 7 then return, -1
+   ENDIF ELSE filaname = 'no file'
+;
+; pour recuperer les reponses possees lors de l''utilisation de ce
+; widget on cree un pointeur que l''on place dans la uvalue. Comme ca
+; une fois que le widget est detruit dans la procedure ...event.pro,
+; la variable surlaquelle pointait le pointeur (contenue ds la uvalue
+; du widget) n''est pas detruite est on peut recuperer le resultat!
+;
+   messenger = ptr_new(/allocate_heap)
+;
+   if keyword_set(parent) then BEGIN
+   base=widget_base(parent, /COLUMN, title = 'whichgrid', /align_center, uvalue = messenger, _EXTRA = ex)
+   ENDIF ELSE BEGIN 
+      base=widget_base(/COLUMN, title = 'whichgrid', /align_center, uvalue = messenger, _EXTRA = ex)
+      nothing = widget_button(base, value = 'Cancel', uvalue = {name:'Cancel'})
+   ENDELSE
+;
+   basemane=widget_base(base, /row, /align_center)
+   nothing = widget_label(basemane, value = 'Mesh Filename or IDL batch file')
+   nothing = widget_text(basemane, value = filename, uname = 'Filename', uvalue = {name:'filename'}, /editable)
+   nothing = widget_button(basemane, value = 'Browse', uvalue = {name:'browse filename'})
+;
+   if filename NE 'no file' then begin
+      if rstrpos(filename, '.pro') EQ strlen(filename)-4 then begin
+         createpro, '@'+strmid(filename, 0, strlen(filename)-4) $
+          , filename = isadirectory(io = homedir, title = 'Bad definition of Homedir') $
+          +'for_createpro.pro'
+         showgridparameter, base, group_leader = base,/frame, uname = 'showgridparameter'
+      ENDIF ELSE BEGIN
+         basetype=widget_base(base, /row, /align_center, group_leader = base, uname = 'typebase')
+         type = ''
+         if rstrpos(filename, '.nc') EQ strlen(filename)-3 then type = 'nc'
+         nothing = cw_pdmenu(basetype, give_file_type_choice(type = type), /return_full_name, uname = 'file type choice', uvalue = {name:'file type choice'})
+         nothing = widget_text(basetype, value = '', uname = 'file type', uvalue = {name:'file type'})
+      ENDELSE
+
+   endif
+;
+   widget_control,base,/realize
+   xmanager,'whichgrid', base,event_handler = 'whichgrid_event', no_block = 0
+   res = *messenger
+   ptr_free, messenger
+
+
+   return, res
+end
Index: tags/start/IMAGE/animgif.pro
===================================================================
--- tags/start/IMAGE/animgif.pro	(revision 5)
+++ tags/start/IMAGE/animgif.pro	(revision 5)
@@ -0,0 +1,126 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:animgif
+;
+; PURPOSE:construire une animation gif
+;
+; CATEGORY:pour faire des dessins animes
+;
+; CALLING SEQUENCE:animgif, 'toto.gif'
+;
+; INPUTS:toto.gif: c''est le nom du fichier gif contenant
+; l''animation. Rq ce fichier est place dans le repertoire definit par
+; iodir.
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:on utilise le Z buffer pour aller plus vite!.
+;              donc si on plante ds animgif il faut faire:
+;              IDL> device, /close
+;              IDL> set_plot, 'x'
+;              IDL> retall
+;
+; RESTRICTIONS: si on veut supprimer le @common,
+;               il faut definir a la main la taille de l''image (les
+;               variables xsize et ysize) ainsi que iodir.
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Guillaume Roullet (grlod@ipsl.jussieu.fr)
+;                       Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       30/4/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO animgif, nomfic
+@common
+;
+;  recupere la palette de couleur et la place dans rouge, vert, bleu
+;
+   tvlct,  rouge,vert,bleu,/get
+;
+;  complete la palette courante sur 256 couleurs
+;
+   red = [rouge, replicate(255, 256-n_elements(rouge))] 
+   green = [vert, replicate(255, 256-n_elements(rouge))] 
+   blue = [bleu, replicate(255, 256-n_elements(rouge))] 
+;
+; bascule sur le z device, permettant de creer l''image sans
+; l''afficher
+   thisOS = !VERSION.OS_FAMILY
+   thisOS = STRMID(thisOS, 0, 3)
+   thisOS = STRUPCASE(thisOS)
+   set_plot, 'z'
+; taille de l''image (en nombre de pixel:
+   xsize = 30*(petitfeuille*key_portrait+grandfeuille*(1-key_portrait))
+   ysize = 30*(petitfeuille*(1-key_portrait)+grandfeuille*key_portrait)
+   device, set_resolution = [xsize, ysize]
+;
+; commencement du fichier gif. ecriture d''une image vide 
+;
+   reinitplt
+   plot, [0], [0], /nodata
+   write_gif,iodir+nomfic,tvrd(),red, green, blue, /multiple
+;
+;
+;----------------------------------------------------------------
+; debut de la partie a changer
+;----------------------------------------------------------------
+;
+; boucle de creation de l''image
+;
+   calen = calendriertotem()
+   debut = where(calen EQ 19810105)
+   debut = where(calen EQ 19790105)
+   debut = debut[0]
+   if debut EQ -1 then begin
+      device, /close
+      CASE thisOS of
+         'MAC': SET_PLOT, thisOS
+         'WIN': SET_PLOT, thisOS
+         ELSE: SET_PLOT, 'X'
+      ENDCASE
+      stop
+   endif
+
+   for i = 0, 73*15-1 do begin
+;   for i = 0, 3*2-1 do begin
+;   for i = 0, 73*2-1 do begin
+      if keyword_set(bavard) then print, 'Image numero : '+strtrim(i, 2)
+      date = calen[debut+i]
+      erase, 255
+      plt, nlec('sst', date, 'ATF'), 19, 29, int = .5, /noerase
+;      plt, nlec('sss', date, 'ATF'), label = 2, /noerase
+;      plt, nlec('htoth', date, 'RE3')-nlec('hpycn', date, 'RE3'), 10, 60, int = 5, /inv, /noerase
+;      domdef, 290,340,-5,15 
+;      plt, norme(nlec('unsurf', date, 'RE3'), nlec('vnsurf', date, 'RE3')), 0, 1.2, int = .1, /noerase
+;
+;     Ecriture de l''image dans le fichier .gif
+;
+      write_gif,iodir+nomfic,tvrd(),red, green, blue, /multiple
+   ENDFOR 
+;----------------------------------------------------------------
+; fin de la partie a changer
+;----------------------------------------------------------------
+;
+; fermeture du fichier
+   write_gif,iodir+nomfic,/close 
+; rebascule en mode terminal X
+   device, /close
+   CASE thisOS of
+      'MAC': SET_PLOT, thisOS
+      'WIN': SET_PLOT, thisOS
+      ELSE: SET_PLOT, 'X'
+   ENDCASE
+
+
+   return
+end
Index: tags/start/IMAGE/saveimage.pro
===================================================================
--- tags/start/IMAGE/saveimage.pro	(revision 5)
+++ tags/start/IMAGE/saveimage.pro	(revision 5)
@@ -0,0 +1,239 @@
+PRO SAVEIMAGE, FILE, BMP=BMP, PNG=PNG, PICT=PICT, JPEG=JPEG, TIFF=TIFF, $
+  QUALITY=QUALITY, DITHER=DITHER, QUIET=QUIET
+
+;+
+; NAME:
+;    SAVEIMAGE
+;
+; PURPOSE:
+;    Save the current graphics window to an output file (GIF by default).
+;
+;    The output formats supported are:
+;    GIF   8-bit with color table,
+;    BMP   8-bit with color table,
+;    PNG   8-bit with color table,
+;    PICT  8-bit with color table,
+;    JPEG 24-bit true color,
+;    TIFF 24-bit true-color.
+;
+;    Any conversions necessary to convert 8-bit or 24-bit images onscreen to
+;    8-bit or 24-bit output files are done automatically.
+;
+; CATEGORY:
+;    Input/Output.
+;
+; CALLING SEQUENCE:
+;    SAVEIMAGE, FILE
+;
+; INPUTS:
+;    FILE     Name of the output file (GIF format by default).
+;    
+; OPTIONAL INPUTS:
+;    None.
+;       
+; KEYWORD PARAMETERS:
+;    BMP      Set this keyword to create BMP format (8-bit with color table).
+;    PNG      Set this keyword to create PNG format (8-bit with color table).
+;    PICT     Set this keyword to create PICT format (8-bit with color table).
+;    JPEG     Set this keyword to create JPEG format (24-bit true color).
+;    TIFF     Set this keyword to create TIFF format (24-bit true color).
+;    QUALITY  If set to a named variable, specifies the quality for
+;             JPEG output (default 75). Ranges from 0 ("terrible") to
+;             100 ("excellent"). Smaller quality values yield higher
+;             compression ratios and smaller output files.
+;    DITHER   Set this keyword to dither the output image when creating 8-bit
+;             GIF or BMP format (default is no dithering).
+;    QUIET    Set this keyword to suppress the information message
+;             (default is to print an information message).
+;
+; OUTPUTS:
+;    None.
+;
+; OPTIONAL OUTPUTS:
+;    None
+;
+; COMMON BLOCKS:
+;    None
+;
+; SIDE EFFECTS:
+;    The output file is overwritten if it exists.
+;
+; RESTRICTIONS:
+;    Requires IDL 5.1 or higher.
+;
+; EXAMPLE:
+;
+;openr, 1, filepath('hurric.dat', subdir='examples/data')
+;image = bytarr(440, 340)
+;readu, 1, image
+;close, 1
+;loadct, 13
+;tvscl, image
+;saveimage, 'hurric.gif'
+;
+; MODIFICATION HISTORY:
+; Liam.Gumley@ssec.wisc.edu
+; $Id$
+;-
+
+;-------------------------------------------------------------------------------
+;- CHECK INPUT
+;-------------------------------------------------------------------------------
+
+;- Check IDL version
+
+if float(!version.release) lt 5.1 then begin
+  message, 'IDL 5.1 or higher is required', /continue
+  return
+endif
+
+;- Check arguments
+
+if n_params() ne 1 then begin
+  message, 'Usage: SAVEIMAGE, FILE', /continue
+  return
+endif
+if n_elements(file) eq 0 then message, 'Argument FILE is undefined'
+if n_elements(file) gt 1 then message, 'Argument FILE must be a scalar string'
+
+;- Check keywords
+
+output = 'GIF'
+if keyword_set(bmp)  then output = 'BMP'
+if keyword_Set(png)  then output = 'PNG'
+if keyword_set(pict) then output = 'PICT'
+if keyword_set(jpeg) then output = 'JPEG'
+if keyword_set(tiff) then output = 'TIFF'
+if n_elements(quality) eq 0 then quality = 75
+
+;- Check for window capable device with an open window, and get visual depth
+
+if (!d.flags and 256) eq 0 then message, 'Unsupported graphics device'
+if !d.window lt 0 then message, 'No graphics windows are open'
+device, get_visual_depth=depth
+
+;-------------------------------------------------------------------------------
+;- GET CONTENTS OF GRAPHICS WINDOW
+;-------------------------------------------------------------------------------
+
+;- Save display order, then set images to display from bottom up
+
+current_order = !order
+!order = 0
+
+;- Copy the contents of the current display to a pixmap
+
+current_window = !d.window
+xsize = !d.x_size
+ysize = !d.y_size
+window, /free, /pixmap, xsize=xsize, ysize=ysize
+device, copy=[0, 0, xsize, ysize, 0, 0, current_window]
+
+;- Read the pixmap contents into an array
+
+if depth gt 8 then image = tvrd(true=1) else image = tvrd()
+
+;- Delete the pixmap
+
+wdelete, !d.window
+wset, current_window
+
+;- Get the current color table
+
+tvlct, r, g, b, /get
+
+;- If an 8-bit image was read, reduce the number of colors
+
+if depth le 8 then begin
+  reduce_colors, image, index
+  r = r[index]
+  g = g[index]
+  b = b[index]
+endif            
+
+;- Restore display order
+
+!order = current_order
+
+;-------------------------------------------------------------------------------
+;- WRITE OUTPUT FILE
+;-------------------------------------------------------------------------------
+
+;- Save the image in 8-bit or 24-bit format
+
+case 1 of
+
+  ;- Save the image in 8-bit output format
+  
+  (output eq 'GIF')  or (output eq 'BMP') or $
+  (output eq 'PICT') or (output eq 'PNG') : begin
+
+    if depth gt 8 then begin
+
+      ;- Convert 24-bit image to 8-bit
+    
+      image = color_quan(image, 1, r, g, b, colors=256, $
+        dither=keyword_set(dither))
+
+      ;- Sort the color table from darkest to brightest
+      
+      table_sum = total([[long(r)], [long(g)], [long(b)]], 2)
+      table_index = sort(table_sum)
+      image_index = sort(table_index)
+      r = r[table_index]
+      g = g[table_index]
+      b = b[table_index]
+      oldimage = image
+      image[*] = image_index[temporary(oldimage)]
+      
+    endif
+    
+    ;- Save the image
+
+    case output of
+      'GIF'  : write_gif,  file, image, r, g, b
+      'BMP'  : write_bmp,  file, image, r, g, b
+      'PNG'  : write_png,  file, image, r, g, b
+      'PICT' : write_pict, file, image, r, g, b
+    endcase
+    
+  end
+  
+  ;- Save the image in 24-bit output format
+  
+  (output eq 'JPEG') or (output eq 'TIFF') : begin
+
+    ;- Convert 8-bit image to 24-bit
+    
+    if depth le 8 then begin
+      dims = size(image, /dimensions)
+      nx = dims[0]
+      ny = dims[1]
+      true = bytarr(3, nx, ny)
+      true[0, *, *] = r[image]
+      true[1, *, *] = g[image]
+      true[2, *, *] = b[image]
+      image = temporary(true)
+    endif
+
+    ;- If TIFF format output, reverse image top to bottom
+    
+    if output eq 'TIFF' then image = reverse(temporary(image), 3)
+    
+    ;- Write the image
+    
+    case output of
+      'JPEG' : write_jpeg, file, image, true=1, quality=quality
+      'TIFF' : write_tiff, file, image, 1
+    endcase
+    
+  end
+  
+endcase
+
+;- Print information for the user
+
+if not keyword_set(quiet) then $
+  print, file, output, format='("Created ",a," in ",a," format")'
+  
+END
Index: tags/start/IMAGE/showimage.pro
===================================================================
--- tags/start/IMAGE/showimage.pro	(revision 5)
+++ tags/start/IMAGE/showimage.pro	(revision 5)
@@ -0,0 +1,314 @@
+PRO SHOWIMAGE, FILE, DITHER=DITHER, CURRENT=CURRENT
+
+;+
+; NAME:
+;    SHOWIMAGE
+;
+; PURPOSE:
+;    Show the contents of a graphics file in the current window.
+;
+;    The input formats supported are:
+;    GIF   8-bit with color table,
+;    BMP   8-bit with color table or 24-bit true-color,
+;    PICT  8-bit with color table,
+;    TIFF  8-bit with color table or 24-bit true-color,
+;    JPEG 24-bit true color,
+;
+;    Any conversions necessary to translate 8-bit or 24-bit files
+;    to 8-bit or 24-bit images on-screen are done automatically.
+;
+; CATEGORY:
+;    Input/Output.
+;
+; CALLING SEQUENCE:
+;    SHOWIMAGE, FILE
+;
+; INPUTS:
+;    FILE     Name of the output file (format is identified automatically).
+;
+; OPTIONAL INPUTS:
+;    None.
+;
+; KEYWORD PARAMETERS:
+;    DITHER   Set this keyword to dither the input image when displaying
+;             24-bit images on an 8-bit display (default is no dithering).
+;    CURRENT  Set this keyword to display the image in the current window
+;             (default is to create a new window sized to fit the image).
+;
+; OUTPUTS:
+;    None.
+;
+; OPTIONAL OUTPUTS:
+;    None
+;
+; COMMON BLOCKS:
+;    None
+;
+; SIDE EFFECTS:
+;    The color table is modified.
+;
+; RESTRICTIONS:
+;    Requires IDL 5.2 or higher (image QUERY functions).
+;
+; EXAMPLE:
+;
+;showimage, filepath('rose.jpg', subdir='examples/data')
+;
+; MODIFICATION HISTORY:
+; Liam.Gumley@ssec.wisc.edu
+; $Id$
+;-
+
+;-------------------------------------------------------------------------------
+;- CHECK INPUT
+;-------------------------------------------------------------------------------
+
+;- Check IDL version
+
+if float(!version.release) lt 5.2 then begin
+  message, 'IDL 5.2 or higher is required', /continue
+  return
+endif
+
+;- Check input arguments
+
+case 1 of
+  n_params() ne 1           : error = 'Usage: SHOWIMAGE, FILE'
+  n_elements(file) eq 0     : error = 'Argument FILE is undefined'
+  n_elements(file) gt 1     : error = 'Argument FILE must be a scalar string'
+  (findfile(file))[0] eq '' : error = 'Argument FILE was not found'
+  else                      : error = ''
+endcase
+
+if error ne '' then begin
+  message, error, /continue
+  return
+endif
+
+;-------------------------------------------------------------------------------
+;- CHECK THE GRAPHICS DEVICE
+;-------------------------------------------------------------------------------
+
+;- Check for device supporting windows and tvrd()
+
+if ((!d.flags and 256) eq 0) or ((!d.flags and 128) eq 0) then begin
+  error = string(!d.name, format='("Graphics device (",a,") is not supported")')
+  message, error, /continue
+  return
+endif
+
+;- Make sure a window has been opened in this session and get visual depth
+
+if !d.window lt 0 then begin
+  window, /free, /pixmap, xsize=20, ysize=20
+  wdelete, !d.window
+endif
+device, get_visual_depth=depth
+
+;- If 8-bit display is low on colors, print a message
+
+if (depth eq 8) and (!d.table_size) lt 64 then message, $
+  'Display has less than 64 colors; image quality may degrade', /continue
+
+;-------------------------------------------------------------------------------
+;- IDENTIFY FILE AND READ IMAGE
+;-------------------------------------------------------------------------------
+
+;- Identify the file format
+
+result = query_gif(file, info)
+if result eq 0 then result = query_bmp(file, info)
+if result eq 0 then result = query_pict(file, info)
+if result eq 0 then result = query_tiff(file, info)
+if result eq 0 then result = query_jpeg(file, info)
+if result eq 0 then begin
+  message, 'File format not recognized', /continue
+  return
+endif
+
+;- Fix the channel information for GIF images
+
+if info.type eq 'GIF' then info.channels = 1
+
+;- Read the image
+
+case info.type of
+
+  'GIF' : read_gif, file, image, r, g, b
+
+  'BMP' : begin
+    if info.channels eq 1 then begin
+      image = read_bmp(file, r, g, b)
+    endif else begin
+      image = read_bmp(file)
+      image = reverse(temporary(image), 1)
+    endelse
+  end
+
+  'PICT' : read_pict, file, image, r, g, b
+
+  'TIFF' : begin
+    if info.channels eq 1 then begin
+      image = read_tiff(file, r, g, b, order=order)
+      image = reverse(temporary(image), 2)
+    endif else begin
+      image = read_tiff(file, order=order)
+      image = reverse(temporary(image), 3)
+    endelse
+  end
+
+  'JPEG' : read_jpeg, file, image
+
+endcase
+
+;- If an 8-bit image was read, reduce the number of colors
+
+if info.channels eq 1 then begin
+  reduce_colors, image, index
+  r = r[index]
+  g = g[index]
+  b = b[index]
+endif
+
+;- Get image size
+
+dims = size(image, /dimensions)
+if n_elements(dims) eq 2 then begin
+  nx = dims[0]
+  ny = dims[1]
+endif else begin
+  nx = dims[1]
+  ny = dims[2]
+endelse
+
+;-------------------------------------------------------------------------------
+;- CREATE A WINDOW
+;-------------------------------------------------------------------------------
+
+;- Create a draw widget sized to fit the image
+
+if not keyword_set(current) then begin
+
+  ;- Set default window size
+
+  scroll = 0
+  xsize = nx
+  ysize = ny
+  draw_xsize = nx
+  draw_ysize = ny
+
+  ;- Adjust the window size if the image is too large
+
+  device, get_screen_size=screen
+  if nx gt (0.95 * screen[0]) then begin
+    xsize = 0.85 * nx
+    scroll = 1
+  endif
+  if ny gt (0.95 * screen[1]) then begin
+    ysize = 0.85 * ny
+    scroll = 1
+  endif
+
+  ;- Create the draw widget
+
+  base = widget_base(title=file)
+  draw = widget_draw(base, scroll=scroll)
+  widget_control, draw, xsize=xsize, ysize=ysize, $
+    draw_xsize=draw_xsize, draw_ysize=draw_ysize
+
+endif
+
+;-------------------------------------------------------------------------------
+;- HANDLE IDL 8-BIT MODE
+;-------------------------------------------------------------------------------
+
+if depth eq 8 then begin
+
+  ;- If the color table of an 8-bit image is larger than
+  ;- the current display table, convert the image to 24-bit
+
+  if (info.channels eq 1) and (n_elements(r) gt !d.table_size) then begin
+
+    ;- Convert to 24-bit
+
+    dims = size(image, /dimensions)
+    nx = dims[0]
+    ny = dims[1]
+    true = bytarr(3, nx, ny)
+    true[0, *, *] = r[image]
+    true[1, *, *] = g[image]
+    true[2, *, *] = b[image]
+    image = temporary(true)
+
+    ;- Reset the number of channels
+
+    info.channels = 3
+
+  endif
+
+  ;- If image is 24-bit, convert to 8-bit
+
+  if info.channels eq 3 then begin
+
+    ;- Convert 24-bit image to 8-bit
+
+    image = color_quan(image, 1, r, g, b, colors=!d.table_size, $
+      dither=keyword_set(dither))
+
+    ;- Sort the color table from darkest to brightest
+
+    table_sum = total([[long(r)], [long(g)], [long(b)]], 2)
+    table_index = sort(table_sum)
+    image_index = sort(table_index)
+    r = r[table_index]
+    g = g[table_index]
+    b = b[table_index]
+    oldimage = image
+    image[*] = image_index[temporary(oldimage)]
+
+    ;- Reset the number of channels
+
+    info.channels = 1
+
+  endif
+
+endif
+
+;-------------------------------------------------------------------------------
+;- DISPLAY THE IMAGE
+;-------------------------------------------------------------------------------
+
+;- Realize the draw widget
+
+if not keyword_set(current) then widget_control, base, /realize
+
+;- Save current decomposed mode and display order
+
+device, get_decomposed=current_decomposed
+current_order = !order
+
+;- Set image to display from bottom up
+
+!order = 0
+
+;- Display the image
+
+if info.channels eq 1 then begin
+
+  device, decomposed=0
+  tvlct, r, g, b
+  tv, image
+
+endif else begin
+
+  device, decomposed=1
+  tv, image, true=1
+
+endelse
+
+;- Restore decomposed mode and display order
+
+device, decomposed=current_decomposed
+!order = current_order
+
+END
Index: tags/start/INIT/common.pro
===================================================================
--- tags/start/INIT/common.pro	(revision 5)
+++ tags/start/INIT/common.pro	(revision 5)
@@ -0,0 +1,75 @@
+;+
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			14/8/98
+;-
+;environement
+common acces_lodc,loginlodyc,machlodyc, loginipsl, machipsl
+;
+;taille de la matrice
+;
+common coord,jpi,jpj,jpk,jpt, jpiglo, jpjglo, jpkglo, jpidta, jpjdta, jpkdta
+common zoom_grille,ixminmesh,ixmaxmesh,iyminmesh,iymaxmesh,izminmesh,izmaxmesh
+common parameters, ccmeshparameters, ccreadparameters
+;
+;tableau definit dans meshmask
+;
+common glam,glamf,glamt,glamu,glamv
+common gphi,gphif,gphit,gphiu,gphiv
+common e12,e1t,e2t,e1u,e2u,e1v,e2v,e1f,e2f
+common mask,tmask,umaskred,vmaskred, fmaskredx, fmaskredy
+common tab,ff,gdept,gdepw,e3t,e3w 
+;
+; pour la lecture des champs
+;
+common zoom_data,ixmindta,ixmaxdta,iymindta,iymaxdta,izmindta,izmaxdta
+;
+;
+; variables liees aux hovmoller
+;
+common axe_temps,jptmax,time
+;
+;
+; variables liees a la def du tableau a traiter
+;
+common date,year,month,day,niveau,prefix
+common attributs,varname,vargrid,vardate,varexp,varunit,valmask
+;
+; fenetre
+;
+COMMON sauvegarde, sauveps
+;
+; graph
+;
+COMMON certaines_couleurs, c_lab, c_cont, c_cote
+COMMON taille_feuille, grandfeuille, petitfeuille, margescadre, ccwindowsize
+common pour_palit, coefpalit
+common vecteur_couleur,rouge,vert,bleu ,couleur
+common pour_placecolor,colorbardiv,colorbarinf,colorbarsup
+;
+; grille et situation geographique
+;
+common carte,lat1,lat2,lon1,lon2,prof1,prof2
+common liees_a_domdef, $
+       nxt,nyt,nzt,nxu,nyu,nxv,nyv,nxf,nyf,nzw, $
+       premierxt,premierxu,premierxv,premierxf, $
+       premieryt,premieryu,premieryv,premieryf,premierzt,premierzw,  $
+       dernierxt,dernierxu,dernierxv,dernierxf, $
+       dernieryt,dernieryu,dernieryv,dernieryf,dernierzt,dernierzw
+;
+COMMON liees_a_triangule, triangles, cointerremont, cointerredesc
+;
+COMMON pour_de_belles_cotes, listcoast
+;
+;
+COMMON keys, key_mpp, key_portrait, key_irregular, key_shift, key_performance, key_periodique $
+, key_offset, key_stride, key_gridtype, key_reverse
+;
+COMMON directories, tmpdir, workdir, homedir, iodir, animdir, psdir, imagedir
+;
+COMMON commentaires, bavard, langage
+
+
+
+
+
Index: tags/start/INIT/init.pro
===================================================================
--- tags/start/INIT/init.pro	(revision 5)
+++ tags/start/INIT/init.pro	(revision 5)
@@ -0,0 +1,118 @@
+; on lance l''aide en ligne
+?
+;
+; partie a modifier
+;
+;----------------------------------------------------------
+; extension du path
+!path=expand_path('+/usr1/com/smasson/IDL')+':'+expand_path('+/usr1/com/smasson/IDL_RD')+':'+expand_path('+'+!dir)
+@common
+;----------------------------------------------------------
+; pour l''impression si vous utiliser imprime depuis le lodyc,
+; l''ipsl, l''idris.
+; loginipsl='smlod'
+; machipsl = 'cook'
+loginlodyc='smasson'
+machlodyc = 'gaia'
+;----------------------------------------------------------
+; definition de differentes directories
+;----------------------------------------------------------
+homedir = '/usr1/com/smasson/IDL/'
+workdir = '/usr1/antiope/smasson/DATA/'
+tmpdir = workdir
+iodir = workdir
+animdir = '/usr1/antiope/smasson/ANIM/'
+psdir = '/usr1/com/smasson/IDL'
+imagedir = '/usr1/com/smasson/IDL'
+;
+; fin de la partie a modifier
+;
+homedir = isadirectory(io = homedir, title = 'Bad definition of homedir')
+workdir = isadirectory(io = workdir, title = 'Bad definition of workdir', /nopath)
+tmpdir = isadirectory(io = tmpdir, title = 'Bad definition of tmpdir', /nopath)
+iodir = isadirectory(io = iodir, title = 'Bad definition of iodir', /nopath)
+animdir = isadirectory(io = animdir, title = 'Bad definition of animdir', /nopath)
+psdir = isadirectory(io = psdir, title = 'Bad definition of psdir', /nopath)
+imagedir = isadirectory(io = imagedir, title = 'Bad definition of imagedir', /nopath)
+;----------------------------------------------------------
+; environnement graphique (window et ps)
+;----------------------------------------------------------
+window, colors=100 & wdelete
+if !d.n_colors gt 256 then device, decomposed = 0 $
+ELSE device, pseudo_color=8
+loadct,39
+tvlct, rouge,vert,bleu, /get
+coefpalit= 1
+key_portrait = 0
+;----------------------------------------------------------
+c_lab=0
+c_cote=0
+c_cont = (!d.n_colors-1) < 255
+;----------------------------------------------------------
+grandfeuille = 29.7
+petitfeuille = 21.
+ccwindowsize = 1
+;----------------------------------------------------------
+!except = 2
+sauveps = 0
+;--------------------------------------------------------
+;   definition par defaut du fichier que l''on traite
+;------------------------------------------------------
+year=1
+month=1
+day=1
+niveau=1
+
+;
+prefix=' '
+;
+vargrid = 'T'
+varname = ' '
+vardate= '0'
+varexp = ' '
+varunit = ' '
+;----------------------------------------------------------
+;----------------------------------------------------------
+jpiglo = 1
+jpjglo = 1
+jpkglo = 1
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpjglo
+jpi = 1
+jpj = 1
+jpk = 1
+jpt = 1
+ixminmesh  =-1
+ixmaxmesh  =-1
+iyminmesh  =-1
+iymaxmesh  =-1
+izminmesh  =-1
+izmaxmesh  =-1
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+key_shift = 0
+key_periodique = 0
+ccmeshparameters ={filename:'No File', filetype:'nothing' $
+, jpiglo:jpiglo, jpjglo:jpjglo, jpkglo:jpkglo $
+, jpi:jpi, jpj:jpj, jpk:jpk $
+, ixminmesh:ixminmesh, ixmaxmesh:ixmaxmesh $
+, iyminmesh:iyminmesh, iymaxmesh:iymaxmesh $
+, izminmesh:izminmesh, izmaxmesh:izmaxmesh $
+, key_shift:key_shift, key_periodique:key_periodique $
+, triangulation:0, boundary:[-180, 180]}
+ccreadparameters = {funclec_name:'No File' $
+, jpidta:jpidta, jpjdta:jpjdta, jpkdta:jpkdta $
+, ixmindta:ixmindta, ixmaxdta:ixmaxdta $
+, iymindta:iymindta, iymaxdta:iymaxdta $
+, izmindta:izmindta, izmaxdta:izmaxdta $
+}
+lon1 = 0
+lon2 = 1
+lat1 = 0
+lat2 = 1
+valmask = 1e20
Index: tags/start/INIT/initamip.pro
===================================================================
--- tags/start/INIT/initamip.pro	(revision 5)
+++ tags/start/INIT/initamip.pro	(revision 5)
@@ -0,0 +1,35 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+computegrid, .5, -89.5, 1, 1, 360, 180
+tmask = replicate(1, jpi, jpj)
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/AMIP/'
+key_shift = 0
+key_stride = [1, 1, 1]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = -1
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initatl.pro
===================================================================
--- tags/start/INIT/initatl.pro	(revision 5)
+++ tags/start/INIT/initatl.pro	(revision 5)
@@ -0,0 +1,37 @@
+;
+;
+@common
+;----------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh  =393
+ixmaxmesh  =551
+;
+iyminmesh  =20
+iymaxmesh  =80
+;
+izminmesh  =-1
+izmaxmesh  =-1
+;
+jpt = 1
+time = 0
+;-------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA'
+key_shift = 0
+ncdf_meshlec
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 0
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+ixmindta = ixminmesh & iymindta = iyminmesh & izmindta = izminmesh
+ixmaxdta = ixmaxmesh & iymaxdta = iymaxmesh & izmaxdta = izmaxmesh
+jpidta = ixmaxdta-ixmindta+1
+jpjdta = iymaxdta-iymindta+1
+jpkdta = izmaxdta-izmindta+1
+;-------------------------------------------------------------
Index: tags/start/INIT/initclipper.pro
===================================================================
--- tags/start/INIT/initclipper.pro	(revision 5)
+++ tags/start/INIT/initclipper.pro	(revision 5)
@@ -0,0 +1,58 @@
+;------------------------------------------------------------
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			26/5/98
+;------------------------------------------------------------
+;----------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh = 1
+ixmaxmesh = 770
+iyminmesh = 2
+iymaxmesh = 1294
+jpk = 1
+;
+jpt = 1
+time = 0
+;--------------------------------------------------------
+;   definition par defaut du fichier que l''on traite
+;----------------------------------------------------------
+;------------------------------------------------------
+;
+iodir= '/usr1/antiope/smasson/DATA/'
+prefix='Clipper'
+;
+;-------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+.r /usr1/com/smasson/IDL_NICO/read_coordinates
+read_coordinates, iodir,'coordinates.new'
+tmask = replicate(1b, jpi, jpj, jpk)
+gdept = 5
+gdepw = 0
+e3t = 10
+e3w = 10
+;-------------------------------------------------------------
+;irregularmask
+;-------------------------------------------------------------
+domdef, grille='T'
+;----------------------------------------------------------
+;----------------------------------------------------------
+.r /usr1/com/smasson/IDL_NICO/read_dimg_body
+.r /usr1/com/smasson/IDL_NICO/read_dimg_head
+read_dimg_body, iodir, 'ATL6-V5_S_y1958m02d14.dimg', sss
+sss = sss[ixminmesh:ixmaxmesh, iyminmesh:iymaxmesh]
+tmask[where(sss EQ 0)] = 0
+key_periodique = 0
+triangles = triangule()
+;
+vargrid = 'T'
+varname = 'sss'
+vardate= '0'
+varexp = 'Clipper'
+varunit = 'psu'
+;
+;
+premierxu = premierxt & premierxv = premierxt & premierxf = premierxt
+premieryu = premieryt & premieryv = premieryt & premieryf = premieryt
+dernierxu = dernierxt & dernierxv = dernierxt & dernierxf = dernierxt
+dernieryu = dernieryt & dernieryv = dernieryt & dernieryf = dernieryt
Index: tags/start/INIT/initecmwf.pro
===================================================================
--- tags/start/INIT/initecmwf.pro	(revision 5)
+++ tags/start/INIT/initecmwf.pro	(revision 5)
@@ -0,0 +1,37 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+;computegrid, 20.25, -90., 1.125, 1.125, 320, 161
+computegrid, 0, -90., 1.125, 1.125, 320, 161
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/'
+tmask = ncdf_lec('mask.ecmwf.nc', iodir = iodir, var = 'mask')
+;iodir = '/mnt/newdisk2/smasson/ECMWF_ANALYSE/'
+key_shift = 0
+key_stride = [1, 1, 1]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initgpcp.pro
===================================================================
--- tags/start/INIT/initgpcp.pro	(revision 5)
+++ tags/start/INIT/initgpcp.pro	(revision 5)
@@ -0,0 +1,35 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+computegrid, 1.25, -88.75, 2.5, 2.5, 144, 72
+tmask = replicate(1, jpi, jpj)
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/'
+key_shift = 0
+key_stride = [1, 1, 1]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initindorca.pro
===================================================================
--- tags/start/INIT/initindorca.pro	(revision 5)
+++ tags/start/INIT/initindorca.pro	(revision 5)
@@ -0,0 +1,42 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh = -1
+ixmaxmesh = -1
+;
+iyminmesh = -1
+iymaxmesh = -1
+;
+izminmesh = -1
+izmaxmesh = -1
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/ORCA'
+key_shift = 0
+key_stide = [1, 1, 1]
+ncdf_meshlec, 'petit.meshmask.orca.2d.nc', glamboundary = [0, 360]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 0
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpjglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initiorca.pro
===================================================================
--- tags/start/INIT/initiorca.pro	(revision 5)
+++ tags/start/INIT/initiorca.pro	(revision 5)
@@ -0,0 +1,42 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh = -1
+ixmaxmesh = -1
+;
+iyminmesh = -1
+iymaxmesh = -1
+;
+izminmesh = -1
+izmaxmesh = -1
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/ORCA'
+key_shift = 0
+key_stide = [1, 1, 1]
+ncdf_meshlec, 'petit.meshmask.orca.2d.nc', glamboundary = [0, 360]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 0
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpjglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initlevitus.pro
===================================================================
--- tags/start/INIT/initlevitus.pro	(revision 5)
+++ tags/start/INIT/initlevitus.pro	(revision 5)
@@ -0,0 +1,50 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+computegrid, 0.5, -89.5, 1, 1, 360, 180
+;
+iodir = '/usr1/antiope/smasson/DATA/'
+;
+;
+jpk = 33
+gdept = ncdf_lec('Levitus98_1m_01_12_S.nc', iodir = iodir, var = 'deptht')
+gdepw = .5*(gdept+shift(gdept, 1))
+gdepw[0] = 0
+e3t = shift(gdepw, -1)-gdepw
+e3t[jpk-1] = gdept[jpk-1]-gdepw[jpk-1]
+e3w = gdept-shift(gdept, 1)
+e3w[0] = 0
+;
+mer = ncdf_lec('Levitus98_1m_01_12_S.nc', iodir = iodir, var = 'vosaline', count = [jpi, jpj, jpk, 1])
+mer = where(mer GT -50)
+tmask = bytarr(jpi, jpj, jpk)
+tmask[temporary(mer)] = 1b
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+key_shift = 0
+key_stride = [1, 1, 1]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initmercator.pro
===================================================================
--- tags/start/INIT/initmercator.pro	(revision 5)
+++ tags/start/INIT/initmercator.pro	(revision 5)
@@ -0,0 +1,67 @@
+;
+;
+@common
+;------------------------------------------------------------
+;----------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+jpi = 1020
+jpj = 1286
+jpk = 1
+gdept = 0
+gdepw = 0
+e3t = 10
+e3w = 10
+tempsun = systime(1)
+iodir = '/usr1/antiope/smasson/DATA/MERCATOR/'
+cdfid = ncdf_open(iodir+'test_mercator.nc')
+ncdf_varget, cdfid, 'glamt', glamt
+ncdf_varget, cdfid, 'gphit', gphit
+ncdf_varget, cdfid, 'e1t' , e1t
+ncdf_varget, cdfid, 'e2t', e2t
+ncdf_varget, cdfid, 'glamf', glamf
+ncdf_varget, cdfid, 'gphif', gphif
+ncdf_varget, cdfid, 'e1f', e1f
+ncdf_varget, cdfid, 'e2f', e2f
+ncdf_varget, cdfid, 'bat', bat
+ncdf_varget, cdfid, 'tmask', tmask
+ncdf_varget, cdfid, 'sss', sss
+ncdf_close, cdfid
+print, 'temps lecture fichier NetCdf 1ere fois', systime(1)-tempsun 
+tempsun = systime(1)
+cdfid = ncdf_open(iodir+'test_mercator.nc')
+ncdf_varget, cdfid, 'glamt', glamt
+ncdf_varget, cdfid, 'gphit', gphit
+ncdf_varget, cdfid, 'e1t' , e1t
+ncdf_varget, cdfid, 'e2t', e2t
+ncdf_varget, cdfid, 'glamf', glamf
+ncdf_varget, cdfid, 'gphif', gphif
+ncdf_varget, cdfid, 'e1f', e1f
+ncdf_varget, cdfid, 'e2f', e2f
+ncdf_varget, cdfid, 'bat', bat
+ncdf_varget, cdfid, 'tmask', tmask
+ncdf_varget, cdfid, 'sss', sss
+ncdf_close, cdfid
+print, 'temps lecture fichier NetCdf 2eme fois', systime(1)-tempsun 
+glamu = glamt & glamv = glamt 
+gphiu = gphit & gphiv = gphit 
+e1u = e1t & e1v = e1t
+e2v = e1t & e2v = e2t
+
+jpt = 1
+time = 0
+
+;-------------------------------------------------------------
+;-------------------------------------------------------------
+domdef
+triangles = triangule()
+;----------------------------------------------------------
+; environnement graphique (window et ps)
+;----------------------------------------------------------
+;----------------------------------------------------------
+sauveps = 0
+;----------------------------------------------------------
+; ajout perso
+;----------------------------------------------------------
+key_performance = 1
+plt, sss, 33, int = .2
Index: tags/start/INIT/initmorgane.pro
===================================================================
--- tags/start/INIT/initmorgane.pro	(revision 5)
+++ tags/start/INIT/initmorgane.pro	(revision 5)
@@ -0,0 +1,42 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh  =1
+ixmaxmesh  =-1
+;
+iyminmesh  =1
+iymaxmesh  =734
+;
+izminmesh  =0
+izmaxmesh  =0
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/'
+key_shift = 0
+key_stride = [2, 2, 1]
+ncdf_meshlec, 'coordinates_mask.nc'
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 0
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initmsu.pro
===================================================================
--- tags/start/INIT/initmsu.pro	(revision 5)
+++ tags/start/INIT/initmsu.pro	(revision 5)
@@ -0,0 +1,36 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+;computegrid, 20., -87.5, 2.5, 2.5, 144, 72
+computegrid, 0., -90, 2.5, 2.5, 144, 73
+tmask = replicate(1, jpi, jpj)
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/'
+key_shift = 0
+key_stride = [1, 1, 1]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+;
Index: tags/start/INIT/initncep.pro
===================================================================
--- tags/start/INIT/initncep.pro	(revision 5)
+++ tags/start/INIT/initncep.pro	(revision 5)
@@ -0,0 +1,68 @@
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+jpi = 192l
+ixminmesh  =0l
+ixmaxmesh  =jpi-1l
+;
+jpj = 94l
+iyminmesh  =0l
+iymaxmesh  =jpj-1l
+;
+jpk = 1l
+izminmesh  =0l
+izmaxmesh  =jpk-1l
+;
+jpt = 1l
+time = 0l
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/'
+key_shift = 0
+key_stride = [1, 1, 1]
+;
+glamt = ncdf_lec('lsmask.19294.nc', iodir = iodir, var = 'lon')
+glamt = glamt#replicate(1, jpj)
+glamu = glamt
+glamv = glamt
+glamf = glamt+1.875/2.
+gphit = ncdf_lec('lsmask.19294.nc', iodir = iodir, var = 'lat')
+gphit = replicate(1, jpi)#gphit
+gphiu = gphit
+gphiv = gphit
+gphif = gphit-1.90/2.
+gdept = 5.
+gdepw = 4.
+;
+e1t = replicate(1, jpi, jpj)
+e1u = e1t
+e1v = e1t
+e2t = replicate(1, jpi, jpj)
+e2u = e2t
+e2v = e2t
+e2f = e2t
+;
+e3t = 10.
+e3w = 10.
+;
+tmask = ncdf_lec('lsmask.19294.nc', iodir = iodir, var = 'lsmask')
+tmask = 1+tmask
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
Index: tags/start/INIT/initorca-170.190.pro
===================================================================
--- tags/start/INIT/initorca-170.190.pro	(revision 5)
+++ tags/start/INIT/initorca-170.190.pro	(revision 5)
@@ -0,0 +1,43 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh  =2
+ixmaxmesh  =181
+;
+iyminmesh  =0
+iymaxmesh  =147
+;
+izminmesh  =-1
+izmaxmesh  =-1
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/ORCA/'
+iodir = '/mnt/newdisk1/smasson/SCSIDISK/ORCA/'
+key_shift = -54
+key_stride = [1, 1, 1]
+ncdf_meshlec, 'meshmask.orca.2d.nc', glamboundary = [-170, 190]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initorca-180.180.pro
===================================================================
--- tags/start/INIT/initorca-180.180.pro	(revision 5)
+++ tags/start/INIT/initorca-180.180.pro	(revision 5)
@@ -0,0 +1,43 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh  =2
+ixmaxmesh  =181
+;
+iyminmesh  =0
+iymaxmesh  =147
+;
+izminmesh  =-1
+izmaxmesh  =-1
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/ORCA/'
+iodir = '/mnt/newdisk1/smasson/SCSIDISK/ORCA/'
+key_shift = -50
+key_stride = [1, 1, 1]
+ncdf_meshlec, 'meshmask.orca.2d.nc', glamboundary = [-180, 180]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initorca.pro
===================================================================
--- tags/start/INIT/initorca.pro	(revision 5)
+++ tags/start/INIT/initorca.pro	(revision 5)
@@ -0,0 +1,45 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh  =2
+ixmaxmesh  =181
+;
+iyminmesh  =0
+iymaxmesh  =147
+;
+izminmesh  =-1
+izmaxmesh  =-1
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/ORCA/'
+iodir = '/mnt/newdisk1/smasson/DATA/ORCA/'
+key_shift = 31
+;key_shift = 1
+key_stride = [1, 1, 1]
+ncdf_meshlec, 'meshmask.orca.2d.nc', glamboundary = [20, 380]
+;ncdf_meshlec, 'meshmask.orca.2d.nc', glamboundary = [80, 460]-360
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initorca05.pro
===================================================================
--- tags/start/INIT/initorca05.pro	(revision 5)
+++ tags/start/INIT/initorca05.pro	(revision 5)
@@ -0,0 +1,45 @@
+;
+;
+@common
+;------------------------------------------------------------
+;----------------------------------------------------------
+;----------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh  =2
+ixmaxmesh  =-1
+;
+iyminmesh  =0
+iymaxmesh  =509
+;
+izminmesh  =-1
+izmaxmesh  =-1
+;
+jpt=1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/ORCA/'
+iodir = '/usr/ipsl_temp/smlod/'
+key_shift = 107
+key_stride = [1, 1, 1]
+ncdf_meshlec, 'meshmask.orca.05d.nc', glamboundary = [20, 380], /checkdat
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpjglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initorca05_unsur2.pro
===================================================================
--- tags/start/INIT/initorca05_unsur2.pro	(revision 5)
+++ tags/start/INIT/initorca05_unsur2.pro	(revision 5)
@@ -0,0 +1,44 @@
+;
+;
+@common
+;------------------------------------------------------------
+;----------------------------------------------------------
+;----------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh  =2
+ixmaxmesh  =-1
+;
+iyminmesh  =0
+iymaxmesh  =509
+;
+izminmesh  =-1
+izmaxmesh  =-1
+;
+jpt=1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/ORCA/'
+key_shift = 107
+key_stride = [2, 2, 1]
+ncdf_meshlec, 'meshmask.orca.05d.1sur2.nc', glamboundary = [20, 380], /checkdat
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpjglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initorca80.440.pro
===================================================================
--- tags/start/INIT/initorca80.440.pro	(revision 5)
+++ tags/start/INIT/initorca80.440.pro	(revision 5)
@@ -0,0 +1,43 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh  =1
+ixmaxmesh  =180
+;
+iyminmesh  =0
+iymaxmesh  =147
+;
+izminmesh  =-1
+izmaxmesh  =-1
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/ORCA/'
+iodir = '/mnt/newdisk1/smasson/SCSIDISK/ORCA/'
+key_shift = 0
+key_stride = [1, 1, 1]
+ncdf_meshlec, 'meshmask.orca.2d.nc', glamboundary = [80, 440]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initorca_unsur2.pro
===================================================================
--- tags/start/INIT/initorca_unsur2.pro	(revision 5)
+++ tags/start/INIT/initorca_unsur2.pro	(revision 5)
@@ -0,0 +1,42 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh  =2
+ixmaxmesh  =181
+;
+iyminmesh  =0
+iymaxmesh  =147
+;
+izminmesh  =-1
+izmaxmesh  =-1
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/ORCA/'
+key_shift = 31
+key_stride = [2, 2, 1]
+ncdf_meshlec, 'meshmask.orca.2d.nc', glamboundary = [20, 380]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/inittotem.pro
===================================================================
--- tags/start/INIT/inittotem.pro	(revision 5)
+++ tags/start/INIT/inittotem.pro	(revision 5)
@@ -0,0 +1,43 @@
+;
+;
+@common
+;----------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+;ixminmesh  =393
+ ixminmesh  =1
+ ixmaxmesh  =551
+ ixminmesh  =13
+ ixmaxmesh  =232
+;
+iyminmesh  =20
+iymaxmesh  =80
+;
+izminmesh  =0
+izmaxmesh  =21
+;
+jpt = 1
+time = 0
+;-------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/'
+iodir = '/mnt/newdisk1/smasson/SCSIDISK/'
+key_shift = 0
+key_stride = [1, 1, 1]
+ncdf_meshlec
+;-------------------------------------------------------------
+domdef
+;
+key_stride = [1, 1, 1]
+key_periodique = 0
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+ixmindta = ixminmesh & iymindta = iyminmesh & izmindta = izminmesh
+ixmaxdta = ixmaxmesh & iymaxdta = iymaxmesh & izmaxdta = izmaxmesh
+jpidta = ixmaxdta-ixmindta+1
+jpjdta = iymaxdta-iymindta+1
+jpkdta = izmaxdta-izmindta+1
+;-------------------------------------------------------------
Index: tags/start/INIT/inittotem20.380.pro
===================================================================
--- tags/start/INIT/inittotem20.380.pro	(revision 5)
+++ tags/start/INIT/inittotem20.380.pro	(revision 5)
@@ -0,0 +1,42 @@
+;
+;
+@common
+;----------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+;ixminmesh  =393
+ ixminmesh  =1
+ ixmaxmesh  =551
+;  ixminmesh  =13
+;  ixmaxmesh  =232
+;
+iyminmesh  =20
+iymaxmesh  =80
+;
+izminmesh  =0
+izmaxmesh  =21
+;
+jpt = 1
+time = 0
+;-------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/'
+key_shift = 0
+key_stride = [1, 1, 1]
+ncdf_meshlec
+;-------------------------------------------------------------
+domdef
+;
+key_stride = [1, 1, 1]
+key_periodique = 0
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+ixmindta = ixminmesh & iymindta = iyminmesh & izmindta = izminmesh
+ixmaxdta = ixmaxmesh & iymaxdta = iymaxmesh & izmaxdta = izmaxmesh
+jpidta = ixmaxdta-ixmindta+1
+jpjdta = iymaxdta-iymindta+1
+jpkdta = izmaxdta-izmindta+1
+;-------------------------------------------------------------
Index: tags/start/INIT/inittotem_unsur2.pro
===================================================================
--- tags/start/INIT/inittotem_unsur2.pro	(revision 5)
+++ tags/start/INIT/inittotem_unsur2.pro	(revision 5)
@@ -0,0 +1,41 @@
+;
+;
+@common
+;----------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+;ixminmesh  =393
+ ixminmesh  =1
+ ixmaxmesh  =551
+ ixminmesh  =13
+ ixmaxmesh  =232
+;
+iyminmesh  =20
+iymaxmesh  =80
+;
+izminmesh  =-1
+izmaxmesh  =-1
+;
+jpt = 1
+time = 0
+;-------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA'
+key_shift = 0
+key_stride = [2, 2, 1]
+ncdf_meshlec
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 0
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+ixmindta = ixminmesh & iymindta = iyminmesh & izmindta = izminmesh
+ixmaxdta = ixmaxmesh & iymaxdta = iymaxmesh & izmaxdta = izmaxmesh
+jpidta = ixmaxdta-ixmindta+1
+jpjdta = iymaxdta-iymindta+1
+jpkdta = izmaxdta-izmindta+1
+;-------------------------------------------------------------
Index: tags/start/INIT/inittoutorca.pro
===================================================================
--- tags/start/INIT/inittoutorca.pro	(revision 5)
+++ tags/start/INIT/inittoutorca.pro	(revision 5)
@@ -0,0 +1,45 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+ixminmesh  =-1
+ixmaxmesh  =-1
+;
+iyminmesh  =-1
+iymaxmesh  =-1
+;
+izminmesh  =-1
+izmaxmesh  =-1
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/ORCA/'
+key_shift = 31
+key_shift = 0
+key_stride = [1, 1, 1]
+;ncdf_meshlec, 'meshmask.orca.2d.nc', glamboundary = [20, 380]
+;ncdf_meshlec, 'meshmask.orca.2d.nc', glamboundary = [80, 460]-360
+ncdf_meshlec, 'meshmask.orca.2d.nc'
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/inittouttotem.pro
===================================================================
--- tags/start/INIT/inittouttotem.pro	(revision 5)
+++ tags/start/INIT/inittouttotem.pro	(revision 5)
@@ -0,0 +1,42 @@
+;
+;
+@common
+;----------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+;ixminmesh  =393
+ ixminmesh  =-1
+ ixmaxmesh  =-1
+ ixminmesh  =-1
+ ixmaxmesh  =-1
+;
+iyminmesh  =-1
+iymaxmesh  =-1
+;
+izminmesh  =0
+izmaxmesh  =0
+izminmesh  =-1
+izmaxmesh  =-1
+;
+jpt = 1
+time = 0
+;-------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA'
+key_shift = 0
+ncdf_meshlec
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 0
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+ixmindta = ixminmesh & iymindta = iyminmesh & izmindta = izminmesh
+ixmaxdta = ixmaxmesh & iymaxdta = iymaxmesh & izmaxdta = izmaxmesh
+jpidta = ixmaxdta-ixmindta+1
+jpjdta = iymaxdta-iymindta+1
+jpkdta = izmaxdta-izmindta+1
+;-------------------------------------------------------------
Index: tags/start/INIT/initxie.pro
===================================================================
--- tags/start/INIT/initxie.pro	(revision 5)
+++ tags/start/INIT/initxie.pro	(revision 5)
@@ -0,0 +1,35 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+computegrid, 0.5, -89.5, 1, 1, 360, 180
+tmask = replicate(1, jpi, jpj)
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/'
+key_shift = 0
+key_stride = [1, 1, 1]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initxie1.pro
===================================================================
--- tags/start/INIT/initxie1.pro	(revision 5)
+++ tags/start/INIT/initxie1.pro	(revision 5)
@@ -0,0 +1,35 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+computegrid, 0.5, -89.5, 1, 1, 360, 180
+tmask = replicate(1, jpi, jpj)
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/usr1/antiope/smasson/DATA/'
+key_shift = 0
+key_stride = [1, 1, 1]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = triangule()
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/INIT/initxie2_5.pro
===================================================================
--- tags/start/INIT/initxie2_5.pro	(revision 5)
+++ tags/start/INIT/initxie2_5.pro	(revision 5)
@@ -0,0 +1,36 @@
+;
+;
+@common
+;---------------------------------------------------------
+; bornes de la grille
+;----------------------------------------------------------
+computegrid, 1.25, -88.75, 2.5, 2.5, 144, 72
+tmask = replicate(1, jpi, jpj)
+;
+jpt = 1
+time = 0
+;------------------------------------------------------
+; lecture de la grille
+;------------------------------------------------------
+iodir = '/mnt/newdisk1/smasson/XIE_ARKIN/'
+iodir = '/usr1/antiope/smasson/DATA/'
+key_shift = 0
+key_stride = [1, 1, 1]
+;-------------------------------------------------------------
+domdef
+;
+key_periodique = 1
+triangles = -1
+;----------------------------------------------------------
+; bornes pour la lecture des donnees
+;----------------------------------------------------------
+jpidta = jpiglo
+jpjdta = jpjglo
+jpkdta = jpkglo
+ixmindta = 0
+ixmaxdta = jpidta-1
+iymindta = 0
+iymaxdta = jpjdta-1
+izmindta = 0
+izmaxdta = jpkdta-1
+
Index: tags/start/LECTURE/changeread.pro
===================================================================
--- tags/start/LECTURE/changeread.pro	(revision 5)
+++ tags/start/LECTURE/changeread.pro	(revision 5)
@@ -0,0 +1,40 @@
+FUNCTION changeread, newread
+;
+@common
+;
+;
+; newread must be two structures
+;
+   if size(newread, /type) NE 8 then return, 0
+;
+; we compare the two structure which caracterise the read  
+;
+   case 1 of
+      ccreadparameters.funclec_name NE newread.funclec_name:
+      ccreadparameters.jpidta NE newread.jpidta:
+      ccreadparameters.jpjdta NE newread.jpjdta:
+      ccreadparameters.jpkdta NE newread.jpkdta:
+      ccreadparameters.ixmindta NE newread.ixmindta:
+      ccreadparameters.ixmaxdta NE newread.ixmaxdta:
+      ccreadparameters.iymindta NE newread.iymindta:
+      ccreadparameters.iymaxdta NE newread.iymaxdta:
+      ccreadparameters.izmindta NE newread.izmindta:
+      ccreadparameters.izmaxdta NE newread.izmaxdta:
+      ELSE:return, 0
+   endcase
+;
+; update the common paramaters
+;
+   ccreadparameters = newread
+   jpidta = newread.jpidta
+   jpjdta = newread.jpjdta
+   jpkdta = newread.jpkdta
+   ixmindta = newread.ixmindta
+   ixmaxdta = newread.ixmaxdta
+   iymindta = newread.iymindta
+   iymaxdta = newread.iymaxdta
+   izmindta = newread.izmindta
+   izmaxdta = newread.izmaxdta
+;
+   return, 1
+end
Index: tags/start/LECTURE/ficdate.pro
===================================================================
--- tags/start/LECTURE/ficdate.pro	(revision 5)
+++ tags/start/LECTURE/ficdate.pro	(revision 5)
@@ -0,0 +1,97 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: ficdate
+;
+; PURPOSE:  sets s_fichier to name of the vairmer file associated
+;           to the given date in vairmer format ( yymmdd )
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:  fic = ficdate(930124)
+;
+; INPUTS:vdate:date vairmer ex:930124
+;	 dim:'so' ou 'vo' par defaut so est choisi
+;	 nomexp:nomde l'experience en trois lettres par defaut prefix
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:le nom du fichier vairmer (depuis iodir)
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Jerome Vialard  (jv@lodyc.jussieu.fr)
+;			1/7/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+function ficdate, vdate, dim, nomexp
+@common
+;------------------------------------------------------------
+case n_params() of
+  1: dim = 'SO'
+  2: dim=strupcase(dim)
+  3: begin
+       prefix=nomexp
+       dim=strupcase(dim)
+     end
+endcase
+;------------------------------------------------------------
+;   constitution de l'adresse ou aller chercher le fichier
+;--------------------------------------------------------------
+; date yymmdd = vdate
+; sets month, year and day to the good value :
+   rien = juldate(vdate)
+; constitution de la date yymmdd
+   case 1 of 
+     year lt 10:                s_year ='0'+string(format='(i1)',year)
+     year ge 10 and year lt 100:s_year=     string(format='(i2)',year)
+     year ge 100:BEGIN 
+        year = year-1900
+        if year LT 10 then s_year ='0'+string(format='(i1)',year) $
+         ELSE s_year =string(format='(i2)',year)
+     end
+   endcase
+   if month lt 10 then s_month='0'+string(format='(i1)',month) $
+                  else s_month=    string(format='(i2)',month)
+   if day lt 10 then s_day='0'+string(format='(i1)',day) $
+                else s_day=    string(format='(i2)',day)
+;
+   case dim of
+     'SO': begin
+       case 1 of
+          (year eq 0) and (month eq 0) : s_fichier=iodir+prefix+'O.EX.SO'
+          (year eq 0) and (month ne 0) and (day eq 0) : s_fichier=iodir+prefix+'O.SE.SO'+s_month
+          (year ne 0) and (month eq 0) : s_fichier=iodir+prefix+'O.AN.SO'+s_year
+          (year ne 0) and (day eq 0) :   s_fichier=iodir+prefix+'O.MO.SO'+s_year+s_month
+          else: s_fichier=iodir+prefix+'O..SO'+s_year+s_month+s_day
+       endcase
+     end
+     'VO': begin
+       case 1 of
+          (year eq 0) and (month eq 0) : s_fichier=iodir+prefix+'O.EX.VO'
+          (year eq 0) and (month ne 0) and (day eq 0) : s_fichier=iodir+prefix+'O.SE.VO'+s_month
+          (year ne 0) and (month eq 0) : s_fichier=iodir+prefix+'O.AN.VO'+s_year
+          (year ne 0) and (day eq 0) : s_fichier=iodir+prefix+'O.MO.VO'+s_year+s_month
+          else: s_fichier=iodir+prefix+'O..VO'+s_year+s_month+s_day
+       endcase
+     end
+     else: return, report('le fichier doit etre VO ou SO')
+   endcase
+;
+;   print,' '
+;   print,' adresse du fichier: ',fichier
+;------------------------------------------------------------
+   return, s_fichier
+;------------------------------------------------------------
+end
+;------------------------------------------------------------
Index: tags/start/LECTURE/fictype.pro
===================================================================
--- tags/start/LECTURE/fictype.pro	(revision 5)
+++ tags/start/LECTURE/fictype.pro	(revision 5)
@@ -0,0 +1,56 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: fictype
+;
+; PURPOSE:  gives fictype ('DA' 'MO' 'AN' 'SE' 'EX') corresponding
+;           to the given date in vairmer format ( yymmdd )
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:  fictype = fictype(930124)
+;
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Jerome Vialard  (jv@lodyc.jussieu.fr)
+;			2/7/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+function fictype, vdate, dim
+@common
+;------------------------------------------------------------
+;   constitution de l'adresse ou aller chercher le fichier
+;--------------------------------------------------------------
+; date yymmdd = vdate
+   jul = juldate(vdate)
+;
+   case 1 of
+      (year eq 0) and (month eq 0) : return, 'EX'
+      (year eq 0) and (month ne 0) and (day eq 0) : return, 'SE'
+      (year ne 0) and (month eq 0) : return, 'AN'
+      (year ne 0) and (day eq 0)   : return, 'MO'
+      else                         : return, 'DA'
+   endcase
+;
+;------------------------------------------------------------
+   fini:
+;
+   return, -1
+end
+;------------------------------------------------------------
Index: tags/start/LECTURE/lec.pro
===================================================================
--- tags/start/LECTURE/lec.pro	(revision 5)
+++ tags/start/LECTURE/lec.pro	(revision 5)
@@ -0,0 +1,356 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:lec
+;   
+;
+; PURPOSE:
+;       lit les fichiers Vairmer en sort:
+;		un tableau 2d ou 3d en fonction de nomchamp qui est le nom
+; du champ a extaire (2d s'il commence par SO et 3d s'il commence par VO)
+;	cette fonction modifie aussi les variables globales:
+;		varname: trois lettres: nom de l'experience
+;		vargrid: nom de la grille
+;		vardate: date (yy)yymmdd
+;		varexp: nom Vairmer du champ a tarcer
+;
+; CATEGORY:
+;       Graphics, lecture de fichier Vaimer
+;
+; CALLING SEQUENCE:
+;	resultat=lec('nom_Vairmer'[,date[,'nom_experience']])
+;
+; INPUTS:
+;	nom_Vairmer: 2 choix possibles:
+;             1) nom de champ Vairmer (chaine de 8 caracteres en majuscule ou 
+; minuscule commencant par vo ou so). Dans cette methode on saute directement
+; d'en-tete en en-tete jusqu'a trouver le bon fichier.
+;             2) chaine de characteres commencant par vo ou so suivit du
+; numero de champ a aller chercher (par ex 'vo5'). Cette methode est un peu
+; plus rapide car elle va directement chercher le fichier qui nous interesse.
+;
+;	arguments optionnels:
+;	
+;	date:nombres de 6 ou 8 chiffres (anneemoisjour, par ex:19980507)
+;	nom_experience:trois lettres designant le nom de l'experience
+;
+; KEYWORD PARAMETERS:
+;
+;       /ANOM:type du fichier vairmer par rapport auquel on doit calculer 
+;             l'anomalie ('EX','AN','SE','MO','')
+;
+;	/ECRIT:permet d'imprimer tous les noms vairmer que contient le fichier.
+; ds ce cas en input on met seulement 'vo' ou 'so' la fonction retourne le
+; nombre de fichiers lus.
+;
+;       /EXPANOM: si on calcule l'anom par rapport a une exper
+;       differente
+;
+;       FILENAME: string pour passer directement le nom du champ sans
+;       utiliser les inputs: nom_Vairmer',date,'nom_experience'. Rq si
+;       ces inputs sont qd meme donnes ils ne sont pas modifies par
+;       filename.
+;
+;       /GRID:lorsque ce mot clef est active, lec retourne la liste
+;       des types de grilles (T, U...) auxquelles se rapportent les
+;       variables. ds ce cas en input on met seulement 'vo' ou 'so'.
+;
+;       /NAME:lorsque ce mot clef est active, lec retourne la liste
+;       des noms des variables. ds ce cas en input on met seulement
+;       'vo' ou 'so'.
+;
+;       /TOUT: oblige lec a lire le champ sur tout le domaine qui a
+;       etait selectionne pour la cession en cours (jpi,jpj,jpk)
+;
+; OUTPUTS: un tableau 2 ou 3d. sans le mot cle /TOUT, sa taille est
+; celle du sous domaine definit par domdef (nx,ny,nz). avec /TOUT le
+; champ a la taille du  domaine qui a etait selectionne pour la
+; cession en cours (jpi,jpj,jpk). 
+; pour les sous domaines cf:  
+;        http://www.ipsl.jussieu.fr/~smlod/sousdomaine.html
+;
+; COMMON BLOCKS:
+;       common.pro	   isnumber.pro		fivardate.pro  
+;
+; SIDE EFFECTS:Retourne -1 en cas d'erreur.
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			26/5/98
+;                       Jerome Vialard : adaptation au format vairmer
+;                                        keyword anom et expanom
+;			1/7/98
+;                       Sebastien Masson (masque des terres)
+;			14/8/98
+;                       Sebastien Masson (decoupe pour les sous domaines...)
+;			2/99
+;;-
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+function lec, nomchamp,date,nomexp,ECRIT=ecrit,ANOM=anom, BOITE = boite,EXPANOM=expanom, TOUT = tout, GRID = grid, NAME = name, filename = FILENAME
+@common
+   tempsun = systime(1)         ; pour key_performance
+   z = -1
+;
+   if keyword_set(filename) then BEGIN
+      CASE strupcase(strmid(!version.os_family, 0, 3)) of
+         'MAC':sep = ':'
+         'WIN':sep = '\'
+         ELSE:sep = '/'
+      ENDCASE
+      fname = strmid(filename, rstrpos(filename, sep)+1)
+      if n_elements(nomchamp) EQ 0 then nomchamp = strmid(fname,6, 2)
+      if n_elements(date) EQ 0 then date = long(strmid(fname,8))
+      if n_elements(nomexp) EQ 0 then nomexp = strmid(fname,0, 3)
+   endif
+;
+   nomchamp=strupcase(nomchamp)
+   dim=string(format='(a2)',nomchamp)
+;print, 'nom de l''experience: ',nomchamp
+;------------------------------------------------------------
+; specification de la date et de l'experience
+;------------------------------------------------------------
+   case n_params() OF
+      0:BEGIN
+         if keyword_set(filename) then begin
+            rien=juldate(date)
+            prefix=nomexp
+         ENDIF ELSE return, report('Donnez un argument en entree ou utilisez le mot clef FILENAME')
+      END
+      1:date=long(day)+long(month)*100+long(year)*10000
+      2:rien=juldate(date)
+      3:begin
+         rien=juldate(date)
+         prefix=nomexp
+      end
+   endcase
+;------------------------------------------------------------
+; verification de la dim du fichier
+;------------------------------------------------------------
+   if dim ne 'SO' and dim ne 'VO' then return, report('le nom du champ doit commencer par VO ou SO')
+;------------------------------------------------------------
+;   constitution de l'adresse ou aller chercher le fichier
+;--------------------------------------------------------------
+   s_fichier=ficdate(date,dim)
+;--------------------------------------------------------------------
+; ouverture du fichier a l'adresse s_fichier
+;--------------------------------------------------------------------
+   openr, numlec, s_fichier, /get_lun,ERROR=err, /swap_if_little_endian
+   if err ne 0 then begin
+;  print,!err_string
+      return, -1
+   endif
+;taille en octet du fichier
+   infofichier=fstat(numlec)
+;---------------------------------------------------------------------
+; definition de la taille du fichier a aller chercher: jpidta,jpjdta,jpkdta...
+;---------------------------------------------------------------------
+   if n_elements(jpidta) EQ 0 THEN BEGIN 
+      if n_elements(ixmindta) EQ 0 OR n_elements(ixmaxdta) EQ 0 then $
+       jpidta = jpiglo else jpidta = ixmaxdta-ixmindta+1
+   endif
+   if n_elements(jpjdta) EQ 0 THEN BEGIN 
+      if n_elements(iymindta) EQ 0 OR n_elements(iymaxdta) EQ 0 then $
+       jpjdta = jpjglo else jpjdta = iymaxdta-iymindta+1
+   endif
+   if n_elements(jpkdta) EQ 0 THEN BEGIN 
+      if n_elements(izmindta) EQ 0 OR n_elements(izmaxdta) EQ 0 then $
+       jpkdta = jpkglo else jpkdta = izmaxdta-izmindta+1
+   endif
+;---------------------------------------------------------------------
+; lecture des champs directement vers le champ ou l'en-tete que l'on recherche
+; il faut savoir que:
+;  le fortran ajoute au debut et a la fin de chaque write 4 octets de controle
+;  les reels du model sont codes sur 4 octets
+;  un charactere fait 1 octet
+;-----------------------------------------------------------------------
+;4 chaines de 8 characteres+un tableau de reels+4 trucs de controle (pour les
+; 2 write):
+   if dim eq 'VO' then $
+    taillebloc=4*8+long(jpidta)*jpjdta*jpkdta*4+4*4 else $
+    taillebloc=4*8+long(jpidta)*jpjdta*4+4*4
+;---------------------------------------------------------------------
+; choix du type de lecture
+;---------------------------------------------------------------------
+   typelec=strmid(nomchamp,2,strlen(nomchamp))
+   test=isnumber(typelec,numerochamp)
+   if test eq 0 then begin
+;--------------------------------------------------------------------
+; 1) LECTURE DIRECTE D'EN-TETE en EN-TETE
+;--------------------------------------------------------------------
+      numerochamp=1
+;---------------------------------------------------------------------
+; lecture des noms de champ
+;---------------------------------------------------------------------
+      resname = ''
+      resgrid = ''
+      while numerochamp*taillebloc le infofichier.size do begin
+         offset=(numerochamp-1)*taillebloc+4
+         a=assoc(numlec,bytarr(8,/nozero), offset)
+         varname=string(a[0])
+         if keyword_set(ecrit) OR keyword_set(name) OR keyword_set(grid) $
+          then begin
+            vargrid=a[1]
+            vargrid=string(vargrid[7])
+            vardate=strtrim(long(string(a[2])), 2)
+            varexp=strtrim(a[3], 2)
+            if keyword_set(ecrit) THEN $
+             print, numerochamp,' ',varname,' ',vargrid,' ',vardate,' ',varexp
+            resname = [resname, varname]
+            resgrid = [resgrid, vargrid]
+         endif
+         if nomchamp eq varname then begin
+            vargrid=a[1]
+            vargrid=string(vargrid[7])
+            vardate=strtrim(long(string(a[2])), 2)
+            varexp=strtrim(a[3], 2)
+            goto,sortieboucle
+         endif
+         numerochamp=numerochamp+1
+      ENDWHILE
+      free_lun,numlec
+      close, numlec
+      case 1 of
+         keyword_set(ecrit):return, numerochamp-1
+         keyword_set(name):return, resname[1:numerochamp-1]
+         keyword_set(grid):$
+          return, strmid(resgrid[1:numerochamp-1],0 > (strlen(resgrid[0])-2))
+         ELSE:return, report('Ce nom Vairmer de champ n''existe pas ds le fichier: '+infofichier.name)
+      endcase
+   endif else begin
+;----------------------------------------------------------------------
+; 2) LECTURE DIRECTEMENT DU CHAMP QUE L'ON VEUT
+;---------------------------------------------------------------------
+;---------------------------------------------------------------------
+; test pour savoir si numero de champ est accessible
+;---------------------------------------------------------------------
+      if taillebloc*numerochamp gt infofichier.size then $
+       return, report('Ce numero de champ n''exite pas. Le fichier '+infofichier.name+' ne contient que ',infofichier.size/taillebloc,' champs.')
+;---------------------------------------------------------------------
+; lecture de l'en-tete numero numerochamp
+;---------------------------------------------------------------------
+      offset=(numerochamp-1)*taillebloc+4
+      a=assoc(numlec,bytarr(8,/nozero), offset)
+      varname=string(a[0])
+      vargrid=a[1]
+      vargrid=string(vargrid[7])
+      vardate=string(a[2])
+      varexp=string(a[3])
+   endelse
+sortieboucle:
+;---------------------------------------------------------------------
+; lecture du champ lui-meme
+;---------------------------------------------------------------------
+   offset=(numerochamp-1)*taillebloc+(8+4*8)+4
+   if dim eq 'VO' then $
+    a=assoc(numlec,fltarr(jpidta,jpjdta,jpkdta,/nozero), offset) else $
+    a=assoc(numlec,fltarr(jpidta,jpjdta,/nozero), offset)
+   z=a[0]
+;---------------------------------------------------------------------
+; on initialise les ixmindta, iymindta  au besoin
+;---------------------------------------------------------------------
+   if n_elements(ixmindta) EQ 0 OR n_elements(ixmaxdta) EQ 0 then BEGIN
+      ixmindta = 0
+      ixmaxdta = jpidta-1
+   endif
+   if n_elements(iymindta) EQ 0 OR n_elements(iymaxdta) EQ 0 then BEGIN
+      iymindta = 0
+      iymaxdta = jpjdta-1
+   endif
+   if n_elements(izmin) EQ 0 OR n_elements(izmax) EQ 0 then BEGIN
+      izmindta = 0
+      izmaxdta = jpkdta-1
+   endif
+;---------------------------------------------------------------------
+; on reduit z selon les valeurs de ixmindta, iymindta, ...
+;---------------------------------------------------------------------
+   if dim EQ 'SO' then z = z[ixminmesh-ixmindta:ixmaxmesh-ixmindta $
+                             ,iyminmesh-iymindta:iymaxmesh-iymindta] $
+   ELSE z = z[ixminmesh-ixmindta:ixmaxmesh-ixmindta $
+              , iyminmesh-iymindta:iymaxmesh-iymindta, izminmesh-izmindta:izmaxmesh-izmindta]
+;---------------------------------------------------------------------
+; on shift z si key_shift est defininit
+;---------------------------------------------------------------------
+   if n_elements(key_shift) NE 0 THEN BEGIN 
+      if dim EQ 'SO' then z = shift(z,key_shift, 0) $
+      ELSE z = shift(z,key_shift, 0, 0)
+   endif
+;---------------------------------------------------------------------
+;  si /TOUT n''est pas active, on coupe z pour q''il soit a la taille
+;  du zoom: nx,ny nz
+;---------------------------------------------------------------------
+   if NOT keyword_set(tout) then BEGIN 
+;-------------------------------------------------------------
+; changement de domaine
+;-------------------------------------------------------------
+      if keyword_set(boite) then BEGIN 
+         Case 1 Of
+            N_Elements(Boite) Eq 1:bte=[lon1, lon2, lat1, lat2, 0.,boite[0]]
+            N_Elements(Boite) Eq 2:bte=[lon1, lon2, lat1, lat2, boite[0],boite[1]]
+            N_Elements(Boite) Eq 4:bte=[Boite, prof1, prof2]
+            N_Elements(Boite) Eq 5:bte=[Boite[0:3], 0, Boite[4]]
+            N_Elements(Boite) Eq 6:bte=Boite
+            Else: return, report('Mauvaise Definition de Boite')
+         endcase
+         oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+         domdef, bte,GRILLE=vargrid
+      ENDIF 
+;-------------------------------------------------------------
+      grille,mask,glam,gphi,gdep,nx,ny,nz,premierx,premiery,premierz,dernierx,derniery,dernierz
+      if nx EQ 1 OR ny EQ 1 OR nz EQ 1 then mask = reform(mask, nx, ny, nz, /over)
+      if dim EQ 'SO' then z = z[premierx:dernierx, premiery:derniery]  $
+      ELSE z = z[premierx:dernierx, premiery:derniery, premierz:dernierz]
+   ENDIF ELSE BEGIN 
+      case vargrid OF           ; on recupere le mask en entier ds le cas ou /TOUT
+         'U':mask = umask()     ; n''est pas active et on le choisit en fontion
+         'T':mask = tmask       ;  de la valeur de vargrid
+         'W':mask = tmask       
+         'V':mask = vmask()
+         'F':mask = fmask()
+      ENDCASE
+   ENDELSE 
+;---------------------------------------------------------------------
+; calcul d'une anomalie si le keyword anom est active
+;---------------------------------------------------------------------
+   if keyword_set(anom) then begin
+      case anom of
+         'EX' : adate = 0
+         'AN' : adate = floor(date/10000)*10000 
+         'SE' : adate = floor(date - floor(date/10000)*10000)/100 * 100
+         'MO' : adate = floor(date/100)*100
+         'DA' : adate = date - floor(date/10000)*10000
+         ''   : adate = date - floor(date/10000)*10000
+         else : return, report('Anom doit etre egal a EX,AN,SE,MO,DA ')
+      endcase
+      if keyword_set(expanom) then nomexpa = expanom $
+      else nomexpa = nomexp
+      if keyword_set(bavard) THEN print, nomchamp,' - ',adate,' - ',nomexpa
+      z = z - lec(nomchamp,adate,nomexpa, TOUT = tout)
+   endif
+;---------------------------------------------------------------------
+; on masque les terres par valmask
+;---------------------------------------------------------------------
+   IF n_elements(valmask) EQ 0 THEN valmask = 1e20
+   if dim EQ 'SO' then BEGIN 
+      terre = where(mask[*,*,0] EQ 0)
+      if terre[0] NE -1 then z[terre] = valmask 
+   ENDIF ELSE BEGIN 
+      terre = where(mask[*,*,0] EQ 0)
+      if terre[0] NE -1 then z(where(mask EQ 0)) = valmask
+   ENDELSE 
+;---------------------------------------------------------------------
+   free_lun,numlec
+   close, numlec
+;---------------------------------------------------------------------
+   if n_elements(oldboite) NE 0 then domdef,  oldboite
+   IF keyword_set(key_performance) EQ 1 THEN print, 'temps lec', systime(1)-tempsun
+;
+   return,reform(z)
+
+end
+
Index: tags/start/LECTURE/lect.pro
===================================================================
--- tags/start/LECTURE/lect.pro	(revision 5)
+++ tags/start/LECTURE/lect.pro	(revision 5)
@@ -0,0 +1,274 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:lect
+;   
+; PURPOSE:
+;       lit les fichiers Vairmer de date1 a date2 et en sort un tableau
+;       1D, 2D ou 3D qui peut etre reutilise pour une courbe / hov / animation
+;	cette fonction modifie aussi les variables globales:
+;		varname: huit lettres: nom Vairmer du champ a tracer
+;		vargrid:1 lettre : nom de la grille
+;		varexp: trois lettres :nom de l'experience
+;
+; CATEGORY:
+;       Graphics, lecture de fichier Vaimer
+;
+; CALLING SEQUENCE:
+;	resultat=lec('nom_Vairmer',date1,date2,'nomexp','direc',BOITE=boite)
+;
+; INPUTS:
+;	nom_Vairmer: nom de champ Vairmer (chaine de 8 caracteres commencant
+;                    par VO ou SO
+;       date de depart (date1) et de fin (date2) de la serie temporelle a
+;             extraire
+;       nomexp nom de l' experience a lire (prefix pardefaut)
+;
+;       direc : 'x' 'y' 'z' 'xy' 'xz' 'yz' 'xyz' 'xt' 'yt' 'zt' 'xyt' 'xzt'
+;       'yzt' 'xyzt' directions selon lesquelles effectuer les moyennes
+;       (si rien n'est donne on n'effectue pas de moyenne)
+;
+;
+;
+; KEYWORD PARAMETERS:
+;         boite  : boite sur laquelle integrer (par defaut tt le domaine)
+;         anom   : type de fichiers ('SE','AN','') a relire pour calc une
+; anomalie  
+;         expanom: experience pour laquelle on veut calculer une anomalie
+; (par defaut la meme que nomexp)
+;         repeat : nombre de fois que l'on veut dupliquer la serie bout a bout
+;
+; COMMON BLOCKS:
+;       common		vraidate	juldate
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Jerome Vialard (jv@lodyc.jussieu.fr)
+;			2/7/98
+;-
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+;                  1      2      3    4      5       
+function lect, nomchamp,date1,date2,nomexp,direc,BOITE=boite, $
+               ANOM=anom,EXPANOM=expanom
+;,REPEAT=repeat
+@common
+   tempsun = systime(1)         ; pour key_performance
+;
+   nomchamp = strupcase(nomchamp)
+   date1=vraidate(date1)
+   date2=vraidate(date2)
+;
+   dim=string(format='(a2)',nomchamp)
+;
+;------------------------------------------------------------
+; specification de la date et de l'experience
+;------------------------------------------------------------
+;
+   if fictype(date1) ne fictype(date2) then $
+    return, report('Les deux dates doivent correspondre au meme type de fic vairmer')
+   fictyp = fictype(date1) 
+;-------------------------------------------------------------
+; creation du nom du fichier
+;-------------------------------------------------------------
+   if n_elements(nomexp) EQ 0 then nomexp = prefix
+   ficname=iodir+nomchamp+'.'+strcompress(date1,/remove_all)
+   ficname=ficname +'-'+fictyp+'-'+strcompress(date2,/remove_all)+'.'+nomexp
+   if (keyword_set(anom)) then ficname=ficname +'.'+anom
+   if (keyword_set(expanom)) then ficname=ficname +'-'+expanom
+   case n_elements(boite) of 
+      4 : box = strcompress(string(format='(i4,"_",i4,"_",i4,"_",i4)',boite) $
+                            ,/remove_all)
+      6 : box = strcompress(string(format='(i4,"_",i4,"_",i4,"_",i4,"_",i4,"_",i4)',boite),/remove_all)
+      else: box= strcompress(string(format='(i4,"_",i4,"_",i4,"_",i4,"_",i4,"_",i4)',[lon1,lon2,lat1,lat2,prof1,prof2]),/remove_all)
+   ENDCASE
+   if n_elements(direc) EQ 0 then direc = ''
+   ficname=ficname+'.'+box+'.'+direc+'.hovdat'
+;-------------------------------------------------------------
+; Est ce que le fichier de hovmoller existe ?
+;-------------------------------------------------------------
+;
+; structure du fichier :
+; jpt (valeur de la dim temporelle), dimtableau (dimension du tableau) 
+; dimttab[0], dimttab[1], ... (valeur des dim )
+; time (axe des tps), ttab (tableau a lire)
+; def du domaine (lon1,lon2,...  ,prof1,prof2)
+;
+   get_lun, numlec
+   openr, numlec, ficname, /get_lun,ERROR=err, /swap_if_little_endian
+   if (err eq 0) then begin
+      jpt = long(1)
+      dimtableau = long(1)
+      readu, numlec, jpt,dimtableau
+      case dimtableau of 
+         1 : begin
+            n1 = long(1)
+            readu, numlec,n1
+            ttab = fltarr(n1)
+         end
+         2 : begin
+            n1 = long(1)
+            n2 = long(1)
+            readu, numlec,n1,n2
+            ttab = fltarr(n1,n2)
+         end
+         3 : begin
+            n1 = long(1)
+            n2 = long(1)
+            n3 = long(1)
+            readu, numlec,n1,n2,n3
+            ttab = fltarr(n1,n2,n3)
+         end
+      endcase
+      time = lonarr(jpt)
+; lecture axe des tps et du tableau
+      readu, numlec,time, ttab
+      newboite = fltarr(6)
+; lecture du domaine
+      readu, numlec,newboite
+      domdef, newboite
+; lecture info complementaire : nom du champs, de l'experience
+      varname='aaaaaaaa'
+      readu, numlec, varname
+      vargrid='a'
+      readu, numlec, vargrid
+      varexp='aaa'
+      readu, numlec, varexp
+;
+      close, numlec
+      free_lun, numlec
+      return, ttab
+   ENDIF
+   close, numlec
+   free_lun, numlec
+;-------------------------------------------------------------
+; changement de domaine
+;-------------------------------------------------------------
+   if keyword_set(boite) then BEGIN 
+      Case 1 Of
+         N_Elements(Boite) Eq 1:bte=[lon1, lon2, lat1, lat2, 0.,boite[0]]
+         N_Elements(Boite) Eq 2:bte=[lon1, lon2, lat1, lat2, boite[0],boite[1]]
+         N_Elements(Boite) Eq 4:bte=[Boite, prof1, prof2]
+         N_Elements(Boite) Eq 5:bte=[Boite[0:3], 0, Boite[4]]
+         N_Elements(Boite) Eq 6:bte=Boite
+         Else: return, report('Mauvaise Definition de Boite')
+      endcase
+      oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+      domdef, bte
+   ENDIF 
+;-------------------------------------------------------------
+;   Boucle de lecture des fichiers 
+;-------------------------------------------------------------
+   case fictyp of
+      'DA' : dec = 0.
+      'MO' : dec = 14.
+      'SE' : dec = 14.
+      'AN' : dec = 182.
+   endcase
+;initialisation des variables associees au tps
+   time = lonarr(jptmax)
+   jpt = 0
+   vdat = date1
+; debut de la boucle
+   while (vdat le date2) do begin
+;---------------------------------------------------------------
+; lecture du fichier a la date vdat (vairmer)
+;---------------------------------------------------------------
+      tab = lec(nomchamp,vdat,nomexp,ANOM=anom,EXPANOM=expanom)
+;---------------------------------------------------------------
+; attribution du mask et des tableaux de longitude et latitude...
+;---------------------------------------------------------------
+      if jpt EQ 0 THEN grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery, dernierz
+;---------------------------------------------------------------
+      if (n_elements(tab) eq 1 and tab[0] eq -1) then begin
+         goto, incrdate
+      endif else begin
+         jpt = jpt + 1
+         if (jpt gt jptmax) then return, report('lect : augmenter jptmax')
+      endelse
+;--------------------------------------------------------
+; Moyenne du champs tab
+;--------------------------------------------------------
+      IF n_params() EQ 5 THEN if direc NE '' then BEGIN 
+         if nx EQ 1 OR ny EQ 1 OR nz EQ 1 THEN BEGIN 
+            if string(format='(a2)',nomchamp) EQ 'SO' then tab = reform(tab, nx, ny, /over) $
+            ELSE tab = reform(tab, nx, ny, nz, /over)
+         ENDIF 
+         tab = moyenne(tab,direc)
+      endif
+      if (jpt eq 1) then begin
+         ttab = tab
+      endif else BEGIN 
+         ttab = colle(ttab, tab, (size(tab))[0]+1 )
+      endelse
+      time[jpt-1] = juldate(vdat)+dec
+;--------------------------------------------------------
+; Incrementation de la date
+;--------------------------------------------------------
+      incrdate :
+      case fictyp of
+         'DA' : caldat,juldate(vdat)+1,month,day,year
+         'MO' : begin
+            caldat,julday(month,1,year)+jourdsmois(),month,day,year
+            day=0
+         end
+         'SE' : month=month+1
+         'AN' : year=year+1
+      endcase
+;------------------------------------------------------------
+;   Fin de boucle de lecture des fichiers 
+;------------------------------------------------------------
+      vdat=long(10000)*year+long(100)*month+day
+   ENDWHILE
+   if ttab[0] EQ -1 then return, report('Aucun fichier n''a ete lu!')
+;------------------------------------------------------------
+;   Ecriture du fichier
+;------------------------------------------------------------
+   get_lun, numlec
+   openw, numlec, ficname, /get_lun, /swap_if_little_endian
+   taille = size(ttab)
+   writeu, numlec, long(jpt),long(taille[0])
+   case taille(0) of 
+      1 : writeu, numlec,long(taille[1])
+      2 : writeu, numlec,long(taille[1]),long(taille[2])
+      3 : writeu, numlec,long(taille[1]),long(taille[2]),long(taille[3])
+   endcase
+   writeu, numlec,long(time[0:jpt-1]), ttab
+   writeu, numlec,float([lon1, lon2, lat1, lat2, prof1, prof2])
+; ecriture info complementaire : nom du champs, de l'experience
+   writeu, numlec, strmid(varname,0,8)
+   writeu, numlec, strmid(vargrid,0,1)
+   writeu, numlec, strmid(varexp,0,3)
+;
+   close, numlec
+   free_lun, numlec
+;-------------------------------------------------------
+;if keyword_set(repeat) then begin
+;   jpt = jpt * repeat
+;   if (jpt gt jptmax) then begin
+;     print, 'lect : augmenter jptmax'
+;     goto, fini
+;   endif
+;   tabadd = ttab
+;   ti
+;endif
+;--------------------------------------------------------
+   if n_elements(oldboite) NE 0 then domdef,  oldboite
+;
+   close, /all
+;
+   IF keyword_set(key_performance) THEN print, 'temps lect', systime(1)-tempsun 
+;
+   return, ttab
+
+end
+
+
+
+
Index: tags/start/LECTURE/litchamp.pro
===================================================================
--- tags/start/LECTURE/litchamp.pro	(revision 5)
+++ tags/start/LECTURE/litchamp.pro	(revision 5)
@@ -0,0 +1,193 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:litchamp
+;
+; PURPOSE:permet de lire un simple tableau ou une structure
+; correspondant a un champ.
+; Si en entree on a :
+;   -un simple tableau, litchamp renvoie le tableau
+;   -une stucture, litchamp renvoie le premier element de la structure
+;   qui doit obligatoirement etre le champ sous forme d''un tableau.
+;   Au passage litchamp regarde les autres elements de la structure et
+;   met a jour si besoin les variables globales qui se rapportent au
+;   champ: vargrid, varname, varunit, vardate, varexp , valmask,
+;   niveau et time 
+;
+; CATEGORY:permet d''appeler plt, pltz, pltt ... avec un tableau ou une
+; structure et de mettre a jour les variables globales liees au champ. 
+;
+; CALLING SEQUENCE:res=litchamp(struct)
+;
+; INPUTS:
+;        struct: c''est soit un tableau soit une structure.
+;    Si struct est une structure, elle doit suivre les regles
+;    suivantes:
+;        -le premier element est le tableau contenant le champ.
+;        -les autres elements sont des strings qui contiennent des
+;        informations sur le champ SAUF pour l''element relatif a
+;        date. Ce dernier peut etre soit un string pour designer une date
+;        particuliere (ex: 'August 1999') ou bien un vecteur de jours
+;        juliens (d''IDL) correspondant au calendrier a associer au
+;        champ si c'est une serie temporelle.
+;        -l''ordre des elements (autre que le premier) n''a pas
+;        d''importance. 
+;        -les autres elements (autre que le premier) sont tous
+;        optionnels.
+;        -ils sont reconnus par la premiere lettre de leur nom:
+;             g  pour actualiser vargrid
+;             u  pour actualiser varunit
+;             e  pour actualiser varexp
+;             d  pour actualiser vardate
+;             n  pour actualiser varname
+;             m  pour actualiser valmask
+;             l  pour actualiser niveau (l pour level! et non pas n)
+;
+; KEYWORD PARAMETERS:
+;
+;        /GRID: activer ce mot cle si on veut que litchamp renvoie la
+;        variable associee a l''element de la structure commencant
+;        par 'g' si il existe et '' dans le cas contraire.
+;
+;        /UNIT: activer ce mot cle si on veut que litchamp renvoie la
+;        variable associee a l''element de la structure commencant
+;        par 'u' si il existe et '' dans le cas contraire.
+;
+;        /EXP: activer ce mot cle si on veut que litchamp renvoie la
+;        variable associee a l''element de la structure commencant
+;        par 'e' si il existe et '' dans le cas contraire.
+;
+;        /DATE: activer ce mot cle si on veut que litchamp renvoie la
+;        variable associee a l''element de la structure commencant
+;        par 'd' si il existe et '' dans le cas contraire.
+;
+;        /NAME: activer ce mot cle si on veut que litchamp renvoie la
+;        variable associee a l''element de la structure commencant
+;        par 'n' si il existe et '' dans le cas contraire.
+;
+;        /LEVEL: activer ce mot cle si on veut que litchamp renvoie la
+;        variable associee a l''element de la structure commencant
+;        par 'l' si il existe et -1 dans le cas contraire.
+;
+;        /MASK: activer ce mot cle si on veut que litchamp renvoie la
+;        variable associee a l''element de la structure commencant
+;        par 'm' si il existe et -1 dans le cas contraire.
+;
+; OUTPUTS:c''est le tableau qui continent le champ.
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS: actualise au besion les variables globales vargrid,
+; varname, varunit, vardate, varexp, valmask, niveau et time.
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;     
+;    IDL> print, vargrid,', ', varname,', ', varunit,', ', vardate,', ', varexp     
+;    T,  ,  , 0,  
+;    IDL> help, litchamp({a:indgen(5), u:'C', name:'toto'})   
+;    <Expression>    INT       = Array[5]
+;    IDL> print, vargrid,', ', varname,', ', varunit,', ', vardate,', ', varexp      
+;    T, toto, C, 0,  
+;    IDL> help, litchamp({a:indgen(5), da:'1999'})   
+;    <Expression>    INT       = Array[5]
+;    IDL> print, vargrid,', ', varname,', ', varunit,', ', vardate,', ', varexp     
+;    T, toto, C, 1999,  
+; 
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       28/5/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION litchamp, struct, GRID = grid, NAME = name, UNIT = unit, EXP = exp, DATE = date $
+                   , LEVEL = level, MASK = mask
+@common
+;------------------------------------------------------------
+   if size(struct, /type) ne 8 then BEGIN ; alors contour n''est pas une structure
+      if keyword_set(grid) then return, ''
+      if keyword_set(name) then return, ''
+      if keyword_set(unit) then return, ''
+      if keyword_set(exp)  then return, ''
+      if keyword_set(date)  then return, ''
+      if keyword_set(level)  then return, -1
+      if keyword_set(mask)  then return, -1
+      return,  struct           
+   ENDIF  
+;------------------------------------------------------------
+   IF n_tags(struct) EQ 1 then BEGIN ; la structure n'a qu''un element
+      if keyword_set(grid) then return, ''
+      if keyword_set(name) then return, ''
+      if keyword_set(unit) then return, ''
+      if keyword_set(exp)  then return, ''
+      if keyword_set(date)  then return, ''
+      if keyword_set(level)  then return, -1
+      if keyword_set(mask)  then return, -1
+      return,  struct.(0)
+   ENDIF  
+;------------------------------------------------------------
+   nomelements = tag_names(struct)
+   for i = 1, n_tags(struct)-1 do begin
+      case strlowcase(strmid(nomelements[i], 0, 1)) of
+         'g':BEGIN
+            if keyword_set(grid) then return, strupcase(struct.(i))
+            vargrid = strupcase(struct.(i))
+         END
+         'n':BEGIN
+            if keyword_set(name) then return, struct.(i)
+            varname = struct.(i)
+         END
+         'u':BEGIN
+            if keyword_set(unit) then return, struct.(i)
+            varunit = struct.(i)
+         END
+         'e':BEGIN
+            if keyword_set(exp) then return, struct.(i)
+            varexp = struct.(i)
+         END
+         'l':BEGIN
+            if keyword_set(level) then return, struct.(i)
+            niveau = struct.(i)
+         END
+         'm':BEGIN
+            if keyword_set(mask) then return, struct.(i)
+            valmask = struct.(i)
+         END
+         'd':BEGIN 
+            if size(struct.(i),/type) EQ 7 THEN BEGIN 
+               vardate = struct.(i)
+            ENDIF ELSE BEGIN
+               time = struct.(i)
+               jpt = n_elements(time)
+               if jpt EQ 1 then vardate =  strtrim(vairdate((struct.(i))[0]), 2)$
+               ELSE vardate =  strtrim(vairdate((struct.(i))[0]), 2)+' - ' $
+                +strtrim(vairdate((struct.(i))[jpt-1]), 2) 
+            ENDELSE
+            if keyword_set(date) then return, vardate
+         END
+         'h':BEGIN
+            computehopegrid, (struct.(i)).xaxis, (struct.(i)).yaxis $
+             , (struct.(i)).zaxis, (struct.(i)).linetype $
+             , FIRSTS = (struct.(i)).firsts, LASTS = (struct.(i)).lasts $
+             , FORTHEMASK = struct.(0), pttype = (struct.(i)).pttype
+         END
+         ELSE:BEGIN 
+            ras = report('Le nom '+nomelements[i]+' ne correspont a aucun element reconnu de la structure. cf. IDL> xhelp, ''litchamp''')
+         end
+      endcase
+   endfor
+;------------------------------------------------------------
+   if keyword_set(grid) then return, ''
+   if keyword_set(name) then return, ''
+   if keyword_set(unit) then return, ''
+   if keyword_set(exp)  then return, ''
+   if keyword_set(date)  then return, ''
+   if keyword_set(level)  then return, -1
+   if keyword_set(mask)  then return, -1
+
+   return,  struct.(0)
+end
Index: tags/start/LECTURE/ncdf_lec.pro
===================================================================
--- tags/start/LECTURE/ncdf_lec.pro	(revision 5)
+++ tags/start/LECTURE/ncdf_lec.pro	(revision 5)
@@ -0,0 +1,146 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:ncdflec
+;
+; PURPOSE:donne des infos sur un fichier netcdf et permet de recupere
+; les variables qui y sont ecrites 
+;
+; CATEGORY:lecture de fichiers netcdf
+;
+; CALLING SEQUENCE: res=ncdflec('nom_de _fichier')
+;
+; INPUTS:nom_de _fichier:nom d'un fichier net cdf situe ds e repertoire
+; stipule par iodir
+;
+; KEYWORD PARAMETERS:
+;
+;	ATT: 'global' ou au nom d'une variable. permet de voir tous les
+; attributs rattaches a une variable.
+;
+;	/DIM:donne la liste des dimensions
+;
+;	VAR:
+;       1) /var: donne la liste des variables
+;       2) var='nom de variable': ds ce cas la fonction retourne la variable
+;
+;       IODIR: string contenant le repertoire ou aller chercher le
+;       fichier a lire.
+;
+;       _EXTRA: permet de passer les mots cles definits par IDL pour
+;       les fonction NETCDF (en particulier OFFSET et COUNT ds ncdf_varget)
+;
+; OUTPUTS:-1 sauf si var='nom de variable' auquel cas la fonction retourne la variable
+;
+; REMARQUE:les noms des variables du programme sont similaires a ceux employes
+; ds le manuel IDL 'scientific data formats'
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       4/1/98
+;-
+;------------------------------------------------------------
+function ncdf_lec,nom,ATT=att,DIM=dim,VAR=var, IODIR = iodir, _extra = ex
+   res = -1
+;------------------------------------------------------------
+   if NOT keyword_set(IODIR) then iodir = ''
+   if not(keyword_set(att) or keyword_set(dim) or keyword_set(var)) then BEGIN
+      att = 1
+      dim = 1
+      var = 1
+;      commande='ncdump -c '+iodir+nom
+;      spawn,commande
+;      goto,fini
+   endif
+;------------------------------------------------------------
+; ouverture du fichier nom
+;------------------------------------------------------------
+   cdfid=ncdf_open(iodir+nom)
+;------------------------------------------------------------
+; que contient le fichier??
+;------------------------------------------------------------
+   wathinside=ncdf_inquire(cdfid)
+;   print,'dans le fichier, ',iodir+nom,', il y a:'
+   if keyword_set(dim) then begin 
+      print,'nombre de dimensions: ',strtrim(wathinside.ndims,1)
+      print,'numero de la dimension dont la valeur est infini: ',strtrim(wathinside.recdim,1)
+   endif
+   if keyword_set(var) then $
+    if size(var, /type) NE 7 then print,'nombre de variables  :',strtrim(wathinside.nvars,1)
+   if keyword_set(att) then begin
+      if strlowcase(att) ne 'global' then goto,nonglobal
+      print,'nombre de attributs globaux :',strtrim(wathinside.ngatts,1)
+   endif
+;------------------------------------------------------------
+; attributs globaux
+;------------------------------------------------------------
+   if keyword_set(att) then begin
+      print, '----------------------------'
+      print,'ATTRIBUTS GLOBAUX'
+      for attiq=0,wathinside.ngatts-1 do begin
+         name=ncdf_attname(cdfid,attiq,/global) ;nom de l''atribut
+         ncdf_attget,cdfid,name,value,/global ;valeur de l''atribut
+         print,name,': ',string(value)
+      endfor
+   endif
+nonglobal:
+;------------------------------------------------------------
+; affichage des differentes dimensions
+;------------------------------------------------------------
+   if keyword_set(dim) then begin 
+      print, '----------------------------'
+      print,'DIMENSIONS'
+   endif
+   nomdim   =strarr(wathinside.ndims)
+   tailledim=lonarr(wathinside.ndims)
+   for dimiq=0,wathinside.ndims-1 do begin
+      ncdf_diminq,cdfid,dimiq,name,value ; nom et valeur de la dimension
+      nomdim[dimiq]=name
+      tailledim[dimiq]=value
+      if keyword_set(dim) then begin 
+         print,'dimension numero ',strtrim(dimiq,1),', nom: ',nomdim[dimiq] $
+          ,', valeur: ' ,strtrim(tailledim[dimiq],1)
+      endif
+   endfor
+;------------------------------------------------------------
+; affichage des differentes variables
+;------------------------------------------------------------
+;
+   if keyword_set(att) or keyword_set(var) then begin 
+; vature de var ? string ou 1
+   help, var, output = nature
+   if (strpos(nature, 'STRING'))[0] NE -1 then nature = 'string' ELSE nature = '1'
+; si on doit juste lire la variable
+   if nature EQ 'string' then begin
+      ncdf_varget, cdfid, var, res, _extra = ex
+      GOTO, sortie
+   ENDIF 
+; si c''est pour avoir des renseignements
+   if not keyword_set(att) then att='rien'
+      print, '----------------------------'
+      for varid=0,wathinside.nvars-1 do begin
+         varcontent=ncdf_varinq(cdfid,varid) ; que contient la variable
+         if strlowcase(att) eq strlowcase(varcontent.name) or keyword_set(var) $
+          then begin
+            print,'variable numero: ',strtrim(varid,1),', nom:',varcontent.name $
+             ,', type:' ,varcontent.datatype,', dimensions:',nomdim(varcontent.dim)
+            if strlowcase(att) eq strlowcase(varcontent.name) then begin
+               for attiq=0,varcontent.natts-1 do begin
+                  name=ncdf_attname(cdfid,varid,attiq)
+                  ncdf_attget,cdfid,varid,name,value
+                  print,'     ',strtrim(attiq),' ',name,': ',strtrim(string(value),1)
+               endfor
+               goto, sortie
+            endif
+         endif
+      endfor
+   endif
+;------------------------------------------------------------
+sortie:
+   ncdf_close,cdfid
+;------------------------------------------------------------
+;------------------------------------------------------------
+fini:
+
+   return, res
+end
Index: tags/start/LECTURE/ncdf_timeget.pro
===================================================================
--- tags/start/LECTURE/ncdf_timeget.pro	(revision 5)
+++ tags/start/LECTURE/ncdf_timeget.pro	(revision 5)
@@ -0,0 +1,87 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: ncdf_timeget
+;
+; PURPOSE: get the time axis fom a netcdf_file and transforms it in
+; julian days of UDL.
+;
+; CATEGORY: reading ncdf_file
+;
+; CALLING SEQUENCE: time = ncdf_timeget(cdfid, timeid)
+; 
+; INPUTS:cdfid: the ID of the ncdf_file, which is already open
+;        timeid: the ID or the name of the variable which describe the calendar
+;
+; KEYWORD PARAMETERS:
+;        /YYYYMMDD: active to obtain the date as a longinterger with
+;        the format YearYearYearYearMonthMonthDayDay
+;
+;        the keyword parameters of ncdf_varget
+;
+; OUTPUTS:a long array of IDL julian days
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS: the calendar variable must have the units attribute
+; folowing the syntaxe bellow:
+;
+; time_counter:units = "seconds since 0001-01-01 00:00:00" ;
+; time_counter:units = "hours since 0001-01-01 00:00:00" ;
+; time_counter:units = "days since 1979-01-01 00:00:00" ;
+; time_counter:units = "months since 1979-01-01 00:00:00" ;
+; time_counter:units = "years since 1979-01-01 00:00:00" ;
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      June 2001
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION ncdf_timeget, cdfid, timeid, YYYYMMDD = yyyymmdd, _extra = ex
+
+   insidetime=ncdf_varinq(cdfid,timeid)
+   if insidetime.natts NE 0 then begin
+      attnames = strarr(insidetime.natts)
+      for attiq=0,insidetime.natts-1 do attnames[attiq]=strlowcase(ncdf_attname(cdfid,timeid,attiq))
+   ENDIF ELSE return, report('the variable '+timeid+' must have the units attribut')
+; reading of the time axis
+   ncdf_varget, cdfid, timeid, time, _extra = ex
+;
+; time_counter:units = "seconds since 0001-01-01 00:00:00" ;
+; time_counter:units = "hours since 0001-01-01 00:00:00" ;
+; time_counter:units = "days since 1979-01-01 00:00:00" ;
+; time_counter:units = "months since 1979-01-01 00:00:00" ;
+; time_counter:units = "years since 1979-01-01 00:00:00" ;
+;
+   if (where(attnames EQ 'units'))[0] NE -1 then begin
+      ncdf_attget,cdfid,timeid,'units',value
+      value = strtrim(strcompress(string(value)), 2)
+      words = str_sep(value, ' ')
+      unite = words[0]
+      start = str_sep(words[2], '-')
+      case strlowcase(unite) of
+         'seconds':time = julday(start[1], start[2], start[0])+time/(long(24)*3600)
+         'hours':time = julday(start[1], start[2], start[0])+time/long(24)
+         'days':time = julday(start[1], start[2], start[0])+time
+         'months':BEGIN 
+            for t = 0, n_elements(time)-1  do begin
+               time[t] = julday(start[1]+time[t], start[2], start[0])
+            endfor
+         END
+         'years':BEGIN
+            for t = 0, n_elements(time)-1  do begin
+               time[t] = julday(start[1], start[2], start[0]+time[t])
+            endfor
+         END
+         ELSE:return, report('bad syntax of the units attribut of the variable '+timeid)
+      ENDCASE
+   ENDIF ELSE return, report('the variable '+timeid+' must have the units attribut')
+   if keyword_set(yyyymmdd) then time = vairdate(time)
+   return, time
+end
Index: tags/start/LECTURE/nlec.pro
===================================================================
--- tags/start/LECTURE/nlec.pro	(revision 5)
+++ tags/start/LECTURE/nlec.pro	(revision 5)
@@ -0,0 +1,286 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:nlec
+;
+; PURPOSE:lit les fichiers Net-Cdf de l'experience TOTEM/ECMWF qui sont sur
+; maia: /u/rech/eee/reee217/TOTEM/REF/OUTPUTS
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:
+;
+; INPUTS:nom:nom du tableau contenant le champ que l'on veut (le
+; trouver avec ncdflec,fichier,/var
+;
+;	arguments optionnels:
+;	
+;	date:nombres de 6 ou 8 chiffres (anneemoisjour, par ex:19980507)
+;	nom_experience:trois lettres designant le nom de l'experience
+;
+;
+; KEYWORD PARAMETERS:
+;
+;       BOITE: boite sur laquelle integrer (par defaut tt le domaine)
+;
+;	DATE2:stipule la seconde date pour extraire une serie temporelle
+;
+;       DIREC: 'x' 'y' 'z' 'xy' 'xz' 'yz' 'xyz' directions selon lesquelles
+;             effectuer les moyennes (si rien n'est donne on n'effectue pas de moyenne)
+;
+;	GRILLE:impose la grille a laquelle est rapporte le champ. rq permet
+; d'aller plus vite ds la lecture 
+;
+;	/TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro	vraidate	juldate 
+;       nlec5j          nlecserie
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			14/8/98
+;-
+;------------------------------------------------------------
+;REF.07.790101.grid.T.nc
+;REF.07.790101.grid.U.nc 
+;REF.07.790101.grid.V.nc 
+;REF.07.790101.grid.W.nc
+;------------------------------------------------------------
+;------------------------------------------------------------
+function nlec,name,debut,fin,nomexperience,BOITE=boite,DIREC=direc,GRILLE=grille,TOUT=tout $
+              , STRUCTURE = structure, SEUILMIN = seuilmin, SEUILMAX = seuilmax, NAN = nan $
+              , _EXTRA = ex
+@common
+;------------------------------------------------------------
+   tempsun = systime(1)         ; pour key_performance
+   nom=strlowcase(name)
+;------------------------------------------------------------
+; specification de la date et de l'experience
+;------------------------------------------------------------
+   case n_params() of
+      1:BEGIN 
+         year=year+1900*(year ne 0 and year ne -1 and year lt 100)
+         date = day+100*month+10000*year
+      end
+      2:BEGIN 
+         if size(debut, /tname) EQ 'STRING' then begin
+            prefix = strupcase(debut)
+            year=year+1900*(year ne 0 and year ne -1 and year lt 100)
+            date = day+100*month+10000*year
+         ENDIF ELSE BEGIN
+            date = debut
+            rien=juldate(date)
+         ENDELSE
+      end
+      3:begin
+         date = debut
+         rien=juldate(date)
+         if size(fin, /tname) EQ 'STRING' then begin
+            prefix = strupcase(fin)
+         ENDIF ELSE BEGIN
+            date2=vraidate(fin)
+            year2=date2/10000
+            month2=date2/100 - year2*100
+            day2=date2 - year2*10000 - month2*100
+         ENDELSE
+      end
+      4:BEGIN
+         date = debut
+         rien=juldate(date)
+          if size(nomexperience, /tname) EQ 'STRING' then begin
+            prefix = strupcase(nomexperience)
+            date2 = fin
+         ENDIF ELSE BEGIN
+            prefix = strupcase(fin)
+            date2 = nomexperience
+         ENDELSE
+         date2=vraidate(date2)
+         year2=date2/10000
+         month2=date2/100 - year2*100
+         day2=date2 - year2*10000 - month2*100
+      end
+   endcase
+   date = long(date)
+   if n_elements(date2) NE 0 then date2 = long(date2)
+   if n_elements(date2) NE 0 then if date2 eq date then tempvar = SIZE(TEMPORARY(date2))
+;------------------------------------------------------------
+; verification de la coherence des dates
+;------------------------------------------------------------
+   if n_elements(date2) ne 0 then begin
+      if (day    EQ 0 AND day2  NE 0) OR (month EQ 0 AND month2 NE 0) OR $
+       (year   EQ 0 AND year2 NE 0) or (day2  EQ 0 AND day    NE 0) OR $
+       (month2 EQ 0 AND month NE 0) OR (year2 EQ 0 AND year   NE 0) then $
+       return,  report('verifier la coherence des dates')
+      if date2 le date then return, report('date2 doit etre posterieure a date')
+   endif
+;------------------------------------------------------------
+; case sur le type de fichiers que l'on veut lire.
+; determination ds chaque cas de numsortie et nbretps
+;------------------------------------------------------------
+   if day NE 0 then begin       ; SORTIES A 5 JOURS
+;------------------------------------------------------------
+; numsortie
+;------------------------------------------------------------
+testjour:
+      numsortie=(1+julday(month,day,year)-julday(1,1,year))/5.
+      if numsortie ne floor(numsortie) then begin
+         if n_elements(date2) ne 0 then begin
+            caldat,julday(month,day+1,year),month,day,year
+            goto, testjour
+         endif
+         return,  -1
+      ENDIF
+      numsortie = long(numsortie)
+;------------------------------------------------------------
+; determination du nombre de pas de tps a extraire pour la serie temporelle
+; entiere: nbretps
+;------------------------------------------------------------
+      if n_elements(date2) ne 0 then begin
+         testjour2:
+         numsortie2=(1+julday(month2,day2,year2)-julday(1,1,year2))/5.
+         if numsortie2 ne floor(numsortie2) then begin
+            caldat,julday(month2,day2-1,year2),month2,day2,year2
+            goto, testjour2
+         endif
+         if year eq year2 then nbretps=numsortie2-numsortie+1 else $
+          nbretps=(73-numsortie+1)+(year2-year-1)*73+numsortie2
+         numsortie2 = long(numsortie2)
+      endif else nbretps=1
+      nbretps = long(nbretps)
+;------------------------------------------------------------
+; si on fait une serie temporelle on cherche a lire plutot un fichier
+; contenant deja une serie temporelle par contre pour une sortie
+; unique on cherche d'abord a lire un fichier contenant toutes les variables.
+;------------------------------------------------------------
+      IF n_elements(date2) ne 0 THEN BEGIN
+         serie:
+         IF n_elements(dejaserie) eq 1 then return, -1
+         datejul = 5*numsortie-1+julday(1, 1, year)
+         if n_elements(date2) ne 0 then date2jul = 5*numsortie2-1+julday(1, 1, year2) $
+         ELSE date2jul = datejul 
+         res = nlecserie(nom, datejul, date2jul,BOITE=boite,GRILLE=grille,TOUT=tout, _EXTRA = ex)
+         IF res[0] EQ -1 THEN BEGIN 
+            dejaserie = 1
+            GOTO,  passerie
+         ENDIF 
+      ENDIF ELSE BEGIN
+         passerie:
+         IF n_elements(dejapasserie) eq 1 then return, -1
+         res =   nlec5j( nom, numsortie  , nbretps,BOITE=boite,GRILLE=grille,TOUT=tout, _EXTRA = ex)
+         IF res[0] EQ -1 THEN BEGIN
+            dejapasserie = 1
+            GOTO,  serie
+         ENDIF 
+      endelse
+   ENDIF ELSE BEGIN
+      CASE 1 of
+         month NE 0 AND year NE 0:BEGIN ; SORTIES MENSUELLES
+            numsortie79 = (year-1979)*12+month
+            if n_elements(date2) ne 0 then nbretps = month2-month+1+12*(year2-year) $
+            ELSE nbretps = 1
+            res = nlecmois(nom,numsortie79,nbretps ,BOITE=boite,GRILLE=grille,TOUT=tout, _EXTRA = ex)
+         end
+         month EQ 0 AND year NE 0:BEGIN ; SORTIES ANNUELLES
+            numsortie79 = (year-1978)
+            if n_elements(date2) ne 0 then nbretps = year2-year+1 $
+            ELSE nbretps = 1
+            res = nlecan(nom,numsortie79,nbretps ,BOITE=boite,GRILLE=grille,TOUT=tout, _EXTRA = ex)
+         end
+         month NE 0 AND year EQ 0:BEGIN ; SORTIES SAISONNIERES
+            numsortie79 = month
+            if n_elements(date2) ne 0 then nbretps = month2-month+1 $
+            ELSE nbretps = 1
+            res = nlecsaison(nom,numsortie79,nbretps ,BOITE=boite,GRILLE=grille,TOUT=tout, _EXTRA = ex)
+         end
+         month EQ 0 AND year EQ 0:BEGIN ; SORTIES CLIMATOLOGIQUE
+            numsortie79 = 13
+            nbretps = 1
+            res = nlecsaison(nom,numsortie79,nbretps ,BOITE=boite,GRILLE=grille,TOUT=tout, _EXTRA = ex)
+         end
+      endcase
+   endelse
+;------------------------------------------------------------
+;  seuil
+;------------------------------------------------------------
+   if n_elements(seuilmin) NE 0 then BEGIN
+      if n_elements(valmask) EQ 0 then valmask = 1e20
+      terre = where(res GT valmask/10.)
+      res = seuilmin > res
+      if terre[0] NE -1 then res[terre] = valmask
+      undefine, terre
+   endif
+   if n_elements(seuilmax) NE 0 then begin
+      if n_elements(valmask) EQ 0 then valmask = 1e20
+      terre = where(res GT valmask/10.)
+      res = res < seuilmax
+      if terre[0] NE -1 then res[terre] = valmask
+      undefine, terre
+   endif
+;------------------------------------------------------------
+; points a metre a nan
+;------------------------------------------------------------
+   if n_elements(nan) NE 0 then BEGIN
+      if n_elements(valmask) EQ 0 then valmask = 1e20
+      if abs(valmask) LT 1e6 then terre = where(abs(res) GT abs(valmask)/10.) $
+      ELSE terre = where(res EQ valmask)
+      if abs(nan) LT 1e6 then notan = where(res EQ nan) $
+      ELSE notan = where(abs(res) GT abs(nan))
+      if notan[0] NE -1 then res[notan] = !values.f_nan
+      notan = notan[0] NE -1
+      if terre[0] NE -1 then res[terre] = valmask
+      undefine, terre
+   endif
+;------------------------------------------------------------
+; ajustement de niveau pour les tableau 2d simples
+;------------------------------------------------------------
+   if jpt EQ 1 then begin
+      taille = size(res)
+      IF taille[0] EQ 2 THEN niveau = 1
+   endif
+;------------------------------------------------------------
+; moyenne eventuelle
+;------------------------------------------------------------
+   IF keyword_set(direc) THEN BEGIN 
+      IF jpt EQ 1 THEN res = moyenne(res,direc,BOITE=boite, nan = notan) $
+      ELSE res = grossemoyenne(res,direc,BOITE=boite, nan = notan)
+   ENDIF 
+;------------------------------------------------------------
+; mise en placer des parametres pour le trace...
+;------------------------------------------------------------
+;   if keyword_set(boite) then legende_pltt = boite ELSE legende_pltt = [lon1, lon2, lat1, lat2]
+;------------------------------------------------------------
+;   IF n_elements(res) NE 1 THEN res = reform(res,/over)
+   IF NOT keyword_set(direc) THEN domdef, lon1, lon2, lat1, lat2, prof1, prof2, _extra = ex, grille = vargrid $
+   ELSE if direc eq 't' then domdef, lon1, lon2, lat1, lat2, prof1, prof2, _extra = ex, grille = vargrid
+;------------------------------------------------------------
+   if keyword_set(structure) then res = {tab:res, grille:vargrid, unite:varunit, experience:varexp, nom:varname}
+;------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps nlec', systime(1)-tempsun 
+   time = time-3l
+   return,res
+;------------------------------------------------------------
+;------------------------------------------------------------
+end
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: tags/start/LECTURE/nlec5j.pro
===================================================================
--- tags/start/LECTURE/nlec5j.pro	(revision 5)
+++ tags/start/LECTURE/nlec5j.pro	(revision 5)
@@ -0,0 +1,191 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:NLEC5J
+;
+; PURPOSE:lit les fichiers Net-Cdf de l'experience TOTEM/ECMWF qui
+; contiennent les sorties a 5j regroupees par type de grille par
+; paquets de 6 mois.
+; sur maia: /u/rech/eee/reee217/TOTEM/REF/OUTPUTS 
+;
+; CATEGORY:lecture de NETCDF
+;
+; CALLING SEQUENCE: res=nlec5j( nom, numsortie, nbretps)
+;
+; INPUTS:
+;       nom:nom du tableau contenant le champ que l'on veut (le
+; trouver avec ncdflec,fichier,/var
+;       numsortie:le numero du pas de temps que l'on veut sortir du
+; fichier (compte a partir de 1) a partir de year
+;       nbretps:nombre de pas de temps a extraire
+;
+; KEYWORD PARAMETERS:
+;
+;       BOITE: boite sur laquelle integrer (par defaut tt le domaine)
+;
+;	GRILLE:impose la grille a laquelle est rapporte le champ. rq permet
+; d'aller plus vite ds la lecture 
+;
+;	/TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef
+;
+; OUTPUTS: res=tableau 2d (qd on ne demande pas de serie) ou 3d ou 4d ds le cas dune serie 
+; 
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:appele par nlec
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+function nlec5j, nom, numsortie, nbretps,BOITE = boite, GRILLE=grille,TOUT=tout, _EXTRA = ex
+@common
+;------------------------------------------------------------
+   res=-1
+   anneedepart=1979
+;------------------------------------------------------------
+; gestion du nom du fichier
+;------------------------------------------------------------
+   if numsortie le 36 then BEGIN 
+      mmdd='0101'
+      numsort=numsortie
+   ENDIF  else BEGIN
+      if leapyr(year) then mmdd='0629' else mmdd='0630'
+      numsort=numsortie-36
+   endelse
+   case 1 of
+      year lt 10:                 s_year ='0'+string(format='(i1)',year)
+      year lt 100 and year ge 10 :s_year =    string(format='(i2)',year)
+      year ge 100:                s_year =    string(format='(i2)',(year-1900)*(year LT 2000))
+   endcase
+   numfich=(year-anneedepart)*2+7+(mmdd ne '0101')
+   s_date=s_year+mmdd
+   if numfich lt 10 then numfich='0'+string(format='(i1)',numfich) $
+   else numfich=    string(format='(i2)',numfich)
+;------------------------------------------------------------
+; gestion du nom de la grille en testant les differentes possibilites
+; et ouverture du fichier
+;------------------------------------------------------------
+   if keyword_set(grille) then begin
+      vargrid=grille
+      nomfich=prefix+'.'+numfich+'.'+s_date+'.grid.'+vargrid+'.nc'
+      cdfid=ncdf_open(iodir+nomfich)
+      varcontient=ncdf_varinq(cdfid,nom)
+   endif else begin
+; liste des fichiers pouvant convenir
+      quelsfichiers = findfile(iodir+prefix+'.'+numfich+'.'+s_date+'.grid.*')
+      IF quelsfichiers[0] EQ '' THEN BEGIN ; liste vide
+         if keyword_set(bavard) then $
+          ras = report('LES FICHIERS: '+iodir+prefix+'.'+numfich+'.'+s_date+'.grid... n''existe pas.')
+         return,  -1
+      ENDIF 
+      for i=0,n_elements(quelsfichiers)-1 do begin
+         cdfid=ncdf_open(quelsfichiers[i])
+         contient=ncdf_inquire(cdfid)
+         for varid=0,contient.nvars-1 do BEGIN ; ds les fichiers existants on
+            varcontient=ncdf_varinq(cdfid,varid) ; cherche le nom des variables
+            if varcontient.name eq nom then BEGIN
+               vargrid=strmid(quelsfichiers[i],strpos(quelsfichiers[i],'grid')+5,1) ;nom de grille
+               goto, grilletrouvee
+            ENDIF 
+         endfor
+         ncdf_close,cdfid
+      endfor
+      if keyword_set(bavard) then $
+       ras = report('La variable '+nom+' n''existe pas ds les fichiers'+iodir+prefix+'.'+numfich+'.'+s_date+'.grid...')
+      return,  -1
+   endelse
+grilletrouvee:
+;------------------------------------------------------------
+; lecture de certains attributs
+;------------------------------------------------------------
+   ncdf_attget,cdfid,nom,'title',value
+   varname=string(value)
+   ncdf_attget,cdfid,nom,'units',value
+   varunit=string(value)
+   if rstrpos(varname,'(') eq -1 then varname=varname+' ('+varunit+')'
+   if month lt 10 then s_month='0'+string(format='(i1)',month) $
+   else s_month=    string(format='(i2)',month)
+   if day lt 10 then s_day='0'+string(format='(i1)',day) $
+   else s_day=    string(format='(i2)',day)
+   vardate=s_year+s_month+s_day
+   ncdf_attget,cdfid,'file_name',value,/global
+   varexp=string(value[0:(where(value EQ (byte('.'))[0]))[0]-1])
+;------------------------------------------------------------
+;------------------------------------------------------------
+; extraction du tableau qui nous interesse
+;------------------------------------------------------------
+;------------------------------------------------------------
+; determination du domaine geographique
+;------------------------------------------------------------
+   if keyword_set(tout) then begin
+      nx=jpi
+      ny=jpj
+      nz=jpk
+      premierx = 0
+      premiery = 0
+      premierz = 0
+   endif else BEGIN 
+;------------------------------------------------------------
+; redefinition eventuelle du domaine ajuste a boite (a 6 elements)
+; + on recupere la dim du no9uveau domaine
+;------------------------------------------------------------
+      if keyword_set(boite) then BEGIN 
+         Case  N_Elements(Boite) Of
+            1:Domdef, lon1, lon2, lat1, lat2, 0.,boite[0],GRILLE=vargrid, _EXTRA = ex
+            2:Domdef, lon1, lon2, lat1, lat2, boite[0],boite[1],GRILLE=vargrid, _EXTRA = ex
+            4:Domdef, [Boite, prof1, prof2],GRILLE=vargrid, _EXTRA = ex
+            5:Domdef, [Boite[0:3], 0, Boite[4]],GRILLE=vargrid, _EXTRA = ex
+            6:Domdef, Boite,GRILLE=vargrid, _EXTRA = ex
+            Else: return, report('Mauvaise Definition de Boite')
+         endcase
+      ENDIF
+      grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery, premierz, dernierx, derniery, dernierz
+   ENDELSE 
+;------------------------------------------------------------
+; determination du nombre de pas de tps a extraire ds ce fichier
+;------------------------------------------------------------
+   if nbretps gt 36+1*(mmdd ne '0101')-numsort+1 then nt=36+1*(mmdd ne '0101')-numsort+1 $
+   else nt=nbretps
+;------------------------------------------------------------
+;
+   if varcontient.ndims eq 3 then $
+    ncdf_varget,cdfid,nom,res,offset=[premierx,premiery,numsort-1],count=[nx,ny,nt] $
+   else $
+    ncdf_varget,cdfid,nom,res,offset=[premierx,premiery, premierz,numsort-1],count=[nx,ny,nz,nt]
+;------------------------------------------------------------
+; rappel en boucle de nlec si il faut ouvrir de nouveaux fichiers
+; pour constituer la serie temporelle
+;------------------------------------------------------------
+   if nbretps gt 36+1*(mmdd ne '0101')-numsort+1 then begin
+      if mmdd ne '0101' then year = year+1
+      if varcontient.ndims eq 3 then $
+       res = [[[res]] $
+              ,[[nlec5j(nom,1+36*(mmdd eq '0101'),nbretps-nt,tout=tout,GRILLE=vargrid,BOITE=boite)]]] $
+      ELSE BEGIN 
+       res=[res[*] $
+            ,(nlec5j(nom,1+36*(mmdd eq '0101'),nbretps-nt,tout=tout,GRILLE=vargrid, BOITE=boite))[*]]
+       res=reform(res,nx,ny,nz,nbretps, /over) 
+    ENDELSE 
+      ncdf_varget,cdfid,'time_counter',temps, offset = [numsort-1],count=[nt]
+      time = [long(temps)+julday(1, 5, 1979), time]
+      jpt=nt+jpt
+   endif else BEGIN
+      ncdf_varget,cdfid,'time_counter',temps, offset = [numsort-1],count=[nt]
+      time = long(temps)+julday(1, 5, 1979)
+      jpt=nt
+   endelse
+;------------------------------------------------------------
+   ncdf_close,cdfid
+   return,res
+;------------------------------------------------------------
+;------------------------------------------------------------
+end
Index: tags/start/LECTURE/nlecan.pro
===================================================================
--- tags/start/LECTURE/nlecan.pro	(revision 5)
+++ tags/start/LECTURE/nlecan.pro	(revision 5)
@@ -0,0 +1,154 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:NLECAN
+;
+; PURPOSE:lit les moyennes annuelles
+; sur maia: /u/rech/eee/reee217/TOTEM/REF/OUTPUTS 
+;
+; CATEGORY:lecture de NETCDF
+;
+; CALLING SEQUENCE:res=nlecan(nom, numsortie79, nbretps)
+;
+; INPUTS:
+;       nom:nom du tableau contenant le champ que l'on veut (le
+; trouver avec ncdflec,fichier,/var
+;       numsortie79:le numero du pas de temps que l'on veut sortir du
+; fichier (compte a partir de 1) a partir de 79
+;       nbretps:nombre de pas de temps a extraire
+;
+; KEYWORD PARAMETERS:
+;
+;       BOITE: boite sur laquelle integrer (par defaut tt le domaine)
+;
+;	GRILLE:impose la grille a laquelle est rapporte le champ. rq permet
+; d'aller plus vite ds la lecture 
+;
+;	/TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef
+;
+; OUTPUTS: res=tableau 2d (qd la serie ne fait que 1 pas de temps) ou
+; 3d (valable ds 1 premier tps que pour les tableaux 2d)
+; 
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:appele par nlec
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;REF.moyenne.annuelle.grid.T.nc
+;------------------------------------------------------------
+function nlecan, nom, numsortie79, nbretps,BOITE = boite,GRILLE=grille,TOUT=tout, _EXTRA = ex
+@common
+;------------------------------------------------------------
+;------------------------------------------------------------
+   res=-1
+   anneedepart=1979
+;------------------------------------------------------------
+; gestion du nom de la grille en testant les differentes possibilites
+; et ouverture du fichier
+;------------------------------------------------------------
+   if keyword_set(grille) then begin
+      vargrid=grille
+      nomfich=prefix+'.moyenne.annuelle.grid.'+vargrid+'.nc'
+      cdfid=ncdf_open(iodir+nomfich)
+      varcontient=ncdf_varinq(cdfid,nom)
+   endif else begin
+; liste des fichiers pouvant convenir
+      quelsfichiers = findfile(iodir+prefix+'.moyenne.annuelle.grid*')
+      IF quelsfichiers[0] EQ '' THEN $ ; liste vide
+         return,  report('LES FICHIERS: '+iodir+prefix+'.moyenne.annuelle.grid... n''existe pas.')
+      for i=0,n_elements(quelsfichiers)-1 do begin
+         cdfid=ncdf_open(quelsfichiers[i])
+         contient=ncdf_inquire(cdfid)
+         for varid=0,contient.nvars-1 do BEGIN   ; ds les fichiers existants on
+            varcontient=ncdf_varinq(cdfid,varid) ; cherche le nom des variables
+            if varcontient.name eq nom then BEGIN
+               vargrid=strmid(quelsfichiers[i],strpos(quelsfichiers[i],'grid')+5,1) ;nom de grille
+               goto, grilletrouvee
+            ENDIF 
+         endfor
+         ncdf_close,cdfid
+      endfor
+      return, report('La variable '+nom+' n''existe pas ds les fichiers'+iodir+prefix+'.moyenne.annuelle.grid...')
+   endelse
+grilletrouvee:
+;------------------------------------------------------------
+; lecture de certains attributs et de l'axe des temps
+;------------------------------------------------------------
+   ncdf_attget,cdfid,nom,'title',value
+   varname=string(value)
+   ncdf_attget,cdfid,nom,'units',value
+   varunit=string(value)
+   if rstrpos(varname,'(') eq -1 then varname=varname+' ('+varunit+')'
+   varexp=prefix
+;------------------------------------------------------------
+; lecture de l'axe des temps
+;------------------------------------------------------------
+   ncdf_varget,cdfid,'time_counter',time, offset = [numsortie79-1],count=[nbretps]
+   time = long(time)+julday(12, 31, 1978)
+   jpt=nbretps
+   IF jpt EQ 1 THEN BEGIN
+      caldat, time[0], month, day, year
+      case 1 of
+         year lt 10:                 s_year ='0'+string(format='(i1)',year)
+         year lt 100 and year ge 10 :s_year =    string(format='(i2)',year)
+         year ge 100:                s_year =    string(format='(i2)',year-1900)
+      endcase
+      vardate='annee: '+s_year
+   endif
+;------------------------------------------------------------
+;------------------------------------------------------------
+; extraction du tableau qui nous interesse
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; determination du domaine geographique
+;------------------------------------------------------------
+   if keyword_set(tout) then begin
+      nx=jpi
+      ny=jpj
+      nz=jpk
+      glam=[1]
+      gphi=[1]
+      gdep=[1]
+      premierx = 0
+      premiery = 0
+      premierz = 0
+   endif else BEGIN 
+;------------------------------------------------------------
+; redefinition eventuelle du domaine ajuste a boite (a 6 elements)
+; + on recupere la dim du no9uveau domaine
+;------------------------------------------------------------
+      if keyword_set(boite) then BEGIN 
+         Case N_Elements(Boite) Of
+            1:Domdef, lon1, lon2, lat1, lat2, 0.,boite[0],GRILLE=vargrid, _EXTRA = ex
+            2:Domdef, lon1, lon2, lat1, lat2, boite[0],boite[1],GRILLE=vargrid, _EXTRA = ex
+            4:Domdef, [Boite,prof1, prof2],GRILLE=vargrid, _EXTRA = ex
+            5:Domdef, [Boite[0:3], 0, Boite[4]],GRILLE=vargrid, _EXTRA = ex
+            6:Domdef, Boite,GRILLE=vargrid, _EXTRA = ex
+            Else:return, report('Mauvaise Definition de Boite')
+         endcase
+      ENDIF
+      grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery, premierz
+   ENDELSE 
+;------------------------------------------------------------
+   if varcontient.ndims eq 3 then $
+    ncdf_varget,cdfid,nom,res,offset=[premierx,premiery,numsortie79-1] $
+    ,count=[nx,ny,nbretps] else $
+    ncdf_varget,cdfid,nom,res,offset=[premierx,premiery, premierz,numsortie79-1] $
+    ,count=[nx,ny,nz,nbretps]
+;------------------------------------------------------------
+   ncdf_close,cdfid
+   return,res
+;------------------------------------------------------------
+;------------------------------------------------------------
+end
Index: tags/start/LECTURE/nlecmois.pro
===================================================================
--- tags/start/LECTURE/nlecmois.pro	(revision 5)
+++ tags/start/LECTURE/nlecmois.pro	(revision 5)
@@ -0,0 +1,165 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:nlecmois.pro
+;
+;
+; PURPOSE:lit les fichiers Net-Cdf  de moyenne mensuel  de
+; l'experience TOTEM/ECMWF qui sont sur
+; maia: /u/rech/eee/reee217/TOTEM/REF/OUTPUTS
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:
+;
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+;       BOITE: boite sur laquelle integrer (par defaut tt le domaine)
+;
+;	GRILLE:impose la grille a laquelle est rapporte le champ. rq permet
+; d'aller plus vite ds la lecture 
+;
+;	/TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;REF.moyenne.mensuelle.79-81.grid.T.nc
+;------------------------------------------------------------
+function nlecmois,nom,numsortie79,nbretps ,BOITE=boite,GRILLE=grille,TOUT=tout, _EXTRA = ex
+@common
+;------------------------------------------------------------
+   res =-1
+;------------------------------------------------------------
+; annee du nom du 1er fichier
+;------------------------------------------------------------
+   annee = floor(floor((numsortie79-1)/12.)/3.)*3+79
+;------------------------------------------------------------
+; gestion du nom de la grille en testant les differentes possibilites
+; et ouverture du fichier
+;------------------------------------------------------------
+   if keyword_set(grille) then begin
+      vargrid=grille
+      nomfich=prefix+'.moyenne.mensuelle.'+strtrim(annee, 1)+'-'+strtrim(annee+2, 1)+'.grid.'+vargrid+'.nc'
+      cdfid=ncdf_open(iodir+nomfich)
+      varcontient=ncdf_varinq(cdfid,nom)
+   endif else begin
+; liste des fichiers pouvant convenir
+      quelsfichiers = findfile(iodir+prefix+'.moyenne.mensuelle.'+strtrim(annee, 1)+'-'+strtrim(annee+2, 1)+'.grid.*')
+      IF quelsfichiers[0] EQ '' THEN $ ; liste vide
+         return, report('LES FICHIERS: '+iodir+prefix+'.moyenne.mensuelle.'+strtrim(annee, 1)+'-'+strtrim(annee+2, 1)+'.grid... n''existe pas.')
+      for i=0,n_elements(quelsfichiers)-1 do begin
+         cdfid=ncdf_open(quelsfichiers[i])
+         contient=ncdf_inquire(cdfid)
+         for varid=0,contient.nvars-1 do BEGIN ; ds les fichiers existants on
+            varcontient=ncdf_varinq(cdfid,varid) ; cherche le nom des variables
+            if varcontient.name eq nom then BEGIN
+               vargrid=strmid(quelsfichiers[i],strpos(quelsfichiers[i],'grid')+5,1) ;nom de grille
+               goto, grilletrouvee
+            ENDIF 
+         endfor
+         ncdf_close,cdfid
+      endfor
+      return, report('La variable '+nom+' n''existe pas ds les fichiers'+iodir+prefix+'.moyenne.mensuelle.'+strtrim(annee, 1)+'-'+strtrim(annee+2, 1)+'grid...')
+   endelse
+grilletrouvee:
+;------------------------------------------------------------
+; lecture de certains attributs et de l'axe des temps
+;------------------------------------------------------------
+   ncdf_attget,cdfid,nom,'title',value
+   varname=string(value)
+   ncdf_attget,cdfid,nom,'units',value
+   varunit=string(value)
+   if rstrpos(varname,'(') eq -1 then varname=varname+' ('+varunit+')'
+   varexp=prefix
+;------------------------------------------------------------
+; determination du domaine geographique
+;------------------------------------------------------------
+   if keyword_set(tout) then begin
+      nx=jpi
+      ny=jpj
+      nz=jpk
+      premierx=0
+      premiery=0
+      premierz=0
+   endif else BEGIN 
+;------------------------------------------------------------
+; redefinition eventuelle du domaine ajuste a boite (a 6 elements)
+; + on recupere la dim du no9uveau domaine
+;------------------------------------------------------------
+      if keyword_set(boite) then BEGIN 
+         Case N_Elements(Boite) Of
+            1:Domdef, lon1, lon2, lat1, lat2, 0.,boite[0],GRILLE=vargrid, _EXTRA = ex
+            2:Domdef, lon1, lon2, lat1, lat2, boite[0],boite[1],GRILLE=vargrid, _EXTRA = ex
+            4:Domdef, [Boite, prof1, prof2],GRILLE=vargrid, _EXTRA = ex
+            5:Domdef, [Boite[0:3], 0, Boite[4]],GRILLE=vargrid, _EXTRA = ex
+            6:Domdef, Boite,GRILLE=vargrid, _EXTRA = ex
+            Else:return,  report('Mauvaise Definition de Boite')
+         endcase
+      ENDIF
+      grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery, premierz
+   ENDELSE 
+;------------------------------------------------------------
+; determination du nombre de pas de tps a extraire ds ce fichier
+;------------------------------------------------------------
+   numsortie = numsortie79-12.*(annee-79)
+   if nbretps+numsortie-1 gt 36 then nt=36-numsortie+1 $
+   else nt=nbretps
+   numsortie = numsortie79-12.*(annee-79)
+;------------------------------------------------------------
+    if varcontient.ndims eq 3 then $
+    ncdf_varget,cdfid,nom,res,offset=[premierx,premiery,numsortie-1],count=[nx,ny,nt] else $
+    ncdf_varget,cdfid,nom,res,offset=[premierx,premiery,premierz,numsortie-1],count=[nx,ny,nz,nt]
+;------------------------------------------------------------
+; rappel en boucle de nlec si il faut ouvrir de nouveaux fichiers
+; pour constituer la serie temporelle
+;------------------------------------------------------------
+   if nbretps gt 36-numsortie+1 then begin
+      if varcontient.ndims eq 3 then $
+       res = [[[res]] $
+              ,[[nlecmois(nom,numsortie79+nt,nbretps-nt,tout=tout,GRILLE=vargrid,BOITE=boite)]]] $
+      else BEGIN 
+         res=[res[*] $
+              ,(nlecmois(nom,numsortie79+nt,nbretps-nt,tout=tout,GRILLE=vargrid,BOITE=boite))[*]] 
+         
+         res=reform(res,nx,ny,nz,nbretps, /over) 
+      ENDELSE 
+      ncdf_varget,cdfid,'time_counter',temps, offset = [numsortie-1],count=[nt]
+      time = [long(temps)+julday(12, 31, 1978), time]
+      jpt=nt+jpt
+   endif else BEGIN
+      ncdf_varget,cdfid,'time_counter',temps, offset = [numsortie-1],count=[nt]
+      time = long(temps)+julday(12, 31, 1978)
+      jpt=nt
+   endelse
+;------------------------------------------------------------
+   ncdf_close,cdfid
+   IF n_elements(time) EQ 1 THEN BEGIN
+      caldat, time, m, d, y
+      if m lt 10 then m='0'+string(format='(i1)',m) $
+      else m=    string(format='(i2)',m)
+      if n_elements(langage) EQ 0 then langage = 'non definit'
+      if langage EQ 'gb' then vardate = strtrim(y, 1)+' '+string(format='(C(CMoA))',31*(m-1)) $
+      ELSE vardate = string(format='(C(CMoA))',31*(m-1))+' '+strtrim(y, 1)
+   endif
+;------------------------------------------------------------
+   return,res
+;------------------------------------------------------------
+;------------------------------------------------------------
+end
Index: tags/start/LECTURE/nlecsaison.pro
===================================================================
--- tags/start/LECTURE/nlecsaison.pro	(revision 5)
+++ tags/start/LECTURE/nlecsaison.pro	(revision 5)
@@ -0,0 +1,151 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:NLECAN
+;
+; PURPOSE:lit les moyennes annuelles
+; sur maia: /u/rech/eee/reee217/TOTEM/REF/OUTPUTS 
+;
+; CATEGORY:lecture de NETCDF
+;
+; CALLING SEQUENCE:res=nlecsaison(nom, numsortie79, nbretps)
+;
+; INPUTS:
+;       nom:nom du tableau contenant le champ que l'on veut (le
+; trouver avec ncdflec,fichier,/var
+;       numsortie79:le numero du pas de temps que l'on veut sortir du
+; fichier (compte a partir de 1) a partir de 79
+;       nbretps:nombre de pas de temps a extraire
+;
+; KEYWORD PARAMETERS:
+;
+;       BOITE: boite sur laquelle integrer (par defaut tt le domaine)
+;
+;	GRILLE:impose la grille a laquelle est rapporte le champ. rq permet
+; d'aller plus vite ds la lecture 
+;
+;	/TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef
+;
+; OUTPUTS: res=tableau 2d (qd la serie ne fait que 1 pas de temps) ou
+; 3d (valable ds 1 premier tps que pour les tableaux 2d)
+; 
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:appele par nlec
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;REF.saisonnier.climato.grid.T.nc
+;------------------------------------------------------------
+;------------------------------------------------------------
+function nlecsaison, nom, numsortie79, nbretps,BOITE = boite, GRILLE=grille,TOUT=tout, _EXTRA = ex
+@common
+;------------------------------------------------------------
+;------------------------------------------------------------
+   res=-1
+   anneedepart=1979
+;------------------------------------------------------------
+; gestion du nom de la grille en testant les differentes possibilites
+; et ouverture du fichier
+;------------------------------------------------------------
+   if keyword_set(grille) then begin
+      vargrid=grille
+      nomfich=prefix+'.saisonnier.climato.grid.'+vargrid+'.nc'
+      cdfid=ncdf_open(iodir+nomfich)
+      varcontient=ncdf_varinq(cdfid,nom)
+   endif else begin
+; liste des fichiers pouvant convenir
+      quelsfichiers = findfile(iodir+prefix+'.saisonnier.climato.grid.*')
+      IF quelsfichiers[0] EQ '' THEN $ ; liste vide
+         return, report('LES FICHIERS: '+iodir+prefix+'.saisonnier.climato.grid... n''existe pas.')
+      for i=0,n_elements(quelsfichiers)-1 do begin
+         cdfid=ncdf_open(quelsfichiers[i])
+         contient=ncdf_inquire(cdfid)
+         for varid=0,contient.nvars-1 do BEGIN   ; ds les fichiers existants on
+            varcontient=ncdf_varinq(cdfid,varid) ; cherche le nom des variables
+            if varcontient.name eq nom then BEGIN
+               vargrid=strmid(quelsfichiers[i],strpos(quelsfichiers[i],'grid')+5,1) ;nom de grille
+               goto, grilletrouvee
+            ENDIF 
+         endfor
+         ncdf_close,cdfid
+      endfor
+      return, report('La variable '+nom+' n''existe pas ds les fichiers'+iodir+prefix+'.saisonnier.climato.grid...')
+   endelse
+grilletrouvee:
+;------------------------------------------------------------
+; lecture de certains attributs et de l'axe des temps
+;------------------------------------------------------------
+   ncdf_attget,cdfid,nom,'title',value
+   varname=string(value)
+   ncdf_attget,cdfid,nom,'units',value
+   varunit=string(value)
+   if rstrpos(varname,'(') eq -1 then varname=varname+' ('+varunit+')'
+   varexp=prefix
+;------------------------------------------------------------
+; lecture de l'axe des temps
+;------------------------------------------------------------
+   ncdf_varget,cdfid,'time_counter',time, offset = [numsortie79-1],count=[nbretps]
+   time = long(time)+julday(12, 31, 1978)
+   jpt=nbretps
+   IF jpt EQ 1 THEN BEGIN
+      IF numsortie79 EQ 13 THEN vardate='CLIMATOLOGIE '+prefix $
+      ELSE begin
+         vardate='climato mensuelle '+strtrim(numsortie79,1)
+      endelse
+   endif
+;------------------------------------------------------------
+;------------------------------------------------------------
+; extraction du tableau qui nous interesse
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; determination du domaine geographique
+;------------------------------------------------------------
+   if keyword_set(tout) then begin
+      nx=jpi
+      ny=jpj
+      nz=jpk
+      glam=[1]
+      gphi=[1]
+      gdep=[1]
+      premierx = 0
+      premiery = 0
+      premierz = 0
+   endif else BEGIN 
+;------------------------------------------------------------
+; redefinition eventuelle du domaine ajuste a boite (a 6 elements)
+; + on recupere la dim du no9uveau domaine
+;------------------------------------------------------------
+      if keyword_set(boite) then BEGIN 
+         CASE N_Elements(Boite) Of
+            1:Domdef, lon1, lon2, lat1, lat2, 0.,boite[0],GRILLE=vargrid, _EXTRA = ex
+            2:Domdef, lon1, lon2, lat1, lat2, boite[0],boite[1],GRILLE=vargrid, _EXTRA = ex
+            4:Domdef, [Boite, prof1, prof2],GRILLE=vargrid, _EXTRA = ex
+            5:Domdef, [Boite[0:3], 0, Boite[4]],GRILLE=vargrid, _EXTRA = ex
+            6:Domdef, Boite,GRILLE=vargrid, _EXTRA = ex
+            Else:return, report('Mauvaise Definition de Boite')
+         endcase
+      ENDIF
+      grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz
+   ENDELSE 
+;------------------------------------------------------------
+   if varcontient.ndims eq 3 then $
+    ncdf_varget,cdfid,nom,res $
+    ,offset=[premierx,premiery,numsortie79-1],count=[nx,ny,nbretps] else $
+    ncdf_varget,cdfid,nom,res $
+    ,offset=[premierx,premiery,premierz,numsortie79-1],count=[nx,ny,nz,nbretps]
+;------------------------------------------------------------
+   ncdf_close,cdfid
+   return,res
+;------------------------------------------------------------
+;------------------------------------------------------------
+end
Index: tags/start/LECTURE/nlecserie.pro
===================================================================
--- tags/start/LECTURE/nlecserie.pro	(revision 5)
+++ tags/start/LECTURE/nlecserie.pro	(revision 5)
@@ -0,0 +1,148 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:NLECSERIE
+;
+; PURPOSE:lit les series temporelles se rapportant a une variable
+; sur maia: /u/rech/eee/reee217/TOTEM/REF/OUTPUTS 
+;
+; CATEGORY:lecture de NETCDF
+;
+; CALLING SEQUENCE:res=nlecserie(nom, date1, date2)
+;
+; INPUTS:
+;       nom:nom du tableau contenant le champ que l'on veut (le
+; trouver avec ncdflec,fichier,/var
+;
+;       date1 et date2 les dates vermairs qui delimitent la serie temporelle
+;
+; KEYWORD PARAMETERS:
+;
+;       BOITE: boite sur laquelle integrer (par defaut tt le domaine)
+;
+;	GRILLE:impose la grille a laquelle est rapporte le champ. rq permet
+; d'aller plus vite ds la lecture 
+;
+;	/TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef
+;
+; OUTPUTS: res=tableau 2d (qd la serie ne fait que 1 pas de temps) ou
+; 3d (valable ds 1 premier tps que pour les tableaux 2d)
+; 
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:appele par nlec
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;REF.sss.grid.T.nc
+;------------------------------------------------------------
+function nlecserie, nom, date1, date2,BOITE = boite, GRILLE=grille,TOUT=tout, _EXTRA = ex
+@common
+;------------------------------------------------------------
+;------------------------------------------------------------
+   res=-1
+   anneedepart=1979
+;------------------------------------------------------------
+; gestion du nom de la grille
+; et ouverture du fichier
+;------------------------------------------------------------
+; liste des fichiers pouvant convenir
+   quelsfichiers = findfile(iodir+prefix+'.'+nom+'.grid.*')
+   IF quelsfichiers[0] EQ '' THEN BEGIN ; liste vide
+;      print, 'LES FICHIERS: '+iodir+prefix+'.'+nom+'.grid... n''existe pas.'
+      return,  -1
+   ENDIF ELSE BEGIN 
+      vargrid=strmid(quelsfichiers[0],strpos(quelsfichiers[0],'grid')+5,1) ;nom de grille
+      cdfid=ncdf_open(quelsfichiers[0])
+   ENDELSE 
+;------------------------------------------------------------
+; lecture de certains attributs et de l'axe des temps
+;------------------------------------------------------------
+   ncdf_attget,cdfid,nom,'title',value
+   varname=string(value)
+   ncdf_attget,cdfid,nom,'units',value
+   varunit=string(value)
+   if rstrpos(varname,'(') eq -1 then varname=varname+' ('+varunit+')'
+   ncdf_attget,cdfid,'file_name',value,/global
+   varexp=string(value)
+   varexp=strmid(varexp, 0, strpos(varexp, '.'))
+;------------------------------------------------------------
+; lecture de l'axe des temps en entier on ja reperer la place des
+; dates debut et fin pour faire l''extraction temporelle
+;------------------------------------------------------------
+   ncdf_varget,cdfid,'time_counter',time
+   time = long(time)+julday(1, 5, 1979)
+;   debut = where(time EQ juldate(date1))
+;   fin = where(time EQ juldate(date2))
+   debut = where(time EQ date1)
+   fin = where(time EQ date2)
+   if debut[0] EQ -1 then $
+      return, report('l''axe des temps ne contient pas la date de debut '+strtrim(date1, 1))
+   if fin[0] EQ -1 then $
+      return, report('l''axe des temps ne contient pas la date de fin '+strtrim(date2, 1))
+   time = time[debut[0]:fin[0]]
+   jpt=fin[0]-debut[0]+1
+   IF jpt EQ 1 THEN BEGIN
+      caldat, time[0], month, day, year
+      case 1 of
+         year lt 10:                 s_year ='0'+string(format='(i1)',year)
+         year lt 100 and year ge 10 :s_year =    string(format='(i2)',year)
+         year ge 100:                s_year =    string(format='(i2)',year-1900)
+      endcase
+      if month lt 10 then s_month='0'+string(format='(i1)',month) $
+      else s_month=    string(format='(i2)',month)
+      if day lt 10 then s_day='0'+string(format='(i1)',day) $
+      else s_day=    string(format='(i2)',day)
+      vardate=s_year+s_month+s_day
+   endif
+;------------------------------------------------------------
+;------------------------------------------------------------
+; extraction du tableau qui nous interesse
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; determination du domaine geographique
+;------------------------------------------------------------
+   if keyword_set(tout) then begin
+      nx=jpi
+      ny=jpj
+      nz=jpk
+      premierx = 0
+      premiery = 0
+      premierz = 0
+   endif else BEGIN 
+;------------------------------------------------------------
+; redefinition eventuelle du domaine ajuste a boite (a 6 elements)
+; + on recupere la dim du no9uveau domaine
+;------------------------------------------------------------
+      if keyword_set(boite) then BEGIN 
+         Case N_Elements(Boite) Of
+            1:Domdef, lon1, lon2, lat1, lat2, 0.,boite[0],GRILLE=vargrid, _EXTRA = ex
+            2:Domdef, lon1, lon2, lat1, lat2, boite[0],boite[1],GRILLE=vargrid, _EXTRA = ex
+            4:Domdef, [Boite, prof1, prof2],GRILLE=vargrid, _EXTRA = ex
+            5:Domdef, [Boite[0:3], 0, Boite[4]],GRILLE=vargrid, _EXTRA = ex
+            6:Domdef, Boite,GRILLE=vargrid, _EXTRA = ex
+            Else:return, report('Mauvaise Definition de Boite')
+         endcase
+      ENDIF
+      grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery
+   ENDELSE
+;------------------------------------------------------------
+   ncdf_varget,cdfid,nom,res $
+    ,offset=[premierx,premiery,debut[0]] $
+    ,count=[nx,ny,fin[0]-debut[0]+1]
+;------------------------------------------------------------
+   ncdf_close,cdfid
+   return,res
+;------------------------------------------------------------
+;------------------------------------------------------------
+end
Index: tags/start/LECTURE/prepareers.pro
===================================================================
--- tags/start/LECTURE/prepareers.pro	(revision 5)
+++ tags/start/LECTURE/prepareers.pro	(revision 5)
@@ -0,0 +1,25 @@
+; @initers
+; a = a=read_ncdf('sozotaux',19920420,20000214,file='tx_ERS_19920420_20000214.nc',/nostruct)
+; ; pb a pas de temps 222 c''est le 19960722
+; b=a
+; b[*,*,222]=0.
+; b=total(b,3)/408.
+; mask=finite(b)
+;
+a = read_ncdf('sozotaux',19920420,20000214,file='tx_ERS_19920420_20000214.nc',/nostruct)
+a[where(a EQ 0.)] = 1e-5
+b = a[*,*,222]
+b[where(b GE 10)] = !values.f_nan
+a[*,*,222] = (remplit(b,nite=2,/nan)) < 300.8
+deb = where(time GE julday(1, 1, 1993)) & deb = deb[0]
+fin = where(time lE julday(1, 1, 1997)) & fin = (reverse(fin))[0]
+print, vairdate(time[deb]), vairdate(time[fin])
+b = a[*, *, deb:fin]
+
+b = total(b, 3)/(fin-deb+1)
+b = b[*]#replicate(1, jpt)
+a = a-temporary(b)
+
+restore, 'maskind_ers.dat'
+
+projecttx, a, mask, 2.0, FILECOEF='coeffprojtx_ers_ind.dat'
Index: tags/start/LECTURE/read_ncdf.pro
===================================================================
--- tags/start/LECTURE/read_ncdf.pro	(revision 5)
+++ tags/start/LECTURE/read_ncdf.pro	(revision 5)
@@ -0,0 +1,352 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: read_ncdf
+;
+; PURPOSE:fonction de lecture pour fichier net_cdf.
+; Ce programme, est moins universel que ncdf_lec (il fait appelle au
+; variables declarees dans common.pro) mais il est du cop bcp plus
+; facile d''utilisation. Il prend en compte la declaration des
+; differents zoom qui ont ete definis (ixminmesh...premierx...) la
+; declaration de la variable key_shift... bref le resultat de
+; read_ncdf peut dorectement etre utilise dans plt...
+; C''est aussi ce programme qui est utilise par defaut dans mes
+; widgets pour la partie lecture.
+;
+; CATEGORY:lecture de fichiers NetCdf
+;
+; CALLING SEQUENCE:res = read_ncdf(name,debut[,fin])
+; 
+; INPUTS: name: un string definissant le champ a lire.
+;         debut et fin: sont relatifs a l''axe des temps. Ce peut etre
+;         - 2 dates du type yyyymmdd et ds ce cas on selectionne les
+;         dates qui sont comprisent entre ces 2 dates.
+;         - 2 indices qui definissent entre quel et quel pas de temps
+;           on doit extraire la dimension temporelle.
+;         exp: ne sert a rien!
+;
+; KEYWORD PARAMETERS: utilisables hors du contexte des widgets
+;
+;        BOITE: contient la boite sur laquelle on doit faire la
+;        lecture
+;        FILENAME: string contennant le nom du fichier
+;        IODIRECTORY: string contennant le nom du repertoire ds lequel
+;        se trouve le fichier
+;        TIMESTEP:activer pour specifier que debut et fin font
+;        reference a des indices de l''axe du temps et non pas a des
+;        dates. 
+;        TOUT: activer si on veut lire le ficher sur l''ensemble du
+;        domaine sans tenir compte du sous domaine definit par boite
+;        ou lon1,lon2,lat1,lat2,prof1,prof2.
+;        NOSTRUCT: activer si on ne veut pas que read_ncdf retourne
+;        une structure mais uniquement le tableau se rapportant au
+;        champ. 
+;
+; OUTPUTS:une stucture lisible par litchamp.pro ou un simple tableau
+; si /NOSTRUCT est active 
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:le champ doit avoir une dimension temporelle
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      15/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION read_ncdf,name,debut,fin, pour_etre_compatible, BOITE=boite, FILENAME = filename $
+             , IODIRECTORY = iodirectory, PARENTIN = parentin, TIMESTEP = timestep $
+             , TOUT = tout, NOSTRUCT = nostruct, CONT_NOFILL = CONT_NOFILL, _EXTRA = ex
+@common
+;------------------------------------------------------------
+; we find the filename.
+;------------------------------------------------------------
+; is parent a valid widget ?
+   if keyword_set(parentin) then BEGIN
+      parent = long(parentin)
+      parent = parent*widget_info(parent,/managed)
+   ENDIF
+   if n_elements(iodirectory) EQ 0 AND n_elements(iodir) NE 0 then iodirectory = iodir
+   filename = isafile(filename = filename, IODIRECTORY = iodirectory)
+;------------------------------------------------------------
+; ouverture du fichier nom
+;------------------------------------------------------------
+   if size(filename, /type) NE 7 then $
+    return, report('read_ncdf cancelled')
+   cdfid=ncdf_open(filename)
+   contient=ncdf_inquire(cdfid)
+;------------------------------------------------------------
+; we check if the variable name exists in the file.
+;------------------------------------------------------------
+   if ncdf_varid(cdfid,name) EQ -1 then $
+    return, report('variable '+name+' !C not found in the file '+filename)
+;
+   varcontient=ncdf_varinq(cdfid,name)
+;------------------------------------------------------------
+; check the time axis and the debut and fin dates
+;------------------------------------------------------------
+   if n_elements(debut) EQ 0 then begin
+      debut = 0
+      timestep = 1
+   endif
+   if keyword_set(timestep) then begin
+      premiertps = debut
+      if n_elements(fin) NE 0 then derniertps = fin ELSE derniertps = premiertps
+      jpt = derniertps-premiertps+1
+      time = lindgen(jpt)
+   ENDIF ELSE BEGIN
+      date1 = juldate(debut, /vraidate)
+      if n_elements(fin) NE 0 then date2 = juldate(fin, /vraidate) ELSE date2 = date1
+      if keyword_set(parent) then BEGIN
+         widget_control, parent, get_uvalue = top_uvalue
+         filelist = extractatt(top_uvalue,'filelist')
+         currentfile = (where(filelist EQ filename))[0]
+         time = (*(extractatt(top_uvalue, 'fileparameters'))[currentfile]).time_counter
+         premiertps = where(time EQ date1) & premiertps = premiertps[0]
+         derniertps = where(time EQ date2) & derniertps = derniertps[0]
+      ENDIF ELSE BEGIN
+; we find the infinite dimension
+         timedim = contient.recdim
+         if timedim EQ -1 then $
+          return, report('the file '+filename+' as no infinite dimension. !C Use the TIMESTEP keyword')
+; we find the FIRST time axis      
+         timeid = 0
+         repeat BEGIN           ; tant que l''on a pas trouve une variable qui n''a qu''
+                                ; une dimension: la dimension infinie
+            timecontient=ncdf_varinq(cdfid,timeid) ; que contient la variable
+            timeid = timeid+1
+         endrep until (n_elements(timecontient.dim) EQ 1 AND timecontient.dim[0] EQ contient.recdim) $
+          OR timeid EQ contient.nvars+1
+;
+         if timeid EQ contient.nvars+1 then $
+          return, report('the file '+filename+' as no time axis variable. !C Use the TIMESTEP keyword')
+; we must found the time origin of the julian calendar used in the
+; time axis. 
+; does the attribut units exist for the variable time axis?
+         timeid = timeid-1
+         if timecontient.natts EQ 0 then $
+          return, report('the variable '+timecontient.name+' has no attribut.!C Use the TIMESTEP keyword or add the attribut ''units'' to the variable')
+         attnames = strarr(timecontient.natts)
+         for attiq=0,timecontient.natts-1 do attnames[attiq]=ncdf_attname(cdfid,timeid,attiq)
+         if (where(attnames EQ 'units'))[0] EQ -1 then $
+          return, report('Attribut ''units'' not found for the variable '+timecontient.name+' !C Use the TIMESTEP keyword')
+         ncdf_attget,cdfid,timeid,'units',value
+;
+; time_counter:units = "seconds since 0001-01-01 00:00:00" ;
+; time_counter:units = "hours since 0001-01-01 00:00:00" ;
+; time_counter:units = "days since 1979-01-01 00:00:00" ;
+; time_counter:units = "months since 1979-01-01 00:00:00" ;
+; time_counter:units = "years since 1979-01-01 00:00:00" ;
+;
+; we decript the "units" attribut to find the time origin
+         value = strtrim(strcompress(string(value)), 2)
+         mots = str_sep(value, ' ')
+         unite = mots[0]
+         depart = str_sep(mots[2], '-')
+         ncdf_varget, cdfid, timeid, time
+         time = long(time)
+         case strlowcase(unite) of
+            'seconds':time = julday(depart[1], depart[2], depart[0])+time/(long(24)*3600)
+            'hours':time = julday(depart[1], depart[2], depart[0])+time/long(24)
+            'days':time = julday(depart[1], depart[2], depart[0])+time
+            'months':BEGIN 
+               for t = 0, n_elements(time)-1  do begin
+                  time[t] = julday(depart[1]+time[t], depart[2], depart[0])
+               endfor
+            END
+            'years':BEGIN
+               for t = 0, n_elements(time)-1  do begin
+                  time[t] = julday(depart[1], depart[2], depart[0]+time[t])
+               endfor
+            END
+            ELSE:return, report('The "units" attribu of the time axis must be something like: !C "seconds since 0001-01-01 ..." !C "days since 1979-01-01 ..." !C "months since 1979-01-01 ..." !C "years since 1979-01-01 ..."')
+         ENDCASE
+         premiertps = where(time GE date1) & premiertps = premiertps[0]
+         if premiertps EQ -1 THEN $
+          return, report('date 1: '+strtrim(date1, 1)+' is not found in the time axis.')
+         derniertps = where(time LE date2)
+         if derniertps[0] EQ -1 THEN $
+          return, report('the time axis as no date before date 2: '+strtrim(date2, 1))
+         derniertps = derniertps[n_elements(derniertps)-1]
+      ENDELSE
+      time = time[premiertps:derniertps]
+      jpt = derniertps-premiertps+1
+   ENDELSE
+;------------------------------------------------------------
+; nom de la grille a laquelle se rapporte le champ
+;------------------------------------------------------------
+   vargrid = strupcase(strmid(filename, strlen(filename)-9))
+   if vargrid EQ 'GRID.T.NC' OR vargrid EQ 'GRID.U.NC' $
+    OR vargrid EQ 'GRID.V.NC' OR vargrid EQ 'GRID.F.NC' $
+    OR vargrid eq 'GRID.W.NC' $
+    OR vargrid EQ 'GRID_T.NC' OR vargrid EQ 'GRID_U.NC' $
+    OR vargrid EQ 'GRID_V.NC' OR vargrid EQ 'GRID_F.NC' $
+    OR vargrid eq 'GRID_W.NC' then $
+    vargrid = strupcase(strmid(filename, strlen(filename)-4, 1)) ELSE vargrid='T'
+;---------------------------------------------------------------
+; redefinition du domaine 
+;---------------------------------------------------------------
+   if keyword_set(tout) then begin
+      nx=jpi
+      ny=jpj
+      nz=jpk
+      premierx = 0
+      premiery = 0
+      premierz = 0
+      dernierx = jpi-1
+      derniery = jpj-1
+      dernierz = jpk-1
+      case strupcase(vargrid) of
+         'T':mask = tmask
+         'U':mask = umask()
+         'V':mask = vmask()
+         'W':mask = tmask
+         'F':mask = fmask()
+      endcase
+   ENDIF ELSE BEGIN
+      if keyword_set(boite) then BEGIN 
+         oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+         Case 1 Of
+            N_Elements(Boite) Eq 1:bte=[lon1, lon2, lat1, lat2, 0.,boite[0]]
+            N_Elements(Boite) Eq 2:bte=[lon1, lon2, lat1, lat2, boite[0],boite[1]]
+            N_Elements(Boite) Eq 4:bte=[Boite, prof1, prof2]
+            N_Elements(Boite) Eq 5:bte=[Boite[0:3], 0, Boite[4]]
+            N_Elements(Boite) Eq 6:bte=Boite
+            Else: return, report('Mauvaise Definition de Boite')
+         ENDCASE
+         domdef, bte,GRILLE=['T', vargrid], _extra = ex
+      ENDIF
+      grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery, dernierz
+      undefine, glam & undefine, gphi & ; on libere un peu de memoire!
+   ENDELSE
+;---------------------------------------------------------------------
+; on initialise les ixmindta, iymindta au besoin
+;---------------------------------------------------------------------
+   if n_elements(jpidta) EQ 0 THEN jpidta = jpiglo
+   if n_elements(jpjdta) EQ 0 THEN jpjdta = jpjglo
+   if n_elements(jpkdta) EQ 0 THEN jpkdta = jpkglo
+   if n_elements(ixmindta) EQ 0 THEN ixmindta = 0
+   if n_elements(ixmaxdta) EQ 0 then ixmaxdta = jpidta-1
+   if ixmindta EQ -1 THEN ixmindta = 0
+   IF ixmaxdta EQ -1 then ixmaxdta = jpidta-1
+   if n_elements(iymindta) EQ 0 THEN iymindta = 0
+   IF n_elements(iymaxdta) EQ 0 then iymaxdta = jpjdta-1
+   if iymindta EQ -1 THEN iymindta = 0
+   IF iymaxdta EQ -1 then iymaxdta = jpjdta-1
+   if n_elements(izmindta) EQ 0 THEN izmindta = 0
+   IF n_elements(izmaxdta) EQ 0 then izmaxdta = jpkdta-1
+   if izmindta EQ -1 THEN izmindta = 0
+   IF izmaxdta EQ -1 then izmaxdta = jpkdta-1
+;----------------------------------------------------------------
+; on va lire le fichier
+;---------------------------------------------------------------
+   if n_elements(key_stride) LE 2 then key_stride = [1, 1, 1]
+   key_stride = 1l > long(key_stride)
+   jpitotal = long(ixmaxmesh-ixminmesh+1)
+   key_shift = long(testvar(var = key_shift))
+;
+   key = long(key_shift MOD jpitotal)
+   if key LT 0 then key = key+jpitotal
+   ixmin = ixminmesh-ixmindta
+;
+@read_ncdf_varget
+;---------------------------------------------------------------------
+; on definit les variables globales rattachees a la variable
+;---------------------------------------------------------------------
+; varname
+   varname = name
+; varunit
+   if varcontient.natts NE 0 then begin
+      attnames = strarr(varcontient.natts)
+      for attiq=0,varcontient.natts-1 do attnames[attiq]=strlowcase(ncdf_attname(cdfid,name,attiq))
+;
+      if (where(attnames EQ 'units'))[0] EQ -1 then value = '' $
+      ELSE ncdf_attget,cdfid,name,'units',value
+      varunit = strtrim(string(value), 2)
+;
+      if (where(attnames EQ 'add_offset'))[0] EQ -1 then add_offset = 0. $
+      ELSE ncdf_attget,cdfid,name,'add_offset',add_offset
+;
+      if (where(attnames EQ 'scale_factor'))[0] EQ -1 then scale_factor = 1. $
+      ELSE ncdf_attget,cdfid,name,'scale_factor',scale_factor
+;
+      if (where(attnames EQ 'missing_value'))[0] EQ -1 then missing_value = 'no' $
+      ELSE ncdf_attget,cdfid,name,'missing_value',missing_value
+;
+   ENDIF ELSE BEGIN 
+      varunit = ''
+      add_offset = 0.
+      scale_factor = 1.
+      missing_value = 'no'
+   ENDELSE
+; vardate
+; on construit une belle date lisible en fonction du langage specifie !!!
+   nothing = juldate(debut,/vrai) ; bidouille pour recuperer year, month, day
+   if keyword_set(language) then BEGIN 
+      if language eq 'gb' THEN $ 
+       vardate = string(format='(C(CMoA))',31*(month-1))+' '+strtrim(day, 1)+' '+strtrim(year, 1) $
+      ELSE vardate = strtrim(day, 1)+' '+string(format='(C(CMoA))',31*(month-1))+' '+strtrim(year, 1)
+   ENDIF ELSE vardate = strtrim(day, 1)+' '+string(format='(C(CMoA))',31*(month-1))+' '+strtrim(year, 1)
+; varexp ???
+; on applique la valeur valmask sur les points terre
+   if NOT keyword_set(cont_nofill) then begin
+      valmask = 1e20
+      case 1 of
+         varcontient.ndims eq 2:BEGIN ;xy array
+            mask = mask[*, *, 0]
+            earth = where(mask EQ 0)
+            if earth[0] NE -1 then res[earth] = 1e20
+         END
+         varcontient.ndims eq 3 AND (where(varcontient.dim EQ contient.recdim))[0] EQ -1:BEGIN ;xyz array
+            earth = where(mask EQ 0)
+            if earth[0] NE -1 then res[earth] = 1e20
+         END
+         varcontient.ndims eq 3 AND (where(varcontient.dim EQ contient.recdim))[0] NE -1:BEGIN ;xyt array
+            mask = mask[*, *, 0]
+            earth = where(mask EQ 0)
+            if earth[0] NE -1 then BEGIN
+               earth = earth#replicate(1, jpt)+replicate(nx*ny, n_elements(earth))#lindgen(jpt)
+               res[earth] = 1e20
+            END
+         END
+         varcontient.ndims eq 4:BEGIN ;xyzt array
+            earth = where(mask EQ 0)
+            if earth[0] NE -1 then BEGIN
+               earth = earth#replicate(1, jpt)+replicate(nx*ny*nz, n_elements(earth))#lindgen(jpt)
+               res[earth] = 1e20
+            END
+         END
+      endcase
+   endif
+; on applique les add_offset, scale_factor et missing_value
+   if size(missing_value, /type) NE 7 then BEGIN
+      if missing_value NE valmask then begin
+         if abs(missing_value) LT 1e6 then missing = where(res EQ missing_value) $
+         ELSE missing = where(abs(res) gt abs(missing_value)/10.)
+         if missing[0] NE -1 then res[temporary(missing)] = !values.f_nan
+      endif
+   ENDIF
+   if scale_factor NE 1 then res = res*scale_factor
+   if add_offset NE 0 then res = res+add_offset
+;
+   if keyword_set(key_reverse) then res = reverse(temporary(res),  2)
+;---------------------------------------------------------------------
+   ncdf_close,cdfid
+;---------------------------------------------------------------------
+   if keyword_set(oldboite) then domdef, oldboite,GRILLE=['T', vargrid]
+   if keyword_set(nostruct) then return, res $
+   ELSE return, {tab:res, grille:vargrid, unite:varunit, experience:varexp, nom:varname}
+
+end
+
+
+
+
+
+
Index: tags/start/LECTURE/read_ncdf_nomask.pro
===================================================================
--- tags/start/LECTURE/read_ncdf_nomask.pro	(revision 5)
+++ tags/start/LECTURE/read_ncdf_nomask.pro	(revision 5)
@@ -0,0 +1,352 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: read_ncdf
+;
+; PURPOSE:fonction de lecture pour fichier net_cdf.
+; Ce programme, est moins universel que ncdf_lec (il fait appelle au
+; variables declarees dans common.pro) mais il est du cop bcp plus
+; facile d''utilisation. Il prend en compte la declaration des
+; differents zoom qui ont ete definis (ixminmesh...premierx...) la
+; declaration de la variable key_shift... bref le resultat de
+; read_ncdf peut dorectement etre utilise dans plt...
+; C''est aussi ce programme qui est utilise par defaut dans mes
+; widgets pour la partie lecture.
+;
+; CATEGORY:lecture de fichiers NetCdf
+;
+; CALLING SEQUENCE:res = read_ncdf(name,debut[,fin])
+; 
+; INPUTS: name: un string definissant le champ a lire.
+;         debut et fin: sont relatifs a l''axe des temps. Ce peut etre
+;         - 2 dates du type yyyymmdd et ds ce cas on selectionne les
+;         dates qui sont comprisent entre ces 2 dates.
+;         - 2 indices qui definissent entre quel et quel pas de temps
+;           on doit extraire la dimension temporelle.
+;         exp: ne sert a rien!
+;
+; KEYWORD PARAMETERS: utilisables hors du contexte des widgets
+;
+;        BOITE: contient la boite sur laquelle on doit faire la
+;        lecture
+;        FILENAME: string contennant le nom du fichier
+;        IODIRECTORY: string contennant le nom du repertoire ds lequel
+;        se trouve le fichier
+;        TIMESTEP:activer pour specifier que debut et fin font
+;        reference a des indices de l''axe du temps et non pas a des
+;        dates. 
+;        TOUT: activer si on veut lire le ficher sur l''ensemble du
+;        domaine sans tenir compte du sous domaine definit par boite
+;        ou lon1,lon2,lat1,lat2,prof1,prof2.
+;        NOSTRUCT: activer si on ne veut pas que read_ncdf retourne
+;        une structure mais uniquement le tableau se rapportant au
+;        champ. 
+;
+; OUTPUTS:une stucture lisible par litchamp.pro ou un simple tableau
+; si /NOSTRUCT est active 
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:le champ doit avoir une dimension temporelle
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      15/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION read_ncdf,name,debut,fin, pour_etre_compatible, BOITE=boite, FILENAME = filename $
+             , IODIRECTORY = iodirectory, PARENTIN = parentin, TIMESTEP = timestep $
+             , TOUT = tout, NOSTRUCT = nostruct, CONT_NOFILL = CONT_NOFILL, _EXTRA = ex
+@common
+;------------------------------------------------------------
+; we find the filename.
+;------------------------------------------------------------
+; is parent a valid widget ?
+   if keyword_set(parentin) then BEGIN
+      parent = long(parentin)
+      parent = parent*widget_info(parent,/managed)
+   ENDIF
+   if n_elements(iodirectory) EQ 0 AND n_elements(iodir) NE 0 then iodirectory = iodir
+   filename = isafile(filename = filename, IODIRECTORY = iodirectory)
+;------------------------------------------------------------
+; ouverture du fichier nom
+;------------------------------------------------------------
+   if size(filename, /type) NE 7 then $
+    return, report('read_ncdf cancelled')
+   cdfid=ncdf_open(filename)
+   contient=ncdf_inquire(cdfid)
+;------------------------------------------------------------
+; we check if the variable name exists in the file.
+;------------------------------------------------------------
+   if ncdf_varid(cdfid,name) EQ -1 then $
+    return, report('variable '+name+' !C not found in the file '+filename)
+;
+   varcontient=ncdf_varinq(cdfid,name)
+;------------------------------------------------------------
+; check the time axis and the debut and fin dates
+;------------------------------------------------------------
+   if n_elements(debut) EQ 0 then begin
+      debut = 0
+      timestep = 1
+   endif
+   if keyword_set(timestep) then begin
+      premiertps = debut
+      if n_elements(fin) NE 0 then derniertps = fin ELSE derniertps = premiertps
+      jpt = derniertps-premiertps+1
+      time = lindgen(jpt)
+   ENDIF ELSE BEGIN
+      date1 = juldate(debut, /vraidate)
+      if n_elements(fin) NE 0 then date2 = juldate(fin, /vraidate) ELSE date2 = date1
+      if keyword_set(parent) then BEGIN
+         widget_control, parent, get_uvalue = top_uvalue
+         filelist = extractatt(top_uvalue,'filelist')
+         currentfile = (where(filelist EQ filename))[0]
+         time = (*(extractatt(top_uvalue, 'fileparameters'))[currentfile]).time_counter
+         premiertps = where(time EQ date1) & premiertps = premiertps[0]
+         derniertps = where(time EQ date2) & derniertps = derniertps[0]
+      ENDIF ELSE BEGIN
+; we find the infinite dimension
+         timedim = contient.recdim
+         if timedim EQ -1 then $
+          return, report('the file '+filename+' as no infinite dimension. !C Use the TIMESTEP keyword')
+; we find the FIRST time axis      
+         timeid = 0
+         repeat BEGIN           ; tant que l''on a pas trouve une variable qui n''a qu''
+                                ; une dimension: la dimension infinie
+            timecontient=ncdf_varinq(cdfid,timeid) ; que contient la variable
+            timeid = timeid+1
+         endrep until (n_elements(timecontient.dim) EQ 1 AND timecontient.dim[0] EQ contient.recdim) $
+          OR timeid EQ contient.nvars+1
+;
+         if timeid EQ contient.nvars+1 then $
+          return, report('the file '+filename+' as no time axis variable. !C Use the TIMESTEP keyword')
+; we must found the time origin of the julian calendar used in the
+; time axis. 
+; does the attribut units exist for the variable time axis?
+         timeid = timeid-1
+         if timecontient.natts EQ 0 then $
+          return, report('the variable '+timecontient.name+' has no attribut.!C Use the TIMESTEP keyword or add the attribut ''units'' to the variable')
+         attnames = strarr(timecontient.natts)
+         for attiq=0,timecontient.natts-1 do attnames[attiq]=ncdf_attname(cdfid,timeid,attiq)
+         if (where(attnames EQ 'units'))[0] EQ -1 then $
+          return, report('Attribut ''units'' not found for the variable '+timecontient.name+' !C Use the TIMESTEP keyword')
+         ncdf_attget,cdfid,timeid,'units',value
+;
+; time_counter:units = "seconds since 0001-01-01 00:00:00" ;
+; time_counter:units = "hours since 0001-01-01 00:00:00" ;
+; time_counter:units = "days since 1979-01-01 00:00:00" ;
+; time_counter:units = "months since 1979-01-01 00:00:00" ;
+; time_counter:units = "years since 1979-01-01 00:00:00" ;
+;
+; we decript the "units" attribut to find the time origin
+         value = strtrim(strcompress(string(value)), 2)
+         mots = str_sep(value, ' ')
+         unite = mots[0]
+         depart = str_sep(mots[2], '-')
+         ncdf_varget, cdfid, timeid, time
+         time = long(time)
+         case strlowcase(unite) of
+            'seconds':time = julday(depart[1], depart[2], depart[0])+time/(long(24)*3600)
+            'hours':time = julday(depart[1], depart[2], depart[0])+time/long(24)
+            'days':time = julday(depart[1], depart[2], depart[0])+time
+            'months':BEGIN 
+               for t = 0, n_elements(time)-1  do begin
+                  time[t] = julday(depart[1]+time[t], depart[2], depart[0])
+               endfor
+            END
+            'years':BEGIN
+               for t = 0, n_elements(time)-1  do begin
+                  time[t] = julday(depart[1], depart[2], depart[0]+time[t])
+               endfor
+            END
+            ELSE:return, report('The "units" attribu of the time axis must be something like: !C "seconds since 0001-01-01 ..." !C "days since 1979-01-01 ..." !C "months since 1979-01-01 ..." !C "years since 1979-01-01 ..."')
+         ENDCASE
+         premiertps = where(time GE date1) & premiertps = premiertps[0]
+         if premiertps EQ -1 THEN $
+          return, report('date 1: '+strtrim(date1, 1)+' is not found in the time axis.')
+         derniertps = where(time LE date2)
+         if derniertps[0] EQ -1 THEN $
+          return, report('the time axis as no date before date 2: '+strtrim(date2, 1))
+         derniertps = derniertps[n_elements(derniertps)-1]
+      ENDELSE
+      time = time[premiertps:derniertps]
+      jpt = derniertps-premiertps+1
+   ENDELSE
+;------------------------------------------------------------
+; nom de la grille a laquelle se rapporte le champ
+;------------------------------------------------------------
+   vargrid = strupcase(strmid(filename, strlen(filename)-9))
+   if vargrid EQ 'GRID.T.NC' OR vargrid EQ 'GRID.U.NC' $
+    OR vargrid EQ 'GRID.V.NC' OR vargrid EQ 'GRID.F.NC' $
+    OR vargrid eq 'GRID.W.NC' $
+    OR vargrid EQ 'GRID_T.NC' OR vargrid EQ 'GRID_U.NC' $
+    OR vargrid EQ 'GRID_V.NC' OR vargrid EQ 'GRID_F.NC' $
+    OR vargrid eq 'GRID_W.NC' then $
+    vargrid = strupcase(strmid(filename, strlen(filename)-4, 1)) ELSE vargrid='T'
+;---------------------------------------------------------------
+; redefinition du domaine 
+;---------------------------------------------------------------
+   if keyword_set(tout) then begin
+      nx=jpi
+      ny=jpj
+      nz=jpk
+      premierx = 0
+      premiery = 0
+      premierz = 0
+      dernierx = jpi-1
+      derniery = jpj-1
+      dernierz = jpk-1
+      case strupcase(vargrid) of
+         'T':mask = tmask
+         'U':mask = umask()
+         'V':mask = vmask()
+         'W':mask = tmask
+         'F':mask = fmask()
+      endcase
+   ENDIF ELSE BEGIN
+      if keyword_set(boite) then BEGIN 
+         oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+         Case 1 Of
+            N_Elements(Boite) Eq 1:bte=[lon1, lon2, lat1, lat2, 0.,boite[0]]
+            N_Elements(Boite) Eq 2:bte=[lon1, lon2, lat1, lat2, boite[0],boite[1]]
+            N_Elements(Boite) Eq 4:bte=[Boite, prof1, prof2]
+            N_Elements(Boite) Eq 5:bte=[Boite[0:3], 0, Boite[4]]
+            N_Elements(Boite) Eq 6:bte=Boite
+            Else: return, report('Mauvaise Definition de Boite')
+         ENDCASE
+         domdef, bte,GRILLE=['T', vargrid], _extra = ex
+      ENDIF
+      grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery, dernierz
+      undefine, glam & undefine, gphi & ; on libere un peu de memoire!
+   ENDELSE
+;---------------------------------------------------------------------
+; on initialise les ixmindta, iymindta au besoin
+;---------------------------------------------------------------------
+   if n_elements(jpidta) EQ 0 THEN jpidta = jpiglo
+   if n_elements(jpjdta) EQ 0 THEN jpjdta = jpjglo
+   if n_elements(jpkdta) EQ 0 THEN jpkdta = jpkglo
+   if n_elements(ixmindta) EQ 0 THEN ixmindta = 0
+   if n_elements(ixmaxdta) EQ 0 then ixmaxdta = jpidta-1
+   if ixmindta EQ -1 THEN ixmindta = 0
+   IF ixmaxdta EQ -1 then ixmaxdta = jpidta-1
+   if n_elements(iymindta) EQ 0 THEN iymindta = 0
+   IF n_elements(iymaxdta) EQ 0 then iymaxdta = jpjdta-1
+   if iymindta EQ -1 THEN iymindta = 0
+   IF iymaxdta EQ -1 then iymaxdta = jpjdta-1
+   if n_elements(izmindta) EQ 0 THEN izmindta = 0
+   IF n_elements(izmaxdta) EQ 0 then izmaxdta = jpkdta-1
+   if izmindta EQ -1 THEN izmindta = 0
+   IF izmaxdta EQ -1 then izmaxdta = jpkdta-1
+;----------------------------------------------------------------
+; on va lire le fichier
+;---------------------------------------------------------------
+   if n_elements(key_stride) LE 2 then key_stride = [1, 1, 1]
+   key_stride = 1l > long(key_stride)
+   jpitotal = long(ixmaxmesh-ixminmesh+1)
+   key_shift = long(testvar(var = key_shift))
+;
+   key = long(key_shift MOD jpitotal)
+   if key LT 0 then key = key+jpitotal
+   ixmin = ixminmesh-ixmindta
+;
+@read_ncdf_varget
+;---------------------------------------------------------------------
+; on definit les variables globales rattachees a la variable
+;---------------------------------------------------------------------
+; varname
+   varname = name
+; varunit
+   if varcontient.natts NE 0 then begin
+      attnames = strarr(varcontient.natts)
+      for attiq=0,varcontient.natts-1 do attnames[attiq]=strlowcase(ncdf_attname(cdfid,name,attiq))
+;
+      if (where(attnames EQ 'units'))[0] EQ -1 then value = '' $
+      ELSE ncdf_attget,cdfid,name,'units',value
+      varunit = strtrim(string(value), 2)
+;
+      if (where(attnames EQ 'add_offset'))[0] EQ -1 then add_offset = 0. $
+      ELSE ncdf_attget,cdfid,name,'add_offset',add_offset
+;
+      if (where(attnames EQ 'scale_factor'))[0] EQ -1 then scale_factor = 1. $
+      ELSE ncdf_attget,cdfid,name,'scale_factor',scale_factor
+;
+      if (where(attnames EQ 'missing_value'))[0] EQ -1 then missing_value = 'no' $
+      ELSE ncdf_attget,cdfid,name,'missing_value',missing_value
+;
+   ENDIF ELSE BEGIN 
+      varunit = ''
+      add_offset = 0.
+      scale_factor = 1.
+      missing_value = 'no'
+   ENDELSE
+; vardate
+; on construit une belle date lisible en fonction du langage specifie !!!
+   nothing = juldate(debut,/vrai) ; bidouille pour recuperer year, month, day
+   if keyword_set(language) then BEGIN 
+      if language eq 'gb' THEN $ 
+       vardate = string(format='(C(CMoA))',31*(month-1))+' '+strtrim(day, 1)+' '+strtrim(year, 1) $
+      ELSE vardate = strtrim(day, 1)+' '+string(format='(C(CMoA))',31*(month-1))+' '+strtrim(year, 1)
+   ENDIF ELSE vardate = strtrim(day, 1)+' '+string(format='(C(CMoA))',31*(month-1))+' '+strtrim(year, 1)
+; varexp ???
+; on applique la valeur valmask sur les points terre
+   if NOT keyword_set(cont_nofill) then begin
+      valmask = 1e20
+      case 1 of
+         varcontient.ndims eq 2:BEGIN ;xy array
+            mask = mask[*, *, 0]
+            earth = where(mask EQ 0)
+            if earth[0] NE -1 then res[earth] = 1e20
+         END
+         varcontient.ndims eq 3 AND (where(varcontient.dim EQ contient.recdim))[0] EQ -1:BEGIN ;xyz array
+            earth = where(mask EQ 0)
+            if earth[0] NE -1 then res[earth] = 1e20
+         END
+         varcontient.ndims eq 3 AND (where(varcontient.dim EQ contient.recdim))[0] NE -1:BEGIN ;xyt array
+            mask = mask[*, *, 0]
+            earth = where(mask EQ 0)
+            if earth[0] NE -1 then BEGIN
+               earth = earth#replicate(1, jpt)+replicate(nx*ny, n_elements(earth))#lindgen(jpt)
+               res[earth] = 1e20
+            END
+         END
+         varcontient.ndims eq 4:BEGIN ;xyzt array
+            earth = where(mask EQ 0)
+            if earth[0] NE -1 then BEGIN
+               earth = earth#replicate(1, jpt)+replicate(nx*ny*nz, n_elements(earth))#lindgen(jpt)
+               res[earth] = 1e20
+            END
+         END
+      endcase
+   endif
+; on applique les add_offset, scale_factor et missing_value
+   if size(missing_value, /type) NE 7 then BEGIN
+      if missing_value NE valmask then begin
+         if abs(missing_value) LT 1e6 then missing = where(res EQ missing_value) $
+         ELSE missing = where(abs(res) gt abs(missing_value)/10.)
+         if missing[0] NE -1 then res[temporary(missing)] = !values.f_nan
+      endif
+   ENDIF
+   if scale_factor NE 1 then res = res*scale_factor
+   if add_offset NE 0 then res = res+add_offset
+;
+   if keyword_set(key_reverse) then res = reverse(temporary(res),  2)
+;---------------------------------------------------------------------
+   ncdf_close,cdfid
+;---------------------------------------------------------------------
+   if keyword_set(oldboite) then domdef, oldboite,GRILLE=['T', vargrid]
+   if keyword_set(nostruct) then return, res $
+   ELSE return, {tab:res, grille:vargrid, unite:varunit, experience:varexp, nom:varname}
+
+end
+
+
+
+
+
+
Index: tags/start/LECTURE/read_ncdf_varget.pro
===================================================================
--- tags/start/LECTURE/read_ncdf_varget.pro	(revision 5)
+++ tags/start/LECTURE/read_ncdf_varget.pro	(revision 5)
@@ -0,0 +1,437 @@
+; le format netcdf et IDL nous permet d''aller lire uniquement la partie de
+; tableau qui nous interesse.
+;
+;  attention, qd il y a un shift il faut faire attention a ce que
+;  l''on fait et en particulier arriver a positionner la boite
+;  specifiee par premierx:dernierx par rapport au tableau contenu dans
+;  le fichier NetCdf.
+;  pour s''y reperer voici un petit dessin
+;
+;  dans le repere 0:jpi, avec le zoom definit par premierx:dernierx
+;
+;        0      j      key-1  key          i              jpi-1
+;        |......|........|     |-----------|----------------|
+;
+;  si on veut savoir comment c''etait avant le shift:
+;
+;        0       i-key     jpi-key-1 jpi-key  jpi-key+j   jpi-1
+;        |--------|--------------|      |........|..........|
+;
+; avant que l''on ajuste au zoom definit par ixminmesh,ixmaxmesh c''etait:
+;
+;   0   ixmin    i-key     jpi-key-1  jpi-key  jpi-key+j   jpi-1     jpidta
+;              +ixmin        +ixmin  +ixmin     +ixmin     +ixmin
+;   |,,,,|--------|--------------|      |........|..........|,,,,,,,,,,,|
+;
+;  apres il suffit de remplacer i et j par premierx ou dernierx qd on
+;  ne fait pas de stride et par premierx*key_stride[0] ou
+;  dernierx*key_stride[0] qd on fait un stride (dans ce cas il faut
+;  aussi remplacer jpi par jpitotal)!
+;
+;
+case 1 OF
+;......................................................................
+;......................................................................
+   varcontient.ndims eq 2:BEGIN ;xy array
+;......................................................................
+;......................................................................
+      case 1 OF
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) EQ 0 AND total(key_stride) EQ 3:BEGIN
+; on ne shift pas et il n''y a pas de stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            ncdf_varget,cdfid,name,res,offset=[premierx+ixminmesh-ixmindta $
+                                               ,premiery+iyminmesh-iymindta] $
+             ,count=[nx,ny], _extra = ex
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) EQ 0 AND total(key_stride) NE 3:BEGIN
+; on ne shift pas mais il y a un stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            ncdf_varget,cdfid,name,res,offset=[premierx*key_stride[0]+ixminmesh-ixmindta $
+                                               ,premiery*key_stride[1]+iyminmesh-iymindta] $
+             ,count=[nx,ny], stride = key_stride[0:1], _extra = ex
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) NE 0 AND total(key_stride) EQ 3:BEGIN
+; on shift mais il n''y a pas de stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            case 1 of
+               premierx GE key:BEGIN ; on peut tout couper d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[ixmin-key+premierx $
+                                                     ,premiery+iyminmesh-iymindta] $
+                   ,count=[nx,ny], _extra = ex
+               END
+               dernierx LE key-1:BEGIN ; on peut tout couper d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[jpi-key+ixmin+premierx $
+                                                     ,premiery+iyminmesh-iymindta] $
+                   ,count=[nx,ny], _extra = ex
+               END
+               ELSE:BEGIN       ; Le tableau est separe en 2 morceaux...
+                  ncdf_varget,cdfid,name,tab1,offset=[jpi-key+ixmin+premierx $
+                                                      ,premiery+iyminmesh-iymindta] $
+                   ,count=[key-1-premierx+1,ny], _extra = ex
+                  ncdf_varget,cdfid,name,tab2,offset=[ixmin $
+                                                      ,premiery+iyminmesh-iymindta] $
+                   ,count=[dernierx-key+1,ny], _extra = ex
+                  res = [temporary(tab1), temporary(tab2)]
+               END
+            ENDCASE
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) NE 0 AND total(key_stride) NE 3:BEGIN
+; on shift et il y a un stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            case 1 OF           ; case sur la facon de fire le champ
+               premierx GE ceil(1.*key/key_stride[0]):BEGIN ; on peut tout coupe d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[ixmin-key+premierx*key_stride[0] $
+                                                     ,premiery*key_stride[1]+iyminmesh-iymindta] $
+                   ,count=[nx,ny], stride = key_stride[0:1], _extra = ex
+               END
+               dernierx LE (key-1)/key_stride[0]:BEGIN ; on peut tout coupe d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[jpitotal-key+ixmin+premierx*key_stride[0] $
+                                                     ,premiery*key_stride[1]+iyminmesh-iymindta] $
+                   ,count=[nx,ny], stride = key_stride[0:1], _extra = ex
+               END
+               ELSE:BEGIN       ; le tableau est separe en 2 morceaux...
+                  ncdf_varget,cdfid,name,tab1,offset=[jpitotal-key+ixmin+premierx*key_stride[0] $
+                                                      ,premiery*key_stride[1]+iyminmesh-iymindta] $
+                   ,count=[(key-1-premierx*key_stride[0]+1)/key_stride[0],ny] $
+                   , stride = key_stride[0:1], _extra = ex
+; grosse blague de IDL qui sur un vecteur 0 1 2 3 4 5 6 7 8
+; extrait pour offset = 0 ou 1 tjs 5 elements pour un stride de 2 par
+; ex, soit le nombre d''elements/le stride. Il manque donc une colonne
+; quand nombre d''elements-1 est un multiple de stride...CQFD
+; il en manque un bout?
+                  IF ( (key-1-premierx*key_stride[0]) MOD key_stride[0] ) EQ 0 then begin
+                     ncdf_varget,cdfid,name,tab1bis,offset=[jpitotal-1+ixmin $
+                                                            ,premiery*key_stride[1]+iyminmesh-iymindta] $
+                      ,count=[1,ny] $
+                      , stride = [1, key_stride[1]], _extra = ex
+                     tab1bis = reform(tab1bis, 1, ny, /over)
+                     tab1 = [temporary(tab1), temporary(tab1bis)]
+                  ENDIF
+; 2eme bout...
+                  ncdf_varget,cdfid,name,tab2,offset=[ceil(1.*key/key_stride[0])*key_stride[0]-key+ixmin $
+                                                      ,premiery*key_stride[1]+iyminmesh-iymindta] $
+                   ,count=[(dernierx*key_stride[0]-key+1)/key_stride[0],ny] $
+                   , stride = key_stride[0:1], _extra = ex
+; on recolle le tout
+                  res = [temporary(tab1), temporary(tab2)]
+               END
+            ENDCASE             ; case sur la facon de fire le champ
+         END
+      ENDCASE                   ; differentes possibilites de key_shift et key_performance
+   END
+;......................................................................
+;......................................................................
+   varcontient.ndims eq 3 AND (where(varcontient.dim EQ contient.recdim))[0] EQ -1:BEGIN ;xyz array
+;......................................................................
+;......................................................................
+      case 1 of
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) EQ 0 AND total(key_stride) EQ 3:BEGIN
+; on ne shift pas et il n''y a pas de stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            ncdf_varget,cdfid,name,res,offset=[premierx+ixminmesh-ixmindta $
+                                               ,premiery+iyminmesh-iymindta $
+                                               ,premierz+izminmesh-izmindta] $
+             ,count=[nx,ny,nz], _extra = ex
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) EQ 0 AND total(key_stride) NE 3:BEGIN
+; on ne shift pas mais il y a un stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            ncdf_varget,cdfid,name,res,offset=[premierx*key_stride[0]+ixminmesh-ixmindta $
+                                               ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                               ,premierz*key_stride[2]+izminmesh-izmindta] $
+             ,count=[nx,ny,nz], stride = key_stride[0:2], _extra = ex
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) NE 0 AND total(key_stride) EQ 3:BEGIN
+; on shift mais il n''y a pas de stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            case 1 of
+               premierx GE key:BEGIN ; on peut tout couper d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[ixmin-key+premierx $
+                                                     ,premiery+iyminmesh-iymindta $
+                                                     ,premierz+izminmesh-izmindta] $
+                   ,count=[nx,ny,nz], _extra = ex
+               END
+               dernierx LE key-1:BEGIN ; on peut tout couper d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[jpi-key+ixmin+premierx $
+                                                     ,premiery+iyminmesh-iymindta $
+                                                     ,premierz+izminmesh-izmindta] $
+                   ,count=[nx,ny,nz], _extra = ex
+               END
+               ELSE:BEGIN       ; Le tableau est separe en 2 morceaux...
+                  ncdf_varget,cdfid,name,tab1,offset=[jpi-key+ixmin+premierx $
+                                                      ,premiery+iyminmesh-iymindta $
+                                                      ,premierz+izminmesh-izmindta] $
+                   ,count=[key-1-premierx+1,ny,nz], _extra = ex
+                  ncdf_varget,cdfid,name,tab2,offset=[ixmin $
+                                                      ,premiery+iyminmesh-iymindta $
+                                                      ,premierz+izminmesh-izmindta] $
+                   ,count=[dernierx-key+1,ny,nz], _extra = ex
+                  res = [temporary(tab1), temporary(tab2)]
+               END
+            ENDCASE
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) NE 0 AND total(key_stride) NE 3:BEGIN
+; on shift et il y a un stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            case 1 OF           ; case sur la facon de fire le champ
+               premierx GE ceil(1.*key/key_stride[0]):BEGIN ; on peut tout coupe d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[ixmin-key+premierx*key_stride[0] $
+                                                     ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                     ,premierz*key_stride[2]+izminmesh-izmindta] $
+                   ,count=[nx,ny,nz], stride = key_stride[0:2], _extra = ex
+               END
+               dernierx LE (key-1)/key_stride[0]:BEGIN ; on peut tout coupe d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[jpitotal-key+ixmin+premierx*key_stride[0] $
+                                                     ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                     ,premierz*key_stride[2]+izminmesh-izmindta] $
+                   ,count=[nx,ny,nz], stride = key_stride[0:2], _extra = ex
+               END
+               ELSE:BEGIN       ; le tableau est separe en 2 morceaux...
+                  ncdf_varget,cdfid,name,tab1,offset=[jpitotal-key+ixmin+premierx*key_stride[0] $
+                                                      ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                      ,premierz*key_stride[2]+izminmesh-izmindta] $
+                   ,count=[(key-1-premierx*key_stride[0]+1)/key_stride[0],ny,nz] $
+                   , stride = key_stride[0:2], _extra = ex
+; il en manque un bout?
+                  IF ( (key-1-premierx*key_stride[0]) MOD key_stride[0] ) EQ 0 then begin
+                     ncdf_varget,cdfid,name,tab1bis,offset=[jpitotal-1+ixmin $
+                                                            ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                            ,premierz*key_stride[2]+izminmesh-izmindta] $
+                      ,count=[1,ny,nz] $
+                      , stride = [1, key_stride[1:2]], _extra = ex
+                     tab1bis = reform(tab1bis, 1, ny, nz, /over)
+                     tab1 = [temporary(tab1), temporary(tab1bis)]
+                  ENDIF
+; 2eme bout...
+                  ncdf_varget,cdfid,name,tab2,offset=[ceil(1.*key/key_stride[0])*key_stride[0]-key+ixmin $
+                                                      ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                      ,premierz*key_stride[2]+izminmesh-izmindta] $
+                   ,count=[(dernierx*key_stride[0]-key+1)/key_stride[0],ny,nz] $
+                   , stride = key_stride[0:2], _extra = ex
+; on recolle le tout
+                  res = [temporary(tab1), temporary(tab2)]
+               END
+            ENDCASE             ; case sur la facon de fire le champ
+         END
+      ENDCASE                   ; differentes possibilites de key_shift et key_performance
+   END
+;......................................................................
+;......................................................................
+   varcontient.ndims eq 3 AND (where(varcontient.dim EQ contient.recdim))[0] NE -1:BEGIN ;xyt array
+;......................................................................
+;......................................................................
+      case 1 of
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) EQ 0 AND total(key_stride) EQ 3:BEGIN
+; on ne shift pas et il n''y a pas de stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            ncdf_varget,cdfid,name,res,offset=[premierx+ixminmesh-ixmindta $
+                                               ,premiery+iyminmesh-iymindta $
+                                               ,premiertps] $
+             ,count=[nx,ny,jpt], _extra = ex
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) EQ 0 AND total(key_stride) NE 3:BEGIN
+; on ne shift pas mais il y a un stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            ncdf_varget,cdfid,name,res,offset=[premierx*key_stride[0]+ixminmesh-ixmindta $
+                                               ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                               ,premiertps] $
+             ,count=[nx,ny,jpt], stride = [key_stride[0:1], 1], _extra = ex
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) NE 0 AND total(key_stride) EQ 3:BEGIN
+; on shift mais il n''y a pas de stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            case 1 of
+               premierx GE key:BEGIN ; on peut tout couper d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[ixmin-key+premierx $
+                                                     ,premiery+iyminmesh-iymindta $
+                                                     ,premiertps] $
+                   ,count=[nx,ny,jpt], _extra = ex
+               END
+               dernierx LE key-1:BEGIN ; on peut tout couper d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[jpi-key+ixmin+premierx $
+                                                     ,premiery+iyminmesh-iymindta $
+                                                     ,premiertps] $
+                   ,count=[nx,ny,jpt], _extra = ex
+               END
+               ELSE:BEGIN       ; Le tableau est separe en 2 morceaux...
+                  ncdf_varget,cdfid,name,tab1,offset=[jpi-key+ixmin+premierx $
+                                                      ,premiery+iyminmesh-iymindta $
+                                                      ,premiertps] $
+                   ,count=[key-1-premierx+1,ny,jpt], _extra = ex
+                  ncdf_varget,cdfid,name,tab2,offset=[ixmin $
+                                                      ,premiery+iyminmesh-iymindta $
+                                                      ,premiertps] $
+                   ,count=[dernierx-key+1,ny,jpt], _extra = ex
+                  res = [temporary(tab1), temporary(tab2)]
+               END
+            ENDCASE
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) NE 0 AND total(key_stride) NE 3:BEGIN
+; on shift et il y a un stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            case 1 OF           ; case sur la facon de fire le champ
+               premierx GE ceil(1.*key/key_stride[0]):BEGIN ; on peut tout coupe d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[ixmin-key+premierx*key_stride[0] $
+                                                     ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                     ,premiertps] $
+                   ,count=[nx,ny,jpt], stride = [key_stride[0:1], 1], _extra = ex
+               END
+               dernierx LE (key-1)/key_stride[0]:BEGIN ; on peut tout coupe d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[jpitotal-key+ixmin+premierx*key_stride[0] $
+                                                     ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                     ,premiertps] $
+                   ,count=[nx,ny,jpt], stride = [key_stride[0:1], 1], _extra = ex
+               END
+               ELSE:BEGIN       ; le tableau est separe en 2 morceaux...
+                  ncdf_varget,cdfid,name,tab1,offset=[jpitotal-key+ixmin+premierx*key_stride[0] $
+                                                      ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                      ,premiertps] $
+                   ,count=[(key-1-premierx*key_stride[0]+1)/key_stride[0],ny,jpt] $
+                   , stride = [key_stride[0:1], 1], _extra = ex
+; il en manque un bout?
+                  IF ( (key-1-premierx*key_stride[0]) MOD key_stride[0] ) EQ 0 then begin
+                     ncdf_varget,cdfid,name,tab1bis,offset=[jpitotal-1+ixmin $
+                                                            ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                            ,premiertps] $
+                      ,count=[1,ny,jpt] $
+                      , stride = [1, key_stride[1:1], 1], _extra = ex
+                     tab1bis = reform(tab1bis, 1, ny, jpt, /over)
+                     tab1 = [temporary(tab1), temporary(tab1bis)]
+                  ENDIF
+; 2eme bout...
+                  ncdf_varget,cdfid,name,tab2,offset=[ceil(1.*key/key_stride[0])*key_stride[0]-key+ixmin $
+                                                      ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                      ,premiertps] $
+                   ,count=[(dernierx*key_stride[0]-key+1)/key_stride[0],ny,jpt] $
+                   , stride = [key_stride[0:1], 1], _extra = ex
+; on recolle le tout
+                  res = [temporary(tab1), temporary(tab2)]
+               END
+            ENDCASE             ; case sur la facon de fire le champ
+         END
+      endcase
+   END
+;......................................................................
+;......................................................................
+   varcontient.ndims eq 4:BEGIN ;xyzt array
+;......................................................................
+;......................................................................
+      case 1 of
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) EQ 0 AND total(key_stride) EQ 3:BEGIN
+; on ne shift pas et il n''y a pas de stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            ncdf_varget,cdfid,name,res,offset=[premierx+ixminmesh-ixmindta $
+                                               ,premiery+iyminmesh-iymindta $
+                                                      ,premierz+izminmesh-izmindta $
+                                               ,premiertps] $
+             ,count=[nx,ny,nz,jpt], _extra = ex
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) EQ 0 AND total(key_stride) NE 3:BEGIN
+; on ne shift pas mais il y a un stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            ncdf_varget,cdfid,name,res,offset=[premierx*key_stride[0]+ixminmesh-ixmindta $
+                                               ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                               ,premierz*key_stride[2]+izminmesh-izmindta $
+                                               ,premiertps] $
+             ,count=[nx,ny,nz,jpt], stride = [key_stride[0:2], 1], _extra = ex
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) NE 0 AND total(key_stride) EQ 3:BEGIN
+; on shift mais il n''y a pas de stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            case 1 of
+               premierx GE key:BEGIN ; on peut tout couper d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[ixmin-key+premierx $
+                                                     ,premiery+iyminmesh-iymindta $
+                                                     ,premierz+izminmesh-izmindta $
+                                                     ,premiertps] $
+                   ,count=[nx,ny,nz,jpt], _extra = ex
+               END
+               dernierx LE key-1:BEGIN ; on peut tout couper d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[jpi-key+ixmin+premierx $
+                                                     ,premiery+iyminmesh-iymindta $
+                                                     ,premierz+izminmesh-izmindta $
+                                                     ,premiertps] $
+                   ,count=[nx,ny,nz,jpt], _extra = ex
+               END
+               ELSE:BEGIN       ; Le tableau est separe en 2 morceaux...
+                  ncdf_varget,cdfid,name,tab1,offset=[jpi-key+ixmin+premierx $
+                                                      ,premiery+iyminmesh-iymindta $
+                                                      ,premierz+izminmesh-izmindta $
+                                                      ,premiertps] $
+                   ,count=[key-1-premierx+1,ny,nz,jpt], _extra = ex
+                  ncdf_varget,cdfid,name,tab2,offset=[ixmin $
+                                                      ,premiery+iyminmesh-iymindta $
+                                                      ,premierz+izminmesh-izmindta $
+                                                      ,premiertps] $
+                   ,count=[dernierx-key+1,ny,nz,jpt], _extra = ex
+                  res = [temporary(tab1), temporary(tab2)]
+               END
+            ENDCASE
+         END
+;,,,,,,,,,,,,,,,,,,,,,,,,
+         keyword_set(key_shift) NE 0 AND total(key_stride) NE 3:BEGIN
+; on shift et il y a un stride
+;,,,,,,,,,,,,,,,,,,,,,,,,
+            case 1 OF           ; case sur la facon de fire le champ
+               premierx GE ceil(1.*key/key_stride[0]):BEGIN ; on peut tout coupe d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[ixmin-key+premierx*key_stride[0] $
+                                                     ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                     ,premierz*key_stride[2]+izminmesh-izmindta $
+                                                     ,premiertps] $
+                   ,count=[nx,ny,nz,jpt], stride = [key_stride[0:2], 1], _extra = ex
+               END
+               dernierx LE (key-1)/key_stride[0]:BEGIN ; on peut tout coupe d''un coup
+                  ncdf_varget,cdfid,name,res,offset=[jpitotal-key+ixmin+premierx*key_stride[0] $
+                                                     ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                     ,premierz*key_stride[2]+izminmesh-izmindta $
+                                                     ,premiertps] $
+                   ,count=[nx,ny,nz,jpt], stride = [key_stride[0:2], 1], _extra = ex
+               END
+               ELSE:BEGIN       ; le tableau est separe en 2 morceaux...
+                  ncdf_varget,cdfid,name,tab1,offset=[jpitotal-key+ixmin+premierx*key_stride[0] $
+                                                      ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                     ,premierz*key_stride[2]+izminmesh-izmindta $
+                                                      ,premiertps] $
+                   ,count=[(key-1-premierx*key_stride[0]+1)/key_stride[0],ny,nz,jpt] $
+                   , stride = [key_stride[0:2], 1], _extra = ex
+; il en manque un bout?
+                  IF ( (key-1-premierx*key_stride[0]) MOD key_stride[0] ) EQ 0 then begin
+                     ncdf_varget,cdfid,name,tab1bis,offset=[jpitotal-1+ixmin $
+                                                            ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                     ,premierz*key_stride[2]+izminmesh-izmindta $
+                                                            ,premiertps] $
+                      ,count=[1,ny,nz,jpt] $
+                      , stride = [1, key_stride[1:2], 1], _extra = ex
+                     tab1bis = reform(tab1bis, 1, ny, nz, jpt, /over)
+                     tab1 = [temporary(tab1), temporary(tab1bis)]
+                  ENDIF
+; 2eme bout...
+                  ncdf_varget,cdfid,name,tab2,offset=[ceil(1.*key/key_stride[0])*key_stride[0]-key+ixmin $
+                                                      ,premiery*key_stride[1]+iyminmesh-iymindta $
+                                                     ,premierz*key_stride[2]+izminmesh-izmindta $
+                                                      ,premiertps] $
+                   ,count=[(dernierx*key_stride[0]-key+1)/key_stride[0],ny,nz,jpt] $
+                   , stride = [key_stride[0:2], 1], _extra = ex
+; on recolle le tout
+                  res = [temporary(tab1), temporary(tab2)]
+               END
+            ENDCASE             ; case sur la facon de fire le champ
+         END
+      endcase
+   END
+endcase
Index: tags/start/LECTURE/whichread.pro
===================================================================
--- tags/start/LECTURE/whichread.pro	(revision 5)
+++ tags/start/LECTURE/whichread.pro	(revision 5)
@@ -0,0 +1,81 @@
+;*********************************************************************
+PRO whichread_event, event
+;
+@common
+;
+   if tag_names(event, /structure_name) NE 'WIDGET_BUTTON' then return
+   widget_control, event.id,  get_uvalue = uvalue
+   widget_control, event.handler, get_uvalue = messenger
+   case uvalue of
+      'Cancel':*messenger = -1
+      'ok finish':BEGIN
+         widget_control, widget_info(event.handler, find_by_uname = 'funclec_name') $
+          , get_value = answer
+         funclec_name = strtrim(answer[0], 2)
+         widget_control, widget_info(event.handler, find_by_uname = 'xdta'), get_value = answer
+         jpiglo = long(answer[0])
+         jpidta = long(answer[1])
+         ixmindta = long(answer[2])
+         ixmaxdta = long(answer[3])
+         widget_control, widget_info(event.handler, find_by_uname = 'ydta'), get_value = answer
+         jpjglo = long(answer[0])
+         jpjdta = long(answer[1])
+         iymindta = long(answer[2])
+         iymaxdta = long(answer[3])
+         widget_control, widget_info(event.handler, find_by_uname = 'zdta'), get_value = answer
+         jpkglo = long(answer[0])
+         jpkdta = long(answer[1])
+         izmindta = long(answer[2])
+         izmaxdta = long(answer[3])
+;
+;
+         *messenger = {funclec_name:funclec_name $
+                       , jpidta:jpidta, jpjdta:jpjdta, jpkdta:jpkdta $
+                       , ixmindta:ixmindta, ixmaxdta:ixmaxdta $
+                       , iymindta:iymindta, iymaxdta:iymaxdta $
+                       , izmindta:izmindta, izmaxdta:izmaxdta $
+                      }
+      END
+   endcase
+   widget_control,event.handler,/destroy
+;
+   return
+end
+;*********************************************************************
+FUNCTION whichread, FUNCLEC_NAME = funclec_name, PARENT = parent, _EXTRA = ex
+;
+@common
+;
+; pour recuperer les reponses possees lors de l''utilisation de ce
+; widget on cree un pointeur que l''on place dans la uvalue. Comme ca
+; une fois que le widget est detruit dans la procedure ...event.pro,
+; la variable surlaquelle pointait le pointeur (contenue ds la uvalue
+; du widget) n''est pas detruite est on peut recuperer le resultat!
+;
+   messenger = ptr_new(/allocate_heap)
+;
+;
+   if keyword_set(parent) then BEGIN
+   base=widget_base(parent, /COLUMN, title = 'whichread', /align_center, uvalue = messenger, _EXTRA = ex)
+   ENDIF ELSE BEGIN 
+      base=widget_base(/COLUMN, title = 'whichread', /align_center, uvalue = messenger, _EXTRA = ex)
+      nothing = widget_button(base, value = 'Cancel', uvalue = 'Cancel')
+   ENDELSE
+;
+   basea=widget_base(base, /row, /align_center)
+   nothing = widget_label(basea, value = 'Read Function name:')
+   if NOT keyword_set(funclec_name) then funclec_name = 'read_ncdf'
+   nothing = widget_text(basea, value = funclec_name, uname = 'funclec_name', xsize = 10, /EDITABLE)
+   nothing = cw_fourparameter(base, jpiglo, jpidta, ixmindta, ixmaxdta, 'x', 'dta', /EDITABLE, uname = 'xdta')
+   nothing = cw_fourparameter(base, jpjglo, jpjdta, iymindta, iymaxdta, 'y', 'dta', /EDITABLE, uname = 'ydta')
+   nothing = cw_fourparameter(base, jpkglo, jpkdta, izmindta, izmaxdta, 'z', 'dta', /EDITABLE, uname = 'zdta')
+   nothing = widget_button(base, value = 'Ok, Get the Read parameters!', uvalue = 'ok finish')
+;
+   widget_control,base,/realize
+   xmanager,'whichread', base,event_handler = 'whichread_event'
+   res = *messenger
+   ptr_free, messenger
+
+   return, res
+;   
+end
Index: tags/start/LECTURE/xncdf_lec.pro
===================================================================
--- tags/start/LECTURE/xncdf_lec.pro	(revision 5)
+++ tags/start/LECTURE/xncdf_lec.pro	(revision 5)
@@ -0,0 +1,538 @@
+; La lecture de ce programme se fait de bas en haut:
+;   1) xncdf_lec
+;    -->2) xncdf_lec_event
+;       |--> 3) wid_var
+;            --> wid_var_event
+;
+pro wid_var_event,  event
+; NAME:wid_var_event
+;
+; PURPOSE:procedure appele par xmanager qd on appuie sur un bouton du
+; 2eme widget cree par wid_var
+; 
+; INPUTS: event, une structure caracterisant le type d''evenement qui
+; arrive au widget numero1 2
+;
+; COMMON BLOCKS:wididbase,resultat,infovariable,indicewid,motcle
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+   COMMON wididbase, base
+   COMMON resultat, res
+   COMMON infovariable, cdfid, listename, contient, nomdim, tailledim, varid, varcontient
+   COMMON indicewid_var, widbase1, widbase2111, widbase212, widbase213, selectatt
+   COMMON motcle, mcatt, mccount, mcoffset, mciodir, mcshift, mcstride, mcvar
+;
+; quel est le type d''evenement?
+   widget_control, event.id, get_uvalue=uval
+   tailledimvar = tailledim[varcontient.dim]
+   if n_elements(uval) EQ 0 then return
+; case sur le type d''evenement
+   case uval OF
+      1:BEGIN                   ; on change des valeurs dans le tableau
+; on controle que les valeurs mises dans le tableau ne sont pas
+; completement fausses
+         widget_control, widbase1, get_value = table
+; agument du bon type ?
+; si le type est mauvais on change automatiquement par des valeurs par
+; defaut
+         if event.x GT (size(table))[1] then return
+         if event.y GT (size(table))[2] then return
+         if size(table[event.x, event.y], /type) GE 6 $
+          OR size(table[event.x, event.y], /type) EQ 0 then BEGIN 
+            if event.x EQ 1 then $
+             widget_control, widbase1, use_table_select = [1, event.y,1, event.y] $
+             , set_value = tailledimvar[event.y] $
+            ELSE widget_control, widbase1 $
+             , use_table_select = [event.x, event.y, event.x, event.y], set_value = 0
+         endif
+; agument avec une valeur nom debile?
+         table = fix(table)
+         case event.x of
+            0:BEGIN             ; on a touche a l''offset:
+               if table[0, event.y] LT 0 then BEGIN
+                  table[0, event.y] = 0
+                  widget_control, widbase1, use_table_select = [0, event.y, 0, event.y] $
+                   , set_value = 0
+               endif
+; si il depasse la dim du tableau on le met au max et le cont a 1
+               if table[0, event.y] GT tailledimvar[event.y]/table[3, event.y] then begin
+                  widget_control, widbase1, use_table_select = [0, event.y,1, event.y] $
+                   , set_value = [tailledimvar[event.y]/table[3, event.y], 1]
+               ENDIF ELSE BEGIN
+; si avec le nouvel offset le count est trop grand, on le diminue juste
+; de ce qu''il faut!
+                  if table[1, event.y] GT $
+                   (tailledimvar[event.y]/table[3, event.y])-table[0, event.y] then begin
+                     widget_control, widbase1, use_table_select = [1, event.y, 1, event.y] $
+                      , set_value = (tailledimvar[event.y]/table[3, event.y])-table[0, event.y]
+                  endif
+               ENDELSE
+            END
+            1:BEGIN             ;on a touche au count
+               if table[1, event.y] LT 1 then BEGIN
+                  table[1, event.y] = 1
+                  widget_control, widbase1, use_table_select = [1, event.y, 1, event.y] $
+                   , set_value = 1
+               endif
+; si il est trop grand, on le diminue juste de ce qu''il faut!
+               if table[1, event.y] GT $
+                (tailledimvar[event.y]/table[3, event.y])-table[0, event.y] then BEGIN
+                  widget_control, widbase1, use_table_select = [1, event.y, 1, event.y] $
+                   , set_value = (tailledimvar[event.y]/table[3, event.y])-table[0, event.y]
+               endif
+            END
+            2:BEGIN             ; on a touche au shift
+               widget_control, widbase1, use_table_select = [2, event.y, 2, event.y] $
+                , set_value = table[2, event.y] MOD (tailledimvar[event.y]/table[3, event.y])
+            END
+            3:BEGIN             ; on touche au stride
+               if table[3, event.y] LT 1 then BEGIN
+                  table[3, event.y] = 1
+                  widget_control, widbase1, use_table_select = [3, event.y, 3, event.y] $
+                   , set_value = 1
+               endif
+               if table[3, event.y] EQ 0 then $ ; il ne doit pas etre nul
+                widget_control, widbase1, use_table_select = [3, event.y, 3, event.y] $
+                , set_value = 1
+; il ne doit pas etre trop grand
+               if table[3, event.y] GT tailledimvar[event.y] then $
+                widget_control, widbase1, use_table_select = [0, event.y,3, event.y] $
+                , set_value = [0, 1, 0, tailledimvar[event.y]] $
+               ELSE BEGIN
+                  if table[1, event.y] GT $
+                   (tailledimvar[event.y]/table[3, event.y])-table[0, event.y] then begin
+                     widget_control, widbase1, use_table_select = [1, event.y, 1, event.y] $
+                      , set_value = (tailledimvar[event.y]/table[3, event.y])-table[0, event.y]
+                  endif
+               ENDELSE
+            END
+            ELSE:
+         endcase
+      END
+      2111:BEGIN                ;on a touche aux boutons oui/non
+; on actualise le vecteur selectatt a 0 ou 1 pour l''attribut concerne
+; (numero event.id)
+         selectatt[where(widbase2111 EQ event.id)] = event.select
+      end
+      31:BEGIN                  ;on a appuye sur 'get'
+         widget_control, widbase1, get_value = table
+         table = fix(table)
+         mcshift = where(table[2, *] NE 0)
+         mcoffset = table[0, *]
+         mccount = table[1, *]
+         mcstride = table[3, *]
+         if mcshift[0] NE -1 then BEGIN ; il y a des shifts
+; on lit l''integralite des dimensions pour lesquelles il y a un shift
+            mcoffset[mcshift] = 0
+            mccount[mcshift] = tailledimvar[mcshift]
+; on active pas stride qd il n''y en a pas besoin car ca fait ecrire a
+; l''ecran qqch de louche...
+            if total(mcstride) EQ n_elements(mcstride) then $
+             ncdf_varget, cdfid, varid, res, OFFSET = mcoffset, COUNT = mccount $
+            ELSE $
+             ncdf_varget, cdfid, varid, res, OFFSET = mcoffset, COUNT = mccount, STRIDE = mcstride
+; pour faire le shift
+            mcshift = table[2, *]
+            mcoffset = table[0, *]
+            mccount = table[1, *]
+; on definit commende qui permet de faire un shift
+            commande = 'res=shift(res'
+            for dim = 0, varcontient.ndims-1 do commande = commande+','+string(table[2,dim])
+            commande = commande+')'
+            rien = execute(commande)
+; on redefinit commnade qui permet de couper les dimensions qui n''ont
+; pas ete encore coupees (c''est celles que l''on shift)
+            commande = 'res=res[' ; initialisation de la commende
+            for dim = 0, varcontient.ndims-1 do BEGIN 
+               if mcshift[dim] EQ 0 then commande = commande+'*,' $
+               ELSE commande=commande+string(mcoffset[dim])+':'+string(mccount[dim]+mcoffset[dim]-1)+','
+            ENDFOR
+            commande = strmid(commande, 0, strlen(commande)-1)+']'
+            rien = execute(commande)
+; cas sans shift, on lit directement le bon bout de tableau
+         ENDIF ELSE BEGIN
+            if total(mcstride) EQ n_elements(mcstride) then $
+             ncdf_varget, cdfid, varid, res, OFFSET = mcoffset, COUNT = mccount $
+            ELSE $
+             ncdf_varget, cdfid, varid, res, OFFSET = mcoffset, COUNT = mccount, STRIDE = mcstride
+         ENDELSE
+; faut-il constituer une structure avec les attributs qui on ete selectionnes
+         if total(selectatt) NE 0 then BEGIN ; il y a des attributs selectionnes
+            res = create_struct(varcontient.name, res) ; on cree la structure
+            selectatt = where(selectatt EQ 1) ; on trouve les attributs selectiones 
+            for attid = 0,  n_elements(selectatt)-1 do BEGIN ; pour lesquels on prend
+               widget_control, widbase212[selectatt[attid]], get_value = attname ; le nom
+               widget_control, widbase213[selectatt[attid]], get_value = attvalue ; la valeur
+              res = create_struct(res, attname[0], attvalue[0]) ; on concatene la structe
+            endfor
+         endif
+         widget_control, event.top, /destroy ;on ferme le 2eme widget
+         widget_control, base, /destroy ;on ferme le 1eme widget
+         ncdf_close,cdfid
+      END
+      32:                       ;cas de l''affichage d''un held (avec xdisplayfile)
+      33:widget_control, event.top, /destroy ;on ferme le 2eme widget
+      ELSE:
+   endcase
+   return
+end
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO wid_var, widid_pere
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; NAME: wid_var
+;
+; PURPOSE: cette procedure gere le 2eme widget cree qd on appelle
+; xncdf_lec. ce widget concerne la lecture de la variable
+;
+; INPUTS: widid_pere: un scalere contenant l'identite du widget pere
+; qui a etait cree par xncdf_lec et qui a permis de selectionner la
+; variable a lire.
+;
+; OUTPUTS: indirectement res (le tableau ou la structure resultat)
+;
+; COMMON BLOCKS:resultat,infovariable,indicewid_var,motcle
+;
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+   COMMON resultat, res
+   COMMON infovariable, cdfid, listename, contient, nomdim, tailledim, varid, varcontient
+   COMMON indicewid_var, widbase1, widbase2111, widbase212, widbase213, selectatt
+   COMMON motcle, mcatt, mccount, mcoffset, mciodir, mcshift, mcstride, mcvar
+   res = -1
+;------------------------------------------------------------
+; ouverture de la fenetre de base sous forme de colonnes
+;------------------------------------------------------------
+   widbase = widget_base(/column, title='variable: '+varcontient.name, /align_center, group_leader = widid_pere)
+;------------------------------------------------------------
+; ouverture de  sous-fenetres de base ;
+;------------------------------------------------------------
+; widbase1 tableau des offsets
+;------------------------------------------------------------
+   rien = widget_label(widbase, value = ' ') ; on saute une ligne
+; defintion des lables des lignes du tableau
+   rowlab = string(tailledim[varcontient.dim])
+   for i = 0,  n_elements(rowlab)-1 do rowlab[i] = strtrim(rowlab[i], 1)
+   rowlab = nomdim[varcontient.dim]+replicate(': ', n_elements(varcontient.dim))+rowlab
+; definition des valeurs initiales du tableau
+   valinit = lonarr(4, n_elements(varcontient.dim))
+; colonne 0 : les offset
+   if keyword_set(mcoffset) AND n_elements(mcoffset) EQ varcontient.ndims THEN $
+    valinit[0,*]=mcoffset ELSE valinit[0, *] = 0
+; colonne 1 : les counts
+   if keyword_set(mccount) AND n_elements(mccount) EQ varcontient.ndims THEN  $
+    valinit[1,*]=mccount ELSE valinit[1, *] = tailledim[varcontient.dim]
+; colonne 2 : les shifts
+   if keyword_set(mcshift) AND n_elements(mcshift) EQ varcontient.ndims THEN $
+    valinit[2,*]=mcshift ELSE valinit[2, *] = 0
+; colonne 3 : les strides
+   if keyword_set(mcstride) AND n_elements(mcstride) EQ varcontient.ndims THEN $
+    valinit[3,*]=mcstride ELSE valinit[3, *] = 1
+; test des valeurs initiales du tableau
+   valinit = fix(valinit)
+   valinit[3, *] = 1 > valinit[3, *] < tailledim[varcontient.dim] ; test des strides
+   valinit[0, *] = 0 > valinit[0, *] < tailledim[varcontient.dim] ; test des offsets
+; test des counts
+   valinit[1, *] = 1 > valinit[1, *] < ((tailledim[varcontient.dim]/valinit[3, *])-valinit[0, *])
+   valinit[2, *] = valinit[2, *] MOD (tailledim[varcontient.dim]/valinit[3, *]) ; test des shifts
+; declaration du tableau
+   widbase1 = widget_table(widbase, row_labels = rowlab, value = valinit, /editable $
+                           , column_labels = ['Offset', 'Count', 'Shift', 'Stride'], uvalue = 1)
+; un petit blabla
+   rien = widget_label(widbase, value = 'ATTENTION: Faire des ''return'' pour que les valeurs', /align_center)
+   rien = widget_label(widbase, value = 'du tableau ou des textes soient bien prises en compte', /align_center)
+;------------------------------------------------------------
+; widbase2 choix des attributs
+;------------------------------------------------------------
+   rien = widget_label(widbase, value = ' ') ; on saute une ligne
+   widbase2 = widget_base(widbase, /column)
+; pour chaque attribut, on cree un widget (widbase21) qui contient en ligne un
+; bouton oui/non (widbase211), et deux wigdet text (widbase212,
+; widbase213)comportant le nom et la valeur de l''attribut.
+   widbase21 = lonarr(varcontient.natts)
+   widbase211 = lonarr(varcontient.natts)
+   widbase2111 = lonarr(varcontient.natts)
+; vecteur qui serviera a savoir quels boutons oui/non sont
+; selectiones. cf. wid_var_event
+   selectatt = lonarr(varcontient.natts)
+   selectatt[*] = 0
+   widbase212 = lonarr(varcontient.natts)
+   widbase213 = lonarr(varcontient.natts)
+   for attid = 0, varcontient.natts-1 do BEGIN ;boucle sur le nombre d''attributs
+      widbase21[attid] = widget_base(widbase2, /row)
+      name=ncdf_attname(cdfid,varid,attid)
+      ncdf_attget,cdfid,varid,name,value
+      widbase211[attid] = widget_base(widbase21[attid], /nonexclusive)
+      widbase2111[attid]  = widget_button(widbase211[attid], value = ' ', uvalue = 2111)
+      widbase212[attid] = widget_text(widbase21[attid], value = name, /editable)
+      widbase213[attid] = widget_text(widbase21[attid], value=strtrim(string(value),1), /editable)
+   endfor
+;------------------------------------------------------------
+; widbase3 boutons du bas
+;------------------------------------------------------------
+   widbase3 = widget_base(widbase, /row,/align_center)
+   widbase31=widget_button(widbase3,value='GET', uvalue=31)
+   widbase32=widget_button(widbase3,value='Help', uvalue=32)
+   widbase33=widget_button(widbase3,value='DONE', uvalue=33)
+;------------------------------------------------------------
+;execution de la fentre de base et des sous-fenetres
+;------------------------------------------------------------
+   widget_control,widbase,/realize
+;------------------------------------------------------------
+   xmanager,'wid_var',widbase
+   return
+end
+;------------------------------------------------------------
+
+PRO xncdf_lec_event, event
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; NAME:xncdf_lec_event
+;
+; PURPOSE: procedure appele par xmanager qd on appuie sur un bouton du
+; 1ere widget cree par xncdf_lec
+; 
+; INPUTS: event, une structure caracterisant le type d''evenement qui
+; arrive au widget numero1
+;
+; COMMON BLOCKS:resultat, infovariable, motcle
+;
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+   COMMON resultat, res
+   COMMON infovariable, cdfid, listename, contient, nomdim, tailledim, varid, varcontient
+   COMMON motcle, mcatt, mccount, mcoffset, mciodir, mcshift, mcstride, mcvar
+; quel est le type d''evenement?
+   widget_control, event.id, get_uvalue=uval
+; case sur le type d''evenement
+   case uval of
+      1:BEGIN                   ; on veut lire un autre fichier
+         widget_control, event.id, get_value = nom ; on recupere le nom
+         widget_control, event.top, /destroy ;on ferme le widget
+         ncdf_close,cdfid       ; on ferme le mauvais fichier qui a ete ouvert
+; on reapelle xncdf_lec
+         res = xncdf_lec(nom[0], ATT = mcatt, COUNT = mccount, OFFSET = mcoffset, IODIR = mciodir $
+                         , SHIFT = mcshift,  STRIDE = mcstride, VAR = mcvar) 
+         return
+      END
+      2:BEGIN                   ; une variable est selectionee
+         varid = event.index    ; on recupere son numero ds le fichier Netcdf
+         varcontient = ncdf_varinq(cdfid,varid)
+         wid_var, event.top     ; on appelle le programme qui lance le 2eme widget. cf. + haut
+      END
+      3:BEGIN                   ; bouton done
+         widget_control, event.top, /destroy ; on tue le widget
+         ncdf_close,cdfid       ; on ferme le fichier
+      END
+      ELSE:
+   endcase
+   return
+end
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: xncdf_lec
+;
+; PURPOSE: lecture d''un fichier Net Cdf avec des widgets ! 
+;
+; CATEGORY: lecture de fichiers avec widgets
+;
+; CALLING SEQUENCE: res=xncdf_lec([nom_fichier])
+; 
+; INPUTS: 
+;      OPTIONNEL, nom_fichier: c''est un string qui donne le nom du
+;       fichier a ouvrir.Si nomfichier ne contient pas le caractere
+;       separateur de repertoirte ('/' sous unix par ex), Le fichier
+;       sera cherche ds le repertoire courant
+;
+; KEYWORD PARAMETERS:
+;
+;       IODIR: string contenant le repertoire ou aller chercher le
+;       fichier a lire. Si nomfichier ne contient pas le caractere
+;       separateur de repertoirte ('/' sous unix par ex), Le fichier
+;       cherche s''appelera iodir+nom_fichier.
+;
+;       COUNT: An optional vector containing the counts to be used in
+;       reading Value. COUNT is a 1-based vector with an element for
+;       each dimension of the data to be written.The default matches
+;       the size of the variable so that all data is written out.
+;
+;       GROUP: The widget ID of the widget that calls XNCDF_LEC. When
+;       this ID is specified, a death of the caller results in a death
+;       of XNCDF_LEC. 
+;
+;       OFFSET: An optional vector containing the starting position
+;       for the read. The default start position is [0, 0, ...].
+;
+;       SHIFT: un vecteur d''entiers, specifiant pour chaque dimension
+;       de combien il faut la shifter. Par defaut c''est
+;       [0,0,...]. cf. la fonction shift pour +
+;       d''explications. ATTENTION, le shift est effectue sur le
+;       tableau de taille maximum avant la reduction eventuelle
+;       determinee par OFFSET et COUNT. Par contre il est effectue
+;       apres l''extraction eventuelle cree par le STRIDE.
+;
+;       STRIDE: An optional vector containing the strides, or sampling
+;       intervals, between accessed values of the netCDF variable. The
+;       default stride vector is that for a contiguous read, [1, 1,
+;       ...].
+;
+; OUTPUTS: 2 cas possibles:
+;       1) aucun attributs n''a ete selectionne. Dans ce cas res est
+;       le tableau que l''on voulait lire.
+;       2) Des attributs ont ete selectionnes. Dans ce cas res est une
+;       structre dont le premier element portant le nom de la variable
+;       est le tableau de valeurs et les autre auguments sont les
+;       arguments selectiones
+;
+; COMMON BLOCKS: wididbase, infovariable, resultat, motcle
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE: help, xncdf_lec()
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      24/8/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION xncdf_lec, nom, ATT = att, COUNT = count, GROUP = group, OFFSET = offset, IODIR = iodir, SHIFT = shift,  STRIDE = stride, VAR = var
+   COMMON wididbase, base
+   COMMON infovariable, cdfid, listename, contient, nomdim, tailledim, varid, varcontient
+   COMMON resultat, res
+   COMMON motcle, mcatt, mccount, mcoffset, mciodir, mcshift, mcstride, mcvar
+;------------------------------------------------------------
+; bidouille pour utiliser les mots cles (on passe par des variables
+; declarees ds un common)
+;------------------------------------------------------------
+   res = -1
+   if keyword_set(att) then mcatt = att ELSE mcatt = 0
+   if keyword_set(count) then mccount =count  ELSE mccount = 0
+   if keyword_set(offset) then mcoffset = offset ELSE mcoffset = 0
+   if keyword_set(shift) then mcshift = shift ELSE mcshift = 0
+   if keyword_set(stride) then mcstride = stride ELSE mcstride = 0
+   if keyword_set(var) then mcvar = var ELSE mcvar = 0
+;------------------------------------------------------------
+; choix du nom du fichier
+;------------------------------------------------------------
+; Quel type de machine est utiliee
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   CASE thisOS of
+      'MAC':sep = ':'
+      'WIN':sep = '\'
+      ELSE: sep = '/'
+   ENDCASE
+; si iodir n''est pas definit on l''initialise au repertoire courant
+   if NOT keyword_set(iodir) then cd,  current = iodir
+   mciodir = iodir
+; on complete iodir d''un caractere separateur de repertoire si besoin
+; est.
+   IF rstrpos(iodir, sep) NE strlen(iodir)-1 THEN iodir = iodir+sep 
+   if n_elements(nom) EQ 0 then BEGIN ; si nom n''est pas definit
+; on en trouve un grace au programme dialog_pickfile
+      nom = dialog_pickfile(filter = iodir+'*.nc') 
+      if nom[0] EQ '' then return,  -1 ; si on a rien trouve on sort
+;on complete nom par iodir si nom ne contient pas de caractere
+;separateur derepertoire
+   ENDIF ELSE if strpos(nom, sep) EQ -1 then nom = iodir+nom
+   test = findfile(nom)         ; le nom cherche correspond bien a un fichier?
+   while test[0] EQ '' OR n_elements(test) GT 1 do BEGIN ; on en cherche un tant qu''il ne correspond a rien!
+      test = test[0]
+      nom = dialog_pickfile(filter = iodir+'*.nc')
+      if nom EQ '' then return,  -1
+      test = findfile(nom)
+   endwhile
+;------------------------------------------------------------
+; ouverture du fichier nom
+;------------------------------------------------------------
+   cdfid=ncdf_open(nom)
+   contient=ncdf_inquire(cdfid)
+;------------------------------------------------------------
+; que contient le fichier??
+;------------------------------------------------------------
+; ouverture de la fenetre de base sous forme de colonnes
+   if n_elements(group) EQ 0 then base = widget_base(/column, title='Fichier: '+nom, /align_left) $
+   ELSE base = widget_base(/column, title='Fichier: '+nom, /align_left, GROUP_LEADER = group)
+; ouverture de  sous-fenetres de base ;
+;------------------------------------------------------------
+; base 1 titre portant le nom du fichier
+;------------------------------------------------------------
+   base1 = widget_base(base, /column, /align_center)
+   rien = widget_label(base1, value = 'Net Cdf filename', /align_center) ; blabla
+   rien = widget_text(base1, value = nom, /align_center, uvalue=1, /editable) ;nom du fichier que l''on peut changer 
+   rien = widget_label(base1, value = ' ') ; on saute une ligne
+;------------------------------------------------------------
+; base 2 informations generales sur le fichier
+;------------------------------------------------------------
+   base2 = widget_base(base, /column)
+;------------------------------------------------------------
+; informations sur les attributs globaux
+;------------------------------------------------------------
+   if contient.ngatts NE -1 then begin
+      rien = widget_label(base2, value = 'Nombre de attributs globaux: '+ strtrim(contient.ngatts,1), /align_left)
+      for attiq=0,contient.ngatts-1 do BEGIN ; bouble sur le nombre d'attributs globaux
+         name=ncdf_attname(cdfid,attiq,/global) ;nom de l''atribut
+         ncdf_attget,cdfid,name,value,/global ;valeur de l''atribut
+         rien = widget_text(base2, value = name+': '+strtrim(string(value),1), xsize = 60, /scroll, /wrap, /align_right)
+      endfor
+      rien = widget_label(base2, value = ' ')
+   endif
+;------------------------------------------------------------
+;  informations sur les dimensions
+;------------------------------------------------------------
+   rien = widget_label(base2, value = 'Nombre de dimensions: '+strtrim(contient.ndims,1), /align_left)
+   if contient.recdim NE -1 then begin ; bouble sur le nombre de dimensions
+      ncdf_diminq,cdfid,contient.recdim,name,value ; nom et valeur de la dimension
+      rien = widget_label(base2, value = 'nom de la dimension infinie: '+name, /align_left)
+   endif
+;
+   nomdim   =strarr(contient.ndims) ; vecteur contenant le nom des dimensions
+   tailledim=lonarr(contient.ndims) ; vecteur contenant la valeur des dimensions
+   for dimiq=0,contient.ndims-1 do begin ; bouble sur le nombre de dimensions
+      ncdf_diminq,cdfid,dimiq,name,value ; nom et valeur de la dimension
+      nomdim[dimiq]=name
+      tailledim[dimiq]=value
+      rien = widget_label(base2, value = name+' de taille: '+strtrim(value,1), /align_right)
+   ENDFOR
+   rien = widget_label(base2, value = ' ') ; on saute une ligne
+;------------------------------------------------------------
+; base 3 choix de la variable
+;------------------------------------------------------------
+   base3 = widget_base(base, /column)
+   rien = widget_label(base3, value = 'Nombre de variables: '+strtrim(contient.nvars,1), /align_left)
+   base31 = widget_base(base3, /row, /align_center)
+;creation d'un vecteur listename contenant le nom de toutes les
+;variables du fichier
+   listename = strarr(contient.nvars)
+   for varid=0,contient.nvars-1 do begin
+      varcontient=ncdf_varinq(cdfid,varid) ; que contient la variable
+      listename[varid] = varcontient.name
+   endfor
+   rien= widget_label(base31, value = 'variable')
+; creation d''un bouton a menu deroulant
+   base311=widget_droplist(base31,value=listename, uvalue=2)
+   rien = widget_label(base3, value = '')
+;------------------------------------------------------------
+; base 4 bouton done
+;------------------------------------------------------------
+   base4 = widget_base(base, /row)
+   base42=widget_button(base4,value='done', uvalue=3, /align_right)
+;execution de la fentre de base et des sous-fenetres
+   widget_control,base,/realize
+;------------------------------------------------------------
+   xmanager,'xncdf_lec',base
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+   return, res
+end
Index: tags/start/MATRICE/cmapply.pro
===================================================================
--- tags/start/MATRICE/cmapply.pro	(revision 5)
+++ tags/start/MATRICE/cmapply.pro	(revision 5)
@@ -0,0 +1,227 @@
+;+
+; NAME:
+;   CMAPPLY
+;
+; AUTHOR:
+;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
+;   craigm@lheamail.gsfc.nasa.gov
+;
+; PURPOSE:
+;   Applies a function to specified dimensions of an array
+;
+; MAJOR TOPICS:
+;   Arrays
+;
+; CALLING SEQUENCE:
+;   XX = CMAPPLY(OP, ARRAY, DIMS, [/DOUBLE], [TYPE=TYPE])
+;
+; DESCRIPTION:
+;   CMAPPLY will apply one of a few select functions to specified 
+;   dimensions of an array.  Unlike some IDL functions, you *do* have
+;   a choice of which dimensions that are to be "collapsed" by this
+;   function.  Iterative loops are avoided where possible, for 
+;   performance reasons.
+;
+;   The possible functions are:             (and number of loop iterations:)
+;     +     - Performs a sum (as in TOTAL)       number of collapsed dimensions
+;     *     - Performs a product                 same
+;     AND   - Finds LOGICAL "AND" (not bitwise)  same
+;     OR    - Finds LOGICAL "OR"  (not bitwise)  same
+;
+;     MIN   - Finds the minimum value            number of output elements
+;     MAX   - Finds the maximum value            same
+;
+; INPUTS:
+;
+;   OP - The operation to perform, as a string.  May be upper or lower
+;        case.
+;
+;   ARRAY - An array of values to be operated on.  Must not be of type
+;           STRING (7) or STRUCTURE (8).
+;
+; OPTIONAL INPUTS:
+;
+;   DIMS - An array of dimensions that are to be "collapsed", where
+;          the the first dimension starts with 1 (ie, same convention
+;          as IDL function TOTAL).  Whereas TOTAL only allows one
+;          dimension to be added, you can specify multiple dimensions
+;          to CMAPPLY.  Order does not matter, since all operations
+;          are associative and transitive.  NOTE: the dimensions refer
+;          to the *input* array, not the output array.  IDL allows a 
+;          maximum of 8 dimensions.
+;          DEFAULT: 1 (ie, first dimension)
+;
+; KEYWORDS:
+;
+;   DOUBLE - Set this if you wish the internal computations to be done
+;            in double precision if necessary.  If ARRAY is double 
+;            precision (real or complex) then DOUBLE=1 is implied.
+;            DEFAULT: not set
+;
+;   TYPE - Set this to the IDL code of the desired output type (refer
+;          to documentation of SIZE()).  Internal results will be
+;          rounded to the nearest integer if the output type is an
+;          integer type.
+;          DEFAULT: same is input type
+;
+; RETURN VALUE:
+;
+;   An array of the required TYPE, whose elements are the result of
+;   the requested operation.  Depending on the operation and number of
+;   elements in the input array, the result may be vulnerable to
+;   overflow or underflow.
+;
+; EXAMPLES:
+;   Shows how CMAPPLY can be used to total the second dimension of the
+;   array called IN.  This is equivalent to OUT = TOTAL(IN, 2)
+;
+;   IDL> IN  = INDGEN(5,5)
+;   IDL> OUT = CMAPPLY('+', IN, [2])
+;   IDL> HELP, OUT
+;   OUT             INT       = Array[5]
+;
+;   Second example.  Input is assumed to be an 5x100 array of 1's and
+;   0's indicating the status of 5 detectors at 100 points in time.
+;   The desired output is an array of 100 values, indicating whether
+;   all 5 detectors are on (=1) at one time.  Use the logical AND
+;   operation.
+;
+;   IDL> IN = detector_status             ; 5x100 array
+;   IDL> OUT = CMAPPLY('AND', IN, [1])    ; collapses 1st dimension
+;   IDL> HELP, OUT
+;   OUT             BYTE      = Array[100]
+;
+;   (note that MIN could also have been used in this particular case,
+;   although there would have been more loop iterations).
+;
+;   Third example.  Shows sum over first and third dimensions in an
+;   array with dimensions 4x4x4:
+;
+;   IDL> IN = INDGEN(4,4,4)
+;   IDL> OUT = CMAPPLY('+', IN, [1,3])
+;   IDL> PRINT, OUT
+;        408     472     536     600
+;
+; MODIFICATION HISTORY:
+;   Mar 1998, Written, CM
+;
+;-
+
+function cmapply, op, array, dimapply, double=dbl, type=type
+
+  if n_params() LT 2 then begin
+      message, "USAGE: XX = CMAPPLY('OP',ARRAY,2)", /info
+      message, '       where OP is +, *, AND, OR, MIN, MAX'
+      return, -1L
+  endif
+
+  ;; Parameter checking
+  ;; 1) the dimensions of the array
+  sz = size(array)
+  if sz(0) EQ 0 then $
+    message, 'ERROR: ARRAY must be an array!'
+
+  ;; 2) The type of the array
+  if sz(sz(0)+1) EQ 0 OR sz(sz(0)+1) EQ 7 OR sz(sz(0)+1) EQ 8 then $
+    message, 'ERROR: Cannot apply to UNDEFINED, STRING, or STRUCTURE'
+  if n_elements(type) EQ 0 then type = sz(sz(0)+1)
+
+  ;; 3) The type of the operation
+  szop = size(op)
+  if szop(szop(0)+1) NE 7 then $
+    message, 'ERROR: operation OP was not a string'
+
+  ;; 4) The dimensions to apply (default is to apply to first dim)
+  if n_params() EQ 2 then dimapply = 1
+  dimapply = [ dimapply ]
+  dimapply = dimapply(sort(dimapply))   ; Sort in ascending order
+  napply = n_elements(dimapply)
+
+  ;; 5) Use double precision if requested or if needed
+  if n_elements(dbl) EQ 0 then begin
+      dbl=0
+      if type EQ 5 OR type EQ 9 then dbl=1
+  endif
+
+  newop = strupcase(op)
+  newarr = array
+  newarr = reform(newarr, sz(1:sz(0)), /overwrite)
+  case 1 of
+
+      ;; *** Addition
+      (newop EQ '+'): begin
+          for i = 0, napply-1 do begin
+              newarr = total(temporary(newarr), dimapply(i)-i, double=dbl)
+          endfor
+      end
+
+      ;; *** Multiplication
+      (newop EQ '*'): begin ;; Multiplication (by summation of logarithms)
+          dummy = check_math(1, 1)  ;; Disable printing of messages
+          ;; The following step seems to be the slowest
+          newarr = alog(abs(dcomplex(temporary(newarr))))
+          for i = 0, napply-1 do begin
+              newarr = total(temporary(newarr), dimapply(i)-i, double=1)
+          endfor
+          newarr = exp(temporary(newarr))
+          dummy = check_math(0, 0)  ;; Enable printing of messages
+      end
+
+      ;; *** LOGICAL AND or OR
+      ((newop EQ 'AND') OR (newop EQ 'OR')): begin
+          newarr = temporary(newarr) NE 0
+          totelt = 1L
+          for i = 0, napply-1 do begin
+              newarr = total(temporary(newarr), dimapply(i)-i)
+              totelt = totelt * sz(dimapply(i))
+          endfor
+          if newop EQ 'AND' then return, (round(newarr) EQ totelt)
+          if newop EQ 'OR'  then return, (round(newarr) NE 0)
+      end
+
+      ;; *** Operations requiring element by element access ... ho hum
+      ((newop EQ 'MAX') OR (newop EQ 'MIN')): begin
+          ;; First task: rearrange dimensions so that the dimensions
+          ;; that are "kept" (ie, uncollapsed) are at the back
+          dimkeep = where(histogram(dimapply,min=1,max=sz(0)) ne 1, count)
+          if count EQ 0 then begin
+              case newop of
+                  'MAX': return, max(newarr)
+                  'MIN': return, min(newarr)
+              endcase
+          endif
+          newarr = transpose( temporary(newarr), [ dimapply-1, dimkeep ])
+          ;; totcol is the total number of collapsed elements
+          totcol = exp(total(alog(sz(dimapply))))
+          totkeep = exp(total(alog(sz(dimkeep+1))))
+          ;; this new array has two dimensions:
+          ;;   * the first, all elements that will be collapsed
+          ;;   * the second, all dimensions that will be preserved
+          ;; (the ordering is so that all elements to be collapsed are
+          ;;  adjacent in memory)
+          newarr = reform(newarr, round([totcol, totkeep]), /overwrite)
+          
+          ;; Next task: create result array
+          result = make_array(dimension=sz(dimkeep+1), type=type)
+
+          ;; Finally, compute the result, element by element
+          case newop of 
+              'MAX': for i = 0, totkeep-1 do result(i) = max(newarr(*,i))
+              'MIN': for i = 0, totkeep-1 do result(i) = min(newarr(*,i))
+          endcase
+          return, result
+      end
+              
+  endcase
+
+  newsz = size(newarr)
+  if type EQ newsz(newsz(0)+1) then return, newarr
+
+  ;; Cast the result into the desired type, if necessary
+  castfns = ['UNDEF', 'BYTE', 'FIX', 'LONG', 'FLOAT', $
+             'DOUBLE', 'COMPLEX', 'UNDEF', 'UNDEF', 'DCOMPLEX' ]
+  if type GE 1 AND type LE 3 then $
+    return, call_function(castfns(type), round(newarr)) $
+  else $
+    return, call_function(castfns(type), newarr)
+end
Index: tags/start/MATRICE/colle.pro
===================================================================
--- tags/start/MATRICE/colle.pro	(revision 5)
+++ tags/start/MATRICE/colle.pro	(revision 5)
@@ -0,0 +1,155 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:colle
+;
+; PURPOSE: Cette fonction de concatenation existe ds IDL (avec [] cf
+; ds le programme ds le case pour direc egale 1,2,3) tant que l''on ne
+; cherche pas a coller suivant une dimensionsuperieure ou egale a 4.  
+;
+; CATEGORY:bidouillage de matrice
+;
+; CALLING SEQUENCE:res=colle(bableau_de_pointeur,direc) ou bien
+;                  res=colle(tab1,tab2,tab3,tab4,.....,direc)
+;
+; INPUTS:
+;         
+;        CAS 1:
+;        tableau_de_pointeur:comme son nom l''indique c'est un tableau
+;        de pointeur, dont chaque elements pointe sur tableau a coller
+;
+;        par ex ds un programme, on veut coller n tableaux entre eux
+;
+;          tab=ptrarr(n,/allocate_heap)
+;          for i=0,n-1 do begin
+;             *tab[n]=replicate(n,2,3)
+;          endfor
+;          res=colle(tab,1)
+;
+;        CAS 2:
+;        on donne directement les tableaux a coller
+;        rq: ds ce cas on peut au plus donner 20 tableaux en entree.
+;
+;        ATTENTION : sans le mot cle /SAUVE les arguments en entree
+;        sont detruits lorsque l''on construit res. ds le cas 1 on
+;        detruit le tableau de pointeurs et les variables sur
+;        lesquelles on pointe.
+;
+;        direc: la direction suivant laquelle les coller, 1,2,3... 
+;
+; KEYWORD PARAMETERS:
+;
+;         /SAUVE: mot cle qui force a sauvegarder le tableau de
+;         pointeur et les tableaux a coller.
+;
+; OUTPUTS:res=matrice resultat
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+; 
+;         IDL> print, colle(replicate(1,2,2,2),indgen(2,2,2),2)   
+;                1       1
+;                1       1
+;                0       1
+;                2       3
+;
+;                1       1
+;                1       1
+;                4       5
+;                6       7
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       13/1/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; pour suprimer une variable.
+;------------------------------------------------------------
+   PRO UNDEFINE, varname  
+      tempvar = SIZE(TEMPORARY(varname))
+   END
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION colle, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, SAUVE = sauve
+   res = -1
+;------------------------------------------------------------
+; on met en place ptrtab et direc en fonction des arguments en entree
+;------------------------------------------------------------
+   case 1 of
+      n_params() EQ 2:BEGIN     ; cas ou l'on donne directement le tableau de pointeurs
+         ptrtab = a0
+         direc = a1
+         if NOT keyword_set(sauve) then undefine, a0
+; on recupere le nombre de tableaux a coller
+         nbretab = (size(ptrtab))[1]
+      end
+      n_params() GT 2:BEGIN
+; on recupere le nombre de tableaux a coller
+         nbretab = n_params()-1
+         bidon = execute('direc = a'+strtrim(n_params()-1, 2))
+; on ecrit le tableau de pointeur dont chaque element pointe sur un tableau
+         ptrtab=ptrarr(nbretab,/allocate_heap)
+         for n = 0,nbretab-1 do begin
+            bidon = execute('*ptrtab[n]=a'+strtrim(n, 2))
+            if NOT keyword_set(sauve) then bidon = execute('undefine, a'+strtrim(n, 2))
+         endfor
+         sauve = 0
+      end
+      ELSE:
+   endcase
+;------------------------------------------------------------
+; case sur la valeure de direc
+;------------------------------------------------------------
+   case direc of
+      1:BEGIN ; on colle suivant la dimension 1
+         res = *ptrtab[0]
+         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
+         FOR n = 1,nbretab-1 DO BEGIN
+            res = [temporary(res), *ptrtab[n]]
+            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
+         ENDFOR 
+      END 
+      2:BEGIN ; on colle suivant la dimension 2
+         res = *ptrtab[0]
+         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
+         FOR n = 1,nbretab-1 DO BEGIN
+            res = [[temporary(res)], [*ptrtab[n]]]
+            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
+         ENDFOR 
+      END 
+      3:BEGIN ; on colle suivant la dimension 3
+         res = *ptrtab[0]
+         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
+         FOR n = 1,nbretab-1 DO BEGIN
+            res = [[[temporary(res)]], [[*ptrtab[n]]]]
+            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
+         ENDFOR 
+      END
+      ELSE:BEGIN 
+; on transpose res de facon a mettre la dimension a coller numero 1.
+; pour cela on contient le vecteur permute qui donne la place que
+; doivent prendre les dimensions ds la matrice transposee
+         permute = indgen((size(*ptrtab[0]))[0])
+         permute[0] = direc-1
+         permute[direc-1] = 0
+         res = transpose(*ptrtab[0], permute)
+         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
+         FOR n = 1,nbretab-1 DO BEGIN ; on colle suivant la dimension 1
+            res = [temporary(res), transpose(*ptrtab[n], permute)]
+            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
+         ENDFOR
+         res = transpose(temporary(res), permute)
+      END
+   ENDCASE 
+;------------------------------------------------------------
+   if NOT keyword_set(sauve) then undefine, ptrtab
+sortie:
+   return,  res
+
+   
+END 
+ 
+;------------------------------------------------------------
Index: tags/start/MATRICE/congridseb.pro
===================================================================
--- tags/start/MATRICE/congridseb.pro	(revision 5)
+++ tags/start/MATRICE/congridseb.pro	(revision 5)
@@ -0,0 +1,70 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:CONGRIDSEB
+;
+; PURPOSE:meme chose que congrid mais qui marche ...
+;        cf par ex:
+;IDL> print, congrid([[1,2,3,4],[5,6,7,8]],12,4)
+;       1 1 1 2 2 2 3 3 3 3 4 4
+;       1 1 1 2 2 2 3 3 3 3 4 4
+;       5 5 5 6 6 6 7 7 7 7 8 8
+;       5 5 5 6 6 6 7 7 7 7 8 8
+;IDL> print, rebin([[1,2,3,4],[5,6,7,8]],12,4)
+;       1 1 1 2 2 2 3 3 3 4 4 4
+;       3 3 3 4 4 4 5 5 5 6 6 6
+;       5 5 5 6 6 6 7 7 7 8 8 8
+;       5 5 5 6 6 6 7 7 7 8 8 8
+;IDL> print, congridseb([[1,2,3,4],[5,6,7,8]],12,4)
+;       1 1 1 2 2 2 3 3 3 4 4 4
+;       1 1 1 2 2 2 3 3 3 4 4 4
+;       5 5 5 6 6 6 7 7 7 8 8 8
+;       5 5 5 6 6 6 7 7 7 8 8 8
+;
+; CATEGORY:bidouille matrices
+;
+; CALLING SEQUENCE:res=congridseb(tableau,x[,y])
+;
+; INPUTS:tableau:un tableau 1 ou 2d
+;        x:dim en x du resultat doit etre un multiple de dim en x de tableau
+;        y:dim en y du resultat doit etre un multiple de dim en y de tableau
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:res un tableau de dim x * y
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      20/3/98
+;                      18/6/1999 supression d''une horrible boucle
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+function congridseb, tableau, x, y
+   res=tableau
+   taille = size(tableau)
+   CASE N_PARAMS() OF
+      2: begin
+         res=replicate(1,1.*x/taille[1])#res[*]
+         return, res[*]
+      end
+      3: begin
+         res = transpose(res)
+         res = replicate(1, 1.*y/taille[2])#res[*]
+         res = reform(res, y, taille[1], /over)
+         res = transpose(res)
+         res = replicate(1, 1.*x/taille[1])#res[*]
+        return, reform(res, x,y, /overwrite)
+      end
+      else: return, report('Mauvais nombre de parametre dans l''appel de CONGRIDSEB')
+   endcase            
+end
Index: tags/start/MATRICE/different.pro
===================================================================
--- tags/start/MATRICE/different.pro	(revision 5)
+++ tags/start/MATRICE/different.pro	(revision 5)
@@ -0,0 +1,58 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:different
+;
+; PURPOSE:calcule les elements differents de 2 matrices D'ENTIERS POSITIFS
+;
+; CATEGORY:calcule sur les matrices
+;
+; CALLING SEQUENCE:res=different(a,b)
+;
+; INPUTS:a et b:arrays of positive integers, which need
+;               not be sorted. Duplicate elements are ignored, as they have no
+;               effect on the result
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:tableau
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; The empty set is denoted by an array with the first element equal to
+; -1.
+;
+; RESTRICTIONS:
+;
+; These functions will not be efficient on sparse sets with wide
+; ranges, as they trade memory for efficiency. The HISTOGRAM function
+; is used, which creates arrays of size equal to the range of the
+; resulting set.
+;
+; EXAMPLE:
+;
+;   a = [2,4,6,8]
+;   b = [6,1,3,2]
+;   different(a,b) = [ 4, 8]         ; Elements in A but not in B
+;
+; MODIFICATION HISTORY: 
+;
+; http://www.dfanning.com/tips/set_operations.html
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION different, a, b  
+
+   ; = a and (not b) = elements in A but not in B
+
+mina = Min(a, Max=maxa)
+minb = Min(b, Max=maxb)
+IF (minb GT maxa) OR (maxb LT mina) THEN RETURN, a ;No intersection...
+r = Where(Histogram(a, Min=mina, Max=maxa) $
+          *(1-Histogram(b, Min=mina, Max=maxa)), count)
+IF count eq 0 THEN RETURN, -1 ELSE RETURN, r + mina
+END
Index: tags/start/MATRICE/extrait.pro
===================================================================
--- tags/start/MATRICE/extrait.pro	(revision 5)
+++ tags/start/MATRICE/extrait.pro	(revision 5)
@@ -0,0 +1,145 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:extrait
+;
+; PURPOSE:extraction de sous domaines de matrices. Meme si le sous
+; domaine est "troue". cf. : l''exemple
+; Par defaut IDL peut faire des extractions de sous domaines:
+;
+;      IDL> a=indgen(5,5) 
+;      IDL> print, a 
+;             0       1       2       3       4
+;             5       6       7       8       9
+;            10      11      12      13      14
+;            15      16      17      18      19
+;            20      21      22      23      24
+;      IDL> print, a[[0,2],3] 
+;            15      17
+;      IDL> print, a[[0,2],*]  
+;             0       2
+;             5       7
+;            10      12
+;            15      17
+;            20      22
+; mais 
+;      IDL> print, a[[0,2],[3,4]] 
+;            15      22
+; alors que
+;      IDL> print, extrait(a,[0,2],[3,4])  
+;            15      17
+;            20      22
+;
+; CATEGORY:bidouille avec les matrices
+;
+; CALLING SEQUENCE:res=extrait(tab,indicex[,indicey[,indicez,[indicet]]])
+;
+; INPUTS:
+;        tab: un tableau 1,2,3 ou 4 d
+;
+;        indicex: indicex peut avoir deux formes:
+;              1)un vecteur contenant les indices des lignes a garder
+;              2)le string '*' dans ce cas touts les lignes sont
+;              gardees
+;
+;        indicey/z/t: la meme chose que indicex mais pour les
+;        dimensions 2,3 et 4.
+;
+;        rq: il faut autant de vecteurs indice que tab a de dimensions
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;         res: une matice 1,2,3 ou 4d extraite a partir de tab
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:res=-1 en cas d''erreur
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+; j''ai une matrice A de dim 2. je veux en extraire une petite matrice
+; 2d interscetion de la ligne 2,3 et 7 et de la colonne 0 et 1
+;      
+;      res=extrait(A,[2,3,7],[0,1])
+;
+;autre ex:
+;      IDL> print, a 
+;      a b c
+;      d e f
+;      g h i
+;      IDL> print, extrait(a,[0,2],[0,2])        
+;      a c
+;      g i
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       12/1/1999
+;                       29/4/1999: correction d''un bug et complement
+;                       de l''en-tete
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION extrait, tab, indicex, indicey, indicez, indicet
+;------------------------------------------------------------
+   taille = size(tab)
+;------------------------------------------------------------
+; test du nombre de parametres
+; et de la nature de indice (pour LE cas 'x')
+;------------------------------------------------------------
+   if n_params() NE taille[0]+1 THEN $
+    return, report('il faut autant d''indices que de dimension du tableau')
+   IF n_params() GE 5 THEN BEGIN 
+      if size(indicet,/type) EQ 7 then indicet = lindgen(taille[4]) $
+      ELSE indicet = long(indicet)
+      nt = n_elements(indicet) 
+   ENDIF 
+   IF n_params() GE 4 THEN BEGIN 
+      if size(indicez,/type) EQ 7 then indicez = lindgen(taille[3]) $
+      ELSE indicez = long(indicez)
+      nz = n_elements(indicez) 
+   ENDIF 
+   IF n_params() GE 3 THEN BEGIN 
+      if size(indicey,/type) EQ 7 then indicey = lindgen(taille[2]) $
+      ELSE indicey = long(indicey)
+      ny = n_elements(indicey) 
+   ENDIF
+   IF n_params() GE 2 THEN BEGIN 
+      if size(indicex,/type) EQ 7 then indicex = lindgen(taille[1]) $
+      ELSE indicex = long(indicex)
+      nx = n_elements(indicex) 
+   ENDIF
+   
+;------------------------------------------------------------
+; construction du tableau d''indice et du resultat suivant la taille
+; de tab
+;------------------------------------------------------------
+  case taille[0] of
+      1:res = tab[indicex]
+      2:BEGIN
+         indice = indicex#replicate(1, ny)+taille[1]*replicate(1, nx)#indicey
+         res = tab[indice]
+      END 
+      3:BEGIN
+         indice = indicex#replicate(1, ny)+taille[1]*replicate(1, nx)#indicey
+         indice = temporary(indice[*])#replicate(1, nz) $
+          +taille[1]*taille[2]*replicate(1, nx*ny)#indicez
+         res = tab[reform(indice, nx, ny, nz, /over)]
+      END 
+      4:BEGIN
+         indice = indicex#replicate(1, ny)+taille[1]*replicate(1, nx)#indicey
+         indice = temporary(indice[*])#replicate(1, nz) $
+          +taille[1]*taille[2]*replicate(1, nx*ny)#indicez
+         indice = temporary(indice[*])#replicate(1, nt) $
+          +taille[1]*taille[2]*taille[3]*replicate(1, nx*ny*nz)#indicet
+         res = tab[reform(indice, nx, ny, nz, nz, /over)]
+      END 
+   endcase
+
+
+;------------------------------------------------------------
+;------------------------------------------------------------
+   return, res
+end
Index: tags/start/MATRICE/inter.pro
===================================================================
--- tags/start/MATRICE/inter.pro	(revision 5)
+++ tags/start/MATRICE/inter.pro	(revision 5)
@@ -0,0 +1,73 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:inter
+;
+; PURPOSE:calcule l''intersection de 2 matrices D'ENTIERS POSITIFS
+;
+; CATEGORY:calcule sur les matrices
+;
+; CALLING SEQUENCE:res=inter(a,b)
+;
+; INPUTS:a et b:arrays of positive integers, which need
+;               not be sorted. Duplicate elements are ignored, as they have no
+;               effect on the result
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:tableau
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; The empty set is denoted by an array with the first element equal to
+; -1.
+;
+; RESTRICTIONS:
+;
+; These functions will not be efficient on sparse sets with wide
+; ranges, as they trade memory for efficiency. The HISTOGRAM function
+; is used, which creates arrays of size equal to the range of the
+; resulting set.
+;
+; EXAMPLE:
+;
+;   a = [2,4,6,8]
+;   b = [6,1,3,2]
+;   inter(a,b) = [ 2, 6]       ; Common elements
+;
+; MODIFICATION HISTORY: 
+;
+; http://www.dfanning.com/tips/set_operations.html
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+
+FUNCTION inter, a, b
+;
+   case 1 of
+      n_elements(a) EQ 0:return,  -1
+      n_elements(b) EQ 0:return,  -1
+      n_elements(a) EQ 1 AND n_elements(b) NE 1: $
+       if (where(b EQ a[0]))[0] EQ -1 then return, -1 ELSE return,  a[0]
+      n_elements(b) EQ 1 AND n_elements(a) NE 1: $
+       if (where(a EQ b[0]))[0] EQ -1 then return, -1 ELSE return,  b[0]
+      n_elements(a) EQ 1 AND n_elements(b) EQ 1: $
+       if (where(a[0] EQ b[0]))[0] EQ -1 then return, -1 ELSE return,  a[0]
+      ELSE:
+   ENDCASE
+;
+minab = Min(a, Max=maxa) > Min(b, Max=maxb) ;Only need intersection of ranges
+maxab = maxa < maxb
+
+   ; If either set is empty, or their ranges don't intersect: result = NULL.
+
+IF maxab LT minab OR maxab LT 0 THEN RETURN, -1
+r = Where(Histogram(a, Min=minab, Max=maxab) $
+          *Histogram(b, Min=minab, Max=maxab), count)
+
+IF count EQ 0 THEN RETURN, -1 ELSE RETURN, r + minab
+END
Index: tags/start/MATRICE/make_selection.pro
===================================================================
--- tags/start/MATRICE/make_selection.pro	(revision 5)
+++ tags/start/MATRICE/make_selection.pro	(revision 5)
@@ -0,0 +1,133 @@
+; $Id$
+;-------------------------------------------------------------
+;+
+; NAME:
+;        MAKE_SELECTION (function)
+;
+; PURPOSE:
+;        Convert an array of selected values to an index
+;        array that identifies the selected values in a list
+;        or data array. 
+;
+; CATEGORY:
+;        Tools
+;
+; CALLING SEQUENCE:
+;        index = MAKE_SELECTION(NAMES,SELNAMES [,keywords])
+;
+; INPUTS:
+;        NAMES -> A list or array of values to choose from 
+;
+;        SELNAMES -> A list of selected values
+;
+; KEYWORD PARAMETERS:
+;        ONLY_VALID -> Return only indices of found values. Values not
+;            found are skipped. Default is to return 1 index value for
+;            each SELNAME, which is -1 if SELNAME is not contained in 
+;            NAMES. If ONLY_VALID is set, the -1 values will be deleted,
+;            and a value of -1 indicates that no SELNAME has been found
+;            at all.
+;
+;        REQUIRED -> Normally, MAKE_SELECTION will return indices for
+;            all values that are found, simply ignoring the selected
+;            values that are not in the NAMES array (although an error
+;            message is displayed). Set this keyword to return with
+;            -1 as soon as a selected value is not found.
+;
+;        QUIET -> Suppress printing of the error message if a
+;            selected value is not found (the error condition will
+;            still be set).
+;
+; OUTPUTS:
+;        A (long) array with indices to reference the selected values
+;        in the NAMES array.
+;
+; SUBROUTINES:
+;
+; REQUIREMENTS:
+;
+; NOTES:
+;        If the NAMES array contains multiple entries of the same value,
+;        only the index to the first entry will be returned.
+;
+;        A selection can contain multiple instances of the same value.
+;        The index array will contain one entry per selected item
+;        (See example below)
+;
+; EXAMPLE:
+;        names = [ 'Alfred','Anton','Peter','John','Mary']
+;        index = MAKE_SELECTION(names,['Peter','Mary'])
+;        print,index
+;        ; prints  2  4
+;
+;        vals = indgen(20)
+;        index = MAKE_SELECTION(vals,[9,-5,8,7,7,8,9])
+;        print,index
+;        ; prints  9  -1  8  7  7  8  9
+;
+;        index = MAKE_SELECTION(vals,[9,-5,8,7,7,8,9],/ONLY_VALID)
+;        print,index
+;        ; prints  9  8  7  7  8  9
+;
+;        index = MAKE_SELECTION(vals,[9,-5,8,7,7,8,9],/REQUIRED)
+;        print,index
+;        ; prints  -1
+;
+;
+; MODIFICATION HISTORY:
+;        mgs, 28 Aug 1998: VERSION 1.00
+;        mgs, 29 Aug 1998: - changed behaviour and added ONLY_VALID keyword
+;
+;-
+; Copyright (C) 1998, Martin Schultz, Harvard University
+; This software is provided as is without any warranty
+; whatsoever. It may be freely used, copied or distributed
+; for non-commercial purposes. This copyright notice must be
+; kept with any copy of this software. If this software shall
+; be used commercially or sold as part of a larger package,
+; please contact the author to arrange payment.
+; Bugs and comments should be directed to mgs@io.harvard.edu
+; with subject "IDL routine make_selection"
+;-------------------------------------------------------------
+
+
+function make_selection,names,selnames,  $
+            only_valid=only_valid,required=required,  $
+            quiet=quiet
+ 
+ 
+ 
+    ; return an index array with a number for each element in 
+    ; selnames that is found in names.
+    ; Set the REQUIRED keyword to return -1 if one element is
+    ; not found, otherwise -1 will only be returned, if no 
+    ; element is found.
+ 
+    ; reset error state to 0
+    message,/reset
+ 
+    quiet = keyword_set(quiet)
+    result = -1L
+ 
+    for i=0,n_elements(selnames)-1 do begin
+       test = where(names eq selnames[i])
+       result = [ result, test[0] ] 
+       if (test[0] lt 0) then begin
+           if (keyword_set(ONLY_VALID) OR keyword_set(REQUIRED)) then $
+              message,'Selected name not found in names array ('+ $
+                      strtrim(selnames[i],2)+')!',/CONT,NOPRINT=quiet
+           if (keyword_set(required)) then return,-1L
+       endif
+    endfor
+ 
+    if (n_elements(result) gt 1) then result = result[1:*]
+
+    if (keyword_set(only_valid)) then begin
+        ind = where(result ge 0)
+        if (ind[0] ge 0) then result = result[ind] $
+        else result = -1L
+    endif
+ 
+    return,result
+ 
+end
Index: tags/start/MATRICE/union.pro
===================================================================
--- tags/start/MATRICE/union.pro	(revision 5)
+++ tags/start/MATRICE/union.pro	(revision 5)
@@ -0,0 +1,52 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:union
+;
+; PURPOSE:calcule l''union de 2 matrices D'ENTIERS POSITIFS
+;
+; CATEGORY:calcule sur les matrices
+;
+; CALLING SEQUENCE:res=union(a,b)
+;
+; INPUTS:a et b:arrays of positive integers, which need
+;               not be sorted. Duplicate elements are ignored, as they have no
+;               effect on the result
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:tableau
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; The empty set is denoted by an array with the first element equal to
+; -1.
+;
+; RESTRICTIONS:
+;
+; These functions will not be efficient on sparse sets with wide
+; ranges, as they trade memory for efficiency. The HISTOGRAM function
+; is used, which creates arrays of size equal to the range of the
+; resulting set.
+;
+; EXAMPLE:
+;
+;   a = [2,4,6,8]
+;   b = [6,1,3,2]
+;   union(a,b) = [ 1, 2, 3, 4, 6, 8]  ; Elements in either set
+;
+; MODIFICATION HISTORY: 
+;
+; http://www.dfanning.com/tips/set_operations.html
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION union, a, b
+IF a[0] LT 0 THEN RETURN, b    ;A union NULL = a
+IF b[0] LT 0 THEN RETURN, a    ;B union NULL = b
+RETURN, Where(Histogram([a,b], OMin = omin)) + omin ; Return combined set
+END
Index: tags/start/MATRICE/zeroun.pro
===================================================================
--- tags/start/MATRICE/zeroun.pro	(revision 5)
+++ tags/start/MATRICE/zeroun.pro	(revision 5)
@@ -0,0 +1,47 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:zeroun
+;
+; PURPOSE:renvoie un vecteur ou une matrice constitue de o et de 1 en
+; alternance
+;
+; CATEGORY:function, matrices
+;
+; CALLING SEQUENCE:resultat=zeroun(n1 [,n2])
+;
+; INPUTS:
+;	n1=nombre d'elements dans la premiere dimension
+;	n2=nombre d'elements dans la deuxieme dimension
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:resultat
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       1/12/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+function zeroun, n1,n2
+   CASE N_PARAMS() OF
+      1:return, findgen(n1) mod 2
+      2:BEGIN 
+         if fix(n1/2) EQ n1/2. then BEGIN ;nombre pair de colonnes
+            res = findgen(n1+1,n2) mod 2
+            return, res[0:n1-1, *]
+         ENDIF ELSE return, findgen(n1,n2) mod 2 ;nombre impair de colonnes
+      END
+      else: return,  report('Mauvais nombre de parametre dans l''appel de ZEROUN')
+   endcase            
+end
Index: tags/start/PLOTS/DESSINE/bar_plot.pro
===================================================================
--- tags/start/PLOTS/DESSINE/bar_plot.pro	(revision 5)
+++ tags/start/PLOTS/DESSINE/bar_plot.pro	(revision 5)
@@ -0,0 +1,249 @@
+; $Id$
+;
+; Copyright (c) 1990-2000, Research Systems, Inc.  All rights reserved.
+;	Unauthorized reproduction prohibited.
+;
+
+pro bar_plot,values,baselines=baselines,colors=colors,barnames=barnames, $
+          title=title,xtitle=xtitle,ytitle=ytitle,baserange=baserange, $
+          barwidth=barwidth,barspace=barspace,baroffset=baroffset, $
+          outline=outline,overplot=overplot,background=background, $
+          rotate=rotate, _EXTRA = ex
+;+
+; NAME:
+;	BAR_PLOT
+;
+; PURPOSE:
+;	Create a bar graph, or overplot on an existing one.
+;
+; CATEGORY:
+;	Graphics.
+;
+; CALLING SEQUENCE:
+;	BAR_PLOT, Values
+;
+; INPUTS:
+;	Values:	A vector containing the values to be represented by the bars.
+;		Each element in VALUES corresponds to a single bar in the
+;		output.
+;
+; KEYWORD PARAMETERS:
+;   BASELINES:	A vector, the same size as VALUES, that contains the
+;		base value associated with each bar.  If not specified,
+;		a base value of zero is used for all bars.
+;
+;      COLORS:	A vector, the same size as VALUES, containing the color index
+;		to be used for each bar.  If not specified, the colors are
+;		selected based on spacing the color indices as widely as
+;		possible within the available colors (specified by D.N_COLORS).
+;
+;    BARNAMES:	A string array, containing one string label per bar.
+;		If the bars are vertical, the labels are placed beneath
+;		them.  If horizontal (rotated) bars are specified, the labels
+;		are placed to the left of the bars.
+;
+;	TITLE:	A string containing the main title to for the bar plot.
+;
+;	XTITLE:	A string containing the title for the X axis.
+;
+;	YTITLE:	A string containing the title for the Y axis.
+;
+;   BASERANGE:	A floating-point scalar in the range 0.0 to 1.0, that
+;		determines the fraction of the total available plotting area
+;		(in the direction perpendicular to the bars) to be used.
+;		If not specified, the full available area is used.
+;
+;    BARWIDTH:	A floating-point value that specifies the width of the bars
+;		in units of "nominal bar width".  The nominal bar width is
+;		computed so that all the bars (and the space between them,
+;		set by default to 20% of the width of the bars) will fill the
+;		available space (optionally controlled with the BASERANGE
+;		keyword).
+;
+;    BARSPACE: 	A scalar that specifies, in units of "nominal bar width",
+;		the spacing between bars.  For example, if BARSPACE is 1.0,
+;		then all bars will have one bar-width of space between them.
+;		If not specified, the bars are spaced apart by 20% of the bar
+;		width.
+;
+;   BAROFFSET:	A scalar that specifies the offset to be applied to the
+;		first bar, in units of "nominal bar width".  This keyword
+;		allows, for example, different groups of bars to be overplotted
+;		on the same graph.  If not specified, the default offset is
+;		equal to BARSPACE.
+;
+;     OUTLINE:	If set, this keyword specifies that an outline should be
+;		drawn around each bar.
+;
+;    OVERPLOT:	If set, this keyword specifies that the bar plot should be
+;		overplotted on an existing graph.
+;
+;  BACKGROUND:	A scalar that specifies the color index to be used for
+;		the background color.  By default, the normal IDL background
+;		color is used.
+;
+;	ROTATE:	If set, this keyword indicates that horizontal rather than
+;		vertical bars should be drawn.  The bases of horizontal bars
+;		are on the left, "Y" axis and the bars extend to the right.
+;
+; OUTPUTS:
+;	A bar plot is created, or an existing one is overplotted.
+;
+; EXAMPLE:
+;	By using the overplotting capability, it is relatively easy to create
+;	stacked bar charts, or different groups of bars on the same graph.
+;
+;	For example, if ARRAY is a two-dimensional array of 5 columns and 8
+;	rows, it is natural to make a plot with 5 bars, each of which is a
+;	"stacked" composite of 8 sections.  First, create a 2D COLORS array,
+;	equal in size to ARRAY, that has identical color index values across
+;	each row to ensure that the same item is represented by the same color
+;	in all bars.
+;
+;	With ARRAYS and COLORS defined, the following code fragment
+;	illustrates the creation of stacked bars (note that the number of rows
+;	and columns is arbitrary):
+;
+;	!Y.RANGE = [0,ymax] ; Scale range to accommodate the total bar lengths.
+;	BASE = INTARR(NROWS)
+;	FOR I = 0, NROWS-1 DO BEGIN
+;	   BAR_PLOT, ARRAY(*,I), COLORS=COLORS(*,I), BASELINES=BASE, $
+;	             BARWIDTH=0.75, BARSPACE=0.25, OVER=(I GT 0)
+;	   BASE = BASE + ARRAY(*,I)
+;	ENDFOR
+;
+;	To plot each row of ARRAY as a clustered group of bars within the same
+;	graph, use the BASERANGE keyword to restrict the available plotting
+;	region for each set of bars.  The sample code fragment below
+;	illustrates this method:
+;
+;	FOR I = 0, NROWS-1 DO $
+;	   BAR_PLOT, ARRAY(*,I), COLORS=COLORVECT, BARWIDTH=0.8,BARSPACE=0.2, $
+;	     BAROFFSET=I*((1.0+BARSPACE)*NCOLS), OVER=(I GT 0), BASERANGE=0.19
+;
+;	where NCOLS is the number of columns in ARRAY, and COLORVECT is a
+;	vector containing the color indices to be used for each group of
+;	bars.  (In this example, each group uses the same set of colors, but
+;	this could easily be changed.)
+;
+; MODIFICATION HISTORY:
+;	August 1990, T.J. Armitage, RSI, initial programming.  Replacement
+;	for PLOTBAR and OPLOTBAR routines written by William Thompson.
+;
+;	September 1990, Steve Richards, RSI, changed defaults to improve the
+;	appearance of the bar plots in the default mode. Included
+;	spacing the bars slightly.
+;-
+if (n_params(d) eq 0) then begin  ;Print call & return if no parameters
+  print,'bar_test,values,baselines=baselines,colors=colors,barnames=barnames,$'
+  print,' title=title,xtitle=xtitle,ytitle=ytitle,baserange=baserange, $'
+  print,' barwidth=barwidth,barspace=barspace,baroffset=baroffset, $'
+  print,' outline=outline,overplot=overplot,background=background, $'
+  print,' rotate=rotate'
+  return
+endif
+
+nbars=n_elements(values)		; Determine number of bars
+; Baselines (bars extend from baselines through values); default=0
+if not(keyword_set(baselines)) then baselines=intarr(nbars)
+; Default colors spaced evenly in current color table
+if not(keyword_set(colors)) then $
+   colors=fix((!d.n_colors/float(nbars))*(indgen(nbars)+0.5))
+; Labels for the individual bars; none by default
+if not(keyword_set(barnames)) then barnames=strarr(nbars)+' '
+; Main title
+if not(keyword_set(title)) then title=''
+; Centered title under X-axis
+if not(keyword_set(xtitle)) then xtitle=''
+; Title for Y-axis
+if not(keyword_set(ytitle)) then ytitle=''
+; Fraction (0-1) of full X range to use
+if not(keyword_set(baserange)) then baserange=1.0
+; Space betw. bars, taken from nominal bar widths; default is none
+If not(keyword_set(barspace)) then barspace=0.2
+; Bar width scaling factor, relative to nominal
+if not(keyword_set(barwidth)) then barwidth=1.0 - barspace - barspace / nbars
+; Initial X offset, in scaled bar widths; default is none
+if not(keyword_set(baroffset)) then baroffset=barspace/barwidth
+; Outline of bars; default is none
+outline = keyword_set(outline)
+; Overplot (do not erase the existing display); default is to create new plot
+overplot = keyword_set(overplot)
+; Background color index; defaults to 0 (usually black) if not specified
+if not(keyword_set(background)) then background=0
+; Rotate (make horizontal bars); default is vertical bars
+rotate = keyword_set(rotate)
+
+mnB = MIN(baselines, MAX=mxB, /NAN)
+mnV = MIN(values, MAX=mxV, /NAN)
+range=[mnB < mnV, $    ;Minimum of bases & values
+		mxB > mxV]      ;Maximum of bases & values
+
+if (rotate) then begin				   ;Horizontal bars
+   if (!x.range[0] eq 0) and (!x.range[1] eq 0) $  ;Determine range for X-axis
+      then xrange=range $
+      else xrange=!x.range			   ;Or, use range specified
+   if (!y.range[0] eq 0) and (!y.range[1] eq 0) $  ;Plot will calculate
+      then $                                       ; defaults for X, but not
+        yrange = [0, n_elements(values)] $         ; for Ys, so fill in here.
+      else $
+        yrange=!y.range				   ;Axis perpend. to bars
+   yticks=1					   ;Suppress ticks in plot
+   ytickname=strarr(2)+' '
+   xticks=0
+   xtickname=strarr(1)+''
+endif else begin				   ;Vertical bars
+   if (!y.range[0] eq 0) and (!y.range[1] eq 0) $  ;Determine range for Y-axis
+      then yrange=range $
+      else yrange=!y.range	           	   ;Or, use range specified
+   xrange=!x.range				   ;Axis perpend. to bars
+   xticks=1					   ;Suppress ticks in plot
+   xtickname=strarr(2)+' '
+   yticks=0
+   ytickname=strarr(1)+''
+endelse
+if (overplot eq 0) then $			   ;Create new plot, no data
+plot,[values],/nodata,title=title,xtitle=xtitle,ytitle=ytitle, $
+   noerase=overplot,xrange=xrange,yrange=yrange,xticks=xticks, $
+   xtickname=xtickname,yticks=yticks,ytickname=ytickname, $
+   xstyle=1,ystyle=1,/data,background=background, _EXTRA = ex
+if (rotate) then begin				   ;Horizontal bars
+   base_win=!y.window				   ;Window range in Y
+   scal_fact=!x.s				   ;Scaling factors
+   tick_scal_fact=!y.s				   ;Tick scaling factors
+endif else begin				   ;Vertical bars
+   base_win=!x.window				   ;Window range in X
+   scal_fact=!y.s				   ;Scaling factors
+   tick_scal_fact=!x.s				   ;Tick scaling factors
+endelse
+winrange=baserange*(base_win[1]-base_win[0])	   ;Normal. window range
+barsize=barwidth*winrange/nbars			   ;Normal. bar width
+winoffset=base_win[0]+(baroffset*barsize)	   ;Normal. first offset
+bases=scal_fact[0]+(scal_fact[1]*baselines)	   ;Baselines, in normal coor.
+normal=scal_fact[0]+(scal_fact[1]*values)	   ;Values, in normal coor.
+barstart=indgen(nbars)*(barsize+barspace*(winrange/nbars)) ;Coor. at left edges
+tickv=winoffset+barstart+(0.5*barsize)		   ;Tick coor. (centered)
+for i=0,nbars-1 do begin			   ;Draw the bars
+   width=winoffset+[barstart[i],barstart[i], $     ;Compute bar width
+     (barstart[i]+barsize),(barstart[i]+barsize)]
+   length=[bases[i],normal[i],normal[i],bases[i]]  ;Compute bar length
+   if (rotate) then begin			   ;Horizontal bars
+      x=length					   ;X-axis is "length" axis
+      y=width					   ;Y-axis is "width" axis
+   endif else begin				   ;Vertical bars
+      x=width					   ;X-axis is "width" axis
+      y=length					   ;Y-axis is "length" axis
+   endelse
+   polyfill,x,y,color=colors[i],/normal		   ;Polyfill with color
+   if (outline) then plots,x,y,/normal		   ;Outline using !p.color
+endfor
+
+tickv=(tickv-tick_scal_fact[0])/tick_scal_fact[1]  ;Locations of the ticks
+if (rotate) then $				   ;Label the bars (Y-axis)
+  axis,yaxis=0,ystyle=1,yticks=(nbars-1),ytickv=tickv,ytickname=barnames, $
+  yticklen=0.0 $
+else $						   ;Label the bars (X-axis)
+  axis,xaxis=0,xstyle=1,xticks=(nbars-1),xtickv=tickv,xtickname=barnames, $
+  xticklen=0.0
+return
+end
Index: tags/start/PLOTS/DESSINE/plt.pro
===================================================================
--- tags/start/PLOTS/DESSINE/plt.pro	(revision 5)
+++ tags/start/PLOTS/DESSINE/plt.pro	(revision 5)
@@ -0,0 +1,656 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:
+;	PLT
+;
+; PURPOSE:
+;	trace des graphes horizontaux (cartes)
+;
+; CATEGORY:
+;       Graphics, trace des graphes horizontaux
+;
+; CALLING SEQUENCE:
+;	plt, champ [,min[, max]]
+;
+; INPUTS:
+;	champ: le champ dont on veut faire la carte horizontale champ
+;	peut etre de 2 types:
+;         1) un tableau 2d ou 3d. Si le champ est un tableau 3d on en
+;         extrait un tableau 2d au niveau stipule par l''utilisateur
+;         qui repond a une question.
+;         2) une structure repondant aux critaire specifies par
+;         litchamp.pro. cf. IDL> xhelp,'litchamp'
+;
+; ces ARGUMENTS ne sont pas obligatoires:
+;  
+;	MAX: valeur maximum que l''on veut prendre en compte dans le trace
+; des contours. Par defaut on prend le max de tab1 (sur les pts mer)
+;
+;	MIN: valeur minimum que l''on veut prendre en compte dans le trace
+; des contours. Par defaut on prend le min de tab1 (sur les pts mer)
+;
+; KEYWORD PARAMETERS:
+;
+;	BOITE:vecteur indiquant la zone geographique sur laquelle doit etre
+; faite la coupe. Si BOITE a :
+; 1 element : l''extraction est faite sur [lon1, lon2, lat1, lat2, 0.,boite[0]]
+; 2 elements: l''extraction est faite sur [lon1, lon2, lat1, lat2, boite[0],boite[1]]
+; 4 elements: l''extraction est faite sur [Boite, 0, max([gdept, gdepw])]
+; 5 elements: l''extraction est faite sur [Boite[0:3], 0, Boite[4]]
+; 6 elements: l''extraction est faite sur Boite
+;
+; Ou lon1, lon2,lat1,lat2 sont les variables globales
+; definies lors du dernier domdef!
+;
+;	CARTE:Permet de dessiner les continents definits ds IDL. CARTE
+;	peut prendre deux formes:
+;           /CARTE: on dessine les continents a la place du mask
+;           CARTE=2 on dessine le contours des continents par
+;           dessus le dessin masque (ceci permet de voir si le masque
+;           correspond bien aux continents reels).
+;
+;      CB_TITLE: le titre de la colorbar
+;
+;      CB_SUBTITLE: le soustitre de la colorbar
+;
+;      CB_CHARSIZE: The character size of the color bar annotations
+;
+;      CMREF: la longeur en cm sur le papier que doit faire la fleche
+;      de norme normeref. par defaut ajuste au dessin et compris entre
+;      .5 et 1.5 cm
+;
+;        /CONT_NOFILL: activer pour ne pas remplir les points masques
+;        a la couleur c_cont mais pour les laisser en transparent! Rq
+;        on trace qd meme le contour du mask de la couleur c_cote
+;
+;	CONTINTERVALLE: lorsque CONTOUR est active, valeur d'un
+; intervalle entre deux isolignes traces par un trait ds la couleur
+; c_lab. Il peut ainsi etre different de celui specifie par INTERVALLE
+; qui, cas ce cas, ne controle que les isolignes coloriees en
+; couleurs. Si aucun min n''est specifie, on choisit un contour min qui va
+; bien avec l''intervalle specifie!. Si ce mot cle n''est pas
+; specifie, on trace 20 isolignes du min au max. 
+;
+;	CONTLABEL: un entier n. lorsque CONTOUR est active, si n
+; different de 0, choisit le type de label correspondant aux cas n
+; pour les isolignes tracees par un trait. Pour specifier le type de
+; label du contour en couleur, utiliser LABEL
+;
+;	CONTMAX: lorsque CONTOUR est active, valeur maximum que l''on
+; veut prendre en compte dans le trace des isolignes traces par un
+; trait de couleur c_lab. Par defaut on prend le max (sur les pts mer)
+; du tableau passe ds le mot cle CONTOUR. 
+;
+;	CONTMIN: lorsque CONTOUR est active, valeur minimum que l''on
+; veut prendre en compte dans le trace des isolignes traces par un
+; trait de couleur c_lab. Par defaut on prend le max (sur les pts mer)
+; du tableau passe ds le mot cle CONTOUR. 
+;
+;	CONTNLEVEL: lorsque CONTOUR est active, nombre de contours
+; trace par un trait de couleur c_lab a dessiner (actif si
+; CONTLABEL=0) par defaut =20.
+;
+;	CONTOUR: si on veut tracer les contours d'un champ different que celui
+; que l''on dessin en couleur (par ex E-P en couleur et QSR en
+; contours). Doit etre un champ repondant aux meme caracteristiques
+; que l''argument numero 1 de plt
+;
+;       GRILLE:'U','T','V','W' ou 'F' pour specifer eventuellement la
+;       grille a laquelle est rattache le champ. Rq: il afaut mieux
+;       utiliser ds ce cas une structure comme champ
+;
+;	INTERVALLE: valeur d''un intervalle entre deux isolignes. Si
+; aucun min n''est specifie, on choisit un contour min qui va bien
+; avec l'intervalle specifie!. Si ce mot cle n''est pas specifie, on
+; trace 20 isolignes du min au max. Rq: Qd CONTOUR est active
+; INTERVALLE ne specifie que intervalle entre 2 isolignes coloriees en
+; couleur. Pour specifier l''intervalle entre 2 isolignes traces par un trait
+; de couleur c_lab utiliser CONTINTERVALLE.
+;
+;	/INV: inverse le vecteur couleur utilise pour colorier le graphe
+;             (sans toucher au noir, au blanc et a la palette utilisee)
+; 
+;	LABEL: un entier n. si n different de 0, choisit le type de
+; label correspondant aux cas n. cf label.pro
+; Rq: Qd CONTOUR est active, ne specifie le type de label que pour les
+; isolignes coloriees en couleur. Pour celles tracees par un trait de
+; couleur c_lab utiliser CONTLABEL.
+;
+;	/LANDSCAPE: oblige la feuille ou le fenetre a l''ecran a etre
+;	en position "allongee".
+;
+;       LCT: entier designant le numero de la palette de couleur que
+;       l''on veut utiliser pour le plot. 
+;	
+;       MAP:Mot cle a actine losque l''on veut faire une projection.
+; Ce mot cle peut etre de 2 formes:
+;     MAP=[P0lat,P0lon,Rot]. Pour la description de ces 3 valeurs cf.
+;         l''aide en ligne de MAP_SET.
+;     /MAP: dans ce cas map est calcule tout seul et vaut: 
+;          map = [0, (lon1+lon2)/2., 0]
+; Rq: Un bon moyen de choisir sa projection est la valeur du vecteur
+; MAP est d''utiliser la demo d''IDL5.2:
+; IDL> demo
+; Puis choisir earth sciences et mapping.
+; Rq2: Par defaut c''est une projection cylindrique qui est effectuee
+; (avec ou sans le mot cle map). Si on veut une autre projection MAP
+; doit etre active et il faut rajouter le mot cle: /nom_projection.
+; par ex pour une projection polaire centree sur le pole sud:
+; IDL> domdef,-180,180,-90,-45
+; IDL> plt, tab, /stereo,map=[-90,0,0]
+;
+;       MAXIN: permet de specifier la valeur maximum que l''on veut
+;       prendre en compte dans le trace des contours a l''aide d''un
+;       mot cle plutot que par l''argument max. Si l''argument et le
+;       mot cle sont specifies en meme temps, c''est la valeur
+;       specifiee par le mot cle qui est retenue.
+;
+;       MININ: permet de specifier la valeur minimum que l''on veut
+;       prendre en compte dans le trace des contours a l''aide d''un
+;       mot cle plutot que par l''argument min. Si l''argument et le
+;       mot cle sont specifies en meme temps, c''est la valeur
+;       specifiee par le mot cle qui est retenue.
+;
+;	NLEVEL: nombre de contours a dessiner. par defaut =20. actif si
+; LABEL=0 ou n'est pas specifie.
+;
+;	/NOCOLORBAR: activer si on ne veut pas de colorbar
+;
+;	/NOCONTOUR: activer si on ne veut pas de contour mais juste
+;	les couleurs
+;
+;	/NOCOULEUR: activer si on veut juste les contours en noir et
+;	blanc sur fond blanc
+;
+;       /NOERASE: activer pour faire un dessin a l''ecran sans creer
+;       une nouvelle fenetre
+;
+;      NORMEREF: la norme de la fleche de reference. par defaut on
+;      essaie de faire qqch qui colle pas trop mal!
+;
+;       /NOTRI: pour forcer a ne pas utiliser de
+;       triangulation. Attention dans ce cas le trace ne marchera que
+;       si la grille est non deformee (cad, chaque pts d''une
+;       longitude donnee a la meme latitude et chaque pts d''une
+;       latitude donnee a la meme longitude) sauf si on utilise le mot
+;       clef CELL_FILL=2. Rq si le champ contient des points a
+;       !values.f_nan alors on fait qd meme une triangulation.
+;
+;       OVERPLOT: pour faire un plt par dessus un autre. Rq:
+;       contrairemnet a l''utilisation de CONTOUR ou de VECTEUR,
+;       l''utilisation de ce mot clef ne modifie pas la legende ou/et
+;       la barre de couleur.
+;
+;	PETITDESSIN: vecteur de 3 ou 4 elements, applique pour faire un
+; dessin sur une petite portion de feuille ou d''ecran. il delimite
+; la zone ds laquelle va etre fait le dessin
+; si il a 4 elements:
+;       il est alors constitute des coordonnees -exprime en cm reperes par
+;       rapport au coin en bas a gauche de la feuille ou de la fenetre
+;       (en portrait comme en landscape)- du coin en bas a
+;       gauche et du coin en haut a droite  de la zone de dessin.
+; si il a 3 elements:
+;       Ds ce cas, on divise la fenetre ou l''ecran en PETITDESSIN[0]
+;       colonnes, en PETITDESSIN[1] lignes le dessin se faisant ds la
+;       case numero PETITDESSIN[2].La numerotation commencant en haut
+;       a gauche par le numero 1 et suivant apres dans le sens de
+;       l''ecriture.
+; Par defaut on fait un dessin occupant la plus grande place possible
+; tout en concervant le rapport d''aspect (sauf qd REMPLI est active)
+;
+;	/PORTRAIT: oblige la feuille ou la fenetre a etre en position "debout".
+;
+;	/POST: faire une sortie postscript. Ne marche que si on fait
+;	un seul dessin sur la feuille. Si on fait plusieurs dessins,
+;	utiliser @ps ou plein2dessins
+;
+;	/REMPLI:oblige le dessin a occuper l'espace maximum definit
+;	par petitdessin
+;
+;       /REVERSE_X: pour inverser l''axe des x (et aussi le dessin)
+;
+;       /REVERSE_Y: pour inverser l''axe des y (et aussi le dessin)
+;
+;       /STRICTFILL: activer ce mot clef pour que le remplissage des
+;       contours ce fasse precisement entre le min et le max specifie
+;       en laissant en banc les valeurs inferieurs au min specifie et
+;       superieurs au max specifie.
+;
+;	STYLE: style de tracer a adopter pour dessiner les isolignes par
+; defaut style=0. cf style.pro
+;
+;	/TRANS: fait un postscript (active /post automatiquement) et l''imprime
+; -si on le desire- sur un transparant
+;
+;        UNLABSUR: entier n. specifant qu''on ne labelle qu''un
+;        contour sur n. Par defaut unlabsur=2
+;
+;	/UNSUR2: si on veut tracer un countour sur deux. par  defaut trace
+; tous les contours
+;
+;	/UNVECTSUR:un scalaire n on un tableau a 2 elements [n1,n2].
+;         dans le premier cas, on tracera un vecteur sur n suivant les
+;         x et les y.
+;         dans le second cas on tracera un vecteur sur n1 suivant x
+;         et un vecteur sur n2 suivant y
+;       Rq; pour tracer tous les vecteurs suivant y et 1 sur 2 suivant
+;       x mettre unvectsur=[2,1]
+;       Rq: ce mot cle est passe ds _extra
+;
+;       VECTCOLOR: la couleur de la fleche. Par defaut noir (couleur 0)
+;
+;	VECTEUR: une structure a 2 elements contenant les 2 champs U
+;	et V des valeurs de la composante zonale et meridienne du
+;	champ de vecteurs a tracer. Ces champs peuvent etre un tableau
+;	ou une structure
+;       par ex: vecteur={matriceu:lec('unsurface'),matricev:lec('vnsurface')}
+;       rq:le nom des elements de vecteur n''a aucune importance.
+;       vecteur={u:lec('unsurface'),v:lec('vnsurface')} convient aussi
+;
+;	VECTMIN=norme minimum des vecteurs a tracer 
+;
+;	VECTMAX=norme maximum des vecteurs a tracer 
+;
+;       VECTTHICK; l''epaissuer de la fleche. par defaut 1.
+;
+;	WINDOW: numero de la fenetre ou l'on veut faire le graphe (permet
+; d'ouvrir plusieurs fenetres). par defaut on ouvre 'IDL0'
+;
+;	YSURX: rapport d'echelle entre y et x (par ex: =1 pour un repere
+; orthonorme, =2 si l'axe des y est deux fois plus dilate que celui des x).
+; Par defaut on adapte pour occupe une grande partie de la feuille en sortie
+; postScript ou pour cree une fenetre pas trop etiree
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			7/1999
+;                       Sebastien Masson 08/02/2000 checkfield and
+;                       notri keyword (or triangule = -1) .
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro plt,tab1, giventype,givenmin,givenmax,CARTE=carte,CONTOUR=contour $
+        ,INTERVALLE=intervalle,INV=inv, GRILLE = grille, BOITE = boite $
+        ,CONTINTERVALLE=contintervalle,LABEL=label,CONTLABEL=contlabel $
+        ,STYLE=style,CONTMAX=contmax,CONTMIN=contmin,NLEVEL=nlevel,CONTNLEVEL=contnlevel $
+        , VECTEUR=vecteur,MAP = map, MININ = minin, MAXIN = maxin $
+        , CONT_NOFILL = cont_nofill, NIVEAUDESSIN = niveaudessin, NOTRI = notri $
+        , DUPLICATE = duplicate, STRICTFILL = strictfill, OVERPLOT = overplot, _extra = ex
+@common
+;--------------------------------------------------------------
+   tempsun = systime(1)         ; pour key_performance
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+; I) preparation de l''environnement graphique et petites verifications
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+; I1) verification du type de grille associe a tab1
+;--------------------------------------------------------------
+   if keyword_set(grille) then vargrid = grille
+   if keyword_set(vecteur) AND (NOT keyword_set(grille)) then BEGIN
+      vargrid = litchamp(tab1, /grid)
+      if vargrid eq '' then BEGIN
+         vargrid = xquestion('Quelle est la grille a laquelle le champ a tracer se rapporte?', 'T', /chkwidget)
+         vargrid = strupcase(vargrid)
+      endif
+   ENDIF
+;--------------------------------------------------------------
+; I2) lecture du champ et checkup.
+;--------------------------------------------------------------
+   if keyword_set(boite) then oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+   if n_elements(giventype) NE 0 then type = giventype
+   if n_elements(givenmin) NE 0 then min = givenmin
+   if n_elements(givenmax) NE 0 then max = givenmax
+   if n_elements(minin) NE 0 then min = minin
+   if n_elements(maxin) NE 0 then max = maxin
+   checktypeminmax, 'plt', TYPE = type, MIN = min, MAX = max
+   z2d = checkfield(tab1, 'plt', TYPE = type, BOITE = boite, DIREC = direc, VECTEUR = vecteur, _extra = ex)
+   if z2d[0] EQ -1 then BEGIN 
+      if keyword_set(boite) then domdef, oldboite,GRILLE=vargrid
+      return
+   endif
+;--------------------------------------------------------------
+; I3) reinitialisation. !p.,!x.,!y.
+; Rq: on ne reinitialise pas qd on rapelle plt en boucle pour utiliser contour
+;--------------------------------------------------------------
+   if n_elements(contour) ne 4 AND NOT keyword_set(overplot) then reinitplt, /z,/invert
+;---------------------------------------------------------------
+; I4) attribution du mask et des tableaux de longitude et latitude
+;---------------------------------------------------------------
+   if keyword_set(niveaudessin) then niveau = niveaudessin
+   if n_elements(gdept) GE 2 then begin
+      IF gdept[0] LT gdept[1] THEN profond = niveau NE 1 ELSE profond = niveau NE jpk
+   ENDIF ELSE profond = niveau NE 1
+   if keyword_set(profond) then $
+; si on fait un plt en profondeur, il faudra recalculer la
+; triangulation, ca ne sert donc a rien de calculer tri maintenant
+; (surtout que c''est assez couteux!)
+   grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery $
+    , dernierz, /forplt, _extra = ex ELSE $
+    grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery $
+    , dernierz, TRI = tri, /forplt, _extra = ex
+   if keyword_set(notri) then tri = -1
+   if keyword_set(profond) AND triangles[0] EQ -1 then tri = -1
+;----------------------------------------------------------------------------
+; I5 determination du mi:min et du ma:max de z2d ainsi que de max: max et
+;    min: min pour le dessin.
+;-----------------------------------------------------------------------------
+   nan = total(finite(z2d,/nan)) < 1
+; faudra-t-il faire un autoscale ???
+   autoscale = testvar(var = min) EQ testvar(var = max) AND NOT keyword_set(intervalle)
+   determineminmax, z2d, mask, mi, ma, glam, gphi, MININ = min, MAXIN = max, nan = nan,INTERVALLE=intervalle
+   if z2d[0] EQ -1 THEN GOTO, sortie
+; on fait un autoscale si besoin
+   if autoscale then autoscale, min, max, intervalle
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+; II) mise en place du dessin sur la fenetre ou la page et ouverture
+; eventuelle de la fenetre et de la page
+;--------------------------------------------------------------
+   if n_elements(contour) NE 4 AND NOT keyword_set(overplot) THEN $
+    placedessin, 'plt',posfenetre, posbar $
+    , CONTOUR = contour, VECTEUR = vecteur, MAP = map, DIREC = direc, _extra = ex
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+; III) habillage du dessin (labels,style,axe)
+;------------------------------------------------------------
+;--------------------------------------------------------------
+;
+;--------------------------------------------------------------
+; III1) choix des labels
+;-----------------------------------------------------------
+   if keyword_set(intervalle) AND NOT keyword_set(label) then label=1
+   if keyword_set(label) eq 0 then cas=0 else cas=label
+   label,cas,min,max,ncontour,level_z2d,NLEVEL=nlevel,INTERVALLE=intervalle, strictfill = strictfill
+;--------------------------------------------------------------
+; III2)choix de style
+;-----------------------------------------------------------
+   if not keyword_set(style) then style=0
+   style,style,level_z2d,linestyle,thick
+   if keyword_set(inv) then couleur=reverse(couleur)
+;-----------------------------------------------------------
+; III3) definition des axes
+;----------------------------------------------------------
+   if NOT keyword_set(overplot) THEN axe, 'xy', _EXTRA = ex
+;   IF NOT(keyword_set(map)) then axe, 'xy'
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+;------------------------------------------------------------
+; IV) dessin
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+   mask = mask[*, *,niveau-1-premierz]
+   if keyword_set(nan) then begin
+      notanumber = where(finite(z2d, /nan) EQ 1)
+      z2d[notanumber] = max
+      masknan = replicate(1, nx, ny)
+      masknan[notanumber] = 0
+   ENDIF ELSE masknan = 1
+   z2d = remplit(z2d,nite=(1+(vargrid NE 'T' AND vargrid NE 'W')+keyword_set(nan)) $
+                 *(1-keyword_set(cont_nofill)) $
+                 , mask = mask*masknan, _extra=ex)
+   if NOT keyword_set(strictfill) then z2d = min > z2d <  max
+;
+   if vargrid EQ 'T' OR vargrid EQ 'W' then BEGIN 
+; ds ce cas, le masque utilise pour le champ est le meme que celui
+; utilise pour la terre.
+; si on fait un dessin en profondeur ou qu''il y a des pts a nan on
+; redefinit une triangulation sur le zoom
+      if keyword_set(profond) OR keyword_set(nan) then BEGIN
+         if ( (testvar(var = tri))[0] NE -1 OR keyword_set(nan) ) $
+          AND NOT keyword_set(notri) then BEGIN
+            IF keyword_set(cont_nofill) then BEGIN
+               if keyword_set(nan) then begin
+                  tri = triangule(masknan, coinmonte = coinmontemask, coindescend = coindescendmask $
+                                  , periodique = keyword_set(key_periodique)*(nx EQ jpi))
+               ENDIF ELSE BEGIN
+                  tri = definetri(nx, ny)
+                  coinmontemask = -1
+                  coindescendmask = -1
+               ENDELSE
+            ENDIF ELSE BEGIN
+               mask = temporary(masknan*mask)
+               tri = triangule(mask, coinmonte = coinmontemask, coindescend = coindescendmask $
+                               , periodique = keyword_set(key_periodique)*(nx EQ jpi))
+            ENDELSE 
+         ENDIF
+         indicezoommask = (lindgen(jpi, jpj))[premierx:dernierx, premiery:derniery]
+      ENDIF ELSE BEGIN
+         if keyword_set(cont_nofill) AND (testvar(var = tri))[0] NE -1 then BEGIN
+            tri = definetri(nx, ny)
+            coinmontemask = -1
+            coindescendmask = -1
+         endif
+      ENDELSE
+      glammsk = glam
+      gphimsk = gphi
+   ENDIF ELSE BEGIN 
+; ds ce cas, le masque utilise pour le champ n''est pas le meme que celui
+; utilise pour la terre (grille T);
+;
+; si on fait un dessin en profondeur on redefinit une triangulation
+; sur le zoom, cette triangulation sera utilisee pour tracer le
+; champ. on utilise tmask pour que les trous de cette triangulation
+; soient bien les memes que ceux utilises pour tracer le
+; masque et correspondent bien au trous qu''il y a a cette nouvelle
+; profondeur.
+      if keyword_set(profond) AND (testvar(var = tri))[0] NE -1 then BEGIN
+         if keyword_set(cont_nofill) then BEGIN
+            tri = definetri(nx, ny)
+            coinmontemask = -1
+            coindescendmask = -1
+         ENDIF ELSE $
+          tri = triangule(tmask[premierx:dernierx, premiery:derniery, niveau-1] $
+                          , coinmonte = coinmontemask, coindescend = coindescendmask $
+                          , periodique = keyword_set(key_periodique)*(nx EQ jpi))
+      ENDIF
+; si on a des pts a nan, comme la grille du mask est differente de
+; celui du mask il faudra les tracer a part. on definit donc pour cela
+; trinan, coinmontenan, coindescendnan, indicezoomnan, xnan et ynan
+; qui permettront de tracer masknan independemment du mask terre.
+; Rq: on utilise xnan, ynan au lieu de glam et gphi car pour ces 2
+; derniers tableaux calcules par grille on a active /forplt donc leur
+; valeur sur les points terre est celle de glamt et gphit.
+      if keyword_set(nan) AND NOT keyword_set(notri) then BEGIN
+         trinan = triangule(1-masknan $
+                            , coinmonte = coinmontenan, coindescend = coindescendnan $
+                            , periodique = keyword_set(key_periodique)*(nx EQ jpi))
+         indicezoomnan = (lindgen(jpi, jpj))[premierx:dernierx, premiery:derniery]
+         grille, rien, xnan, ynan
+         undefine, rien
+      ENDIF
+; decoupe terre: pour que le tarce des cotes soient propres on essaye de
+; prenddre des points en + pour la terre comme ca on ne voit pas le
+; decalage des grilles. c''est ce que fait decoupeterre. au passage on
+; redefinit trimsk.
+      decoupeterre, mask, glammsk, gphimsk, TRI = trimsk, indicezoom = indicezoommask $
+       , coinmonte = coinmontemask, coindescend = coindescendmask, _EXTRA = ex
+   ENDELSE 
+;------------------------------------------------------------
+; IV1) choix du type de dessin
+;------------------------------------------------------------
+   typetrace = 'classique'
+   if keyword_set(map) then BEGIN 
+; appelle de mapset qd on veut faire des projections
+      IF n_elements(map) NE 3 THEN map = [0, ((lon1+lon2)/2.) MOD 360, 0]
+      typetrace = 'projection'
+      map_lat = map[0]
+      map_lon = map[1]
+      map_rot = map[2]
+      if n_elements(ex) NE 0 then BEGIN 
+         if (where(tag_names(ex) EQ 'TITLE'))[0] NE -1 then BEGIN 
+            titre = ex.title 
+            ex.title = ''
+         endif
+      ENDIF
+      map_set, map_lat, map_lon, map_rot, _extra = ex, position = posfenetre, /iso $
+       ,limit = [lat1, lon1, lat2, lon2], /noborder
+      if n_elements(tri) GE 2 then tri = ciseauxtri(tri, glam, gphi, _EXTRA = ex)
+      if n_elements(trimsk) GE 2 then trimsk = ciseauxtri(trimsk,glammsk,gphimsk,_EXTRA=ex)
+      if n_elements(trinan) GE 2 then BEGIN 
+         trinan = ciseauxtri(trinan,xnan,ynan,_EXTRA=ex)
+         if trinan[0] EQ -1 then undefine, trinan
+      endif
+   ENDIF ELSE BEGIN 
+;pour que les axes de coordonees soient pris en compte
+      if !x.type EQ 0 AND n_elements(contour) LE 4 then $
+       plot, [0], [0], xstyle = 5, ystyle = 5, title = '', subtitle = '', /noerase 
+      if keyword_set(key_periodique) then BEGIN
+; ds ce cas la triangulation est refermee en x et couvre toute la
+; sphere. il faut dont la couper au niveau ou l''on coupe la sphere
+; pour faire le dessin
+         if n_elements(tri) GE 2 then tri = ciseauxtri(tri, glam, gphi, _EXTRA = ex)
+         if n_elements(trimsk) GE 2 then trimsk = ciseauxtri(trimsk, glammsk, gphimsk,_EXTRA=ex)
+         if n_elements(trinan) GE 2 then trinan = ciseauxtri(trinan,xnan,ynan,_EXTRA=ex)
+      endif
+   endelse
+;------------------------------------------------------------
+; IV2) coutours et coloriages
+;------------------------------------------------------------
+   if keyword_set(duplicate)  then BEGIN
+; pour marina uniquement ATTENTION C'EST TRES MAL CODE
+      lon = glam[*, 0]
+      decalage = max(lon)-min(lon)+(lon-shift(lon, 1))[n_elements(lon)-1]
+      !x.range[1] = !x.range[1]+(duplicate-1)*decalage
+      for i = 1,duplicate-1 do BEGIN
+         z2d = [z2d, z2d]
+         gphi = [gphi, gphi]
+         mask = [mask, mask]
+         gphimsk = [gphimsk, gphimsk]
+         glam = [glam, glam+i*decalage]
+         glammsk = [glammsk, glammsk]
+      ENDFOR
+   endif
+   pltbase, z2d,glam,gphi $
+    , mask,glammsk,gphimsk,trichamp=tri,trimsk=trimsk, /forplt $
+    , level_z2d, couleur, contour = contour, carte = carte $
+    , overplot = keyword_set(overplot)+keyword_set(map) $
+    , c_linestyle=linestyle,c_labels=1-(indgen(n_elements(level_z2d)) MOD 2) $
+    , c_thick=thick, cont_nofill = cont_nofill, nan = nan $
+    , coinmontemask = coinmontemask, coindescendmask = coindescendmask $
+    , coinmontenan = coinmontenan, coindescendnan = coindescendnan $
+    , indicezoommask = indicezoommask, indicezoomnan = indicezoomnan $
+    , masknan = masknan, trinan = trinan, xnan = xnan, ynan = ynan, _extra = ex
+;------------------------------------------------------------
+; IV3) rappelle de plt en boucle qd contour est active
+;------------------------------------------------------------
+   if n_elements(contour) eq 4 then BEGIN ; c''est la 2eme fois que je passe ds pltt
+      contour = {mietma:[mi, ma], unit:varunit, inter:intervalle} ; je renvoie le min, le max et l''unite
+      return
+   endif
+   if keyword_set(contour) THEN BEGIN 
+      pourlegende = [1, 1, 1, 1]
+      oldattributs = saveatt()
+      oldcouleur = couleur
+      plt,contour,contmin,contmax,CONTOUR=pourlegende, /noerase, NOTRI = notri $
+       ,INTERVALLE=contintervalle,LABEL=contlabel,STYLE=style $
+       ,NLEVEL=contnlevel, DUPLICATE = duplicate, STRICTFILL = strictfill, _extra = ex
+      restoreatt, oldattributs
+      couleur = oldcouleur
+   ENDIF
+;------------------------------------------------------------
+;------------------------------------------------------------
+; V) petites finitions
+;------------------------------------------------------------
+;------------------------------------------------------------
+;
+;------------------------------------------------------------
+; V1) ajout eventuel de vecteurs en surimpression
+;------------------------------------------------------------
+   if keyword_set(vecteur) then BEGIN 
+      oldattributs = saveatt()
+      ajoutvect,vecteur,vectlegende, _extra = ex
+      restoreatt, oldattributs
+   ENDIF
+;
+   if keyword_set(overplot) then GOTO, fini
+;------------------------------------------------------------
+; V2) Trace de la ligne de changement de date,l'equateur et
+; le meridien de greenwich, ...
+;------------------------------------------------------------
+   if NOT keyword_set(map) then meridienparallele, 'xy'
+;------------------------------------------------------------
+; V3) pour tracer les continents d'IDL
+;------------------------------------------------------------
+   if keyword_set(carte) then BEGIN
+; si noease est passe de _extra, on s''assure qu''il est a 1
+      if chkstru(ex, 'NOERASE') then begin
+         oldnoerase = ex.noerase
+         ex.noerase = 1
+      ENDIF
+      if chkstru(ex, 'cont_thick') then mlinethick = ex.cont_thick ELSE mlinethick = 1
+      IF NOT keyword_set(map) THEN $
+       map_set,0,((lon1+lon2)/2.) MOD 360,0, _extra = ex, position = posfenetre $
+       ,  limit =[lat1, lon1, lat2, lon2], /NOERASE, /noborder, color = 0
+      if carte NE 2 AND NOT keyword_set(cont_nofill) then $
+       map_continents, /fill_continents, color = c_cont, _extra = ex, /noerase
+      map_continents, /continents, color = c_cote, MLINETHICK = mlinethick, /noerase, _extra = ex
+      if chkstru(ex, 'NOERASE') THEN  ex.noerase = oldnoerase
+   ENDIF 
+;------------------------------------------------------------
+; V4) legendes + affichage de celles-ci
+;------------------------------------------------------------
+   legende,mi,ma,'xy', CONTOUR = pourlegende, VECTLEGENDE = vectlegende, INTERVALLE = intervalle, DIREC = direc, _EXTRA = ex
+   if n_elements(ex) NE 0 then BEGIN 
+; pour garder les axes du cadre en noir
+      if (where(tag_names(ex) EQ 'COLOR'))[0] NE -1 then ex.COLOR = c_cote
+   endif
+;
+   case typetrace of
+      'classique': $
+       plot, [0], [0],/noerase,color=0,xtickformat='lonaxe',ytickformat='lataxe' $
+       , xstyle = 1, ystyle = 1, _extra = ex
+      'projection': BEGIN 
+         if chkstru(ex, 'NOERASE') then begin
+            oldnoerase = ex.noerase
+            ex.noerase = 1
+         endif
+         map_set, map_lat, map_lon, map_rot, _extra = ex, /iso, limit = [lat1, lon1, lat2, lon2]$
+          , /NOERASE, /noborder, title = !p.title, color = 0
+;         map_proj_info, numproj, /current
+;         map_proj_info, numproj, name = nomproj
+;         if nomproj EQ 'Mercator' OR nomproj EQ 'Cylindrical' OR nomproj EQ 'LambertConic'$
+;          OR nomproj EQ 'Gnomic' OR nomproj EQ 'AlbersEqualAreaConic' $
+;          OR nomproj EQ 'TransverseMercator' OR nomproj EQ 'MillerCylindrical' $
+;          OR nomproj EQ 'LambertConicEllipsoid' then map_grid, box_axes=1,latdel=10,londel=10 $
+;         ELSE map_grid, charsize = 0.75, /label,latalign = 1,lonalign = 1,latdel = 10,londel = 30
+         map_grid, charsize = 0.75, /label,latalign = 1,lonalign = 1,latdel = 10,londel = 30, color = 0, _extra = ex
+         if chkstru(ex, 'NOERASE') THEN  ex.noerase = oldnoerase
+      end
+   endcase
+;------------------------------------------------------------
+; V5) barre de couleur
+;------------------------------------------------------------
+   couleur = couleur[0:ncontour-1-keyword_set(strictfill)]
+   barrecouleur, position=posbar,divisions=(ncontour-keyword_set(strictfill))/2,min=min $
+    , max=max,discret=couleur,_extra = ex
+;------------------------------------------------------------
+;------------------------------------------------------------
+; VI) impression eventuelle
+;------------------------------------------------------------
+;------------------------------------------------------------
+fini:
+   terminedessin, _extra = ex
+   if keyword_set(vecteur) then grillechoice = [vargrid, 'T', 'U', 'V'] ELSE grillechoice = ['T', vargrid]
+   if keyword_set(oldboite) then domdef, oldboite, GRILLE = grillechoice
+;------------------------------------------------------------
+;------------------------------------------------------------
+sortie:
+   if keyword_set(key_performance) NE 0 THEN print, 'temps plt', systime(1)-tempsun 
+;------------------------------------------------------------
+;------------------------------------------------------------
+   return
+end
+
+
Index: tags/start/PLOTS/DESSINE/plt1d.pro
===================================================================
--- tags/start/PLOTS/DESSINE/plt1d.pro	(revision 5)
+++ tags/start/PLOTS/DESSINE/plt1d.pro	(revision 5)
@@ -0,0 +1,356 @@
+;------------------------------------------------------------
+;+
+; NAME:
+;	PLT1D
+;
+; PURPOSE:
+;	trace des graphes 1d
+;
+; CATEGORY:
+;       Graphics, trace des graphes 1d: x,y,z (ou t mais ds ce cas, on
+;       rapelle directement pltt)
+;
+; CALLING SEQUENCE:
+;	plt1d, champ,type [,min[, max]]
+;
+; INPUTS:
+;	champ: le champ dont on veut faire le hovmoller champ
+;	peut etre de 2 types:
+;	1) un tableu qui peut etre:
+;          * 2d, 3d ou 4d:  tableau xy, xyz. xyt ou xyzt. dans ce cas,
+;            le tableau va passer dans moyenne ou grossemoyenne pour
+;            etre moyennee et devenir un tableau 1 1d. 
+;          * 1d:type doit qd meme etre specifie pour qu''on sache de
+;          quel trace il sagit. Pour avoir une legende correcte,
+;          respecifier la zone d''extraction via BOITE
+;       2) une structure repondant aux critaires specifies par
+;       litchamp.pro. cf. IDL> xhelp,'litchamp'. Le tableau contennu ds
+;       la structure repondant aux criteres du cas 1) cf. ci-dessus
+;
+;       TYPE: un string: type de plot 1d que l''on veut faire:
+;       trace suivant: 'x','y','z'  
+;
+; ces arguments ne sont pas obligatoires:
+;  
+;	MAX: valeur maximum que l'on veut prendre en compte dans le trace
+; du plot. Par defaut on prend le max de tableau (sur les pts mer)
+;
+;	MIN: valeur minimum que l'on veut prendre en compte dans le trace
+; du plot. Par defaut on prend le min de tableau (sur les pts mer)
+;
+; KEYWORD PARAMETERS:
+;
+;	BOITE:vecteur indiquant la zone geographique (3d) sur laquelle doit
+; etre fait l''extraction du champ pour faire le hovmoeller.
+; Si BOITE a :
+; 1 element : l''extraction est faite sur [lon1, lon2, lat1, lat2, 0.,boite[0]]
+; 2 elements: l''extraction est faite sur [lon1, lon2, lat1, lat2, boite[0],boite[1]]
+; 4 elements: l''extraction est faite sur [Boite, prof1, prof2]
+; 5 elements: l''extraction est faite sur [Boite[0:3], 0, Boite[4]]
+; 6 elements: l''extraction est faite sur Boite
+;
+; Ou lon1, lon2,lat1,lat2,prof1,prof2 sont les variables globales
+; definies lors du dernier domdef!
+;
+;       COL1d: --OBSOLETE--numero de la couleur qd on fait un trace 1d
+;       par defaut, 0. il faut mieux utiliser le mot cle COLOR utilise
+;       par plot
+;
+;       ENDPOINTS: mot clef specifiant que l'on veut faire une coupe
+;       verticale en diagonale. les coordonnees des extremites de
+;       celle-ci sont alors definies les 4 elements du vecteur
+;       ENDPOINTS: [x1,y1,x2,y2] qui sont les coordonnees 
+;
+;	/LANDSCAPE: oblige la feuille ou le fenetre a l''ecran a etre
+;	en position "allongee".
+;	
+;       MAXIN: permet de specifier la valeur maximum que l''on veut
+;       prendre en compte dans le trace des contours a l''aide d''un
+;       mot cle plutot que par l''argument max. Si l''argument et le
+;       mot cle sont specifies en meme temps, c''est la valeur
+;       specifiee par le mot cle qui est retenue.
+;
+;       MININ: permet de specifier la valeur minimum que l''on veut
+;       prendre en compte dans le trace des contours a l''aide d''un
+;       mot cle plutot que par l''argument min. Si l''argument et le
+;       mot cle sont specifies en meme temps, c''est la valeur
+;       specifiee par le mot cle qui est retenue.
+;
+;       /NOERASE: activer pour faire un dessin a l''ecran sans creer
+; une nouvelle fenetre. Rq: activer ds le cas d''un Postscript de
+; plusieurs traces de type 't' pour ne pas faire un Postscript de
+; plusieurs pages 
+;
+;       /OV1D:permet de surimprimer un courbe 1d a un precedent trace 1d.
+;
+;	PETITDESSIN: vecteur de 3 ou 4 elements, applique pour faire un
+; dessin sur une petite portion de feuille ou d''ecran. il delimite
+; la zone ds laquelle va etre fait le dessin
+; si il a 4 elements:
+;       il est alors constitute des coordonnees -exprime en cm reperes par
+;       rapport au coin en bas a gauche de la feuille ou de la fenetre
+;       (en portrait comme en landscape)- du coin en bas a
+;       gauche et du coin en haut a droite  de la zone de dessin.
+; si il a 3 elements:
+;       Ds ce cas, on divise la fenetre ou l''ecran en PETITDESSIN[0]
+;       colonnes, en PETITDESSIN[1] lignes le dessin se faisant ds la
+;       case numero PETITDESSIN[2].La numerotation commencant en haut
+;       a gauche par le numero 1 et suivant apres dans le sens de
+;       l''ecriture.
+; Par defaut on fait un dessin occupant la plus grande place possible
+; tout en concervant le rapport d''aspect (sauf qd REMPLI est active)
+;
+;	/PORTRAIT: oblige la feuille ou la fenetre a etre en position "debout".
+;
+;	/POST: faire une sortie postscript. Ne marche que si on fait
+;	un seul dessin sur la feuille. Si on fait plusieurs dessins,
+;	utiliser @ps ou plein2dessins
+;
+;	/REMPLI:oblige le dessin a occuper l'espace maximum definit
+;	par petitdessin
+;
+;       /REVERSE_X: pour inverser l''axe des x (et aussi le dessin)
+;
+;       /REVERSE_Y: pour inverser l''axe des y (et aussi le dessin)
+;
+;       /SIN: activer ce mot cle si l''on veut que l'' axe des x soit
+;       trace en sinus de la latitude qd on fait un frace f(y)
+;
+;       STY1D: --OBSOLETE--numero du style utilise lors d'un trace
+;       1d. Il faut mieux utiliser le mot cle LINESTYLE qui est celui
+;       de plot. Attention ce mot cle est encore utile si on veut
+;       faire des barres plutot qu'un courbe, mettre sty1d='bar'
+;
+;	/TRANS: fait un postscript (active /post automatiquement) et l'imprime
+; -si on le desire- sur un transparant
+;
+;	WINDOW: nimero de la fenetre ou l'on veut faire le graphe (permet
+; d'ouvrir plusieurs fenetres). par defaut on ouvre 'IDL0'
+;
+;	YSURX: rapport d'echelle entre y et x. Par defaut=1
+; Par defaut on adapte pour occupe une grande partie de la feuille en sortie
+; postScript ou pour cree une fenetre pas trop etiree
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: creation 24/6/99 Eric Guilyardi 
+;                       (a partir routine pltt de Sebastien Masson)
+; 8/7/1999 Sebastien Masson (smasson@lodyc.jussieu.fr) 
+; inspection des travaux finis
+; 8/2/2000 Sebastien Masson: checkfield
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro plt1d,tab,giventype, givenmin,givenmax,BOITE = boite, SIN = sin $
+          , MININ = minin, MAXIN = maxin, TYPEIN = typein,ENDPOINTS=endpoints $
+          ,COL1D=col1d,STY1D=sty1d,OV1D=ov1d, X = x, Y = y, Z = z, TT = tt $
+          , REVERSE_X = reverse_x, REVERSE_Y = reverse_y, _extra = ex
+@common
+;------------------------------------------------------------
+   tempsun = systime(1)         ; pour key_performance
+;--------------------------------------------------------------
+; 1ere partie: initialisation et petits calculs...
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+; verification de la valeur de type
+;--------------------------------------------------------------
+   if n_elements(giventype) NE 0 then type = giventype
+   if n_elements(givenmin) NE 0 then min = givenmin
+   if n_elements(givenmax) NE 0 then max = givenmax
+   if n_elements(minin) NE 0 then min = minin
+   if n_elements(maxin) NE 0 then max = maxin
+   if keyword_set(tt) then typein = 't'
+   if keyword_set(typein) then BEGIN 
+      if size(type, /type) NE 7 AND size(type, /type) NE 0 then begin
+         if n_elements(min) NE 0 then max = min
+         min = type
+      endif
+      type = typein
+   endif
+   if keyword_set(boite) then BEGIN 
+      oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+      vraiboite = boite
+   ENDIF
+   checktypeminmax, 'plt1d', TYPE = type, MIN = min, MAX = max, ENDPOINTS=endpoints $
+    , XX = keyword_set(x) , YY = keyword_set(y) , ZZ = keyword_set(z) 
+   if type EQ 't' then BEGIN
+      pltt, tab,type, min,max,BOITE = boite, SIN = sin, TYPEIN = typein $
+       ,COL1D=col1d,STY1D=sty1d,OV1D=ov1d, ENDPOINTS=endpoints, _extra = ex
+      return
+   endif
+;--------------------------------------------------------------
+; I2) reinitialisation. !p.,!x.,!y.
+; Rq: on ne reinitialise pas qd on rapelle plt1d
+;--------------------------------------------------------------
+   if NOT keyword_set(ov1d) then reinitplt
+;--------------------------------------------------------------
+; I1) lecture du champ
+;--------------------------------------------------------------
+   if keyword_set(endpoints) then begin
+      section, tab, z1d, glam, gphi, ENDPOINTS = endpoints, TYPE = type, BOITE = boite, DIREC = direc
+      nx = n_elements(glam) 
+      ny = nx
+      if strupcase(vargrid) EQ 'W' then begin
+         z = gdepw[premierzw:dernierzw]
+         nz = nzw
+      ENDIF ELSE BEGIN
+         z = gdept[premierzt:dernierzt]
+         nz = nzt
+      ENDELSE
+   ENDIF ELSE BEGIN 
+      z1d = checkfield(tab, 'plt1d', TYPE = type, BOITE = boite, direc = direc, _extra = ex)
+      grille, mask, glam, gphi, gdep, nx, ny,nz
+   ENDELSE
+   if z1d[0] EQ -1 then BEGIN 
+      if keyword_set(boite) then domdef, oldboite,GRILLE=vargrid
+      return
+   endif
+; on construit le mask pour cela le tableau doit etre masque (fait
+; automatiquement a la valeure valmask si on passe ds moyenne ou grossemoyenne)
+   mask = fltarr(n_elements(z1d))
+   if n_elements(valmask) EQ 0 then valmask = 1e20
+   nan = total(finite(z1d,/nan))  < 1
+   if keyword_set(nan) then begin
+      notanum = where(finite(z1d) EQ 0)
+      z1d[notanum] = 0
+      mask(where(z1d LT valmask/10)) = 1
+      z1d[notanum] = !values.f_nan
+   ENDIF ELSE mask(where(z1d LT valmask/10)) = 1
+;-----------------------------------------------------------------------------
+; determination du min et du max apres la moyenne
+;-----------------------------------------------------------------------------
+   nan = total(finite(z1d,/nan)) < 1
+   determineminmax, z1d, mask, mi, ma, MININ = min, MAXIN = max, nan = nan, INTERVALLE = intervalle
+   if z1d[0] EQ -1 THEN return
+;-----------------------------------------------------------------------------
+;-----------------------------------------------------------------------------
+   if NOT keyword_set(ov1d) THEN placedessin, 'autre', posfenetre, posbar, contour = contour, DIREC = direc, endpoints = endpoints, _extra = ex
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+; 2eme partie: dessin
+;--------------------------------------------------------------
+;-----------------------------------------------------------------------------
+; definition des vecteurs abscisse et ordonee
+; la triangulation est definie pour que le trace soit effectue du bas
+; a gauche vers le haut a droite. il faut donc la matrice e contourer
+; se presente de cette maniere, d''ou certains transpose et reverse
+;-----------------------------------------------------------------------------
+;-----------------------------------------------------------------------------
+   case type of
+      'y': begin
+         yy = z1d
+         if (size(gphi))[0] EQ 1 then xx = gphi ELSE xx = reform(gphi[0, *])
+         if keyword_set(sin) then xx = sin(!pi/180.*xx)
+         min0 = lat1 & max0 = lat2
+      END
+      'x':begin
+         yy = z1d
+         xx = glam[*, 0]
+         min0 = lon1 & max0 = lon2
+      END 
+      'z':begin
+         yy = reverse(gdep, 1)
+         xx = reverse(z1d, 1)
+         min0 = 0 & max0 = 0
+         case n_elements(vraiboite) of
+            0:!y.range=[prof1, prof2]
+            1:!y.range=[0, vraiboite]
+            2:!y.range=vraiboite
+            4:!y.range=[prof1, prof2]
+            5:!y.range=[0, vraiboite[4]]
+            6:!y.range=vraiboite[4:5]
+         endcase
+         if NOT keyword_set(ov1d) then !y.range = reverse(!y.range)
+      END 
+   ENDCASE 
+;-----------------------------------------------------------
+;-----------------------------------------------------------
+;   definition des axes
+;----------------------------------------------------------
+;    if keyword_set(integrationtps) then axe, type, time[0], time[jpt-1], SIN = sin, _extra = ex $
+;    ELSE axe, type, SIN = sin
+   if NOT keyword_set(ov1d) then axe, type, SIN = sin
+;------------------------------------------------------------
+;------------------------------------------------------------
+; dessin
+;------------------------------------------------------------
+;------------------------------------------------------------
+   if type EQ 'z' then begin
+      idx = where(xx NE valmask)
+      if NOT keyword_set(ov1d) then BEGIN 
+         if min EQ mi then !x.range=[min-abs(max-min)/5.,max+abs(max-min)/5.] $
+         ELSE !x.range=[min, max]
+      ENDIF
+   ENDIF ELSE BEGIN 
+      idx = where(yy NE valmask)
+      if NOT keyword_set(ov1d) then BEGIN 
+         if min EQ mi then !y.range=[min-abs(max-min)/5.,max+abs(max-min)/5.] $
+         ELSE !y.range=[min, max]
+      ENDIF
+   ENDELSE 
+;
+   if NOT keyword_set(ov1d) then BEGIN 
+      if keyword_set(reverse_x) then !x.range=reverse(!x.range)
+      if keyword_set(reverse_y) then !y.range=reverse(!y.range)
+   ENDIF
+;
+   xx = xx[idx]
+   yy = yy[idx]
+   if (not keyword_set(col1d)) then col1d = 0
+   if keyword_set(sty1d) then BEGIN ;si on veut faire des barres
+      IF strlowcase(strtrim(sty1d)) EQ 'bar' then begin
+         !y.range = [!y.range[0]-(!y.range[1]-!y.range[0])*.05,!y.range[1]] 
+         bar_plot, yy, background = (!d.n_colors-1) < 255,  $
+          baselines = replicate(!y.range[0], n_elements(yy)), barnames = ['', ''], $
+          colors    = replicate(col1d      , n_elements(yy)), /outline
+         plot, [0], [0],/noerase,color=c_cote, _extra = ex
+         GOTO, fini
+      ENDIF 
+   ENDIF
+   if NOT keyword_set(ov1d) then BEGIN 
+      legende,mi,ma,type, CONTOUR = contour, DIREC = direc, ENDPOINTS = endpoints, _EXTRA = ex
+;
+      plot,xx,yy,color=col1d,linestyle=sty1d,thick=2, title = '', subtitle = '',_extra = ex
+      if n_elements(ex) NE 0 then BEGIN 
+; pour avoir un cadre de la couleur c_cote et trace une ligne a y=0
+         if (where(tag_names(ex) EQ 'COLOR'))[0] NE -1 then ex.COLOR = c_cote
+         if (where(tag_names(ex) EQ 'LINESTYLE'))[0] NE -1 then ex.LINESTYLE= 0
+         if (where(tag_names(ex) EQ 'THICK'))[0] NE -1 then ex.THICK= 0
+      ENDIF
+      plot, !x.range, [0, 0],/noerase,color=c_cote $
+       , xstyle = 1+4*(keyword_set(endpoints) AND $
+                       ((type EQ 'x' AND lat1 NE lat2) OR (type EQ 'y' AND lon1 NE lon2))) $
+       , ystyle = 1, _extra = ex
+; ajout d'un axe ds le cas ou l'on utilise endpoints
+      if keyword_set(endpoints) then addaxe, endpoints, type, posfenetre, _EXTRA = ex
+; trace une ligne a x=0
+      plot, [0, 0],!y.range ,/noerase,color=c_cote, title = '', subtitle = '', _extra = ex
+   ENDIF ELSE oplot,xx,yy,color=col1d,linestyle=sty1d,thick=2, _extra = ex
+;------------------------------------------------------------
+;------------------------------------------------------------
+; 3eme partie: impression eventuelle
+;------------------------------------------------------------
+;------------------------------------------------------------
+fini:
+   if keyword_set(oldboite) then domdef, oldboite,GRILLE=[vargrid, 'T']
+   terminedessin, _extra = ex
+   if keyword_set(vraiboite) then boite = vraiboite
+;------------------------------------------------------------
+   if n_elements(key_performance) NE 0 then $
+    IF key_performance EQ 1 THEN print, 'temps plt1d', systime(1)-tempsun 
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+   return
+end
+
+
Index: tags/start/PLOTS/DESSINE/pltbase.pro
===================================================================
--- tags/start/PLOTS/DESSINE/pltbase.pro	(revision 5)
+++ tags/start/PLOTS/DESSINE/pltbase.pro	(revision 5)
@@ -0,0 +1,261 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:pltbase
+;
+; PURPOSE: surcouche de contour pour tracer un champ eventuellement
+; masque. brique elementaire de plt, pltz et pltt.
+;
+; CATEGORY:un tarce vite fait et/ou delestage de l''ecriture de plt, pltz, pltt
+;
+; CALLING SEQUENCE: pltbase, z2d, x, y, mask,xm, ym, [, levels, colors],
+;
+; INPUTS:
+;        z2d:le tableau a tracer
+;
+;        x et y les axes. vecteurs ou tableaux de meme taille que
+;        z2d. Ce sont les coordonnees de z2d
+;
+;        mask: le tableau qui masque z2d (avec des 0 sur les points a
+;        masquer et des 1 sur les autres). si z2d n'est pas masque
+;        mettre cet argument egale a 1.
+;
+;        xm et ym les axes du mask. vecteurs ou tableaux de meme taille que
+;        mask. Ce sont les coordonnees de mask
+;
+;        levels et colors: (optionnels) les vecteurs qui contiennent
+;        les niveaus et les couleurs necessaires au contour. S''il ne
+;        sont pas donnes on prends 20 niveau entre le min et le max.
+;
+; KEYWORD PARAMETERS:
+;
+;        COLORTRICHAMP : la couleur que l''on veut utiliser pour
+;        dessiner la triangulation qui est utilisee pour faire les
+;        contour du champ
+;
+;        COLORTRIMASK : la couleur que l''on veut utiliser pour
+;        dessiner la triangulation qui est utilisee pour faire les
+;        contour du mask
+;
+;        /CONT_NOFILL: activer pour ne pas remplir les points masques
+;        a la couleur c_cont mais pour les laisser en transparent! Rq
+;        on trace qd meme le contour du mask de la couleur c_cote
+;
+;        CONT_THICK: l''epaisseur du trait pour tracer les
+;        continents. par defaut c''est 1.
+;
+;        /DESSTRICHAMP: pour dessiner la triangulation qui est
+;        utilisee pour faire les contour du champ. 
+;
+;        /DESSTRIMASK: pour dessiner la triangulation qui est
+;        utilisee pour faire les contour du mask
+;
+;        /FORPLT: a activer si on veut que le trace des cote soit
+;        realise par tracecote plutot que tracemask.
+;
+;        I_COLORS: un vecteur specifiant la couleur a utiliser pour
+;        tracer les contours. C''est la meme chose que c_colors qui
+;        ajit sur les contours.
+;
+;        MORE: chiffre a donner pour eviter les bug du style:
+;  % Out of range subscript encountered: <LONG      Array[38911]>.
+;  % Execution halted at:  PLTBASE           151
+;             par defaut more=10 si le bug existe tjs, augmenter la
+;             valeur de more! (l''explication et la justification de
+;             cette methode n''ont pas encore de fondements
+;             scientifiques)...
+;         
+;
+;
+;        /NOCOULEUR: pour faire juste les isolignes
+;
+;        /NOCONTOUR: pour faire juste les couleurs
+;
+;        /UNSUR2: pour tarcer une isoligne sur 2
+;
+;        UNLABSUR: entier n. specifant qu''on ne labelle qu''un
+;        contour sur n
+;
+;        CONTOUR: pour etrte utilise depuis plt, pltz ou pltt. cf ces
+;        routines.
+;
+;        _EXTRA: mot cle magique d''idl pour faire passer tous lse
+;        mots cles acceptes par les routines et fonctions utilises ds
+;        ce programme sans les declarer explicitement. 
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;        common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:ds le cas ou z2d, x et y sont des tableaux de meme
+; taille il faut les metre sous forme de vecteur: z2d[*], x[*], y[*].
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       ????
+;                       8/2/2000 check if the tri array is not equal to
+;                       -1. allow contour with out using a triangulation.
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO pltbase, z2d, x, y, mask,xm, ym, levels, colors,UNSUR2 = unsur2, CONTOUR = contour $
+             , NOCONTOUR = nocontour, NOCOULEUR = nocouleur, TRICHAMP = trichamp, TRIMSK = trimsk $
+             , CARTE = carte, NAN = nan $
+             , COLORTRICHAMP = colortrichamp, COLORTRIMASK = colortrimask $
+             , COLORTRINAN = colortrinan $
+             , TH_TRICHAMP = th_trichamp, TH_TRIMASK = th_trimask $
+             , DESSTRICHAMP = desstrichamp, DESSTRIMASK = desstrimask $
+             , DESSTRINAN = desstrinan $
+             , I_COLORS = i_colors $
+             , CONT_THICK = cont_thick,CONT_NOFILL = cont_nofill, UNLABSUR = unlabsur $
+             , COINMONTEMASK = coinmontemask, COINDESCENDMASK = coindescendmask $
+             , COINMONTENAN = coinmontenan, COINDESCENDNAN = coindescendnan $
+             , INDICEZOOMMASK = indicezoommask, INDICEZOOMNAN = indicezoomnan $
+             , MASKNAN = masknan, TRINAN = trinan, XNAN = xnan, YNAN = ynan, FORPLT = forplt $
+             , MORE = more, _EXTRA = ex
+@common
+;
+; explication concernant contour. Ce mot cle est active qd on on trace
+; un contour en couleur different de celui en trait noir.
+; si il est active (cas n_elements(contour) NE 0), on passe 2 fois ds pltbase:
+;   1) on trace les couleurs puis on sort c''est le cas:
+;         n_elements(contour) NE 0 AND n_elements(contour) NE 4)
+;   2) on trace les contour en trait puis les continents c''est le cas 
+;         n_elements(contour) NE 0 AND n_elements(contour) EQ 4)
+;
+;------------------------------------------------------------
+   tempsun = systime(1)         ; pour key_performance
+   if n_elements(masknan) EQ 0 then masknan = 1
+;----------------------------------------------------------------------
+; si les niveaux et les couleurs ne sont pas donnes
+;----------------------------------------------------------------------
+   if n_params() EQ 4 then BEGIN 
+      label,0,min(z2d*mask),max(z2d*mask),ncontour,levels
+      colors = couleur
+   endif
+; attention bidouille inexplicable pour que tout se passe bien avec les
+; postcript ds pltz!!!
+   if n_elements(contour) LE 4 AND !x.type EQ 0 THEN $
+    plot, [0], [0], xstyle = 5, ystyle = 5,/noerase, title = '',  subtitle = ''
+;----------------------------------------------------------------------
+; si cell_fill fait partit de _extra, on le desactive si il n''est pas
+; egale a 2
+;----------------------------------------------------------------------
+   IF chkstru(ex, 'CELL_FILL') THEN BEGIN 
+      cell_fill = ex.CELL_FILL
+      if ex.CELL_FILL NE 2 then ex.CELL_FILL = 0
+   ENDIF ELSE cell_fill = 0     ;
+; do we use the triangulation??
+   usetri = n_elements(trichamp) NE 0 AND (testvar(var = trichamp))[0] NE -1
+;----------------------------------------------------------------------
+; I) remplissage des contours en palette de couleur 
+;----------------------------------------------------------------------
+   if NOT keyword_set(more) then more = 10
+   if NOT keyword_set(nocouleur) then begin
+      if n_elements(contour) NE 4 THEN BEGIN 
+         if usetri then $
+          contour,[z2d[*], fltarr(more)],[x[*], fltarr(more)],[y[*], fltarr(more)],levels=levels,c_color=colors,/noerase,/fill,/closed $
+          ,TRIANGULATION=trichamp, _extra = ex $
+         else $
+          contour,z2d,x,y,levels=levels,c_color=colors,/noerase,/fill,/closed, _extra = ex 
+      endif
+   endif
+   if n_elements(contour) NE 0 AND n_elements(contour) NE 4 THEN GOTO, fini 
+   IF chkstru(ex, 'C_ORIENTATION') THEN ex = extractstru(ex, 'C_ORIENTATION')
+   IF chkstru(ex, 'C_SPACING') THEN ex = extractstru(ex, 'C_SPACING')
+;------------------------------------------------------------
+; II) trace des contours en trait de couleur c_lab
+;------------------------------------------------------------
+   if n_elements(contour) EQ 4 OR n_elements(contour) EQ 0 THEN BEGIN
+; on ne passe pas si on doit faire des contours differents...
+; ds le cas on unsur2 est active on reduit levels
+      if NOT keyword_set(nocontour) then begin
+         IF keyword_set(unsur2) THEN levels = levels(where(zeroun(n_elements(levels) ) eq 1))
+; unlabsur est active?  C_LABEL est passe via _EXTRA?
+         if keyword_set(unlabsur) THEN IF chkstru(ex, 'C_LABELS') THEN $
+          ex.C_LABELS = 1-((indgen(n_elements(ex.C_LABELS)) MOD unlabsur) < 1)
+;
+; pour ne pas filler qd cell_fill est impose...
+         IF chkstru(ex, 'CELL_FILL') THEN ex.CELL_FILL = 0
+         IF chkstru(ex, 'C_COLORS') THEN ex = extractstru(ex, 'C_COLORS')
+;
+         if usetri then $
+          contour, [z2d[*], fltarr(more)], [x[*], fltarr(more)],[y[*], fltarr(more)],levels=levels, overplot = 1-keyword_set(nocouleur) $
+          ,noerase = keyword_set(nocouleur), c_color=c_lab*(1-keyword_set(i_colors))+testvar(var = i_colors),TRIANGULATION=trichamp, _extra = ex $
+         else $
+          contour, z2d, x,y,levels=levels, overplot = 1-keyword_set(nocouleur) $
+          ,noerase = keyword_set(nocouleur), c_color=c_lab*(1-keyword_set(i_colors))+testvar(var = i_colors), _extra = ex
+;
+      endif
+;
+      if keyword_set(carte) then if carte EQ 1 then mask = 1
+      if n_elements(mask) NE 1 then BEGIN ; si mask=1 on saute.
+;----------------------------------------------------------------------
+; III) remplissage des continents de couleur c_cont
+;----------------------------------------------------------------------
+         if NOT keyword_set(cont_nofill) then BEGIN
+            IF chkstru(ex, 'CELL_FILL') THEN ex.CELL_FILL = cell_fill < 1
+            IF chkstru(ex, 'LEVELS') THEN ex = extractstru(ex, 'LEVELS')
+            if n_elements(trimsk) eq 0 and usetri then trimsk = trichamp
+;
+            usetri = n_elements(trimsk) NE 0 AND (testvar(var = trimsk))[0] NE -1
+            if usetri then BEGIN
+               if keyword_set(forplt) then $
+                contour, -1*[mask[*], fltarr(more)], [xm[*], fltarr(more)], [ym[*], fltarr(more)], levels=-0.5, /overplot, /fill ,c_color=c_cont $
+                ,TRIANGULATION=trimsk, _extra=ex ELSE $
+                contour, -1*[(mask*masknan)[*], fltarr(more)], [xm[*], fltarr(more)], [ym[*], fltarr(more)], levels=-0.5, /overplot, /fill $
+                ,c_color=c_cont,TRIANGULATION=trimsk, _extra=ex ;
+               completecointerre, coinmonte=coinmontemask, coindescend=coindescendmask $
+                , indicezoom = indicezoommask, _extra = ex
+            ENDIF ELSE BEGIN
+               if keyword_set(forplt) then $
+                contour, -1*mask, xm, ym, levels=-0.5, /overplot, /fill ,c_color=c_cont $
+                , _extra=ex ELSE $
+                contour, -1*(mask*masknan), xm, ym, levels=-0.5, /overplot, /fill $
+                ,c_color=c_cont, _extra=ex ;
+            ENDELSE
+;
+
+; si il y a des points a nan et que le champ n''est pas sur la grille T
+; on trace en blanc les points a nan avant de dessiner les cotes avec
+; un trait.
+            if keyword_set(trinan) THEN BEGIN
+               contour, [-masknan[*], fltarr(more)],[xnan[*], fltarr(more)],[ynan[*], fltarr(more)],levels=-0.5,/overplot,/fill,c_color=c_cont $
+                , TRIANGULATION=trinan, _extra = ex
+               completecointerre, coinmonte=coinmontenan, coindescend=coindescendnan $
+                , indicezoom = indicezoomnan, _extra = ex
+               if keyword_set(desstrinan) then dessinetri, trinan, xnan, ynan, color = colortrinan
+            endif
+         endif
+;------------------------------------------------------------
+; IV) trace les cotes en trait de couleur c_cote
+;------------------------------------------------------------
+
+         if NOT keyword_set(cont_thick) then cont_thick = 1
+         IF chkstru(ex, 'C_THICK') THEN ex.C_THICK = cont_thick
+;
+         if n_elements(key_stride) LE 2 then key_stride = [1, 1, 1]
+         key_stride = 1l > long(key_stride)
+;
+         if (keyword_set(forplt) AND (!map.projection GT 0 OR key_irregular)) $
+          OR keyword_set(nan) then $
+          tracecote, CONT_THICK = cont_thick, _extra = ex $
+         ELSE tracemask, mask, xm, ym, CONT_THICK = cont_thick, _extra = ex
+;
+      endif
+   ENDIF
+;------------------------------------------------------------
+fini:
+   if keyword_set(desstrichamp) then dessinetri, trichamp, x, y, color = colortrichamp, thick = th_trichamp
+   if keyword_set(desstrimask) then dessinetri, trimsk, xm, ym, color = colortrimask, thick = th_trimask
+   IF keyword_set(key_performance) THEN print, 'temps pltbase', systime(1)-tempsun 
+
+   return
+end
Index: tags/start/PLOTS/DESSINE/pltsc.pro
===================================================================
--- tags/start/PLOTS/DESSINE/pltsc.pro	(revision 5)
+++ tags/start/PLOTS/DESSINE/pltsc.pro	(revision 5)
@@ -0,0 +1,91 @@
+PRO  pltsc,tab1,tab2, min1, max1, min2, max2, varname2, BOITE = boite, $
+           COL1D=col1d,STY1D=sty1d,OV1D=ov1d, _extra = ex
+;
+; scatter plot (inspired from plt1d)
+;
+
+@common
+
+; Rq: on ne reinitialise pas qd on rapelle pltsc
+   if NOT keyword_set(ov1d) then reinitplt
+   ;; reduce data xyzt domain
+
+   oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+   if keyword_set(boite) then BEGIN 
+      if n_elements(integration3d) EQ 0 THEN integration3d = n_elements(boite) ne 4
+      Case 1 Of
+         N_Elements(Boite) Eq 1:bte=[lon1, lon2, lat1, lat2, 0.,boite[0]]
+         N_Elements(Boite) Eq 2:bte=[lon1, lon2, lat1, lat2, boite[0],boite[1]]
+         N_Elements(Boite) Eq 4:bte=[Boite, prof1, prof2]
+         N_Elements(Boite) Eq 5:bte=[Boite[0:3], 0, Boite[4]]
+         N_Elements(Boite) Eq 6:bte=Boite
+         Else: Begin
+            ras = report('Mauvaise Definition de Boite') 
+            return
+         End
+      endcase
+   ENDIF else bte=[lon1, lon2, lat1, lat2, prof1, prof2]
+
+   domdef, bte,GRILLE=vargrid
+
+; extract indexes to plot
+
+   indexm = where(tab1 LE valmask/10.)
+   tab1 = tab1[indexm]
+   tab2 = tab2[indexm]
+
+   npts = (size(indexm))[1]
+
+; deal with  min and max of plot
+   IF finite(min1) EQ 0 THEN min1 = min(tab1)
+   IF finite(max1) EQ 0 THEN max1 = max(tab1)
+   IF finite(min2) EQ 0 THEN min2 = min(tab2)
+   IF finite(max2) EQ 0 THEN max2 = max(tab2)
+   
+
+; init plot if not overlay
+   
+   IF NOT keyword_set(ov1d) THEN placedessin, 'yfx', posfenetre, posbar, $
+    contour = contour, _extra = ex
+   yy = tab1
+   xx = tab2
+
+; axis range
+   !x.range = [min2-abs(max2-min2)/5.,max2+abs(max2-min2)/5.]
+   !y.range = [min1-abs(max1-min1)/5.,max1+abs(max1-min1)/5.]
+
+   IF (NOT keyword_set(sty1d)) THEN sty1d = 0
+   IF (NOT keyword_set(col1d)) THEN col1d = 0
+   IF  NOT keyword_set(ov1d) THEN  BEGIN 
+      legende, min1, max1, 'yfx', VARNAME2 = varname2, NPTS = npts, _EXTRA = ex 
+;
+      plot,xx,yy, background = 255, psym = sty1d+1, color=col1d, thick=2 $
+       , title = '', subtitle = '',_extra = ex
+
+      if n_elements(ex) NE 0 then BEGIN 
+; pour avoir un cadre de la couleur c_cote et trace une ligne a y=0
+         if (where(tag_names(ex) EQ 'COLOR'))[0] NE -1 then ex.COLOR = c_cote
+         if (where(tag_names(ex) EQ 'LINESTYLE'))[0] NE -1 then ex.LINESTYLE= 0
+      ENDIF
+      plot, !x.range, [0, 0],/noerase,color=c_cote, xstyle = 1, ystyle = 1, _extra = ex
+; trace une ligne a x=0
+      plot, [0, 0],!y.range ,/noerase,color=c_cote, title = '', subtitle = '', _extra = ex
+   ENDIF ELSE oplot,xx,yy,color=col1d,linestyle=sty1d,thick=2, _extra = ex
+;------------------------------------------------------------
+;------------------------------------------------------------
+; 3eme partie: impression eventuelle
+;------------------------------------------------------------
+;------------------------------------------------------------
+fini:
+   domdef, oldboite,GRILLE=vargrid
+   terminedessin, _extra = ex
+;------------------------------------------------------------
+   if n_elements(key_performance) NE 0 then $
+    IF key_performance EQ 1 THEN print, 'temps plt1d', systime(1)-tempsun 
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+   return
+end
+
+
Index: tags/start/PLOTS/DESSINE/pltt.pro
===================================================================
--- tags/start/PLOTS/DESSINE/pltt.pro	(revision 5)
+++ tags/start/PLOTS/DESSINE/pltt.pro	(revision 5)
@@ -0,0 +1,652 @@
+;------------------------------------------------------------
+;+
+; NAME:
+;	PLTT
+;
+; PURPOSE:
+;	trace des graphes hovmoller
+;
+; CATEGORY:
+;       Graphics, trace des graphes hovmoller: xt,yt,zt,t
+;
+; CALLING SEQUENCE:
+;	pltt, champ,type [,min[, max[, datmin[, datmax]]]]
+;
+; INPUTS:
+;	champ: le champ dont on veut faire le hovmoller champ
+;	peut etre de 2 types:
+;	1) un tableu qui peut etre:
+;          * 3d ou 4d: la derniere composante etant le temps. dans ce
+;            cas, le tableau va passer dans grossemoyenne pour etre
+;            moyennee suivant et devenir un tableau 2d ou 1d.
+;          * 2d: si tableau est deja 2d, il n''est pas modifie
+;            (attention les terres doivent etre masquees a la valeure
+;            valmask) et type doit qd meme etre specifie pour qu''on
+;            sache de quel trace il sagit. Pour avoir une legende
+;            correcte, respecifier la zone d''extraction via BOITE
+;          * 1d: uniquement pour les traces de type 't'. Type doit qd
+;            meme etre specifie pour qu''on sache de quel trace il
+;            sagit. Pour avoir une legende correcte, respecifier la zone
+;            d''extraction via BOITE
+;       2) une structure repondant aux critaire specifies par
+;       litchamp.pro. cf. IDL> xhelp,'litchamp'. Le tableau contennu ds
+;       la structure repondant aux criteres du cas 1) cf. ci-dessus
+;
+;       TYPE: type de hovmoller que l''on veut faire:
+;             'xt','yt','zt','t'  
+;
+; ces arguments ne sont pas obligatoires:
+;  
+;	MAX: valeur maximum que l''on veut prendre en compte dans le trace
+; des contours. Par defaut on prend le max de tableau (sur les pts mer)
+;
+;	MIN: valeur minimum que l''on veut prendre en compte dans le trace
+; des contours. Par defaut on prend le min de tableau (sur les pts
+; mer)
+;
+;       DATMIN: c''est la borne inf de l''axe temporel. c''est un
+;       longinteger de la forme yyyymmdd (ou bien yymmdd).
+;
+;       DATMAX: c''est la borne max de l''axe temporel. c''est un
+;       longinteger de la forme yyyymmdd (ou bien yymmdd)
+;
+; KEYWORD PARAMETERS:
+;
+;	BOITE:vecteur indiquant la zone geographique (3d) sur laquelle doit
+; etre fait l''extraction du champ pour faire le hovmoeller.
+; Si BOITE a :
+; 1 element : l''extraction est faite sur [lon1, lon2, lat1, lat2, 0.,boite[0]]
+; 2 elements: l''extraction est faite sur [lon1, lon2, lat1, lat2, boite[0],boite[1]]
+; 4 elements: l''extraction est faite sur [Boite, prof1, prof2]
+; 5 elements: l''extraction est faite sur [Boite[0:3], 0, Boite[4]]
+; 6 elements: l''extraction est faite sur Boite
+;
+; Ou lon1, lon2,lat1,lat2,prof1,prof2 sont les variables globales
+; definies lors du dernier domdef!
+;
+;      CB_TITLE: le titre de la colorbar
+;
+;      CB_SUBTITLE: le soustitre de la colorbar
+;
+;      CB_CHARSIZE: The character size of the color bar annotations
+;
+;	CONTINTERVALLE: lorsque CONTOUR est active, valeur d''un
+; intervalle entre deux isolignes traces par un trait ds la couleur
+; c_lab. Il peut ainsi etre different de celui specifie par INTERVALLE
+; qui, cas ce cas, ne controle que les isolignes coloriees en
+; couleurs. Si aucun min n''est specifie, on choisit un contour min qui va
+; bien avec l''intervalle specifie!. Si ce mot cle n''est pas
+; specifie, on trace 20 isolignes du min au max. 
+;
+;	CONTLABEL: un entier n. lorsque CONTOUR est active, si n
+; different de 0, choisit le type de label correspondant aux cas n
+; pour les isolignes tracees par un trait. Pour specifier le type de
+; label du contour en couleur, utiliser LABEL
+;
+;	CONTMAX: lorsque CONTOUR est active, valeur maximum que l''on
+; veut prendre en compte dans le trace des isolignes traces par un
+; trait de couleur c_lab. Par defaut on prend le max (sur les pts mer)
+; du tableau passe ds le mot cle CONTOUR. 
+;
+;	CONTMIN: lorsque CONTOUR est active, valeur minimum que l''on
+; veut prendre en compte dans le trace des isolignes traces par un
+; trait de couleur c_lab. Par defaut on prend le max (sur les pts mer)
+; du tableau passe ds le mot cle CONTOUR. 
+;
+;	CONTNLEVEL: lorsque CONTOUR est active, nombre de contours
+; trace par un trait de couleur c_lab a dessiner (actif si
+; CONTLABEL=0) par defaut =20.
+;
+;	CONTOUR: si on veut tracer les contours d''un champ different que celui
+; que l''on dessin en couleur (par ex E-P en couleur et QSR en
+; contours). Doit etre un champ reponadnt aux meme caracteristiques
+; que l''argument numero 1 de pltt
+;
+;       ENDPOINTS: mot clef specifiant que l'on veut faire une coupe
+;       verticale en diagonale. les coordonnees des extremites de
+;       celle-ci sont alors definies les 4 elements du vecteur
+;       ENDPOINTS: [x1,y1,x2,y2] qui sont les coordonnees 
+;
+;       /EXCHANGE_XY: permet d''intervertir les axes.
+; 
+;       FILTER: applique une moyenne glissante de largeur FILTER
+; 
+;	INTERVALLE: valeur d''un intervalle entre deux isolignes. Si
+; aucun min n''est specifie, on choisit un contour min qui va bien
+; avec l''intervalle specifie!. Si ce mot cle n''est pas specifie, on
+; trace 20 isolignes du min au max. Rq: Qd CONTOUR est active
+; INTERVALLE ne specifie que intervalle entre 2 isolignes coloriees en
+; couleur. Pour specifier l''intervalle entre 2 isolignes traces par un trait
+; de couleur c_lab utiliser CONTINTERVALLE.
+;
+;	/INV: inverse le vecteur couleur utilise pour colorier le graphe
+;             (sans toucher au noir, au blanc et a la palette utilisee)
+; 
+;	LABEL: un entier n. si n different de 0, choisit le type de
+; label correspondant aux cas n. cf label.pro
+; Rq: Qd CONTOUR est active, ne specifie le type de label que pour les
+; isolignes coloriees en couleur. Pour celles tracees par un trait de
+; couleur c_lab utiliser CONTLABEL.
+;
+;	/LANDSCAPE: oblige la feuille ou le fenetre a l''ecran a etre
+;	en position "allongee".
+;	
+;       LCT: entier designant le numero de la palette de couleur que
+;       l''on veut utiliser pour le plot. 
+;	
+;       COL1d: --OBSOLETE--numero de la couleur qd on fait un trace 1d
+;       par defaut, 0. il faut mieux utiliser le mot cle COLOR utilise
+;       par plot
+;
+;       MAXIN: permet de specifier la valeur maximum que l''on veut
+;       prendre en compte dans le trace des contours a l''aide d''un
+;       mot cle plutot que par l''argument max. Si l''argument et le
+;       mot cle sont specifies en meme temps, c''est la valeur
+;       specifiee par le mot cle qui est retenue.
+;
+;       MININ: permet de specifier la valeur minimum que l''on veut
+;       prendre en compte dans le trace des contours a l''aide d''un
+;       mot cle plutot que par l''argument min. Si l''argument et le
+;       mot cle sont specifies en meme temps, c''est la valeur
+;       specifiee par le mot cle qui est retenue.
+;
+;	NLEVEL: nombre de contours a dessiner. par defaut =20. actif si
+; LABEL=0 ou n''est pas specifie.
+;
+;	CONTNLEVEL: nombre de contours a dessiner qd on utilise ajoutcontour
+; active par le mot cle CONTOUR.(actif si CONTLABEL=0) par defaut =20.
+;
+;	/NOCOLORBAR: activer si on ne veut pas de colorbar
+;
+;	/NOCONTOUR: activer si on ne veut pas de contour mais juste
+;	les couleurs
+;
+;	/NOCOULEUR: activer si on veut juste les contours en noir et
+;	blanc sur fond blanc
+;
+;       /NOERASE: activer pour faire un dessin a l''ecran sans creer
+; une nouvelle fenetre. Rq: activer ds le cas d''un Postscript de
+; plusieurs traces de type 't' pour ne pas faire un Postscript de
+; plusieurs pages 
+;
+;       /OV1D:permet de surimprimer un courbe 1d a un precedent trace 1d.
+;
+;       OVERPLOT: pour faire un pltt par dessus un autre. Rq:
+;       contrairemnet a l''utilisation de CONTOUR,
+;       l''utilisation de ce mot clef ne modifie pas la legende ou/et
+;       la barre de couleur. dans le cas d''un plot 1d, contrairement
+;       a ov1d, on peut changer les axes et les ranges.
+;
+;	PETITDESSIN: vecteur de 3 ou 4 elements, applique pour faire un
+; dessin sur une petite portion de feuille ou d''ecran. il delimite
+; la zone ds laquelle va etre fait le dessin
+; si il a 4 elements:
+;       il est alors constitute des coordonnees -exprime en cm reperes par
+;       rapport au coin en bas a gauche de la feuille ou de la fenetre
+;       (en portrait comme en landscape)- du coin en bas a
+;       gauche et du coin en haut a droite  de la zone de dessin.
+; si il a 3 elements:
+;       Ds ce cas, on divise la fenetre ou l''ecran en PETITDESSIN[0]
+;       colonnes, en PETITDESSIN[1] lignes le dessin se faisant ds la
+;       case numero PETITDESSIN[2].La numerotation commencant en haut
+;       a gauche par le numero 1 et suivant apres dans le sens de
+;       l''ecriture.
+; Par defaut on fait un dessin occupant la plus grande place possible
+; tout en concervant le rapport d''aspect (sauf qd REMPLI est active)
+;
+;	/PORTRAIT: oblige la feuille ou la fenetre a etre en position "debout".
+;
+;	/POST: faire une sortie postscript. Ne marche que si on fait
+;	un seul dessin sur la feuille. Si on fait plusieurs dessins,
+;	utiliser @ps ou plein2dessins
+;
+;       REPEAT_C=n pour repeter une serie temporelle n fois
+;
+;	/REMPLI:oblige le dessin a occuper l''espace maximum definit
+;	par petitdessin
+;
+;       /REVERSE_X: pour inverser l''axe des x (et aussi le dessin)
+;
+;       /REVERSE_Y: pour inverser l''axe des y (et aussi le dessin)
+;
+;       /STRICTFILL: activer ce mot clef pour que le remplissage des
+;       contours ce fasse precisement entre le min et le max specifie
+;       en laissant en banc les valeurs inferieurs au min specifie et
+;       superieurs au max specifie.
+;
+;	STYLE: style de tracer a adopter pour dessiner les isolignes par
+; defaut style=0. cf style.pro
+;
+;       STY1D: --OBSOLETE--numero du style utilise lors d''un trace
+;       1d. Il faut mieux utiliser le mot cle LINESTYLE qui est celui
+;       de plot. Attention ce mot cle est encore utile si on veut
+;       faire des barres plutot qu''une courbe, mettre sty1d='bar'
+;
+;	/TRANS: fait un postscript (active /post automatiquement) et l''imprime
+; -si on le desire- sur un transparant
+;
+;        TREND_TYPE: modify data by calling trends.pro
+;
+;        TYPEIN: permet de specifier la valeur type de hovmoller que
+;        l''on veut faire:
+;             'xt','yt','zt','t'  
+;       a l''aide d''un mot cle plutot que par l''argument type Si
+;       l''argument et le mot cle sont specifies en meme temps, c''est
+;       la valeur specifiee par le mot cle qui est retenue.
+;
+;       /USETRI: pour forcer a utiliser de triangulation.
+;
+;        UNLABSUR: entier n. specifant qu''on ne labelle qu''un
+;        contour sur n. Par defaut unlabsur=2
+;
+;	/UNSUR2: si on veut tracer un countour sur deux. par  defaut trace
+; tous les contours
+;
+;	WINDOW: nimero de la fenetre ou l''on veut faire le graphe (permet
+; d'ouvrir plusieurs fenetres). par defaut on ouvre 'IDL0'
+;
+;	YSURX: rapport d'echelle entre y et x. Par defaut=1
+; Par defaut on adapte pour occupe une grande partie de la feuille en sortie
+; postScript ou pour cree une fenetre pas trop etiree
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			27/5/98
+;                       Jerome Vialard (adapting plt to hovmoller drawing)
+;                       2/7/98
+;                       Sebastien Masson 14/8/98 (continents,barres)
+;                       15/1/98
+; adaptation pour les tableaux 3 et 4d pour que la moyenne soit faite
+; dans pltt plutot que lors de la lecture.
+;                       Sebastien Masson 14/8/98 
+;                       7/1999 
+;                       Eric Guilyardi 29/7/99 FILTER, TREND_TYPE,
+;                       REPEAT_C 
+;                       Sebastien Masson 08/02/2000 checkfield and
+;                       usetri keyword.
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro pltt,tab,giventype,givenmin,givenmax,datmin,datmax,BOITE = boite, CONTOUR=contour $
+         ,ENDPOINTS=endpoints,INTERVALLE=intervalle,INV=inv  $
+         ,CONTINTERVALLE=contintervalle,LABEL=label,CONTLABEL=contlabel $
+         ,STYLE=style, CONTMAX=contmax, USETRI = usetri $
+         ,CONTMIN=contmin,NLEVEL=nlevel,CONTNLEVEL=contnlevel $
+         ,COL1D=col1d,STY1D=sty1d, MININ = minin, MAXIN = maxin $
+         ,OV1D=ov1d, FILTER = filter, TREND_TYPE = trend_type $
+         ,REPEAT_C = repeat_c, TYPEIN = typein, XT = XT, YT = YT, ZT = zt $
+         , TT = tt, STRICTFILL = strictfill, OVERPLOT = overplot, EXCHANGE_XY = exchange_xy $
+         , _extra = ex
+@common
+;------------------------------------------------------------
+   tempsun = systime(1)         ; pour key_performance
+;--------------------------------------------------------------
+; I2) reinitialisation. !p.,!x.,!y.
+; Rq: on ne reinitialise pas qd on rapelle plt en boucle pour utiliser contour
+;--------------------------------------------------------------
+   if n_elements(contour) ne 4 AND NOT keyword_set(overplot) $
+    AND NOT keyword_set(ov1d) then reinitplt
+;--------------------------------------------------------------
+; I1) lecture du champ
+;--------------------------------------------------------------
+   if keyword_set(boite) then oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+   if n_elements(giventype) NE 0 then type = giventype
+   if n_elements(givenmin) NE 0 then min = givenmin
+   if n_elements(givenmax) NE 0 then max = givenmax
+   if n_elements(minin) NE 0 then min = minin
+   if n_elements(maxin) NE 0 then max = maxin
+   if keyword_set(typein) then BEGIN 
+      if size(type, /type) NE 7 AND size(type, /type) NE 0 then begin
+         if n_elements(min) NE 0 then max = min
+         min = type
+      endif
+      type = typein
+   endif
+   checktypeminmax, 'pltt', TYPE = type, MIN = min, MAX = max, XT = XT, YT = YT, ZT = zt, TT = tt, ENDPOINTS=endpoints, BOITE = boite, _extra = ex
+   if keyword_set(endpoints) then begin
+      section, tab, z2d, glam, gphi, ENDPOINTS = endpoints, TYPE = type, BOITE = boite, DIREC = direc
+      nx = n_elements(glam) 
+      ny = nx
+      if strupcase(vargrid) EQ 'W' then begin
+         z = gdepw[premierzw:dernierzw]
+         nz = nzw
+      ENDIF ELSE BEGIN
+         z = gdept[premierzt:dernierzt]
+         nz = nzt
+      ENDELSE
+   ENDIF ELSE BEGIN 
+      z2d = checkfield(tab, 'pltt', TYPE = type, BOITE = boite, direc = direc, _extra = ex)
+      if z2d[0] EQ -1 then BEGIN 
+         if keyword_set(boite) AND n_elements(oldboite) NE 0 then domdef, oldboite,GRILLE=vargrid
+         return
+      endif
+      grille, mask, glam, gphi, gdep, nx, ny,nz
+   ENDELSE
+;---------------------------------------------------------------
+; calcul de tendance/anomaly suivant TREND_TYPE
+;---------------------------------------------------------------
+
+   IF NOT keyword_set(trend_type) THEN trend_type = 0
+
+   IF trend_type GT 0 THEN z2d = trends(z2d, trend_type, type)
+
+;---------------------------------------------------------------
+; filtrage des donnee dans le cas 't' 
+;---------------------------------------------------------------
+
+   IF type EQ 't' AND keyword_set(filter) THEN BEGIN 
+      print, '    Applying a running mean filter of width '+string(filter, format = '(I3)')
+      z2d = smooth(z2d, filter)
+      z2d[0:filter/2-1] = 0.
+      z2d[(size(z2d))[1]-filter/2-1:(size(z2d))[1]-1] = 0.
+   ENDIF 
+
+;---------------------------------------------------------------
+; repetition de la serie temporelle
+;---------------------------------------------------------------
+
+   IF NOT keyword_set(repeat_c) THEN repeat_c = 1
+
+   temps = time[0:jpt-1]
+   IF repeat_c GT 1 THEN BEGIN
+      taille=size(z2d)
+      CASE taille[0] OF
+         1: z2d = reform(z2d#replicate(1, repeat_c), taille[1]*repeat_c)
+         2: BEGIN
+            z2d = z2d[*]#replicate(1, repeat_c)
+            z2d = reform(z2d, taille[1], taille[2]*repeat_c, /over)
+         END 
+         ELSE: 
+      ENDCASE
+      temps = [temps, (lindgen(jpt*(REPEAT_c-1))+1)*(temps[1]-temps[0])+temps[jpt-1]]
+   ENDIF 
+
+
+;---------------------------------------------------------------
+; selection du type de graphique. 
+;---------------------------------------------------------------
+   taille=size(z2d)
+   case taille[0] of
+      2 : begin
+         niveau=1
+         typdes='2d'
+      end
+      1 : begin
+         z1d=z2d
+         typdes='1d'
+         if keyword_set(OV1D) then begin
+            yy = z2d
+            if n_elements(datmin) NE 0 then tempsmin = juldate(datmin, _extra = ex) $
+            ELSE tempsmin = temps[0]
+; on shift l''axe du temps pour des questions de precision sur les
+; dates du calendier julien en long qui sont passes en float ds les axes
+            xx = temps-tempsmin
+            !x.range=!x.range-tempsmin
+            !x.tickv=!x.tickv-tempsmin
+; on fait un faux plot pour appliquer ces changements!
+            plot,[0], [0],/noerase,xstyle=5, ystyle = 5, title = '', subtitle = '', ytitle = '', xtitle = ''
+            goto, trace1d
+         endif
+      end
+   endcase
+; on construit le mask pour cela le tableau doit etre masque (fait
+; automatiquement a la valeur valmask si on passe ds moyenne ou grossemoyenne)
+   mask = fltarr(taille[1], taille[2])
+   nan = total(finite(z2d,/nan)) < 1
+   if n_elements(valmask) EQ 0 then valmask = 1e20
+   if keyword_set(nan) then begin
+      notanum = where(finite(z2d) EQ 0)
+      z2d[notanum] = 0.
+      mask(where(z2d LT valmask/10.)) = 1
+      z2d[notanum] = !values.f_nan
+   ENDIF ELSE mask(where(z2d LT valmask/10)) = 1
+;----------------------------------------------------------------------------
+;   determination du mi:min et du ma:max de z2d ainsi que de max: max et
+;    min: min pour le dessin.
+;-----------------------------------------------------------------------------
+; faudra-t-il faire un autoscale ???
+   autoscale = testvar(var = min) EQ testvar(var = max) AND NOT keyword_set(intervalle)
+   determineminmax, z2d, mask, mi, ma, MININ = min, MAXIN = max, nan = nan, INTERVALLE = intervalle
+   if z2d[0] EQ -1 THEN return
+; on fait un autoscale si besoin
+   if autoscale then autoscale, min, max, intervalle
+;-----------------------------------------------------------------------------
+;-----------------------------------------------------------------------------
+   if n_elements(contour) ne 4  AND NOT keyword_set(overplot) THEN $
+    placedessin, 'pltt',posfenetre, posbar, contour = contour, direc = direc, type = type, endpoints = endpoints, _extra = ex
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+; 2eme partie: dessin
+;--------------------------------------------------------------
+;-----------------------------------------------------------
+;   definition des axes
+;----------------------------------------------------------
+;-----------------------------------------------------------------------------
+; definition des vecteurs abscisse et ordonee
+; la triangulation est definie pour que le trace soit effectue du bas
+; a gauche vers le haut a droite. il faut donc la matrice e contourer
+; se presente de cette maniere, d''ou certains transpose et reverse
+;-----------------------------------------------------------------------------
+;-----------------------------------------------------------------------------
+; definition des bornes de l''axe temporel
+;-----------------------------------------------------------------------------
+   case N_PARAMS() OF
+      5 : begin
+         tempsmin = juldate(datmin, _extra = ex)
+         tempsmax = temps[(jpt*repeat_c)-1]
+      end
+      6 : begin
+         tempsmin = juldate(datmin, _extra = ex)
+         tempsmax = juldate(datmax, _extra = ex)
+      end
+      else : begin
+         tempsmin = temps[0]
+         tempsmax = temps[(jpt*repeat_c)-1]
+      end
+   endcase
+;-----------------------------------------------------------------------------
+; on shift l''axe du temps pour des questions de precision sur les
+; dates du calendier julien en long qui sont passes en float ds les axes
+   case typdes of
+      '1d' : begin
+         yy = z1d
+         xx = temps-tempsmin
+      end
+      '2d' : begin
+         case 1 of
+            type eq 'xt' : BEGIN
+               xx = glam[*, 0]
+               yy = temps-tempsmin
+            end
+            type eq 'yt' : begin
+               IF (size(gphi))[0] EQ 1 then yy = gphi ELSE yy = reform(gphi[0, *])
+               xx = temps-tempsmin
+               z2d = transpose(z2d)
+               mask = transpose(mask)
+            end
+            type eq 'zt' : begin
+               yy =  gdep
+               xx = temps-tempsmin
+               z2d = transpose(z2d)
+               mask = transpose(mask)
+            end
+         endcase
+      end
+   endcase
+;--------------------------------------------------------------
+   if NOT keyword_set(overplot) THEN axe, type, tempsmin, tempsmax, _EXTRA = ex ELSE BEGIN 
+      if type EQ 'xt' then BEGIN 
+         !y.range=!y.range-tempsmin 
+         !y.tickv=!y.tickv-tempsmin
+      ENDIF ELSE BEGIN 
+         !x.range=!x.range-tempsmin
+         !x.tickv=!x.tickv-tempsmin
+      ENDELSE
+   ENDELSE
+;------------------------------------------------------------
+;------------------------------------------------------------
+; dessin
+;------------------------------------------------------------
+; 2d
+;------------------------------------------------------------
+   if (typdes eq '2d') then begin
+;--------------------------------------------------------------
+; choix des labels
+;-----------------------------------------------------------
+      if keyword_set(intervalle) AND NOT keyword_set(label) then label=1
+      if keyword_set(label) eq 0 then cas=0 else cas=label
+      label,cas,min,max,ncontour,level_z2d,NLEVEL=nlevel,INTERVALLE=intervalle, strictfill = strictfill
+;--------------------------------------------------------------
+; choix de style
+;-----------------------------------------------------------
+      if not keyword_set(style) then style=0
+      style,style,level_z2d,linestyle,thick
+      if keyword_set(inv) then couleur=reverse(couleur)
+;----------------------------------------------------------------------
+      nby = n_elements(yy)
+      nbx = n_elements(xx)
+      xx = xx#replicate(1, nby) ; on passe les axes en tableaux 2d
+      yy = replicate(1, nbx)#yy
+;
+      if keyword_set(nan) then begin
+         notanumber = where(finite(z2d, /nan) EQ 1)
+         z2d[notanumber] = max
+         case type of
+            'xt':masknan = replicate(1, nx, jpt)
+            'yt':masknan = replicate(1, ny, jpt)
+            'zt':masknan = replicate(1, nz, jpt)
+         endcase
+         masknan[notanumber] = 0
+      ENDIF ELSE masknan = 1
+      z2d = remplit(z2d,nite=2+keyword_set(nan), mask = mask*masknan, /basique, _extra=ex)
+      if NOT keyword_set(strictfill) then z2d = min > z2d <  max
+      if NOT keyword_set(usetri) then triangulation = -1 ELSE $
+       triangulation = triangule(mask*masknan,/regulier,coinmonte=coinmontemask,coindescend=coindescendmask)
+;
+;----------------------------------------------------------------------
+      pltbase,z2d, xx, yy, mask,xx, yy, level_z2d,couleur, contour = contour,/noerase $
+       , c_linestyle=linestyle,c_labels=1-(indgen(n_elements(level_z2d)) MOD 2) $
+       , trichamp = triangulation, trimsk = triangulation, overplot = overplot $
+       , c_thick=thick, performance = key_performance $
+       , coinmontemask=-1, coindescendmask=-1, masknan = masknan, _extra = ex
+;------------------------------------------------------------
+      if n_elements(contour) eq 4 then BEGIN ; c''est la 2eme fois que je passe ds pltt
+         contour = {mietma:[mi, ma], unit:varunit, inter:intervalle} ; je renvoie le min, le max et l''unite
+         return
+      endif
+;------------------------------------------------------------
+      if keyword_set(contour) then BEGIN 
+         pourlegende = [1, 1, 1, 1]
+         oldattributs = saveatt()
+         oldcouleur = couleur
+         pltt,contour,type, contmin,contmax,CONTOUR=pourlegende, /noerase, USETRI = usetri $
+          ,INTERVALLE=contintervalle,LABEL=contlabel,STYLE=style, ENDPOINTS = endpoints $
+          ,NLEVEL=contnlevel,YSURX=ysurx, BOITE = boite, STRICTFILL = strictfill, _extra = ex
+         couleur = oldcouleur
+         restoreatt, oldattributs
+      endif
+;----------------------------------------------------------------------
+;----------------------------------------------------------------------
+      if keyword_set(overplot) then GOTO, fini
+;------------------------------------------------------------
+; Trace de la ligne de changement de date
+;------------------------------------------------------------
+      if (type eq 'xt') then $ 
+       plot, [180,180],[tempsmin,tempsmax],/noerase,color=c_cote
+;------------------------------------------------------------
+; legendes + affichage de celles-ci
+;------------------------------------------------------------
+      legende,mi,ma,type, CONTOUR = pourlegende, DIREC = direc, INTERVALLE = intervalle $
+       , ENDPOINTS = endpoints, _extra = ex
+;
+      plot,[0],[0],/noerase,color=c_cote, xstyle = 1+4*(keyword_set(endpoints) AND type EQ 'xt' AND lat1 NE lat2) $
+       , ystyle = 1+4*(keyword_set(endpoints) AND type EQ 'yt'), _extra = ex
+; ajout d'un axe ds le cas ou l'on utilise endpoints
+      if keyword_set(endpoints) then addaxe, endpoints, type, posfenetre, _EXTRA = ex
+;------------------------------------------------------------
+; barre de couleur
+;------------------------------------------------------------
+      couleur = couleur[0:ncontour-1-keyword_set(strictfill)]
+      barrecouleur, position=posbar,divisions=(ncontour-keyword_set(strictfill))/2,min=min $
+       , max=max,discret=couleur,_extra = ex
+;------------------------------------------------------------
+   endif
+;------------------------------------------------------------
+; 1d
+;------------------------------------------------------------
+trace1d:
+   if (typdes eq '1d') then begin
+      if (not keyword_set(col1d)) then col1d = 0
+      if keyword_set(sty1d) then BEGIN ;si on veut faire des barres
+         IF strlowcase(strtrim(sty1d)) EQ 'bar' then begin
+            !y.range = [!y.range[0]-(!y.range[1]-!y.range[0])*.05,!y.range[1]] 
+            bar_plot, yy, background = (!d.n_colors-1) < 255,  $
+             baselines = replicate(!y.range[0], n_elements(yy)), barnames = ['', ''], $
+             colors    = replicate(col1d      , n_elements(yy)), /outline
+            plot, [0], [0],/noerase,color=c_cote, _extra = ex
+            GOTO, fini
+         ENDIF 
+      ENDIF
+      if NOT keyword_set(ov1d) then BEGIN 
+         !y.range=[min-abs(max-min)/50.,max+abs(max-min)/50.]
+         legende,mi,ma,type, DIREC = direc, _extra = ex
+;
+         if keyword_set(exchange_xy) then begin
+            rien = !x
+            !x = !y
+            !y = rien
+            rien = xx
+            xx = yy
+            yy = rien
+         endif
+         plot,xx,yy,color=col1d,linestyle=sty1d,thick=2, title = '', subtitle = '', _extra = ex
+         if n_elements(ex) NE 0 then BEGIN 
+; pour avoir un cadre de la couleur c_cote
+            if (where(tag_names(ex) EQ 'COLOR'))[0] NE -1 then ex.COLOR = c_cote
+         ENDIF
+         if keyword_set(exchange_xy) then $
+          plot, [0, 0],!y.range ,/noerase,color=c_cote, xstyle = 1, ystyle = 1, _extra = ex $
+         ELSE plot, !x.range, [0, 0],/noerase,color=c_cote, xstyle = 1, ystyle = 1, _extra = ex
+      ENDIF ELSE oplot,xx,yy,color=col1d,linestyle=sty1d,thick=2, _extra = ex
+   endif
+fini:
+;------------------------------------------------------------
+; on remet l''axe du temps en jours julien IDL et non pas en jours
+; juliens comptes a partir tempsmin 
+;------------------------------------------------------------
+   if type EQ 'xt' then BEGIN 
+      !y.range=!y.range+tempsmin 
+      !y.tickv=!y.tickv+tempsmin
+   ENDIF ELSE BEGIN 
+      !x.range=!x.range+tempsmin
+      !x.tickv=!x.tickv+tempsmin
+   ENDELSE
+; on fait un faut plot pour que ces valeurs soient prises en
+; consideration
+   plot,[0], [0], /noerase,xstyle=5, ystyle = 5, title = '', subtitle = '', ytitle = '', xtitle = ''
+;------------------------------------------------------------
+;------------------------------------------------------------
+; 3eme partie: impression eventuelle
+;------------------------------------------------------------
+;------------------------------------------------------------
+   terminedessin, _extra = ex
+   if keyword_set(oldboite) then domdef, oldboite,GRILLE=[vargrid, 'T']
+;------------------------------------------------------------
+   if n_elements(key_performance) NE 0 then $
+    IF key_performance EQ 1 THEN print, 'temps pltt', systime(1)-tempsun 
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+   return
+end
+
+
Index: tags/start/PLOTS/DESSINE/pltz.pro
===================================================================
--- tags/start/PLOTS/DESSINE/pltz.pro	(revision 5)
+++ tags/start/PLOTS/DESSINE/pltz.pro	(revision 5)
@@ -0,0 +1,505 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:
+;	PLTZ
+;
+; PURPOSE:
+;	trace des graphes verticaux
+;
+; CATEGORY:
+;       Graphics
+;
+; CALLING SEQUENCE:
+;	pltz, champ [,min[, max]]
+;
+; INPUTS:
+;	champ: le champ dont on veut faire la coupe verticale champ
+;	peut etre de 2 types:
+;         1) un tableau 2d ou 3d. 
+;         Si le champ est 2d undiquer avec le mot cle boite les
+;         delimitations geographiques de la boite. Si le chyamp est
+;         3d, on extrait la section et on moyenne eventuellement avant
+;         de faire le plot
+;         2) une structure repondant aux critaire specifies par
+;         litchamp.pro. cf. IDL> xhelp,'litchamp'. le tableau contenu
+;         ds la structure doit etre 2 ou 3d cf cas 1) si dessus
+;
+; ces arguments ne sont pas obligatoires:
+;  
+;	MAX: valeur maximum que l'on veut prendre en compte dans le trace
+; des contours. Par defaut on prend le max de tab1 (sur les pts mer)
+;
+;	MIN: valeur minimum que l'on veut prendre en compte dans le trace
+; des contours. Par defaut on prend le min de tab1 (sur les pts mer)
+;
+; KEYWORD PARAMETERS:
+;
+;	BOITE:vecteur indiquant la zone geographique sur laquelle doit etre
+; faite la coupe. Si BOITE a :
+; 1 element : l''extraction est faite sur [lon1, lon2, lat1, lat2, 0.,boite[0]]
+; 2 elements: l''extraction est faite sur [lon1, lon2, lat1, lat2, boite[0],boite[1]]
+; 4 elements: l''extraction est faite sur [Boite, 0, 200]
+; 5 elements: l''extraction est faite sur [Boite[0:3], 0, Boite[4]]
+; 6 elements: l''extraction est faite sur Boite
+;
+; Ou lon1, lon2,lat1,lat2 sont les variables globales
+; definies lors du dernier domdef!
+;
+;      CB_TITLE: le titre de la colorbar
+;
+;      CB_SUBTITLE: le soustitre de la colorbar
+;
+;      CB_CHARSIZE: The character size of the color bar annotations
+;
+;	CONTINTERVALLE: lorsque CONTOUR est active, valeur d'un
+; intervalle entre deux isolignes traces par un trait ds la couleur
+; c_lab. Il peut ainsi etre different de celui specifie par INTERVALLE
+; qui, cas ce cas, ne controle que les isolignes coloriees en
+; couleurs. Si aucun min n''est specifie, on choisit un contour min qui va
+; bien avec l''intervalle specifie!. Si ce mot cle n''est pas
+; specifie, on trace 20 isolignes du min au max. 
+;
+;	CONTLABEL: un entier n. lorsque CONTOUR est active, si n
+; different de 0, choisit le type de label correspondant aux cas n
+; pour les isolignes tracees par un trait. Pour specifier le type de
+; label du contour en couleur, utiliser LABEL
+;
+;	CONTMAX: lorsque CONTOUR est active, valeur maximum que l''on
+; veut prendre en compte dans le trace des isolignes traces par un
+; trait de couleur c_lab. Par defaut on prend le max (sur les pts mer)
+; du tableau passe ds le mot cle CONTOUR. 
+;
+;	CONTMIN: lorsque CONTOUR est active, valeur minimum que l''on
+; veut prendre en compte dans le trace des isolignes traces par un
+; trait de couleur c_lab. Par defaut on prend le max (sur les pts mer)
+; du tableau passe ds le mot cle CONTOUR. 
+;
+;	CONTNLEVEL: lorsque CONTOUR est active, nombre de contours
+; trace par un trait de couleur c_lab a dessiner (actif si
+; CONTLABEL=0) par defaut =20.
+;
+;	CONTOUR: si on veut tracer les contours d'un champ different que celui
+; que l''on dessin en couleur (par ex E-P en couleur et QSR en
+; contours). Doit etre un champ reponadnt aux meme caracteristiques
+; que l''argument numero 1 de pltz
+;
+;       ENDPOINTS: mot clef specifiant que l'on veut faire une coupe
+;       verticale en diagonale. les coordonnees des extremites de
+;       celle-ci sont alors definies les 4 elements du vecteur
+;       ENDPOINTS: [x1,y1,x2,y2] qui sont les coordonnees 
+;
+;	INTERVALLE: valeur d''un intervalle entre deux isolignes. Si
+; aucun min n''est specifie, on choisit un contour min qui va bien
+; avec l'intervalle specifie!. Si ce mot cle n''est pas specifie, on
+; trace 20 isolignes du min au max. Rq: Qd CONTOUR est active
+; INTERVALLE ne specifie que intervalle entre 2 isolignes coloriees en
+; couleur. Pour specifier l''intervalle entre 2 isolignes traces par un trait
+; de couleur c_lab utiliser CONTINTERVALLE.
+;
+;	/INV: inverse le vecteur couleur utilisee pour colorier le graphe
+;             (sans toucher au noir, au blanc et a la palette utilisee)
+;
+;	HZSURHT: lorsque le dessin presente une partie zoomee, rapport de
+; taille entre la partie zommee, hz (hauteur zoom), et le dessin entier, ht
+; (hauteur total). Par defaut =2./3
+;
+;	LABEL: un entier n. si n different de 0, choisit le type de
+; label correspondant aux cas n. cf label.pro
+; Rq: Qd CONTOUR est active, ne specifie le type de label que pour les
+; isolignes coloriees en couleur. Pour celles tracees par un trait de
+; couleur c_lab utiliser CONTLABEL.
+;
+;	/LANDSCAPE: oblige la feuille ou la fenetre a etre en position
+;	"allongee"
+;
+;       LCT: entier designant le numero de la palette de couleur que
+;       l''on veut utiliser pour le plot. 
+;	
+;       MAXIN: permet de specifier la valeur maximum que l''on veut
+;       prendre en compte dans le trace des contours a l''aide d''un
+;       mot cle plutot que par l''argument max. Si l''argument et le
+;       mot cle sont specifies en meme temps, c''est la valeur
+;       specifiee par le mot cle qui est retenue.
+;
+;       MININ: permet de specifier la valeur minimum que l''on veut
+;       prendre en compte dans le trace des contours a l''aide d''un
+;       mot cle plutot que par l''argument min. Si l''argument et le
+;       mot cle sont specifies en meme temps, c''est la valeur
+;       specifiee par le mot cle qui est retenue.
+;	
+;	NLEVEL: nombre de contours a dessiner. par defaut =20. actif si
+; LABEL=0 ou n'est pas specifie.
+;
+;	/NOCOLORBAR: activer si on ne veut pas de colorbar
+;
+;	/NOCONTOUR: activer si on ne veut pas de contour mais juste
+;	les couleurs
+;
+;	/NOCOULEUR: activer si on veut juste les contours en noir et
+;	blanc sur fond blanc
+;
+;       /NOERASE: activer pour faire un dessin a l''ecran sans creer
+;       une nouvelle fenetre
+;
+;       /NOTRI: pour forcer a ne pas utiliser de triangulation.
+;
+;       OVERPLOT: pour faire un plt par dessus un autre. Rq:
+;       contrairemnet a l''utilisation de CONTOUR,
+;       l''utilisation de ce mot clef ne modifie pas la legende ou/et
+;       la barre de couleur.
+;
+;	PETITDESSIN: vecteur de 3 ou 4 elements, applique pour faire un
+; dessin sur une petite portion de feuille ou d''ecran. il delimite
+; la zone ds laquelle va etre fait le dessin
+; si il a 4 elements:
+;       il est alors constitute des coordonnees -exprime en cm reperes par
+;       rapport au coin en bas a gauche de la feuille ou de la fenetre
+;       (en portrait comme en landscape)- du coin en bas a
+;       gauche et du coin en haut a droite  de la zone de dessin.
+; si il a 3 elements:
+;       Ds ce cas, on divise la fenetre ou l''ecran en PETITDESSIN[0]
+;       colonnes, en PETITDESSIN[1] lignes le dessin se faisant ds la
+;       case numero PETITDESSIN[2].La numerotation commencant en haut
+;       a gauche par le numero 1 et suivant apres dans le sens de
+;       l''ecriture.
+; Par defaut on fait un dessin occupant la plus grande place possible
+; tout en concervant le rapport d''aspect (sauf qd REMPLI est active)
+;
+;	/PORTRAIT: oblige la feuille ou la fenetre a etre en position
+;	"debout"
+;
+;	/POST: faire une sortie postscript. Ne marche que si on fait
+;	un seul dessin sur la feuille. Si on fait plusieurs dessins,
+;	utiliser @ps ou plein2dessins
+;
+;	/REMPLI:oblige le dessin a occuper l'espace maximum definit
+;	par petitdessin
+;
+;       /REVERSE_X: pour inverser l''axe des x (et aussi le dessin)
+;
+;       /REVERSE_Y: pour inverser l''axe des y (et aussi le dessin)
+;
+;       /SIN: activer ce mot cle si l''on veut que l'' axe des x soit
+;       trace en sinus de la latitude qd on fait une coupe 'yz'
+;
+;       /STRICTFILL: activer ce mot clef pour que le remplissage des
+;       contours ce fasse precisement entre le min et le max specifie
+;       en laissant en banc les valeurs inferieurs au min specifie et
+;       superieurs au max specifie.
+;
+;	STYLE: style de tracer a adopter pour dessiner les isolignes par
+; defaut style=0. cf style.pro
+;
+;	/TRANS: fait un postscript (active /post automatiquement) et l'imprime
+; -si on le desire- sur un transparant
+;
+;        UNLABSUR: entier n. specifant qu''on ne labelle qu''un
+;        contour sur n. Par defaut unlabsur=2
+;
+;	/UNSUR2: si on veut tracer un countour sur deux. par  defaut trace
+; tous les contours
+;
+;	WINDOW: nimero de la fenetre ou l'on veut faire le graphe (permet
+; d'ouvrir plusieurs fenetres). par defaut on ouvre 'IDL0'
+;
+;       /XZ: force a faire une coupe xz
+;
+;       /YZ: force a faire une coupe yz
+;
+;	YSURX: rapport d'echelle entre y et x (par ex: =1 pour un repere
+; presque orthonorme, =2 si l'axe des y est environ deux fois plus dilate
+; que celui des x). Par defaut on adapte pour occupe une grande partie de
+; la feuille en sortie postScript ou pour cree une fenetre pas trop etiree
+;
+;	ZOOM: profondeur jusqu'a laquelle on fait un zoom. par defaut 200m ou
+; la profondeur maximale si elle est inf a 200
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro	
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			7/1999
+;                       Sebastien Masson 08/02/2000 checkfield and
+;                       notri keyword.
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro pltz,tab,giventype, givenmin,givenmax,BOITE=boite,CONTOUR=contour $
+         ,ENDPOINTS=endpoints,INTERVALLE=intervalle,INV=inv,HZSURHT=hzsurht $
+         ,CONTINTERVALLE=contintervalle,LABEL=label,CONTLABEL=contlabel $
+         ,STYLE=style,CONTMAX=contmax, SIN = sin, TYPEIN = typein $
+         ,CONTMIN=contmin,NLEVEL=nlevel,CONTNLEVEL=contnlevel, NOTRI = notri $
+         ,ZOOM=zoom, XZ = xz, YZ = yz, MININ = minin, MAXIN = maxin $
+         , STRICTFILL = strictfill, OVERPLOT = overplot, _EXTRA = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;------------------------------------------------------------
+;--------------------------------------------------------------
+; 1ere partie: initialisation et petits calculs...
+;--------------------------------------------------------------
+;on ne reinitialise pas qd on rapelle pltz en boucle pour utiliser contour
+   if n_elements(contour) ne 4 AND NOT keyword_set(overplot) then reinitplt
+;
+   if keyword_set(boite) then oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+;--------------------------------------------------------------
+; lecture du champ
+;--------------------------------------------------------------
+   if n_elements(giventype) NE 0 then type = giventype
+   if n_elements(givenmin) NE 0 then min = givenmin
+   if n_elements(givenmax) NE 0 then max = givenmax
+   if n_elements(minin) NE 0 then min = minin
+   if n_elements(maxin) NE 0 then max = maxin
+   if keyword_set(typein) then BEGIN 
+      if size(type, /type) NE 7 AND size(type, /type) NE 0 then begin
+         if n_elements(min) NE 0 then max = min
+         min = type
+      endif
+      type = typein
+   endif
+   if keyword_set(boite) then vraiboite = boite
+   checktypeminmax, 'pltz', TYPE = type, MIN = min, MAX = max, XZ = xz, YZ = yz, ENDPOINTS=endpoints, BOITE = boite, _extra = ex
+   coupe = type
+   if keyword_set(endpoints) then begin
+      section, tab, z2d, glam, gphi, ENDPOINTS = endpoints, TYPE = type, BOITE = boite, DIREC = direc
+      nx = n_elements(glam) 
+      ny = nx
+      if strupcase(vargrid) EQ 'W' then begin
+         z = gdepw[premierzw:dernierzw]
+         nz = nzw
+      ENDIF ELSE BEGIN
+         z = gdept[premierzt:dernierzt]
+         nz = nzt
+      ENDELSE
+   ENDIF ELSE BEGIN
+      z2d = checkfield(tab, 'pltz', TYPE = type, BOITE = boite, DIREC = direc, _extra = ex)
+      if z2d[0] EQ -1 then BEGIN 
+         if keyword_set(boite) AND n_elements(oldboite) NE 0 then domdef, oldboite, GRILLE=vargrid
+         return
+      ENDIF
+      grille,mask,glam,gphi,z,nx,ny,nz
+   ENDELSE
+;---------------------------------------------------------------
+   profmax = !y.range[0]
+   profmin = !y.range[1]
+   if not keyword_set(zoom) then zoom=200
+   zoom = zoom[0]
+   if zoom GE prof2 then zoom=profmax
+;--------------------------------------------------------------------
+; construction du mask
+;--------------------------------------------------------------------
+   mask = fltarr((size(z2d))[1],(size(z2d))[2] )
+   nan = total(finite(z2d,/nan))  < 1
+   if keyword_set(nan) then begin
+      notanum = where(finite(z2d) EQ 0)
+      z2d[notanum] = 0
+      mask(where(z2d LT valmask/10)) = 1
+      z2d[notanum] = !values.f_nan
+   ENDIF ELSE mask(where(z2d LT valmask/10)) = 1
+   if (where(mask EQ 0))[0] EQ -1 AND NOT keyword_set(nan) then notri = 1
+;-----------------------------------------------------------------------------
+;   determination du mi:min et du ma:max de tab1 ainsi que de max: max et
+;   min: min pour le dessin.
+;-----------------------------------------------------------------------------
+; faudra-t-il faire un autoscale ???
+   autoscale = testvar(var = min) EQ testvar(var = max) AND NOT keyword_set(intervalle)
+   determineminmax, z2d,mask, mi, ma, MININ = min, MAXIN = max, nan = nan,INTERVALLE=intervalle
+   if z2d[0] EQ -1 THEN GOTO, sortie
+; on fait un autoscale si besoin
+   if autoscale then autoscale, min, max, intervalle
+;--------------------------------------------------------------
+   z2d=reverse(z2d,2)
+   mask=reverse(mask,2)
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+; 2eme partie: dessin
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+   if n_elements(contour) NE 4 AND NOT keyword_set(overplot) THEN $
+    placedessin, 'pltz',posfenetre, posbar, contour = contour, endpoints = endpoints $
+    , direc = direc, _extra = ex
+;------------------------------------------------------------
+;--------------------------------------------------------------
+; choix des labels
+;-----------------------------------------------------------
+   if keyword_set(intervalle) AND NOT keyword_set(label) then label=1
+   if keyword_set(label) eq 0 then cas=0 else cas=label
+   label,cas,min,max,ncontour,level_z2d,NLEVEL=nlevel,INTERVALLE=intervalle $
+    , strictfill = strictfill
+;--------------------------------------------------------------
+; choix de style
+;-----------------------------------------------------------
+   if not keyword_set(style) then style=0
+   style,style,level_z2d,linestyle,thick
+   if keyword_set(inv) then couleur=reverse(couleur)
+;-----------------------------------------------------------
+;   definition des axes
+;----------------------------------------------------------
+   if NOT keyword_set(overplot) THEN axe, coupe, SIN = sin, _EXTRA = ex
+   if keyword_set(reverse_y) then !y.range=[0, -1] ELSE !y.range = [-1, 0]
+;----------------------------------------------------------
+; on projette l''axe z dans [0,1]
+;----------------------------------------------------------
+   if not keyword_set(hzsurht) then hzsurht=2./3
+   if zoom ge profmax then hzsurht=1.
+   if zoom LT profmax then begin
+      mp = projsegment([profmin, zoom], [0, hzsurht], /mp)
+      z[where(z LE zoom)] = mp[0]*z[where(z LE zoom)]+mp[1]
+      mp = projsegment([zoom, profmax], [hzsurht, 1], /mp)
+      z[where(z GE zoom)] = mp[0]*z[where(z GE zoom)]+mp[1]
+   ENDIF ELSE BEGIN
+      mp = projsegment([profmin, profmax], [0, 1], /mp)
+      z = mp[0]*z+mp[1]
+   ENDELSE
+   z=reverse(-z,1)
+;----------------------------------------------------------
+; on passe les axes en tableaux 2d pour pouvoir utiliser la
+; trianguletion
+;----------------------------------------------------------
+   if coupe eq 'yz' then BEGIN 
+      if (size(gphi))[0] EQ 2 then x=reform(gphi[0, *]) ELSE x=gphi 
+      if keyword_set(sin) then x = sin(!pi/180.*x)
+      x = x#replicate(1, nz)
+      z = replicate(1, ny)#z
+   ENDIF ELSE BEGIN 
+      x = glam[*, 0]#replicate(1, nz)
+      z = replicate(1, nx)#z
+   ENDELSE 
+;--------------------------------------------------------------
+; extrapolation des donnees sur les terres et seuillage
+;--------------------------------------------------------------
+   if keyword_set(nan) then begin
+      notanumber = where(finite(z2d, /nan) EQ 1)
+      z2d[notanumber] = max
+      if coupe eq 'yz' then masknan = replicate(1, ny, nz) ELSE masknan = replicate(1, nx, nz) 
+      masknan[notanumber] = 0
+   ENDIF ELSE masknan = 1
+   z2d = remplit(z2d,nite=1+keyword_set(nan), mask = mask*masknan, /basique, _extra=ex)
+   if NOT keyword_set(strictfill) then z2d = min > z2d <  max
+   if keyword_set(notri) then triangulation = -1 ELSE $
+    triangulation = triangule(mask*masknan,/regulier,coinmonte=coinmontemask,coindescend=coindescendmask)
+;------------------------------------------------------------
+; dessin en lui meme
+;------------------------------------------------------------
+   pltbase, z2d,x, z, mask,x, z, level_z2d,couleur, overplot = overplot $
+    , contour = contour, trichamp = triangulation, trimsk = triangulation  $
+    , c_linestyle=linestyle,c_labels=1-(indgen(n_elements(level_z2d)) MOD 2) $
+    , c_thick=thick,unsur2 = unsur2 $
+    , coinmontemask=-1,coindescendmask=-1, masknan = masknan $
+    , _extra = ex
+;------------------------------------------------------------
+; rappelle de plt en boucle qd contour est active
+;------------------------------------------------------------
+   if n_elements(contour) eq 4 then BEGIN ; c''est la 2eme fois que je passe ds pltt
+      contour = {mietma:[mi, ma], unit:varunit, inter:intervalle} ; je renvoie le min, le max et l''unite
+      if keyword_set(vraiboite) then boite = vraiboite
+      return
+   endif
+   if keyword_set(contour) THEN BEGIN 
+      pourlegende = [1, 1, 1, 1]
+      oldattributs = saveatt()
+      oldcouleur = couleur
+      pltz,contour,contmin,contmax,CONTOUR=pourlegende,HZSURHT=hzsurht $
+       ,INTERVALLE=contintervalle,LABEL=contlabel,STYLE=style, /noerase, NOTRI = notri  $
+       ,NLEVEL=contnlevel,ZOOM=zoom,BOITE=vraiboite,ENDPOINTS=endpoints, STRICTFILL = strictfill $
+       , _extra = ex
+      restoreatt, oldattributs
+      couleur = oldcouleur
+   ENDIF
+;------------------------------------------------------------
+;------------------------------------------------------------
+; 3eme partie: dessin du cadre, legendes, colorbar...
+;------------------------------------------------------------
+   if keyword_set(overplot) then BEGIN 
+      !y.range =  [zoom, profmin] ; on repasse en coordonees physiques!
+      plot,[0], [0],/nodata, /noerase, title = '', subtitle = '', xstyle = 5, ystyle = 5
+      GOTO, fini
+   endif
+;------------------------------------------------------------
+; legendes + affichage de celles-ci
+;------------------------------------------------------------
+   legende,mi,ma,coupe, CONTOUR = pourlegende, INTERVALLE = intervalle, DIREC = direc, endpoints = endpoints, _EXTRA = ex
+   if coupe eq 'yz' then xaxe='lataxe' else xaxe='lonaxe'
+   if keyword_set(sin) then xaxe = ''
+; cadre applique par defaut
+   plot,[x[0], x[n_elements(x)-1]],[-hzsurht,-hzsurht],/noerase,color=c_cote $
+    ,xstyle=1+4*(keyword_set(endpoints) AND ((type EQ 'xz' AND lat1 NE lat2) OR (type EQ 'yz' AND lon1 NE lon2))) $
+    ,xtickformat=xaxe, _extra = ex
+; ajout d'un axe ds le cas ou l'on utilise endpoints
+   if keyword_set(endpoints) then addaxe, endpoints, type, posfenetre, _EXTRA = ex
+;------------------------------------------------------------
+; axe y en 1 ou 2 parties
+;------------------------------------------------------------
+   if n_elements(ex) NE 0 then BEGIN 
+; pour ne plus mettre de titre
+      if (where(tag_names(ex) EQ 'TITLE'))[0] NE -1 then ex.TITLE = ' '
+; pour ne plus mettre de sous titre
+      if (where(tag_names(ex) EQ 'SUBTITLE'))[0] NE -1 then ex.SUBTITLE = ' '
+; pour n''avoir q''un ytitle
+      if (where(tag_names(ex) EQ 'YTITLE'))[0] NE -1 then BEGIN 
+         ytitle = ex.YTITLE
+         ex.YTITLE = ' '
+      endif
+   ENDIF
+   htotal=posfenetre[3]-posfenetre[1]
+   hzoom=1.*hzsurht*htotal
+   if zoom LT profmax then $
+    plot,[0], [0],/noerase,color=c_cote,ystyle=1, yrange = [profmax, zoom+0.001] $
+    , position=posfenetre+[0,0,0,-hzoom], _extra = ex, title = '', subtitle = '', ytitle = ''
+;
+   !y.range =  [zoom, profmin]  ; on repasse en coordonees physiques!
+   plot,[0], [0],/noerase,color=c_cote,ystyle=1, _extra = ex $
+    , title = '', subtitle = '', ytitle = '', position=posfenetre+[0,htotal-hzoom,0,0]
+;------------------------------------------------------------
+; pour ecrire le ytitle...
+;------------------------------------------------------------
+   if !d.name EQ 'PS' then $
+    xs = (grandfeuille*(1-key_portrait)+petitfeuille*key_portrait)*!d.x_px_cm $
+   ELSE xs = !d.x_size
+   if n_elements(ytitle) NE 0 then !y.title = ytitle
+   charsize = chkstru(ex, 'ycharsize', /extract)
+   if charsize EQ -1 then charsize = !p.charsize
+   IF chkstru(ex, 'charsize') THEN ex.charsize = charsize
+   if chkstru(ex, 'ytitle', /extract) NE '' then $
+   decalage = string(format='(e10.3)',profmax)
+   decalage = float(strmid(decalage,strpos(decalage,'e')+1))
+   posy=posfenetre[1]+1.*htotal/2
+   posx=posfenetre[0]-(decalage+3)*!d.x_ch_size*charsize/xs
+    xyouts,posx,posy,!y.title, /normal,orientation=90,color=0,ALIGNMENT = .5, charsize = charsize, _extra = ex
+
+;------------------------------------------------------------
+; barre de couleur
+;------------------------------------------------------------
+   couleur = couleur[0:ncontour-1-keyword_set(strictfill)]
+   barrecouleur, position=posbar,divisions=(ncontour-keyword_set(strictfill))/2,min=min $
+    , max=max,discret=couleur,_extra = ex
+;------------------------------------------------------------
+;------------------------------------------------------------
+; 4eme partie: impression eventuelle
+;------------------------------------------------------------
+;------------------------------------------------------------
+fini:
+   if keyword_set(oldboite) then domdef, oldboite,GRILLE=[vargrid, 'T']
+   terminedessin, _extra = ex
+   if keyword_set(vraiboite) then boite = vraiboite
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+sortie:
+   if keyword_set(key_performance) NE 0 THEN print, 'temps pltz', systime(1)-tempsun 
+   return
+end
+
+
+
Index: tags/start/PLOTS/DESSINE/sbar_plot.pro
===================================================================
--- tags/start/PLOTS/DESSINE/sbar_plot.pro	(revision 5)
+++ tags/start/PLOTS/DESSINE/sbar_plot.pro	(revision 5)
@@ -0,0 +1,69 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:sbar_plot (super bar_plot)
+;
+; PURPOSE: meme chose que bar_plot mais compatible avec l''ensemble de
+; l'environnement (common.pro est inclu)
+;
+; CATEGORY:dessine
+;
+; CALLING SEQUENCE: sbar_plot,y
+; 
+; INPUTS: cd IDL>?bar_plot
+;
+; KEYWORD PARAMETERS:
+;
+;  meme que ceux de bar_plot avec en plus:
+;      COLOR: un entier donnant la couleur de toutes les barres de
+;      couleurs. (contrairement a colors qui est en vecteur donnant le
+;      couleur de chaque barre de couleur.
+;
+;      NOREINITPLT: a actier si on ne veut pas que les variables
+;      d''environnemet !p, !x, !y, !z soient reinitialisees par la
+;      procedure reinitplt
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+;   Si NOREINITPLT n''est pas ective toutes les variables
+;      d''environnemet !p, !x, !y, !z sont reinitialisees par la
+;      procedure reinitplt
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+;      IDL> sbar_plot, indgen(10),petit=[2,2,2],/rempli
+;      IDL> sbar_plot, indgen(10),petit=[2,2,3],/noerase
+;      IDL> @ps
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      10/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+
+PRO sbar_plot, Values, COLOR = color, NOREINITPLT = noreinitplt, _extra = ex 
+@common
+; 1) je reinitialise l''environnememt graphique (les variables !x, !y et !p): 
+   if NOT keyword_set(NOREINITPLT) then reinitplt, _extra = ex 
+; 2) je place le dessin a l'ecran comme sur le postcript 
+   IF chkstru(ex, 'overplot')EQ 0 THEN placedessin, 'autre', _extra = ex
+; 3) je fais mon joli dessin 
+   if n_elements(COLOR) then BEGIN
+      if n_elements(COLOR) EQ n_elements(Values) then colors = color $
+       ELSE colors = replicate(color[0], n_elements(Values))
+   ENDIF ELSE colors = congrid(indgen(!d.n_colors < 256), n_elements(Values))
+;
+   bar_plot, Values, background = !p.background, colors = colors, _extra = ex
+; 4) je termine le dessin 
+   terminedessin, _extra=ex 
+
+   return
+end
Index: tags/start/PLOTS/DESSINE/scontour.pro
===================================================================
--- tags/start/PLOTS/DESSINE/scontour.pro	(revision 5)
+++ tags/start/PLOTS/DESSINE/scontour.pro	(revision 5)
@@ -0,0 +1,60 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:scontour (super contour)
+;
+; PURPOSE: meme chose que contour mais compatible avec l''ensemble de
+; l'environnement (common.pro est inclu)
+;
+; CATEGORY:dessine
+;
+; CALLING SEQUENCE: scontour, z [, x, y]
+; 
+; INPUTS:cd IDL>?contour
+;
+; KEYWORD PARAMETERS:
+;
+;  meme que ceux de bar_plot avec en plus:
+;      NOREINITPLT: a actier si on ne veut pas que les variables
+;      d''environnemet !p, !x, !y, !z soient reinitialisees par la
+;      procedure reinitplt
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;      IDL> z = dist(100) 
+;      IDL> scontour, z, nlevels=10,petit=[1,2,1],xstyle=1,ystyle=1
+;      IDL> @ps
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      10/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO scontour, x, y, z, NOREINITPLT = noreinitplt, _EXTRA = ex
+@common
+; 1) je reinitialise l''environnememt graphique (les variables !x, !y et !p): 
+   if NOT keyword_set(NOREINITPLT) then reinitplt, _extra = ex 
+; 2) je place le dessin a l'ecran comme sur le postcript 
+   IF chkstru(ex, 'overplot')EQ 0 THEN placedessin, 'autre', _extra = ex
+; 3) je fais mon joli dessin 
+   case n_params() OF
+      1:contour, x, _EXTRA = ex
+      2:contour, x, y, _EXTRA = ex
+      3:contour, x, y, z, _EXTRA = ex
+
+   endcase
+   
+; 4) je termine le dessin 
+   terminedessin, _extra=ex 
+
+   return
+end
Index: tags/start/PLOTS/DESSINE/splot.pro
===================================================================
--- tags/start/PLOTS/DESSINE/splot.pro	(revision 5)
+++ tags/start/PLOTS/DESSINE/splot.pro	(revision 5)
@@ -0,0 +1,59 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:splot (super plot)
+;
+; PURPOSE: meme chose que plot mais compatible avec l''ensemble de
+; l'environnement (common.pro est inclu)
+;
+; CATEGORY:dessine
+;
+; CALLING SEQUENCE: PLOT, [X,] Y
+; 
+; INPUTS:cd IDL> ?plot
+;
+; KEYWORD PARAMETERS:
+;  meme que ceux de plot avec en plus:
+;
+;      NOREINITPLT: a actier si on ne veut pas que les variables
+;      d''environnemet !p, !x, !y, !z soient reinitialisees par la
+;      procedure reinitplt
+;
+; OUTPUTS:
+;
+;   Si NOREINITPLT n''est pas ective toutes les variables
+;      d''environnemet !p, !x, !y, !z sont reinitialisees par la
+;      procedure reinitplt
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+;      IDL> splot, indgen(10),ystyle=1,petit=[1,2,1],/portrait
+;      IDL> splot, -indgen(10),ystyle=1,petit=[1,2,2],/noerase
+;      IDL> @ps
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      18/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO splot,  x, y, NOREINITPLT = noreinitplt, _EXTRA = ex
+@common
+; 1) je reinitialise l''environnememt graphique (les variables !x, !y et !p): 
+   if NOT keyword_set(NOREINITPLT) then reinitplt, _extra = ex 
+; 2) je place le dessin a l'ecran comme sur le postcript 
+   placedessin, 'autre', _extra = ex
+; 3) je fais mon joli dessin 
+   if n_elements(y) EQ 0 then plot,  x, _EXTRA = ex ELSE plot,  x, y, _EXTRA = ex
+; 4) je termine le dessin 
+   terminedessin, _extra=ex 
+;
+   return
+end
Index: tags/start/PLOTS/DESSINE/tvplus.pro
===================================================================
--- tags/start/PLOTS/DESSINE/tvplus.pro	(revision 5)
+++ tags/start/PLOTS/DESSINE/tvplus.pro	(revision 5)
@@ -0,0 +1,279 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: tvplus
+;
+; PURPOSE: tvscl ameliore, permet de visualiser un tableau sans interpolation
+;
+; CATEGORY: pour regarder un tableau au point par point, chaque point
+; etant represente par un carre de coefzoom pixels de cote. la couleur
+; du carre, representant sa valeur, est une interpolation lineaire
+; entre le min du tableau de couleur 0 et le max du tableau de couleur
+; !d.n_colors-1 <255
+;
+; CALLING SEQUENCE:tvplus,z2d [,coefzoom]
+;
+; INPUTS: z2d le tableau 2d a visualiser
+;
+;         coefzoom : (optionnel) c''est la taille des cotes des carres
+;         representant un point, mesure en pixel. si cet argument
+;         n''est pas specifie, la taille des carres est calculee pour
+;         que la fenetre soit au plus pres de 95% de la taille de l''ecran
+;
+; KEYWORD PARAMETERS:
+;
+;       BOTTOM: The lowest color index of the colors to be loaded in
+;       the bar. default is 0.
+;
+;       C_NAN: c'est le numero de la couleur des points a
+;       !values.f_nan. par defaut c''est !d.n_colors< 256 -1
+;
+;       C_MASK: c'est le numero de la couleur des points a
+;       la valeur specifiee par MASK. par defaut c''est 0
+;
+;       OFFSET: c''est un vecteur de 2 elements donnant la valeur dont
+;       il faut decaler la numerotation des points en x et en y.
+;       Par ex:
+;          tvplus,sst[x1:x2,y1:y2],offest=[x1,y1]
+;
+;       MASK: la valeur qui sert de mask a l''ecran. si abs(mask) lt
+;       1e6 les points egaux a mask seronts en noir, dans le cas
+;       contraire ce seront les points ge que abs(mask)/10. Ceci est
+;       nessaire pour eviter les erreurs d''arrondi. 
+;
+;       MIN et MAX permet de borner z2d a un min ou a un max, les
+;       points inferieurs a min etant de la couleur 0 (noir) et ceux
+;       superieurs a max etant de la couleur (!d.n_colors-1) < 255 (blanc)
+;
+;       NCOLORS:  This is the number of colors in the color
+;       bar. default is !d.n_colors<255 -1
+;
+;       NOINTERP: activer si on ne veut pas que les valeurs du tableau
+;       soient interpoles entre 0 et !d.n_colors-1 < 255 pour obtenir
+;       les correspondances avec les couleurs. Utile qd on travaille
+;       avec des tableaux de type byte
+;
+;	WINDOW: numero de la fenetre ou l''on veut faire la visualisation (permet
+;       d''ouvrir plusieurs fenetres). par defaut on ouvre 'IDL0'
+;
+; OUTPUTS: affichage de parametres selectionnes a la souris, cf. apres
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;       1) qd la fenetre qui doit etre ouverte a une dimension -imposee
+;       par la presence de coefzoom- superieure a 75% de la taille de
+;       l''ecran, c''est une fenetre avec un scrolling bar qui est
+;       ouverte.
+;
+;       2) qd le dessin est realise ds une fenetre normale, le
+;       programme s''arrete apres le trace pour faire des l'analyses au
+;       point par point a l''aide de la souris:
+;          Bouton de gauche: position du curseur et valeur du tableau en ce point
+;          Bouton du milieu: zoom
+;          Bouton de droite: quitter
+;
+; RESTRICTIONS: l''analyse a la souris ne marche pas ds les fenetres
+; avec une scrolling bar...
+;
+; EXAMPLE:  IDL> tvplus,nlec('sst'),max=30
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       18/12/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO tvplus, z2d, coefzoom, BOTTOM = bottom, C_MASK = c_mask, C_NAN = c_nan, WINDOW = window $
+            , MIN = min, MAX = max, MASK = mask, OFFSET = offset, PASBLABLA = PASBLABLA $
+            , NCOLORS = ncolors, NOINTERP = nointerp, _EXTRA = ex
+;
+   tab = float(z2d)
+;------------------------------------------------------------
+; on verifie la taille de tab
+;------------------------------------------------------------
+   if (size(tab))[0] NE 2 then begin
+      ras = report('le tableau doit etre 2D')
+      return
+   endif
+;------------------------------------------------------------
+; on definit au besoin ncoulmax, bottom, topcoul et ncolors
+;------------------------------------------------------------
+   ncoulmax = !d.n_colors < 256
+   IF N_ELEMENTS(bottom) EQ 0 THEN bottom = 0
+   if NOT keyword_set(ncolors) then ncolors = ncoulmax-bottom
+   topcoul = (bottom+ncolors-1) < (ncoulmax-1)
+;------------------------------------------------------------
+; on fait le menage
+;------------------------------------------------------------
+   xenvsauve = !x & yenvsauve = !y & penvsauve = !p
+   reinitplt, /z, /invert
+;------------------------------------------------------------
+; le tableau contient des valeurs a !values.f_nan ???
+;------------------------------------------------------------
+   nan = total(finite(z2d,/nan)) < 1
+   if keyword_set(nan) then begin
+      nanindex = where(finite(z2d,/nan) EQ 1)
+      tab[nanindex] = min(tab, /nan)
+   endif
+;------------------------------------------------------------
+; on calcule coefzoom ou bien on verifit qu''il n''est pas trop grand
+;------------------------------------------------------------
+   dimensions = GET_SCREEN_SIZE()
+   if n_elements(coefzoom) EQ 0 then BEGIN 
+      coefzoom = min(floor(dimensions/(size(z2d))[1: 2]*.85))
+   ENDIF ELSE $ 
+; il faudra ouvrir une fenetre avec une scrolling barre
+   if coefzoom GE min(floor(dimensions/(size(z2d))[1: 2]*.85)) then scrolling = 1
+   if coefzoom LT 1 then begin
+      coefzoom = 1
+      scrolling = 1
+   endif
+;------------------------------------------------------------
+; on met les valeurs masques au max (sur les points non masques) du tableau
+;------------------------------------------------------------
+   if n_elements(mask) then BEGIN 
+      if abs(mask) LT 1e6 then BEGIN 
+         terre = where(tab EQ mask)
+         if terre[0] NE -1 then tab(terre) = min(tab(where(tab NE mask)))
+      ENDIF ELSE BEGIN 
+         terre = where(abs(tab) GE abs(mask)/10.)
+         if terre[0] NE -1 then tab(terre) = min(tab(where(abs(tab) LT abs(mask)/10.)))
+      ENDELSE
+   ENDIF ELSE terre = -1
+;------------------------------------------------------------
+; on borne le tableau a min et max s''il sont declares
+;------------------------------------------------------------
+   if keyword_set(min) then BEGIN 
+      tab = min > tab
+      vraimin = min
+   ENDIF ELSE vraimin = min(tab)
+   if keyword_set(max) then BEGIN 
+      tab = tab < max
+      vraimax = max
+   ENDIF ELSE vraimax = max(tab)
+;------------------------------------------------------------
+; on bidoulle tab 
+;------------------------------------------------------------
+   if NOT keyword_set(nointerp) then BEGIN
+; on interpole tab entre bottom et bottom+ncolors-1
+      m=1.*(ncolors-1)/(vraimax-vraimin)
+      p=bottom-1.*vraimin*m
+      tab=round(1.*m*tab+p) 
+   endif
+; on met les point nan a la couleur numero c_nan
+   if keyword_set(nan) then begin
+      if keyword_set(c_nan) THEN tab[nanindex] = c_nan <  (ncoulmax -1) $
+      ELSE tab[nanindex] = topcoul
+   endif
+; on met les point terre a la couleur numero c_mask
+   if keyword_set(c_mask) AND terre[0] NE -1 THEN $
+    tab[terre] = c_mask < (ncoulmax -1)
+; on passe le tableau en byte
+   tab = byte(tab)
+; on augmente la taille de tab pour pouvoir faire le tv
+   tab = congridseb(tab, (size(tab))[1]*coefzoom,(size(tab))[2]*coefzoom)
+;------------------------------------------------------------
+; on ouvre une fenetre a la bonne taille et on dessine
+;------------------------------------------------------------
+   nx = (size(tab))[1]
+   ny = (size(tab))[2]
+; marges en pixel
+   rapportaspect = 1.*nx/ny
+   if rapportaspect GE 1 THEN margepix = 1.*[25, 25, 75, 25] ELSE margepix = 1.*[25, 100, 25, 25]
+;
+   if n_elements(scrolling) EQ 0 then BEGIN ; on ouvre une fenetre classique
+      if NOT keyword_set(window) then window = 0
+      window,window, xsize = nx+margepix[0]+margepix[1] $
+       , ysize = ny+margepix[2]+margepix[3] ; ouverture de la fenetre
+; qd on utilise des couleurs codees sur 24 bit, je n''arrive pas a stipuler la couleur du
+; fond d''une fenetre a l'aide de !p.background, je suis oblige de faire cette bidouille!!!
+      if !d.n_colors gt 256 then BEGIN ; alors  les couleurs sont codees sur 24 bit
+         device, decomposed=1
+         !p.background='ffffff'x
+         plot,[0],[0], xstyle = 5, ystyle = 5
+         device, decomposed=0
+      endif
+      tv, tab,margepix[0], margepix[2], _EXTRA = ex ; dessin de tab interpole entre 0 et !d.n_colors-1 < 255
+;
+; mise en place des axes et du cadre
+;
+; on recupere en coordonnees normalises la position du tv et donc
+; cette du cadre
+      poscadre = fltarr(4)
+      poscadre[0] = margepix[0]/!d.x_size
+      poscadre[2] = 1.-margepix[1]/!d.x_size
+      poscadre[1] = margepix[2]/!d.y_size
+      poscadre[3] = 1-margepix[3]/!d.y_size
+;    on trace le cadre a l''aide d''un plot
+      if NOT keyword_set(offset) then offset = [0, 0]
+      plot, [0], [0],/noerase, position = poscadre, color = 0 $
+       , xstyle = 1, ystyle = 1, xticklen = 1, yticklen = 1 $
+       , xrange = 1.*[0, nx]/coefzoom-.5+offset[0], yrange = 1.*[0, ny]/coefzoom-.5+offset[1]
+;
+; mise en place de la colorbar
+;
+      if rapportaspect ge 1 then $
+       posbar = [25./!d.x_size, 25./!d.y_size, 1-25./!d.x_size, 50./!d.y_size] $
+      ELSE posbar = [1-75./!d.x_size, 25./!d.y_size, 1-50./!d.x_size, 1-25./!d.y_size]
+   if keyword_set(nointerp) then BEGIN & vraimin = 0 & vraimax = ncoulmax & endif
+      colorbar, min = vraimin, max = vraimax, division = 10, cb_color = 0, position = posbar $
+       , vertical = rapportaspect lt 1, /right, BOTTOM = bottom, NCOLORS = ncolors, _EXTRA = ex
+   ENDIF ELSE BEGIN 
+;------------------------------------------------------------
+; dessin ds une fenetre avec une scrolling barre
+;------------------------------------------------------------
+; qd on utilise des couleurs codees sur 24 bit, je n''arrive pas a stipuler la couleur du
+; fond d''une fenetre a l'aide de !p.background, je suis oblige de faire cette bidouille!!!
+      if !d.n_colors gt 256 then begin
+         window, /pixmap
+         device, decomposed=1
+         !p.background='ffffff'x
+         plot,[0],[0]
+         device, decomposed=0
+      endif
+      slide_image, tab $        ; on le dessine ds une fenetre avec une scrolling bar
+       , xsize = nx, ysize = ny $
+       ,xvisible=round(.7*dimensions[0]) < (size(tab))[1] $
+       ,yvisible=round(.7*dimensions[1]) < (size(tab))[2],/register,congrid=0,show_full=0
+      return
+   ENDELSE 
+;------------------------------------------------------------
+; on prend des infos a la souris
+;------------------------------------------------------------
+   if NOT keyword_set(pasblabla) then begin
+      print, 'Bouton de gauche: position du curseur et valeur du tableau en ce point'
+      print, 'Bouton du milieu: zoom'
+      print, 'Bouton de droite: quitter'
+   endif
+   cursor,x,y,/device, /down
+   while (!mouse.button ne 4) do BEGIN
+      x = x-margepix[0] & x = 0 > floor(x/coefzoom) < ((size(tab))[1]-1)
+      y = y-margepix[2] & y = 0 > floor(y/coefzoom) < ((size(tab))[2]-1)
+      case !mouse.button of
+         1:BEGIN                ; saisie d''une valeur
+            if x LE nx/coefzoom AND y LE ny/coefzoom then begin
+               print,'position: x='+strtrim(x+offset[0],1)+', y= '+strtrim(y+offset[1],1) $
+                +' valeur: '+strtrim(float(z2d[x,y]), 1)
+            ENDIF
+            cursor,x,y,/device, /down
+         END
+         2:BEGIN                ; zoom
+            cursor,x2,y2,/device, /down
+            x2 = x2-margepix[0] & x2 =  0 > floor(x2/coefzoom) < ((size(tab))[1]-1)
+            y2 = y2-margepix[2] & y2 =  0 > floor(y2/coefzoom) < ((size(tab))[2]-1)
+            x =  [x, x2] & x =  x[sort(x)]
+            y =  [y, y2] & y =  y[sort(y)]
+            tvplus, z2d[x[0]:x[1],y[0]:y[1] ], WINDOW = window, MIN = min, MAX = max $
+             , MASK = mask, C_MASK = c_mask, C_NAN = c_nan, /PASBLABLA, OFFSET = [x[0],y[0]] $
+             , NCOLORS = ncolors, NOINTERP = nointerp, BOTTOM = bottom, _EXTRA = ex
+            return
+         END
+      endcase
+   ENDWHILE
+;------------------------------------------------------------
+   !x = xenvsauve & !y = yenvsauve & !p = penvsauve
+;------------------------------------------------------------
+   return
+end
Index: tags/start/PLOTS/DIVERS/addaxe.pro
===================================================================
--- tags/start/PLOTS/DIVERS/addaxe.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/addaxe.pro	(revision 5)
@@ -0,0 +1,65 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:addaxe
+;
+; PURPOSE:ajoute un axe qd on fait une section oblique ds pltz, pltt
+; ou plt1d
+;
+; CATEGORY:autour de pltz, pltt et plt1d
+;
+; CALLING SEQUENCE:addaxe, type, posfenetre
+; 
+; INPUTS:endpoints:coordonnees des extremites de ;a section
+;        type: un string de 2 characteres specifiant qule type de plot
+; on fait.
+;        posfenetre: ler vecteur !p.posotion correspondant a ;a
+;        position du cadre de la partie dessin du plot.
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO addaxe, endpoints, type, posfenetre, _EXTRA = ex
+@common
+;---------------------------------------
+   IF strpos(type, 'x') NE -1 THEN BEGIN
+      IF endpoints[1] EQ endpoints[3] THEN return
+      formeaxe0 = 'lonaxe'
+      formeaxe1 = 'lataxe'
+      titreaxe = 'latitude'
+      range = [endpoints[1], endpoints[3]]
+   ENDIF ELSE BEGIN
+      IF endpoints[0] EQ endpoints[2] THEN return
+      formeaxe0 = 'lataxe'
+      formeaxe1 = 'lonaxe'
+      titreaxe = 'longitude'
+      range = [endpoints[0], endpoints[2]]
+      if endpoints[3] LT endpoints[1] THEN range = reverse(range)
+   ENDELSE
+   if type EQ 'yt' then BEGIN
+      axis,yaxis=0,ytickformat=formeaxe0,color=0,ystyle = 1, _EXTRA = ex
+      axis,yaxis=1,ytickformat=formeaxe1,color=0,ystyle = 1,ytitle=titreaxe, yrange = range, _EXTRA = ex
+   ENDIF ELSE BEGIN
+      axis,xaxis=0,xtickformat=formeaxe0,color=0,xstyle = 1,_EXTRA = ex
+      axis,xaxis=1,xtickformat=formeaxe1,color=0,xstyle = 1,xtitle=titreaxe, xrange = range, _EXTRA = ex
+   ENDELSE
+
+;---------------------------------------
+   return
+end
Index: tags/start/PLOTS/DIVERS/autoscale.pro
===================================================================
--- tags/start/PLOTS/DIVERS/autoscale.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/autoscale.pro	(revision 5)
@@ -0,0 +1,78 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: autoscale
+;
+; PURPOSE: on donne un min et un max et la procedure renvoie le
+; contour intevalle qui va bien et la valeur des labels.
+;
+; CATEGORY: autour de CONTOUR
+;
+; CALLING SEQUENCE: autoscale, min, max, ci
+; 
+; INPUTS: min et max: 2 reels specifiants entre quel min et quel max
+; on veut tracer un contour
+;
+; KEYWORD PARAMETERS: none
+;
+; OUTPUTS: ci et evenuellement levels. ci est un reel qui donne le
+; contour intevalle. A utiliser ds CONTOUR avlec le mot clef LEVEL.
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+;  CI est un multiple de l'unite en unite log de 10.
+;  force le nombre de contour a etre pair.
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: G. Roullet / aout 99 (gr@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO autoscale, min, max, ci
+;
+;  estimation d'un premier CI, notez la presence du floor (arrondi inferieur)
+; ce CI est un multiple de l'unite en unite log de 10.
+;
+    ci = (max-min)/20.
+    ci = 10.^floor(alog10(ci))
+
+    n = 0
+    ci0 = ci
+;
+    coef = [2, 2.5, 5, 10]
+;
+; test differents CI (contour intervales), i.e. 1, 2, 2.5, 5 et 10
+; jusqu'a ce que le nombre de contours soit inferieur a 30.
+;
+    WHILE ceil((max-min)/ci) GE 30 DO BEGIN 
+          ci = ci0*coef[n]
+          n = n+1
+    ENDWHILE 
+
+    min = floor(min/ci/2)*ci*2
+    max = ceil(max/ci/2)*ci*2
+    
+    nlevels = round((max-min)/ci)    
+
+;
+;  force le nombre de contour a etre pair
+;
+    IF nlevels MOD 2 EQ 1 THEN BEGIN 
+          nlevels = nlevels+1
+          max = max+ci
+    END 
+
+
+END 
+
+
+
+
Index: tags/start/PLOTS/DIVERS/barrecouleur.pro
===================================================================
--- tags/start/PLOTS/DIVERS/barrecouleur.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/barrecouleur.pro	(revision 5)
@@ -0,0 +1,46 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:barrecouleur
+;
+; PURPOSE:surcouche de colorbar
+;
+; CATEGORY:delestage de l''ecriture de plt, pltz, pltt
+;
+; CALLING SEQUENCE:barrecouleur
+;
+; SIDE EFFECTS: passer tous les arguments que l''on veut grace a _extra
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       23/12/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO barrecouleur, NOCOLORBAR = nocolorbar, CB_TITLE = cb_title, CB_SUBTITLE = cb_subtitle $
+                  , POST = post, _extra = ex
+@common
+;------------------------------------------------------------
+   ancienx = !x
+   ancieny = !y
+   ancienp = !p
+   reinitplt
+   !x.style = 1
+   !y.style = 1
+;------------------------------------------------------------
+   if n_elements(ex) NE 0 then BEGIN 
+      if (where(tag_names(ex) EQ 'MIN'))[0] NE -1 then colorbarinf=ex.MIN
+      if (where(tag_names(ex) EQ 'MAX'))[0] NE -1 then colorbarsup=ex.MAX
+      if (where(tag_names(ex) EQ 'DIVISIONS'))[0] NE -1 then colorbardiv=ex.DIVISIONS
+      if (where(tag_names(ex) EQ 'NOCOULEUR'))[0] NE -1 then nocolorbar = 1
+   ENDIF
+   if not keyword_set(nocolorbar) then BEGIN 
+      colorbar,cb_color=0, cb_charsize=ancienp.charsize, pscolor=keyword_set(post) $
+       , cb_title = cb_title,_extra = ex
+   ENDIF
+   !x= ancienx
+   !y= ancieny
+   !p= ancienp
+   return
+end
Index: tags/start/PLOTS/DIVERS/checkfield.pro
===================================================================
--- tags/start/PLOTS/DIVERS/checkfield.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/checkfield.pro	(revision 5)
@@ -0,0 +1,353 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:checkfield
+;
+; PURPOSE:en entree de plt, pltz, pltt et plt1d, verifie que le
+; champ donne a bien une taille compatible avec le domaine et fait au
+; besoin les moyennes pour ressortir en fin de fonction un tableau 2d
+; si on fait un plot du type: 'xy', 'xz', 'xt', 'yz', 'yt', 'zt' ou un
+; tableau 1d si on fait un plot du type 'x', 'y', 'z', 't'.
+;
+; CATEGORY:en entree de plt, pltz, pltt et plt1d
+;
+; CALLING SEQUENCE:res=checkfield(field, procedure)
+; 
+; INPUTS:
+;        filed: un champ recomdant aux criteres de litchamp.pro, cf.
+;        IDL>xhelp,'litchamp'
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      08/02/2000
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION checkfield, field, procedure, TYPE = type, BOITE = boite, DIREC = direc, NOQUESTION = noquestion, VECTEUR = vecteur, _EXTRA = ex
+;--------------------------------------------------------------
+@common
+;--------------------------------------------------------------
+; I1) lecture du champ
+;--------------------------------------------------------------
+   if n_elements(field) EQ 0 then return, report('field undefined')
+   z2d = litchamp(field)
+   nan = total(finite(z2d,/nan)) < 1
+;---------------------------------------------------------------
+; redefinition du domaine 
+;---------------------------------------------------------------
+   minprof = 0
+   profdefault = 200
+   if keyword_set(boite) then BEGIN 
+;
+;      if n_elements(integration3d) EQ 0 THEN integration3d = n_elements(boite) ne 4
+;
+      neleboitein = N_Elements(Boite)
+      Case neleboitein Of
+         1:boite=[lon1, lon2, lat1, lat2, minprof,boite[0]]
+         2:boite=[lon1, lon2, lat1, lat2, boite[0],boite[1]]
+         4:$ 
+          if strpos(type, 'z') NE -1 THEN boite=[Boite, minprof, profdefault] $
+         ELSE boite=[Boite, prof1, prof2]
+         5:boite=[Boite[0:3], minprof, Boite[4]]
+         6:boite=Boite
+         Else: return, report('Mauvaise Definition de Boite')
+      ENDCASE
+   ENDIF ELSE neleboitein = 0
+; la procedure domdef determine les elements qui sont a l''interieur
+; de la boite. 
+; si on fait un plot contenant l''axe z:
+; Suivant l''axe z si on veut par ex faire un dessin
+; entre 0 et 1000 il se peut que l''on selectionne les niveaux
+; correspondants aux profondeurs comprises entre 0 et 900m (vu la
+; discretisation assez lache de cet axe qd on atteint des profondeurs
+; elevees). Pour ne pas que le dessin s''arrete a 900 mais bien a
+; 1000, on va aller chercher le niveau au dessous de 1000, d''ou la
+; manip suivante sur la boite: l''approfondir de 1 niveau sur la
+; verticale (si possible) sans changer les y range. 
+   if strpos(type, 'z') NE -1 THEN BEGIN
+      if NOT keyword_set(boite) then boite = 1.*[lon1,lon2,lat1,lat2,minprof, profdefault]
+      !y.range = [boite[5], boite[4]] ;on garde les yranges (axe z) avant de changer la boite.
+      profmax = boite[5]
+      if vargrid EQ 'W' then gdep = gdepw ELSE gdep = gdept
+; check with vertical grid limits (nearest level)
+      gwork = gdep
+; check the increse or decrese of the z axis
+      IF gwork[1] LE gwork[0] THEN gwork = reverse(gdep, 1)
+      niveauprof = where(gwork ge boite[5]) & niveauprof = niveauprof[0]
+      if niveauprof NE -1 then boite[5] = gwork[niveauprof]+1
+   ENDIF
+   if keyword_set(boite) then BEGIN
+      if keyword_set(vecteur) then grillechoice = [vargrid, 'T', 'U', 'V'] ELSE grillechoice = [vargrid, 'T']
+      if neleboitein LE 2 then domdef, boite, GRILLE=grillechoice ELSE domdef, boite, GRILLE=grillechoice, _extra = ex
+   ENDIF
+;--------------------------------------------------------------
+; verification de la taille du tableau d''entree et de la valeur de type
+;--------------------------------------------------------------
+   grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx,derniery,dernierz
+   taille=size(z2d)
+   case taille[0] of
+;--------------------------------------------------------------
+      0:BEGIN 
+         if z2d EQ -1 then $
+          return, report('Attention le tableau est egale a -1. Probleme lors de la lecture...') $
+         ELSE return, report('Attention le tableau est un scalaire') 
+      END 
+;--------------------------------------------------------------
+      1:BEGIN
+         nele = n_elements(z2d)
+         case type of
+            't':if jpt NE nele then $
+             return, report('jpt: '+strtrim(jpt, 1)+' n''est pas egale au nombres d''elements du vecteur: '+strtrim(nele, 1))
+            'x':BEGIN 
+               case nele of
+                  jpi:z2d = z2d[premierx:dernierx]
+                  nx:
+                  ELSE:return, report('nx: '+strtrim(nx, 1)+' n''est pas egale au nombres d''elements du vecteur: '+strtrim(nele, 1))
+               endcase
+            end
+            'y':BEGIN 
+               case nele of
+                  jpj:z2d = z2d[premiery:derniery]
+                  ny:
+                  ELSE:return, report('ny: '+strtrim(ny, 1)+' n''est pas egale au nombres d''elements du vecteur: '+strtrim(nele, 1))
+               endcase
+            END
+            'z':BEGIN 
+               case nele of
+                  jpk:z2d = z2d[premierz:dernierz]
+                  nz:
+                  ELSE:return, report('nz: '+strtrim(nz, 1)+' n''est pas egale au nombres d''elements du vecteur: '+strtrim(nele, 1))
+               endcase
+            END
+            ELSE:return, report('imcompatibilite entre type: '+type+' et la taille du tableau 1d en entree: '+strtrim(nele, 1))
+         ENDCASE
+      END 
+;--------------------------------------------------------------
+      2:BEGIN
+         case type of
+            'x':BEGIN
+               case taille[2] of
+                  ny:direc = 'y'
+                  jpj:direc = 'y'
+                  jpt:direc = 't'
+                  ELSE:return, report('imcompatibilite entre type: '+type+' et la taille du tableau 2d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+               endcase
+            end
+            'y':BEGIN
+               case 1 of
+                  taille[1] EQ jpi OR taille[1] EQ nx:direc = 'x'
+                  taille[2] EQ jpt:direc = 't'
+                  ELSE:return, report('imcompatibilite entre type: '+type+' et la taille du tableau 2d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+               endcase
+            END
+            'z':BEGIN
+               if taille[2] EQ jpt then direc = 't' $
+               ELSE return, report('imcompatibilite entre type: '+type+' et la taille du tableau 2d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+            END
+            't':BEGIN
+               case 1 of
+                  taille[1] EQ jpi OR taille[1] EQ nx:BEGIN
+                     direc = 'x'
+                     timearray = 1
+                  END
+                  jpt EQ 1:BEGIN
+                     ras = report('Field average: '+strtrim(moyenne(z2d, 'xy', boite = boite, NAN = nan, _extra = ex), 1)+' in box: '+tostr(boite))
+                     return,  -1
+                  END
+                  ELSE: return, report('imcompatibilite entre type: '+type+' et la taille du tableau 2d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+               ENDCASE
+            END
+            'xy':BEGIN 
+               case 1 of
+                  taille[1] eq  nx and taille[2] eq  ny:
+                  taille[1] eq jpi and taille[2] eq jpj:z2d=z2d[premierx:dernierx, premiery:derniery]
+                  else:return, report('Probleme d''adequation entre les tailles du domaine nx*ny '+strtrim(nx, 1)+'*'+strtrim(ny, 1)+' et du tableau '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+               endcase
+               if vargrid EQ 'W' then niveau = premierzw+1 ELSE niveau = premierzt+1
+            END
+            'xz':BEGIN 
+               case 1 of
+                  taille[1] eq jpi and taille[2] eq jpk:z2d = z2d[premierx:dernierx,premierz:dernierz]
+                  taille[1] eq nx and taille[2] eq jpk:z2d = z2d[*,premierz:dernierz]
+                  taille[1] eq nx and taille[2] eq nz:
+                  else:return, report('Probleme d''adequation entre les tailles du domaine nx*nz '+strtrim(nx, 1)+'*'+strtrim(nz, 1)+'et du tableau'+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+               endcase
+            END
+            'yz':BEGIN 
+               case 1 of
+                  taille[1] eq jpj and taille[2] eq jpk:z2d = z2d[premiery:derniery,premierz:dernierz]
+                  taille[1] eq ny and taille[2] eq jpk:z2d = z2d[*,premierz:dernierz]
+                  taille[1] eq ny and taille[2] eq nz:
+                  else:return, report('Probleme d''adequation entre les tailles du domaine ny*nz '+strtrim(ny, 1)+'*'+strtrim(nz, 1)+'et du tableau'+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+               endcase
+            END
+            'xt':BEGIN
+               case 1 of
+                  taille[1] eq jpi and taille[2] eq jpt:z2d = z2d[premierx:dernierx,*]
+                  taille[1] eq nx and taille[2] eq jpt:
+                  else:return, report('Probleme d''adequation entre les tailles du domaine nx*jpt '+strtrim(nx, 1)+'*'+strtrim(jpt, 1)+'et du tableau'+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+               endcase
+            END
+            'yt':BEGIN
+               case 1 of
+                  taille[1] eq jpj and taille[2] eq jpt:z2d = z2d[premiery:derniery,*]
+                  taille[1] eq ny and taille[2] eq jpt:
+                  else:return, report('Probleme d''adequation entre les tailles du domaine ny*jpt '+strtrim(ny, 1)+'*'+strtrim(jpt, 1)+'et du tableau'+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+               endcase
+            END
+            'zt':BEGIN
+               case 1 of
+                  taille[1] eq jpk and taille[2] eq jpt:z2d = z2d[premierz:dernierz,*]
+                  taille[1] eq nz and taille[2] eq jpt:
+                  else:return, report('Probleme d''adequation entre les tailles du domaine nz*jpt '+strtrim(nz, 1)+'*'+strtrim(jpt, 1)+'et du tableau'+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+               endcase
+            END
+         endcase
+      END
+;--------------------------------------------------------------
+      3:BEGIN
+         case type of
+            'x':BEGIN
+               case taille[3] of
+                  nz:direc = 'yz'
+                  jpk:direc = 'yz'
+                  jpt:direc = 'yt'
+                  ELSE:return, report('imcompatibilite entre type: '+type+' et la taille du tableau 3d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+               endcase
+            END
+            'y':BEGIN
+               case taille [3] of
+                  nz:direc = 'xz'
+                  jpk:direc = 'xz'
+                  jpt:direc = 'xt'
+                  ELSE:return, report('imcompatibilite entre type: '+type+' et la taille du tableau 3d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+               endcase
+            END
+            'z':BEGIN
+               case taille [3] of
+                  nz:direc = 'xy'
+                  jpk:direc = 'xy'
+                  ELSE:return, report('imcompatibilite entre type: '+type+' et la taille du tableau 3d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+               endcase
+            END
+            't':BEGIN
+               IF jpt EQ 1 THEN BEGIN 
+                  ras = report('Field average: '+strtrim(moyenne(z2d, 'xyz', boite = boite, NAN = nan, _extra = ex), 1)+' in box: '+tostr(boite))
+                  return,  -1
+               ENDIF ELSE BEGIN
+                  direc = 'xy'
+                  timearray = 1
+               ENDELSE
+            END
+            'xy':BEGIN
+               case 1 of
+                  taille[3] EQ jpt:BEGIN
+                     direc = 't'
+                     if vargrid EQ 'W' then niveau = premierzw+1 ELSE niveau = premierzt+1
+                  END
+                  taille[3] EQ nz OR taille[3] EQ jpk:BEGIN 
+                     if keyword_set(boite) OR keyword_set(noquestion) then begin
+                        direc = 'z'
+                        if vargrid EQ 'W' then niveau = premierzw+1 ELSE niveau = premierzt+1
+                     ENDIF ELSE BEGIN
+                        if vargrid EQ 'W' then premierz = premierzw ELSE premierz = premierzt
+                        if NZ NE 1 then begin
+                           niveau = xquestion('Le tableau d''entree est un tableau 3d,' $
+                                              +'!C a quel niveau faut-il faire le graphique?', '1', /chkwidget)
+                           niveau = 1 > fix(niveau) < (jpk-premierz)
+                           case 1 of
+                              taille[1] EQ nx AND taille[2] EQ ny: $
+                               z2d=z2d[*, *,niveau-1]
+                              taille[1] EQ jpi AND taille[2] EQ jpj: $
+                               z2d=z2d[premierx:dernierx, premiery:derniery,niveau-1]
+                              ELSE:return, report('imcompatibilite entre type: '+type+' et la taille du tableau 3d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+                           endcase
+                        ENDIF ELSE niveau = 1
+                        niveau = premierz+niveau
+                     endelse    
+                  END
+                  ELSE:return, report('imcompatibilite entre type: '+type+' et la taille du tableau 3d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+               endcase
+            END
+            'xz':BEGIN
+               case 1 of
+                  (taille[2] EQ ny OR taille[2] EQ jpj) AND taille[3] EQ jpk:BEGIN
+                     z2d = z2d[*, *, premierz:dernierz]
+                     direc = 'y'
+                  END
+                  (taille[2] EQ ny OR taille[2] EQ jpj) AND taille[3] EQ nz:direc = 'y'
+                  taille[3] EQ jpt:direc = 't'
+                  ELSE:return, report('imcompatibilite entre type: '+type+' et la taille du tableau 3d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+               endcase
+            END
+            'yz':BEGIN
+               case 1 of
+                  (taille[1] EQ nx OR taille[1] EQ jpi) AND taille[3] EQ jpk:BEGIN
+                     z2d = z2d[*, *, premierz:dernierz]
+                     direc = 'x'
+                  END
+                  (taille[1] EQ nx OR taille[1] EQ jpi) AND taille[3] EQ nz:direc = 'x'
+                  ELSE:return, report('imcompatibilite entre type: '+type+' et la taille du tableau 3d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+               endcase
+            END
+         'xt':BEGIN & direc = 'y' & timearray = 1 & end
+         'yt':BEGIN & direc = 'x' & timearray = 1 & end
+            'zt':return, report('imcompatibilite entre type: '+type+' et la taille du tableau 3d en entree: '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+         ENDCASE
+      end
+;--------------------------------------------------------------
+      4:BEGIN 
+         case type of
+            'x':direc = 'yzt'
+            'y':direc = 'xzt'
+            'z':direc = 'xyt'
+            't':direc = 'xyz'
+            'xy':BEGIN 
+               if keyword_set(boite) OR keyword_set(noquestion) then begin
+                  if vargrid EQ 'W' then niveau = premierzw+1 ELSE niveau = premierzt+1
+                  direc = 'zt'
+               ENDIF ELSE BEGIN 
+                  if vargrid EQ 'W' then premierz = premierzw ELSE premierz = premierzt
+                  if NZ NE 1 then begin
+                     niveau = xquestion('Le tableau d''entree est un tableau 4d,' $
+                                        +'!C a quel niveau faut-il faire le graphique?', '1', /chkwidget)
+                     niveau = 1 > fix(niveau) < (jpk-premierz)
+                     z2d=reform(z2d[*,*,niveau-1, *], /over)
+                  ENDIF ELSE niveau = 1
+                  niveau = premierz+niveau
+                  direc = 't'
+               ENDELSE
+            END
+            '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 keyword_set(timearray) OR taille[0] EQ 4 then $
+       z2d = grossemoyenne(z2d, direc, boite = boite, NAN = nan, /nodomdef, _extra = ex) $
+      ELSE z2d = moyenne(z2d, direc, boite = boite, NAN = nan, /nodomdef, _extra = ex)
+   ENDIF
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+;--------------------------------------------------------------
+   return, z2d
+end
Index: tags/start/PLOTS/DIVERS/checktypeminmax.pro
===================================================================
--- tags/start/PLOTS/DIVERS/checktypeminmax.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/checktypeminmax.pro	(revision 5)
@@ -0,0 +1,188 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:
+;
+; PURPOSE:
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:
+; 
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO checktypeminmax, procedure, TYPE = type, MIN = min, MAX = max, XY = xy $
+                     , XZ = xz, YZ = yz, XT = XT, YT = YT, ZT = zt $
+                     , TT = tt, XX = xx, YY = yy, ZZ = zz $
+                     , XINDEX = xindex, YINDEX = yindex, BOITE = boite, ENDPOINTS = endpoints
+;
+@common
+;--------------------------------------------------------------
+   case size(type, /type) of
+      0:
+      7:
+      ELSE:BEGIN
+         vraimin = type
+         case size(min, /type) of
+            0:BEGIN 
+               min = vraimin
+               type = 0
+            END
+            7:BEGIN 
+               type = min
+               min = vraimin
+            end
+            ELSE:BEGIN
+               case size(max, /type) of
+                  0:BEGIN
+                     max = min
+                     min = vraimin
+                     type = 0
+                  END
+                  7:BEGIN 
+                     type = max
+                     max = min
+                     min = vraimin
+                  end
+                  ELSE:BEGIN
+                     rien = report('Probleme dans la definition des arguments en entree de ' $
+                                   +procedure, /chkwidget)
+                     return
+                  end
+               endcase
+            end
+         endcase
+      end
+   endcase
+;
+   if keyword_set(xy) then type = 'xy'
+   if keyword_set(xz) then type = 'xz'
+   if keyword_set(yz) then type = 'yz'
+   if keyword_set(xt) then type = 'xt'
+   if keyword_set(yt) then type = 'yt'
+   if keyword_set(zt) then type = 'zt'
+   if keyword_set(tt) then type = 't'
+   if keyword_set(xx) then type = 'x'
+   if keyword_set(yy) then type = 'y'
+   if keyword_set(zz) then type = 'z'
+;
+   if keyword_set(type) then begin
+      if type EQ 'plt' then type = ''
+      if type EQ 'pltz' then type = ''
+      if type EQ 'pltt' then type = ''
+      if type EQ 'plt1d' then type = ''
+   endif
+;--------------------------------------------------------------
+; determination du type de plot que l''on veut faire
+;--------------------------------------------------------------
+   if NOT keyword_set(type) then BEGIN
+      case procedure of
+         'plt':type = 'xy'
+         'pltz':BEGIN
+            @common
+            if keyword_set(endpoints) then BEGIN 
+               lon1 = min([endpoints[0], endpoints[2]])
+               lon2 = max([endpoints[0], endpoints[2]])
+               lat1 = min([endpoints[1], endpoints[3]])
+               lat2 = max([endpoints[1], endpoints[3]])
+            ENDIF ELSE BEGIN
+               if n_elements(boite) GE 4 then BEGIN
+                  if keyword_set(xindex) then begin
+                     lon1 = glamt[boite[0], 0]
+                     lon2 = glamf[boite[1], 0]
+                  ENDIF ELSE BEGIN
+                     lon1 = boite[0]
+                     lon2 = boite[1]
+                  ENDELSE
+                  if keyword_set(yindex) then begin
+                     lat1 = gphit[0, boite[2]]
+                     lat2 = gphif[0, boite[3]]
+                  ENDIF ELSE BEGIN
+                     lat1 = boite[2]
+                     lat2 = boite[3]
+                  ENDELSE
+               ENDIF
+            ENDELSE
+            if lon2-lon1 gt lat2-lat1 then type='xz' else type='yz' 
+         END
+         'pltt':BEGIN
+            if keyword_set(endpoints) then BEGIN 
+               lon1 = min([endpoints[0], endpoints[2]])
+               lon2 = max([endpoints[0], endpoints[2]])
+               lat1 = min([endpoints[1], endpoints[3]])
+               lat2 = max([endpoints[1], endpoints[3]])
+            ENDIF ELSE BEGIN
+               if n_elements(boite) GE 4 then BEGIN
+                  if keyword_set(xindex) then begin
+                     lon1 = glamt[boite[0], 0]
+                     lon2 = glamf[boite[1], 0]
+                  ENDIF ELSE BEGIN
+                     lon1 = boite[0]
+                     lon2 = boite[1]
+                  ENDELSE
+                  if keyword_set(yindex) then begin
+                     lat1 = gphit[0, boite[2]]
+                     lat2 = gphif[0, boite[3]]
+                  ENDIF ELSE BEGIN
+                     lat1 = boite[2]
+                     lat2 = boite[3]
+                  ENDELSE
+               ENDIF
+            ENDELSE
+            if (lon2-lon1) gt (lat2-lat1) then type='xt' else type='yt'
+;             type = ''
+;             WHILE type NE 't' AND type NE 'xt' AND type NE 'yt' AND type NE 'zt' DO BEGIN
+;                type = xquestion('Quel type de hovmoeller voulez-vous faire? t,xt,yt,zt ? ' $
+;                                 , /chkwidget)
+;                type = strlowcase(type)
+;             ENDWHILE 
+         END
+         'plt1d':BEGIN
+            if keyword_set(endpoints) then BEGIN 
+               lon1 = min([endpoints[0], endpoints[2]])
+               lon2 = max([endpoints[0], endpoints[2]])
+               lat1 = min([endpoints[1], endpoints[3]])
+               lat2 = max([endpoints[1], endpoints[3]])
+               if (lon2-lon1) gt (lat2-lat1) then type='x' else type='y'
+            ENDIF ELSE BEGIN
+               type = ''
+               WHILE type NE 'x' AND type NE 'y' AND type NE 'z' DO BEGIN
+                  type = xquestion('Quel type de plot 1D voulez-vous faire? x,y,z ou t ?' $
+                                   , /chkwidget)
+                  type = strlowcase(type)
+               endwhile
+            ENDELSE
+         END
+      endcase
+   ENDIF 
+   WHILE type NE 'xy' AND type NE 'xz' AND type NE 'yz' $
+    AND type NE 'xt' AND type NE 'yt' AND type NE 'zt' $
+    AND type NE 't' AND type NE 'x' AND type NE 'y' AND type NE 'z' DO BEGIN
+      type = xquestion('Quel type de plot voulez-vous faire? xy,xz,yz,xt,yt,zt,t,x,y,z ? ' $
+                       , /chkwidget)
+      type = strlowcase(type)
+   ENDWHILE 
+;
+;
+
+   return
+end
Index: tags/start/PLOTS/DIVERS/determineminmax.pro
===================================================================
--- tags/start/PLOTS/DIVERS/determineminmax.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/determineminmax.pro	(revision 5)
@@ -0,0 +1,83 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:determineminmax
+;
+; PURPOSE:determiner le min et le max d''un tableau masque
+;
+; CATEGORY: delestage de l''ecriture de plt, pltz, pltt
+;
+; CALLING SEQUENCE:determineminmax, tab, mask, vraimin, vraimax
+;
+; INPUTS:
+;
+;       tab: le tableau dont il faut determiner le min et le max
+;       mask: le tableau de masque 
+;
+; KEYWORD PARAMETERS:
+;
+;       minin et maxin deux scalaire qui s''il ne sont pas definits
+;       prennent la valeur de vraimin et vraimax
+;
+; OUTPUTS:
+;
+;       vraimin et vraimax: le min et le max du tableau
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:degarde si le champ est constant sur la mer
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       11/12/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO determineminmax, tab, mask, vraimin, vraimax, glam, gphi, MAXIN = maxin, MININ = minin, INTERVALLE = intervalle, _extra = ex
+@common
+;-----------------------------------------------------------------------------
+;-----------------------------------------------------------------------------
+; type de grille verticale:
+   if vargrid EQ 'W' then nz = nzw ELSE nz = nzt
+; liste des points mer
+   if (size(mask))[0] EQ 3 then BEGIN 
+      if (size(mask))[3] EQ jpk then mer=mask[*,*,niveau-1] $
+      ELSE mer=mask[*,*,nz-1]
+   ENDIF ELSE mer=mask
+; si key_irregular eq 1, on masque aussi les points qui ne rentrent
+; pas ds le domaine geographique definit par lon1,lon2,lat1,lat2
+   if keyword_set(key_irregular) AND n_elements(glam) NE 0 AND n_elements(gphi) NE 0 then begin
+      dom =   where(glam LT lon1 OR glam GT lon2 OR gphi LT lat1 OR gphi GT lat2)
+      if dom[0] NE -1 then mer[dom] = 0
+   endif
+;
+   mer=where(mer eq 1)
+;
+   if mer[0] eq -1 then begin
+      ras = report('Il n''y a que de la terre sur le dessin!')
+      tab = -1
+   endif
+; ma et mi : max et min sur les points mer
+   vraimax=max(tab(mer),min=vraimin, _extra = ex)
+   sameminmax = testvar(var = minin) EQ testvar(var = maxin) 
+   if n_elements(maxin) EQ 0 OR sameminmax then maxin = vraimax
+   if n_elements(minin) EQ 0 OR sameminmax then BEGIN 
+      if keyword_set(intervalle) then minin = floor(vraimin/intervalle)*intervalle $
+      ELSE minin = vraimin
+   endif
+   if vraimin eq vraimax then BEGIN
+      question = 'ATTENTION le champ est CONSTANT! Faut-il quand meme le tracer?'
+      answer = report(question, /default_no,  /question)
+      if answer then begin
+         maxin=vraimax+1
+         minin=vraimin-1
+      endif ELSE tab = -1
+   endif
+   return
+end
Index: tags/start/PLOTS/DIVERS/givewindowsize.pro
===================================================================
--- tags/start/PLOTS/DIVERS/givewindowsize.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/givewindowsize.pro	(revision 5)
@@ -0,0 +1,13 @@
+FUNCTION givewindowsize
+@common
+;
+   dimensions = get_screen_size(RESOLUTION=resolution)
+   coef = floor(1./resolution[0])
+   if NOT keyword_set(ccwindowsize) then ccwindowsize = 1
+   coef = ccwindowsize*coef
+;
+   xsize=coef*(petitfeuille*key_portrait+grandfeuille*(1-key_portrait))
+   ysize=coef*(petitfeuille*(1-key_portrait)+grandfeuille*key_portrait)
+;
+   return, [xsize, ysize]
+end
Index: tags/start/PLOTS/DIVERS/meridienparallele.pro
===================================================================
--- tags/start/PLOTS/DIVERS/meridienparallele.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/meridienparallele.pro	(revision 5)
@@ -0,0 +1,42 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:meridienparallele
+;
+; PURPOSE:trace certains medidiens ou paralles
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:meridienparallele, coupe
+;
+; INPUTS:coupe: le type de dessin que l''on traite
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       11/12/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO meridienparallele, coupe
+@common
+;------------------------------------------------------------
+   case coupe of
+      'xy':BEGIN 
+         if lon1 lt 180 and lon2 gt 180 then $
+          plot, [180,180],[lat1,lat2],/noerase,color=0
+         if lon1 lt 0 and lon2 gt 0 then $
+          plot, [0,0],[lat1,lat2],/noerase,color=0
+         if lon1 lt 360 and lon2 gt 360 then $
+          plot, [360,360],[lat1,lat2],/noerase,color=0
+         if lat1 lt 0 and lat2 gt 0 then $
+          plot, [lon1,lon2],[0,0],/noerase,color=0
+      END
+
+   endcase
+
+   return
+end
Index: tags/start/PLOTS/DIVERS/placecolor.pro
===================================================================
--- tags/start/PLOTS/DIVERS/placecolor.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/placecolor.pro	(revision 5)
@@ -0,0 +1,72 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:PLACECOLOR
+;
+; PURPOSE:permet de tracer la colorbar independammment d'un graphe
+;
+; CATEGORY:graph
+;
+; CALLING SEQUENCE:placecolor,pos
+;
+; INPUTS:
+;	pos:vecteur de 4 elements donnant les coordonnees du coin en bas
+; a gauche et de celui en haut a droite -en cm- ds lequel on veut faire la
+; barre de couleur
+;
+; KEYWORD PARAMETERS: tous ceux de colorbar.pro.
+;
+; par defaut trace une barre de couleur du meme type que celle presente ds plt
+; et pltz. si max, min et divisions ne sont pas stipulees alors max=sup,min=inf
+; et divisions=div
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:utilisable que pour les POSTCRIPT effectues avec plein2dessin
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			7/5/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro placecolor,pos,_extra = ex
+@common
+;------------------------------------------------------------
+   xsave = !x
+   ysave = !y
+   psave = !p
+
+   reinitplt, /z, /invert
+   pos=1.*pos
+   if key_portrait eq 1 then begin
+      pos[0]=pos[0]/petitfeuille    
+      pos[1]=pos[1]/grandfeuille    
+      pos[2]=pos[2]/petitfeuille    
+      pos[3]=pos[3]/grandfeuille    
+   endif else begin
+      pos[0]=pos[0]/grandfeuille    
+      pos[1]=pos[1]/petitfeuille    
+      pos[2]=pos[2]/grandfeuille    
+      pos[3]=pos[3]/petitfeuille    
+   endelse
+   if keyword_set(divisions) eq 0 then divisions=colorbardiv
+   if keyword_set(max) eq 0 then max=colorbarsup
+   if keyword_set(min) eq 0 then min=colorbarinf
+   COLORBAR, COLOR=0, DIVISIONS=divisions, DISCRET=couleur, cb_color = 0, $
+    POSITION=pos, MAX=max, MIN=min, cb_charsize=!p.charsize, _extra = ex
+
+   !x = xsave
+   !y = ysave
+   !p = psave
+;------------------------------------------------------------
+   return
+end
Index: tags/start/PLOTS/DIVERS/placedessin.pro
===================================================================
--- tags/start/PLOTS/DIVERS/placedessin.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/placedessin.pro	(revision 5)
@@ -0,0 +1,156 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:placedessin
+;
+; PURPOSE: mise en place du dessin / ouverture de la fenetre ou du PS
+;
+; CATEGORY: pour alleger les programmes plt, pltz, pltt.
+;
+; CALLING SEQUENCE: placedessin, typedessin,posfenetre, posbar
+;
+; INPUTS:
+;   typedessin: une chaine de charactere specifiant quelle procedure
+;   appelle placedessin: 'plt', 'pltz', 'pltt'
+;
+; KEYWORD PARAMETERS: pleins (ce de CALIBRE de WINDOW ...)
+;
+;       LCT: intier designant le numero de la palette de couleur que
+;       l''on veut utiliser pour les plot. 
+;	
+; OUTPUTS:
+;
+;       posfenetre: un vecteur de 4 elements contenant la position de
+;       cadre contenant les legendes + le graphe en coordonnes
+;       normalises. Rq: pour positionner le dessin il faut apres
+;       l''appelle de calibre faire !p.position=posfenetre
+;
+;       posbar: cf posfentre mais pour la barre de couleur. meme
+;       remarque pour positionner la barre de couleur, !p.position=posbar
+;
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       26/4/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO placedessin, typedessin,posfenetre, posbar, BARMARGES = barmarges, NOCOLORBAR = nocolorbar, CONTOUR = contour $
+                 , VECTEUR = vecteur, PORTRAIT = portrait, LANDSCAPE = landscape $
+                 , YSURX = ysurx, PETITDESSIN = petitdessin, MARGES = marges, MAP = map $
+                 , REMPLI = REMPLI, POST = post, WINDOW = window $
+                 , ENDPOINTS = endpoints, TYPE = type, Basicmarges = basicmarges $
+                 , NOERASE = noerase, LCT = lct, DIREC = direc, CB_TITLE = cb_title, _extra = ex
+@common
+;-------------------------------------------------------------
+; 1) determination de la taille des marges (unite=nbre de lignes ou colonnes)
+; a gauche, a droite, en bas, en haut
+; ATTENTION ds margebar le dernier element est le coint en haut a droite au
+; lieu de la marge en haut
+;-------------------------------------------------------------
+   if n_elements(typedessin) EQ 0 then typedessin = 'autre'
+   if keyword_set(basicmarges) then begin
+      marge=1.*[6,2,4,3]
+      margebar= replicate(0, 4)
+      if keyword_set(marges) THEN marge = marge+marges
+   ENDIF ELSE BEGIN 
+      if n_elements(ex)  NE 0 then $
+       if (where(tag_names(ex) EQ 'NOCOULEUR'))[0] NE -1 then IF ex.NOCOULEUR EQ 1 THEN nocolorbar=1
+      case typedessin of
+         'plt':marge=1.*[6,2,4,3]
+         'pltt':marge=1.*[6+4*(type EQ 'xt'),2,4,4]
+         'pltz':marge=1.*[6,2,4,3]
+         else:marge=1.*[6,2,4,3]
+      ENDCASE
+      if keyword_set(marges) THEN marge = marge+marges
+      if NOT keyword_set(barmarges) then barmarges = replicate(0, 4)
+      barmarges[3] = -barmarges[3]
+      margebar=1.*[marge[0]+1,marge[1]+1,2,4]+barmarges
+      marge=marge+[0,0,4,0]*keyword_set(cb_title)
+      marge=marge+[0,0,2,0]*keyword_set(direc)
+      marge=marge+[0,0,2,0]*keyword_set(contour)
+      marge=marge+[0,0,2,0]*keyword_set(vecteur)
+      if n_elements(lon1) NE 0 and n_elements(lon2) NE 0 $
+       and n_elements(lat1) NE 0 and n_elements(lat2) NE 0 then begin
+         if keyword_set(type) then $
+          marge=marge+[0, 3*(type EQ 'yt' AND lon1 NE lon2),0 $
+                       ,2*(type NE 'yt' AND lat1 NE lat2)]*keyword_set(endpoints) $
+         ELSE marge=marge+[0,0,0,2*(lat1 NE lat2)]*keyword_set(endpoints)
+      endif
+      marge=marge+[0,0,2+margebar[3],0]*(1-keyword_set(nocolorbar))
+   ENDELSE
+;--------------------------------------------------------------
+; portrair ou landscape
+;--------------------------------------------------------------
+   if n_elements(portrait) NE 0 then key_portrait=portrait $
+   else if key_portrait ne 1 then key_portrait=0
+   if n_elements(landscape) then key_portrait=1-landscape
+;--------------------------------------------------------------
+; Quel type de rapport d''aspect (sera ecrase si YSURX existe)
+;--------------------------------------------------------------
+   case typedessin of
+      'plt':yaspect=1.*(lat2-lat1)/(lon2-lon1)
+      'pltt':yaspect= 1.
+      'pltz':yaspect=.5
+      ELSE:yaspect= 1.
+   endcase
+;-------------------------------------------------------------
+; 2) calcul de !p.position
+; cf calibre.pro.
+;------------------------------------------------------------
+;
+   IF NOT keyword_set(petitdessin) then petitdessin = [1, 1, 1]
+;
+   if keyword_set(map) then rempli = 1
+;
+   calibre,yaspect,marge,margebar,petitdessin,posfenetre, posbar,YSURX=ysurx,REMPLI=rempli, _extra = xe
+;
+   !p.position=posfenetre
+;------------------------------------------------------------
+; 3) ouverture de la fenetre graphique ou du postscript
+;------------------------------------------------------------
+   case 1 of
+; cas du premier dessin sur un postcript
+      keyword_set(post) AND !d.name ne 'PS':openps, _extra = ex
+; cas du premier dessin sur un ecran
+      keyword_set(post) EQ 0 AND keyword_set(noerase) EQ 0 $
+       AND !d.name ne 'PS' AND !d.name ne 'Z':BEGIN
+         if not keyword_set(window) then window=0
+; pour l''utilisation de @ps, @oups et de @vzoom
+         if lmgr(/demo) EQ 0 then BEGIN ; on est en mode demo??
+            if !journal NE 0 then journal ; on ferme le journal s''il est ouvert
+            homedir = isadirectory(io = homedir, title = 'Bad definition of homedir')
+            journal, homedir+'idlsave.pro' ; on en ouvre un nouveau
+            help, /recall_commands, output = listecommande ; on recupere la derniere commande
+            listecommande = strmid(strcompress(listecommande[1]), 2)
+            printf, !journal, listecommande ; on l''ecrit dans le journal
+         ENDIF
+         windsize = givewindowsize()
+         window, window, xsize = windsize[0], ysize = windsize[1],  retain = 2, _extra = ex
+; qd on utilise des couleurs codees sur 24 bit, je n''arrive pas a stipuler la couleur du
+; fond d''une fenetre a l'aide de !p.background, je suis oblige de faire cette bidouille!!!
+;          if !d.n_colors gt 256 then begin
+;             device, decomposed=1
+;             !p.background='ffffff'x
+;             plot,[0],[0], /nodata, xstyle = 4, ystyle = 4
+;             device, decomposed=0
+;          endif
+      END
+      ELSE:
+   endcase
+;------------------------------------------------------------
+   if n_elements(lct) NE 0 then lct, lct
+;------------------------------------------------------------
+
+   return
+end
Index: tags/start/PLOTS/DIVERS/projsegment.pro
===================================================================
--- tags/start/PLOTS/DIVERS/projsegment.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/projsegment.pro	(revision 5)
@@ -0,0 +1,62 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; NAME: projsegment
+;
+; PURPOSE: projecte lineairement un segment un vecteur dont les bornes
+; sont [a,b] sur un vecteur dont les bornes sont [c,d]
+;
+; CATEGORY: caculs a 2 francs
+;
+; CALLING SEQUENCE: res=projsegment(vecteur, bornes) 
+;
+; INPUTS: vecteur: un vecteur dont le premier element doit etre le
+; plus petit element et le dernier doit etre le plus grand.
+;         bornes: les nouvelles bornes du vecteur.
+;
+; KEYWORD PARAMETERS:
+;
+;         /MP: activer ce motcle pour que la fonction retourne un
+;         vecteur de 2 elements qui sont les coefficient m et p de la
+;         projection lineaire y=mx+p utilisee pour passer du segment
+;         [a,b] au segment [c,d]
+;
+; OUTPUTS:un vecteurs dont les nouvelles bornes sont specifiees par
+; bornes
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;   
+;   IDL> a=indgen(9) 
+;   IDL> print, a 
+;          0       1       2       3       4       5       6       7       8
+;   IDL> print, projsegment(a,[0,80]) 
+;          0      10      20      30      40      50      60      70      80
+;   IDL> print, projsegment(a,[0,-80])  
+;          0     -10     -20     -30     -40     -50     -60     -70     -80
+;   IDL> print, projsegment(a,[-80,0])   
+;        -80     -70     -60     -50     -40     -30     -20     -10      0
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       24/6/1999
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION projsegment, vecteur, bornes, MP = mp
+;--------------------------------------------------------------
+   a1 = float(vecteur[0])
+   b1 = float(vecteur[n_elements(vecteur)-1])
+   a2 = float(bornes[0])
+   b2 =float( bornes[1])
+   if a1 EQ b1 then return, -1
+   m = (b2-a2)/(b1-a1)
+   p = a2-m*a1
+;--------------------------------------------------------------
+   if keyword_set(mp) then return, [m, p] ELSE return, m*vecteur+p
+;--------------------------------------------------------------
+end
Index: tags/start/PLOTS/DIVERS/restoreatt.pro
===================================================================
--- tags/start/PLOTS/DIVERS/restoreatt.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/restoreatt.pro	(revision 5)
@@ -0,0 +1,57 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:restoreatt
+;
+; PURPOSE:permet de reattribuer les variables globales associees a un
+; champ qd on donne une stucture cree par ex par saveatt.pro.
+;
+; CATEGORY:allegement d''ecriture
+;
+; CALLING SEQUENCE:restoreatt, structure
+;
+; INPUTS:une structure comme celle que lit litchamp. 
+;        cf. IDL> xhelp,'litchamp'
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS: change la valeur des variables globales attributs
+; d''un champ: vargrid, varname, varunit, vardate, varexp , valmask,
+; niveau et time
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       15/6/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO restoreatt, struct
+@common
+;------------------------------------------------------------
+   nomelements = tag_names(struct)
+   for i = 0, n_tags(struct)-1 do begin
+      case strlowcase(strmid(nomelements[i], 0, 1)) of
+         'g':vargrid = strupcase(struct.(i))
+         'n':varname = struct.(i)
+         'u':varunit = struct.(i)
+         'e':varexp = struct.(i)
+         'l':niveau = struct.(i)
+         'm':valmask = struct.(i)
+         'd':BEGIN 
+            if size(struct.(i),/type) EQ 7 THEN BEGIN 
+               vardate = struct.(i)
+            ENDIF ELSE BEGIN
+               vardate =  'time series'
+               time = struct.(i)
+            ENDELSE
+         end
+         ELSE:BEGIN 
+            ras = report('Le nom '+nomelements[i]+' ne correspont a aucun element reconnu de la structure. !C cf. IDL> xhelp, ''litchamp''')
+         end
+      endcase
+   endfor
+;------------------------------------------------------------
+   return
+end
Index: tags/start/PLOTS/DIVERS/rotation.pro
===================================================================
--- tags/start/PLOTS/DIVERS/rotation.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/rotation.pro	(revision 5)
@@ -0,0 +1,47 @@
+;+
+; NAME:
+;
+;           ROTATION
+; 
+; PURPOSE:
+; 
+;	    Rotate two vectors by a specified amount.
+;	    
+; CALLING SEQUENCE:
+; 
+;	    ROTATION,X,Y,DEG,NX,NY
+;	    
+; INPUTS:
+;
+;           X,Y   :orignal data point pairs
+;           
+;	    DEG   :degrees to rotate.
+;	    
+; OUTPUTS:
+; 
+;	    Nx, Ny = rotated point pairs.
+;	    
+; MODIFICATION HISTORY:
+; 
+;	    Jeff Bennett, U of Colorado
+;-
+
+PRO ROTATION,X,Y,DEG,NX,NY
+ang=deg*!dtor
+
+;convert to polar coordinates for rotation
+r = sqrt(x*x + y*y)
+theta = r*0.
+;get angle in for loop so that zero radii will be left as zero angle
+for i = 0,n_elements(r)-1 do $
+if r(i) ne 0 then theta(i) = atan(y(i),x(i))  ;range from -pi to +pi
+;
+;add rotation angle
+theta = theta + ang
+;
+;convert back to rectangular coordinates, now rotated
+nx = r * cos(theta)
+ny = r * sin(theta)
+;
+return
+end
Index: tags/start/PLOTS/DIVERS/saveatt.pro
===================================================================
--- tags/start/PLOTS/DIVERS/saveatt.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/saveatt.pro	(revision 5)
@@ -0,0 +1,30 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:saveatt
+;
+; PURPOSE:permet de mettre dans une structure les attributs qui peuvent
+; etre associes a une variable.
+;
+; CATEGORY:allegement d''ecriture
+;
+; CALLING SEQUENCE:res=saveatt()
+;
+; OUTPUTS:
+;    une stucture de la forme:
+;         {n:varname,g:vargrid,d:vardate,e:varexp,u:varunit,m:valmask,l:niveau}
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       15/6/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION saveatt
+@common
+   return, {n:varname,g:vargrid,d:vardate,e:varexp,u:varunit,m:valmask,l:niveau}
+end
Index: tags/start/PLOTS/DIVERS/terminedessin.pro
===================================================================
--- tags/start/PLOTS/DIVERS/terminedessin.pro	(revision 5)
+++ tags/start/PLOTS/DIVERS/terminedessin.pro	(revision 5)
@@ -0,0 +1,44 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:terminedessin
+;
+; PURPOSE:termnine le dessin si besion est qd c''est un postcsript.
+;
+; CATEGORY:mise en forme et allegement de l''ecrityre de plt, pltz et pltt
+;
+; CALLING SEQUENCE:terminedessin
+;
+; INPUTS:
+;
+; KEYWORD PARAMETERS:POST et PETITDESSIN cf l''aide de plt
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       3/6/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO terminedessin, POST=post, PETITDESSIN=petitdessin, _EXTRA = ex
+@common
+   if keyword_set(post) then BEGIN
+      if keyword_set(petitdessin) then $
+      if total(petitdessin) NE (margescadre[2]+margescadre[0]+petitfeuille+grandfeuille $
+                                -margescadre[1]-margescadre[3]) then return
+      closeps
+      imprime,_extra = ex
+   endif
+   return
+end
Index: tags/start/PLOTS/LABEL/label.pro
===================================================================
--- tags/start/PLOTS/LABEL/label.pro	(revision 5)
+++ tags/start/PLOTS/LABEL/label.pro	(revision 5)
@@ -0,0 +1,115 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:label
+;
+; PURPOSE:permet de choisir le stype de label que l'on veut utiliser
+; lors d'un contour
+;
+; CATEGORY:graphique
+;
+; CALLING SEQUENCE:pro label,cas,min,max,ncontour,level_z2d
+;
+; INPUTS:
+;	cas=numero du type de label que l'on veut tracer
+;	min et max = valeures min et max entre lesquelles on veut faire
+; des contours
+;
+; KEYWORD PARAMETERS:
+;
+;	INTERVALLE: valeur d'un intervalle entre deux isolignes. par defaut
+; est calcule pour tracer 20 isolighnes. Dans tous les cas ce not cle
+; doit etre retourne pour pouvoir avoir une belle legende. Si les
+; niveaux ne comportent pas d''intevalle regulier, le mettre a -1
+;
+;	NLEVEL: nombre de contours a dessiner. par defaut =20. actif si
+; LABEL=0 ou nest pas specifie.
+;
+; OUTPUTS:
+;	ncontour=nombre de contour a tracer
+;	level_z2d=vecteur contenant les valeurs des contours que l'on trace
+; (rq couleur est definit ds le common:
+;	c'est un vecteur contenant le numero des couleurs qui serviront a
+;               remplir entre les contours)
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			7/5/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro label,cas,min,max,ncontour,level_z2d,NLEVEL=nlevel $
+          ,INTERVALLE=intervalle, STRICTFILL = strictfill
+@common
+   if !d.name EQ 'PS' OR !d.name EQ 'Z' then BEGIN
+      old_dname = !d.name
+      thisOS = !VERSION.OS_FAMILY
+      thisOS = STRMID(thisOS, 0, 3)
+      thisOS = STRUPCASE(thisOS)
+      CASE thisOS of
+         'MAC': SET_PLOT, thisOS
+         'WIN': SET_PLOT, thisOS
+         ELSE: SET_PLOT, 'X'
+      ENDCASE
+      !p.BACKGROUND=(!d.n_colors-1) < 255
+      !p.color=0
+      if !d.n_colors gt 256 then !p.background='ffffff'x
+      ncoul = !D.n_Colors < 256
+      set_plot,old_dname
+   ENDIF ELSE ncoul = !D.n_Colors < 256
+   case cas of
+      0: begin
+;nlevel label entre le min et le max
+         if keyword_set(Nlevel) eq 0 then ncontour=20 else ncontour=nlevel
+         ncontour = 1 > ncontour
+         level_z2d  = min + (max-min)*(findgen(Ncontour)/Ncontour)
+         couleur    = ncoul*(findgen(Ncontour))/Ncontour+ncoul/(2*ncontour)
+         intervalle = level_z2d[1]-level_z2d[0]
+      end
+      1: begin
+;un certain nombre de label en partant du min jusqu'au plus pres de max avec
+; un pas fixe par intervalle
+         ncontour  = fix((max-min)/intervalle)
+         ncontour = 1 > ncontour
+         level_z2d = min + intervalle*findgen(Ncontour) 
+         couleur   = ncoul*(findgen(Ncontour))/Ncontour+ncoul/(2*ncontour)
+         max=level_z2d(Ncontour-1)+intervalle
+      end
+; label pour faire les memes sss que dessier
+
+      2: begin
+         lct, 63, file = 'palette.tbl'
+         level_z2d  = [20, 25, 30, 31, 32, 33, 33.5, 34+.25*findgen(16)]
+         ncontour=23
+         couleur    = findgen(23)+1
+         masx = 37.75
+         intervalle = -1
+         return
+      end
+      3: begin
+; lecture intervalles + palette dans fichier GMT
+
+         label_gmt, min, max, intervalle, ncoul, ncontour, level_z2d, couleur
+
+      end
+      else: begin
+         ras = report('Le numero de label demande n''existe pas', /error)
+      end
+   ENDCASE
+   if keyword_set(strictfill) then begin
+      ncontour = ncontour+1
+      level_z2d = [level_z2d, max]
+      couleur = [couleur, ncoul-1]
+   endif
+   return
+end
Index: tags/start/PLOTS/LABEL/label_date.pro
===================================================================
--- tags/start/PLOTS/LABEL/label_date.pro	(revision 5)
+++ tags/start/PLOTS/LABEL/label_date.pro	(revision 5)
@@ -0,0 +1,143 @@
+; $Id$
+;
+; Copyright (c) 1993-1998, Research Systems, Inc.  All rights reserved.
+;	Unauthorized reproduction prohibited.
+
+FUNCTION LABEL_DATE, axis, index, x, DATE_FORMAT = format, MONTHS = months, $
+              OFFSET= offs, _EXTRA = ex
+;+
+; NAME:
+;	LABEL_DATE
+;
+; PURPOSE:
+;	This function labels axes with dates and times.
+;
+; CATEGORY:
+;	Plotting.
+;
+; CALLING SEQUENCE:
+;	To set up:
+;		dummy = LABEL_DATE(DATE_FORMAT='string')
+;	To use:
+;		PLOT, x, y, XTICKFORMAT='LABEL_DATE'
+;
+; INPUTS:
+;	No explicit user defined inputs. When called from the plotting
+;	routines, the input parameters are (Axis, Index, Value)
+;
+; KEYWORD PARAMETERS:
+;	DATE_FORMAT: a format string which may contain the following:
+;		       %M for month (3 character abbr)
+;		       %N for month (2 digit abbr)
+;		       %D for day of month,
+;		       %Y for 4 digit year.
+;		       %Z for last two digits of year.
+;	     For time:
+;		       %H for Hours, 2 digits.
+;		       %I for mInutes, 2 digits.
+;		       %S for Seconds, 2 digits.
+;		       %% is %.
+;		     Other characters are passed directly thru.
+;		     For example, '%M %D, %Y' prints DEC 11, 1993
+;		       '%M %2Y' yields DEC 93
+;		       '%D-%M' yields 11-DEC
+;		       '%D/%N/%Y' yields 11/12/1993
+;		       '%M!C%Y' yields DEC on the top line, 1993 on
+;		       the bottom (!C is the new line graphic command).
+;
+;	MONTHS:      The names of the months, a twelve element string array.
+;		     If omitted, use Jan, Feb, ..., Dec.
+;
+;	OFFSET:	     An optional starting offset of the plot.
+;		Unfortunately, single precision floating point is not accurate
+;		enough to properly represent Julian times.  This offset, which
+;		may be double precision, contains an offset that is added to
+;		all x values, before conversion to Julian date and time.
+
+; OUTPUTS:
+;	The date string to be plotted.
+;
+; COMMON BLOCKS:
+;	LABEL_DATE_COM.
+;
+; RESTRICTIONS:
+;	Only one date axis may be simultaneously active.
+;
+; PROCEDURE:
+;	Straightforward.
+;
+;       For an alternative way to label a plot axis with dates, refer to
+;       the C() format code accepted within format strings (applicable via
+;       the [XYZ]TICKFORMAT keywords).  This new format code was 
+;       introduced in IDL 5.2.
+;
+; EXAMPLE:
+;	For example, to plot from Jan 1, 1993, to July 12, 1994:
+;	  Start_date = julday(1, 1, 1993)
+;	  End_date = julday(7, 12, 1994)
+;	  Dummy = LABEL_DATE(DATE_FORMAT='%N/%D')  ;Simple mm/dd
+;	  x = findgen(end_date+1 - start_date) + start_date ;Time axis
+;	  PLOT, x, sqrt(x), XTICKFORMAT = 'LABEL_DATE', XSTYLE=1
+;	  (Plot with X axis style set to exact.)
+;	
+; Example with times:
+;	For example, to plot from 3PM, Jan 1, 1993, to 5AM, Jan 3,
+;	1993:
+;	Start_date = Julday(1,1,1993)   ;Also starting offset
+;	Start_time = (3+12)/24.         ;Starting_time less offset
+;	End_time = (Julday(1,3,1993) - Start_date) + 5./24. ;Ending
+;       	;date/time - offset, note that the order of operations is
+;               ; important to avoid loss of precision.
+;	Dummy = LABEL_DATE(DATE_FORMAT='%D %M!C%H:%I', $
+;		offset=Start_date)       ;MMM NN <new line> HH:MM format
+;	x = findgen(20) * (End_time - Start_time) / 19 + start_time ;Time axis
+;	PLOT, x, sqrt(x), XTICKFORMAT = 'LABEL_DATE', XSTYLE=1
+;
+; MODIFICATION HISTORY:
+;	DMS, RSI.	April, 1993.	Written.
+;	DMS, RSI.	March, 1997.	Added Time format.
+;-
+
+COMMON label_date_com, fmt, month_chr, offset
+
+if keyword_set(format) then begin ;Save format string?
+    if n_elements(offs) ne 0 then offset = double(offs) else offset = 0.0d0
+    if keyword_set(months) then month_chr = months $
+    else month_chr = ['Jan','Feb','Mar', 'Apr', 'May', 'Jun', 'Jul', $
+                      'Aug', 'Sep', 'Oct', 'Nov', 'Dec']
+    fmt = format
+    return, 0
+endif
+
+if n_elements(month_chr) ne 12 or n_elements(fmt) le 0 $
+  or n_elements(offset) eq 0 then $
+  message,' Not initialized.'
+
+x1 = x + offset
+caldat, long(x1), month, day, year, _EXTRA = ex;Get the calendar date from julian
+frac = x1 - long(x1)            ;time of day, from 0 to 1.
+
+n = strlen(fmt)
+out = ''
+
+for i=0, n-1 do begin           ;Each format character...
+    c = strmid(fmt, i, 1)       ;The character.
+    if c eq '%' then begin
+        i = i + 1
+        c = strmid(fmt, i, 1)   ;The function
+        case c of		;format character?
+            'M' : out = out + month_chr[month-1]
+            'N' : out = out + string(format='(i2.2)', month)
+            'D' : out = out + string(format='(i2.2)', day)
+            'Y' : out = out + string(format='(i4)', year)
+            'Z' : out = out + string(format='(i2.2)', year  mod 100)
+            'H' : out = out + string(format='(i2.2)', floor(24*frac))
+            'I' : out = out + string(format='(i2.2)', floor(1440 * frac mod 60))
+            'S' : out = out + string(format='(i2.2)', 86400L * frac mod 60)
+            '%' : out = out + '%'
+            else : message, 'Illegal character in date format string: '+fmt
+        endcase
+    endif else out = out + c
+endfor
+return, out
+end
Index: tags/start/PLOTS/LABEL/label_gmt.pro
===================================================================
--- tags/start/PLOTS/LABEL/label_gmt.pro	(revision 5)
+++ tags/start/PLOTS/LABEL/label_gmt.pro	(revision 5)
@@ -0,0 +1,65 @@
+;
+; Apply GMT palette into IDL color/intervals system
+;
+PRO label_gmt, min, max, intervalle, ncoul, ncontour, level_z2d, coul
+@common
+@com_eg
+
+   IF pal_type NE '2dom' THEN BEGIN 
+
+;  color defined in lec_pal_gmt.pro
+
+      ncontour = ncont_gmt
+      level_z2d = levels_gmt
+      coul = coul_gmt
+      max = max_gmt
+      intervalle =  -1
+
+   ENDIF ELSE BEGIN 
+
+      ; grey_shade palette (case 1 in label)
+      IF finite(min) EQ 0 THEN read, ' Grey shade needs a min,max :', min, max
+      ncontour  = fix((max-min)/intervalle)
+      level_z2d = min + intervalle*findgen(Ncontour) 
+      max=level_z2d(Ncontour-1)+intervalle
+
+      print, '     Number of contour intervals, plotting min & max ', ncontour, min, max
+      print, ' '
+
+      ; color index
+
+      IF idx_pal EQ 0 THEN BEGIN 
+
+         ; build palette
+         red = lonarr(99)
+         red[*] = 255
+         red[50:98] = long((100.-float(grey_shade))/100.*255.)
+
+         IF field.origin EQ 'diff' THEN BEGIN 
+      
+           ; difference plot : lighter below first negative interval
+            red[51:98] = long((100.-float(grey_shade_2))/100.*255.)
+            red(1:48) = long((100.-float(grey_shade))/100.*255.)
+            red[50] = 255
+
+         ENDIF 
+
+         ; first color=black
+         ; last = white
+         red = [0, red]
+         red[99] = 255
+         ; gray scale
+         green = red
+         blue = red
+
+         tvlct, red, green, blue
+
+      ENDIF  
+ 
+      mid_index = max(where(level_z2d LE fldatt.mid))
+      coul = findgen(Ncontour)+49-mid_index +2
+
+   ENDELSE 
+
+
+END 
Index: tags/start/PLOTS/LABEL/lataxe.pro
===================================================================
--- tags/start/PLOTS/LABEL/lataxe.pro	(revision 5)
+++ tags/start/PLOTS/LABEL/lataxe.pro	(revision 5)
@@ -0,0 +1,56 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:LATAXE
+;
+; PURPOSE:fonction appelee par [XYZ]TICKFORMAT (cf l'help pour voir
+;         comment l'utiliser) pour labeller les axes en latitude.
+;
+; CATEGORY:graphe
+;
+; CALLING SEQUENCE:[XYZ]TICKFORMAT='lataxe'
+;
+; INPUTS:fournis (et imposes) automatiquement par IDL: axis, index, value:
+;	Axis is the axis number: 0 for X axis, 1 for Y axis, 2 for Z axis.
+;	Index is the tick mark index which starts at 0.
+;	Value is the default tick mark value (a floating-point number).
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:un string, utilise automatiquement pour labeller
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       ???
+;                       14/10/1999 format des labels
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION lataxe, axis, index, value
+;------------------------------------------------------------
+; on ramenne value ds le segment [0,180]
+   lat=value mod 360
+   if lat lt 0 then lat=lat+360
+   if lat gt 180 then lat=lat-180
+; format des labels:
+   case 1 of
+      lat EQ round(lat):fmt = 'i4'
+      10.*lat EQ round(10.*lat):fmt = 'f6.1'
+      ELSE:fmt = 'f7.2'
+   endcase
+; on ecrit le label
+   if lat le 90 and lat ne 0 then nom=string(lat,     format='('+fmt+',''N'')')
+   if lat gt 90              then nom=string(180-lat, format='('+fmt+',''S'')')
+   if lat eq  0              then nom=string(lat,     format='('+fmt+')')
+;
+   return, nom
+end
+
Index: tags/start/PLOTS/LABEL/lonaxe.pro
===================================================================
--- tags/start/PLOTS/LABEL/lonaxe.pro	(revision 5)
+++ tags/start/PLOTS/LABEL/lonaxe.pro	(revision 5)
@@ -0,0 +1,55 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:LONAXE
+;
+; PURPOSE:fonction appelee par [XYZ]TICKFORMAT (cf l'help pour voir
+;         comment l'utiliser) pour labeller les axes en longitude.
+;
+; CATEGORY:graphe
+;
+; CALLING SEQUENCE:[XYZ]TICKFORMAT='lonaxe'
+;
+; INPUTS:fournis (et imposes) automatiquement par IDL: axis, index, value:
+;	Axis is the axis number: 0 for X axis, 1 for Y axis, 2 for Z axis.
+;	Index is the tick mark index which starts at 0.
+;	Value is the default tick mark value (a floating-point number).
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:un string, utilise automatiquement pour labeller
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       ???
+;                       14/10/1999 format des labels
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION lonaxe, axis, index, value
+;------------------------------------------------------------
+; on ramenne value ds le segment [0,360[
+   lon=value mod 360
+   if lon lt 0 then lon=lon+360
+; format des labels:
+   case 1 of
+      lon EQ round(lon):fmt = 'i4'
+      10.*lon EQ round(10.*lon):fmt = 'f6.1'
+      ELSE:fmt = 'f7.2'
+   endcase
+; on ecrit le label
+   if lon lt 180 then nom=string(lon,     format='('+fmt+',''E'')')
+   if lon gt 180 then nom=string(360-lon, format='('+fmt+',''W'')')
+   if lon eq 180 then nom=string(lon,     format='('+fmt+')')
+;
+   return, nom
+end
+
Index: tags/start/PLOTS/VECTEUR/ajoutvect.pro
===================================================================
--- tags/start/PLOTS/VECTEUR/ajoutvect.pro	(revision 5)
+++ tags/start/PLOTS/VECTEUR/ajoutvect.pro	(revision 5)
@@ -0,0 +1,258 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:ajoutvect
+;
+; PURPOSE:surimprimme des vecteur sur un champ tarce par plt
+;
+; CATEGORY:grafique
+;
+; CALLING SEQUENCE:ajoutvect,vecteur 
+;
+; INPUTS:
+;	vecteur: une structure a 2 elements contenant les 2 matrices U
+;	et V des valeurs de la composante zonale et meridienne du
+;	champ de vecteurs a tracer.
+;       par ex:
+;       vecteur={matriceu:lec('unsurface'),matricev:lec('vnsurface')}
+;       rq:le nom des elements de vecteur n''a aucune importance.
+;       vecteur={u:lec('unsurface'),v:lec('vnsurface')} convient aussi
+;
+; KEYWORD PARAMETERS:
+;
+;	/UNVECTSUR:un scalaire n on un tableau a 2 elements [n1,n2].
+;         dans le premier cas, on tracera un vecteur sur n suivant les
+;         x et les y.
+;         dans le second cas on tracera un vecteur sur n1 suivant x
+;         et un vecteur sur n2 suivant y
+;       Rq; pour tracer tous les vecteurs suivant y et 1 sur 2 suivant
+;       x mettre unvectsur=[2,1]
+;
+;	VECTMIN=norme minimun des vecteurs a tracer 
+;
+;	VECTMAX=norme minimun des vecteurs a tracer 
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro		
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			10/3/1999
+;                       11/6/1999 compatibilite avec NAN et la lecture
+;                       des structures.
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro ajoutvect,vecteur, vectlegende, UNVECTSUR=unvectsur,VECTMIN=vectmin, VECTMAX=vectmax, _EXTRA = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;----------------------------------------------------------------------------
+;
+   u = litchamp(vecteur.(0))
+   u = checkfield(u, 'plt', TYPE = 'xy', /NOQUESTION)
+   v = litchamp(vecteur.(1))
+   v = checkfield(v, 'plt', TYPE = 'xy', /NOQUESTION)
+;         niv=''
+   IF (size(u))[0] EQ 3 THEN BEGIN 
+      niveau = xquestion('Le tableau d''entree est un tableau 3d, a quel niveau faut-il faire les vecteurs? (par defaut le premier niveau) ', strtrim(niveau, 1), /chkwidget)
+      niveau = 1 > fix(niveau) < jpk
+      u=u(*,*,niveau-1)
+      v=v(*,*,niveau-1)
+   endif
+
+;-----------------------------------------------------------
+;------------------------------------------------------------
+; on recupere les eventuelles info sur les champs
+;------------------------------------------------------------
+   grilleu = litchamp(vecteur.(0), /grid)
+   if grilleu EQ '' then grilleu = 'U'
+   grillev = litchamp(vecteur.(1), /grid)
+   if grillev EQ '' then grillev = 'V'
+   IF grilleu EQ 'V' AND grillev EQ 'U' THEN inverse = 1
+   IF grilleu EQ grillev THEN interpolle  = 0 ELSE interpolle = 1
+   if keyword_set(inverse) then begin
+      rien = u
+      u = v
+      v = rien
+   endif
+;------------------------------------------------------------
+; on trouve les points que u et v ont en communs
+;------------------------------------------------------------
+   if interpolle then begin
+      indicexu = (lindgen(jpi))[premierxu:premierxu+nxu-1]
+      indicexv = (lindgen(jpi))[premierxv:premierxv+nxv-1]
+      indicex = inter(indicexu, indicexv)
+      indiceyu = (lindgen(jpj))[premieryu:premieryu+nyu-1]
+      indiceyv = (lindgen(jpj))[premieryv:premieryv+nyv-1]
+      indicey = inter(indiceyu, indiceyv)
+      nx = n_elements(indicex) 
+      ny = n_elements(indicey)
+      indice2d = lindgen(jpi, jpj)
+      indice2d = indice2d[indicex[0]:indicex[0]+nx-1,indicey[0]:indicey[0]+ny-1]
+;------------------------------------------------------------
+; extraction de u et v sur le domaine qui convient
+;------------------------------------------------------------
+      case 1 of
+         (size(u))[0] NE 2 OR (size(v))[0] NE 2: return
+         (size(u))[1] EQ nxu AND (size(u))[2] EQ nyu AND $
+          (size(v))[1] EQ nxv AND (size(v))[2] EQ nyv:BEGIN 
+            if nxu NE nx then $
+             if indicex[0] EQ premierxu then u = u[0:nx-1, *] ELSE u = u[1: nx, *] 
+            IF nxv NE nx THEN $
+             if indicex[0] EQ premierxv then v = v[0:nx-1, *] ELSE v = v[1: nx, *]
+            IF nyu NE ny THEN $
+             if indicey[0] EQ premieryu then u = u[*, 0:ny-1] ELSE u = u[*, 1: ny] 
+            IF nyv NE ny THEN $
+             if indicey[0] EQ premieryv then v = v[*, 0:ny-1] ELSE v = v[*, 1: ny]
+         END
+         (size(u))[1] EQ jpi AND (size(u))[2] EQ jpj AND $
+          (size(v))[1] EQ jpi AND (size(v))[2] EQ jpj:BEGIN 
+            u = u[indice2d]
+            v = v[indice2d]
+         END
+         ELSE:BEGIN 
+            ras = report('problemes d''adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs')
+            return
+         end
+      endcase
+;------------------------------------------------------------------
+; on reform u et v pour s'assurer qu'aucune dimension n'a ete ecrasee
+;------------------------------------------------------------------
+      if ny EQ 1 then begin
+         u = reform(u, nx, ny)
+         v = reform(v, nx, ny)
+      endif
+;------------------------------------------------------------------
+; construction de u et v aux pts T
+;-----------------------------------------------------------
+      a=u(0,*)
+      u=(u+shift(u,1,0))/2.
+      if NOT keyword_set(key_periodique) OR nx NE jpi then u(0,*)=a
+      a=v(*,0)
+      v=(v+shift(v,0,1))/2.
+      if NOT keyword_set(key_periodique) OR nx NE jpi then v(*,0)=a
+;----------------------------------------------------------------------------
+; attribution du mask et des tableau de longitude et latitude
+; on recupere la grille complette pour etablir un grand mask etendu ds les 4
+; directions pour couvrir les points pour lesquels un pt terre a ete pris en
+; compte (faire un petit dessin...)
+;----------------------------------------------------------------------------
+      vargrid='T'
+      msku = (umask())[indice2d+jpi*jpj*(niveau-1)]
+      mskv = (vmask())[indice2d+jpi*jpj*(niveau-1)]
+      glam = glamt[indice2d]
+      gphi = gphit[indice2d]
+      if ny EQ 1 then begin
+         msku = reform(msku, nx, ny)
+         mskv = reform(mskv, nx, ny)
+;          glam = reform(glam, nx, ny)
+;          gphi = reform(gphi, nx, ny)
+      endif
+;-----------------------------------------------------------
+; on masque u et v le long des cotes (la on l''on ne peut pas calculer
+; la moyenne)
+;-----------------------------------------------------------
+; extention du mask
+      u = u*msku*shift(msku,1,0)
+      v = v*mskv*shift(mskv,0,1)
+   ENDIF ELSE BEGIN 
+      u = u*tmask[premierxt:dernierxt,premieryt:dernieryt,premierzt]
+      v = v*tmask[premierxt:dernierxt,premieryt:dernieryt,premierzt]
+      indice2d = lindgen(jpi, jpj)
+      indice2d = indice2d[premierxt:dernierxt, premieryt:dernieryt]
+      nx = nxt
+      ny = nyt
+   endelse
+   tabnorme=sqrt(u^2+v^2)
+   nan = where(finite(u, /nan) EQ 1)
+   if nan[0] NE -1 then u[nan] = 1e5
+   nan = where(finite(v, /nan) EQ 1)
+   if nan[0] NE -1 then v[nan] = 1e5
+   if keyword_set(vectmin) then BEGIN 
+      troppetit=where(tabnorme lt vectmin)
+      if troppetit[0] NE -1 then begin
+         u[troppetit] = 1e5
+         v[troppetit] = 1e5
+      ENDIF
+   endif
+   if keyword_set(vectmax) then BEGIN
+      tropgrand=where(tabnorme gt vectmax)
+      if tropgrand[0] NE -1 then begin
+         u[tropgrand] = 1e5
+         v[tropgrand] = 1e5
+      ENDIF
+   ENDIF
+;-----------------------------------------------------------
+; remise d''une grande valeur sur tous les points pour lesquelles on ne
+; put faire le calcul
+;-----------------------------------------------------------
+   if interpolle then t2 = msku*shift(msku,1,0)*mskv*shift(mskv,0,1) $
+   ELSE t2 = tmask[premierxt:dernierxt,premieryt:dernieryt,premierzt]
+   if NOT keyword_set(key_periodique) OR nx NE jpi then t2(0, *)=0.
+   t2(*,0)=0.
+   terre=where(t2 eq 0)
+   if terre[0] ne -1 then begin
+      u(terre)=1e5
+      v(terre)=1e5
+   ENDIF
+;-----------------------------------------------------------
+; tracer qu'un vecteur sur
+;-----------------------------------------------------------
+   if keyword_set(unvectsur) then BEGIN ;
+; indx est un vecteur contenant les numero des colonnes a selectionner 
+; indy est un vecteur contenant les numero des lignes a selectionner 
+      if n_elements(unvectsur) EQ 1 then begin
+         indx = where((lindgen(nx) MOD unvectsur[0]) eq 0)
+         indy = where((lindgen(ny) MOD unvectsur[0]) eq 0)
+      ENDIF ELSE BEGIN 
+         indx = where((lindgen(nx) MOD unvectsur[0]) eq 0)
+         indy = where((lindgen(ny) MOD unvectsur[1]) eq 0)
+      ENDELSE
+; a partir de indx et indy on va construire un tableau d''indices 2d
+; qui donnera les indices des points intersections des colonnes
+; specifiee par indx 
+      indicereduit = indx#replicate(1,n_elements(indy))+nx*replicate(1,n_elements(indx))#indy
+; on reduit les tableaux qui vont etre passes a vecteur.
+      u = u[indicereduit]
+      v = v[indicereduit]
+      tabnorme = tabnorme[indicereduit]
+;
+   endif
+;-----------------------------------------------------------
+; 
+;-----------------------------------------------------------
+   if keyword_set(inverse) then begin
+      rien = u
+      u = v
+      v = rien
+   endif
+;-----------------------------------------------------------
+; trace des vecteurs
+;----------------------------------------------------------
+   vecteur, u, v, tabnorme, indice2d, indicereduit, missing=1e5, _extra = ex
+;-----------------------------------------------------------
+; on complete la legende
+;-----------------------------------------------------------
+   if terre[0] ne -1 then mini = min(tabnorme[where(t2 eq 1)], max = maxi, /nan) $
+   ELSE mini = min(tabnorme, max = maxi, /nan)
+   
+   if litchamp(vecteur.(0), /u) NE '' then $
+    vectlegende = {minmax:[mini, maxi], unite:litchamp(vecteur.(0), /u)} $
+   ELSE vectlegende = {minmax:[mini, maxi], unite:varunit}
+
+
+sortie:
+   if keyword_set(key_performance) NE 0 THEN print, 'temps ajoutvect', systime(1)-tempsun 
+   return
+end
+
+
Index: tags/start/PLOTS/VECTEUR/vecteur.pro
===================================================================
--- tags/start/PLOTS/VECTEUR/vecteur.pro	(revision 5)
+++ tags/start/PLOTS/VECTEUR/vecteur.pro	(revision 5)
@@ -0,0 +1,428 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:vecteur
+;
+; PURPOSE: trace des vecteurs (meme situees sur une grille tordue) sur
+; n''importe quelle projection, de telle sorte que tous les vecteurs
+; aient une norme comparable sur le dessin (en clair, un vecteur qui
+; doit faire 1cm le fait quelque soit la projection et sa position sur
+; la sphere) 
+;
+; CATEGORY:trace de vecteur
+;
+; CALLING SEQUENCE:vecteur, composanteu, composantev, normevecteur, indice2d, reduitindice2d
+; 
+; INPUTS: COMPOSANTEU et COMPOSANTEV: ce sont les composantes des
+; vecteurs a tracer. Ces tableaux 2d ont la meme dimension que
+; reduitindice2d (cf apres).
+;       INDICE2D: indice permettant de passer d''un tableau jpi,jpj au
+;       zoom surlequel on fait le dessin.
+;       REDUITINDICE2D: indice permettant de passer d''un tableau
+;       definit par indice2d au tableau pourlequel on a reelement des
+;       vecteurs a tracer (en clair: c''est par ex qd on ne trace par exemple
+;       que un vecteur sur 2)
+;
+; KEYWORD PARAMETERS:
+;
+;      CMREF: la longeur en cm sur le papier que diot faire la fleche
+;      de norme normeref. par defaut ajuste au dessin et compris entre
+;      .5 et 1.5 cm
+;
+;      MISSING: la valeur d''une missing value. ne pas utilisder ce
+;      mot cle. fixe a 1e5 par ajoutvect.pro
+;      
+;      NORMEREF: la norme de la fleche de reference. par defaut on
+;      essaie de faire qqch qui colle pas trop mal!
+;
+;      VECTCOLOR: la couleur de la fleche. Par defaut noir (couleur 0)
+;
+;      VECTTHICK; l''epaissuer de la fleche. par defaut 1.
+;
+;      VECTREFPOS: vecteur de 2 elements specifiant la position en
+;      coordonnees DATA du debut du vecteur de reference. Par defaut
+;      en bas a droite du dessin.
+;
+;      VECTREFFORMAT: format a utiliser pour specifier la norme du
+;      vecteur de reference.
+;
+;      /NOVECTREF: pour supprimer l'affichage du vecteur de reference.
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:
+;  Creation : 13/02/98 G. Roullet (grlod@lodyc.jussieu.fr)
+;  Modification : 14/01/99 realise la transformation
+;  spherique<->cartesien G. Roullet
+;                 12/03/99 verification de la routine G. Roullet
+;  8/11/1999:
+;  G. Roullet et Sebastien Masson (smasson@lodyc.jussieu.fr)
+;  adaptation pour les zoom. reverification...traitement separe de la
+;  direction et de la norme des vecteurs. mots cles NORMEREF et CMREF.
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+
+FUNCTION cv_cm2normal, angle
+;
+; donne la longeur en coordonnes normales d''un trait ortiente de
+; angle par rapport a l''axe des x et qui doit faire 1 cm sur le
+; dessin.
+; angle peut etre un tableau.
+;
+@common
+; quelle est la longeur en coordonnees normales d''un trait qui fera 1
+; cm sur le parier et qui est parallele a x?
+   sizexfeuille = petitfeuille*key_portrait+grandfeuille*(1-key_portrait)
+   sizeyfeuille = grandfeuille*key_portrait+petitfeuille*(1-key_portrait)
+   cm_en_normal = 1./sizexfeuille
+;
+;  si le rapport d''aspect de la fenetre n''est pas egale a 1, la
+;  longeur en coordonees normalise d''un trait de 1cm varie suivant
+;  l''angle polaire de ce trait.
+;
+   aspect = sizexfeuille/sizeyfeuille
+   cm_en_normal = cm_en_normal*sqrt( 1 +(aspect^2-1)*sin(angle)^2 )
+;
+   return, cm_en_normal
+END
+;
+PRO normalise, u, v, w
+;
+; normalise le vecteur
+;
+   IF n_elements(w) NE 0 THEN BEGIN 
+      norme = sqrt(u^2.+v^2.+w^2.)
+      ind = where(norme NE 0)
+      u(ind) = u(ind)/norme[ind]
+      v(ind) = v(ind)/norme[ind]
+      w(ind) = w(ind)/norme[ind]
+   ENDIF ELSE BEGIN
+      norme = sqrt(u^2.+v^2.)
+      ind = where(norme NE 0)
+      u(ind) = u(ind)/norme[ind]
+      v(ind) = v(ind)/norme[ind]
+   ENDELSE 
+END
+PRO vecteur, composanteu, composantev, normevecteur, indice2d, reduitindice2d $
+             , CMREF = cmref, MISSING = missing, NORMEREF = normeref $
+             , VECTCOLOR = vectcolor, VECTTHICK = vectthick, VECTREFPOS = vectrefpos $
+             , VECTREFFORMAT = vectrefformat, NOVECTREF = novectref, _extra = extra
+@common
+   tempsun = systime(1)         ; pour key_performance
+;
+;
+   taille = size(composanteu)
+   nx = taille[1]
+   ny = taille[2]
+   if n_elements(reduitindice2d) EQ 0 then reduitindice2d = lindgen(nx, ny)
+   zu = composanteu
+   zv = composantev
+   norme = normevecteur
+   taille = size(indice2d)
+   nxgd = taille[1]
+   nygd = taille[2]
+;
+   msk = replicate(1, nx, ny)
+   if keyword_set(missing) then terre = where(abs(zu) GE missing/10) ELSE terre = -1
+   if terre[0] NE -1  then BEGIN 
+      msk[terre] = 0
+      zu[terre] = 0
+      zv[terre] = 0
+      norme[terre] = 0
+   ENDIF
+;
+; Etape 1: 
+;
+; etant donne la direction et le sens que le vecteur a sur la
+; sphere, il faut se debrouiller pour determiner cette direction et le
+; sens qu'aura le vecteur sur l''ecran ou la feuille une fois qu''il
+; aura ete projete.
+;
+; En theorie: sur la sphere, un vecteur en un point donne a pour
+; direction la tangente au cercle qui passe par le centre de la terre
+; et par le vecteur. Donc trouver la direction une fois la projection
+; faite ds le plan 2d, c''est trouver la tangente a la courbe
+; representant la projection du cercle sur le plan 2d au point
+; representant la projection du point de depart de la shere sur le
+; plan 2d!!!
+;
+; En pratique on ne connait pas la definition de la courbe que donne
+; la projection d''un cercle alors trouver sa tangente en un point...
+;
+; Ce que l''on fait:
+; Ds un repere cartesien 3d, 
+;       a) on trouve les coordonnees du point T (debut de la fleche)
+;       situe sur la shere.
+;       b) pour chaque point T on determine les directions locales
+;       definies par la grille en ce point et auxquelles se rapportent
+;       les coordonnes (u,v) du vecteur. Ces directions locales sont
+;       definies par les gradiants des glam et gphi. Une fois ces
+;       directions obtenues, on les considere comme orthogonales et en
+;       les normant on construit un repere orthonormal (nu,nv) auquel se
+;       rapporte les coordonnes (u,v) du vecteur. Ds le repere
+;       cartesien 3d de depart, le vecteur est definit par:
+;       V=u*nu+v*nv (ou V, nu et nv sont des vecteurs 3d et u et v des
+;       scalaires)
+;       c) pour approximer la tangente au cercle par la corde definie
+;       par le debut et la fin de la fleche, on va normaliser V puis
+;       le diviser par 100.
+;       d) ceci nous permet de determiner les coordonnees ds le repere
+;       cartesien 3d des extremites de la corde, on les passe en
+;       coordonnes sphereriques de facon a recuperer les positions en
+;       latitude longitude de ces points sur la sphere.
+;       e) on passe les coordonnees de ces points en coordonnees
+;       normalise puis en corrdonnes polaire de facon a trouver
+;       l''angle et la direction qu''ils determinent sur le dessin...
+;
+;
+; etape 1, a)
+;
+;
+; coordonnes du point T (debut de la fleche) en coordonnes sheriques
+   glam = glamt[indice2d[reduitindice2d]]
+   gphi = gphit[indice2d[reduitindice2d]]
+;
+; coordonnes du point T (debut de la fleche) dans le repere cartesien
+; on utilise comme shere, une shere de rayon 1.
+;
+   radius = replicate(1,nx*ny)
+   coord_sphe = transpose([ [glam[*]], [gphi[*]], [radius[*]] ])
+   r = cv_coord(from_sphere=coord_sphe,/to_rect,/degrees)
+;
+   x0 = reform(r(0, *), nx, ny)
+   y0 = reform(r(1, *), nx, ny)
+   z0 = reform(r(2, *), nx, ny)
+;
+; etape 1, b)
+;
+; Construction du vecteur nu (resp. nv), vecteur norme porte par
+; l''axe des points u(i,j) et u(i-1,j) (resp v(i,j) et v(i,j-1))
+; qui definissent pour chaque point sur la shere les directions locales
+; associee a u et v. ces vecteurs definissent un repere orthonorme
+; local. 
+; ces vecteurs sont construits dans un repere cartesien (cv_coord)
+; on a choisit un rayon de la terre unite (unit).
+;
+; definition de nu
+   radius = replicate(1,nxgd*nygd)
+   coord_sphe = transpose([ [(glamu[indice2d])[*]], [(gphiu[indice2d])[*]], [radius(*)] ])
+   r = cv_coord(from_sphere=coord_sphe,/to_rect,/degrees)
+; coordonnes de points de la grille u en cartesien
+   ux = reform(r(0, *), nxgd, nygd)
+   uy = reform(r(1, *), nxgd, nygd)
+   uz = reform(r(2, *), nxgd, nygd)
+; calcul de nu 
+   nux = ux-shift(ux, 1, 0)
+   nuy = uy-shift(uy, 1, 0)
+   nuz = uz-shift(uz, 1, 0)
+; conditions aux limites
+   if NOT keyword_set(key_periodique) OR nxgd NE jpi then begin
+      nux[0, *] = nux[1, *]
+      nuy[0, *] = nuy[1, *]
+      nuz[0, *] = nuz[1, *]
+   ENDIF
+; reduction de la grille
+   nux = nux[reduitindice2d]
+   nuy = nuy[reduitindice2d]
+   nuz = nuz[reduitindice2d]
+; definition de nv
+   coord_sphe = transpose([ [(glamv[indice2d])[*]], [(gphiv[indice2d])[*]], [radius(*)] ])
+   r = cv_coord(from_sphere=coord_sphe,/to_rect,/degrees)
+; coordonnes de points de la grille v en cartesien
+   vx = reform(r(0, *), nxgd, nygd)
+   vy = reform(r(1, *), nxgd, nygd)
+   vz = reform(r(2, *), nxgd, nygd)
+; calcul de nv 
+   nvx = vx-shift(vx, 0, 1)
+   nvy = vy-shift(vy, 0, 1)
+   nvz = vz-shift(vz, 0, 1)
+; conditions aux limites
+   nvx[*, 0] = nvx[*, 1]
+   nvy[*, 0] = nvy[*, 1]
+   nvz[*, 0] = nvz[*, 1]
+; reduction de la grille
+   nvx = nvx[reduitindice2d]
+   nvy = nvy[reduitindice2d]
+   nvz = nvz[reduitindice2d]
+;
+; normalisation
+;
+   normalise, nux, nuy, nuz
+   normalise, nvx, nvy, nvz
+;
+; etape 1, c)
+;
+; coordonnes du vecteur V ds le repere cartesion
+;
+   direcx = zu*nux + zv*nvx
+   direcy = zu*nuy + zv*nvy
+   direcz = zu*nuz + zv*nvz
+; normalisation du vecteur v
+   normalise, direcx, direcy, direcz
+; on divise par 100.
+   direcx = direcx/100.
+   direcy = direcy/100.
+   direcz = direcz/100.
+;
+; etape 1, d)
+; coordonnees de la pointe de la fleche dans le repere cartesien
+
+   x1 = x0 + direcx
+   y1 = y0 + direcy
+   z1 = z0 + direcz
+
+; coordonnees de la pointe en spherique
+
+   coord_rect = transpose([ [x1(*)], [y1(*)], [z1(*)] ])
+   r = cv_coord(from_rect=coord_rect,/to_sphere,/degrees)
+   glam1 = reform(r(0, *), nx, ny)
+   gphi1 = reform(r(1, *), nx, ny)
+
+;
+; modif des glam tout se passe bien au niveau de la ligne de
+; changement de date...attention, il ne faut pas couper les fleches
+; qui sortent de la fenetre!
+; test: si il sort du cadre mais qu''avec un +/- 360 il y rentre on le
+; modifie...
+;
+   ind = where(glam1 LT !x.range[0] AND glam1+360. LE !x.range[1])
+   if ind[0] NE -1 then glam1(ind) = glam1(ind)+360.
+   ind = where(glam1 GT !x.range[1] AND glam1-360. GE !x.range[0])
+   if ind[0] NE -1 then glam1(ind) = glam1(ind)-360.
+
+   ind = where(glam LT !x.range[0] AND glam+360. LE !x.range[1])
+   if ind[0] NE -1 then glam(ind) = glam(ind)+360.
+   ind = where(glam  GT !x.range[1] AND glam-360. GE !x.range[0])
+   if ind[0] NE -1 then glam(ind) = glam(ind)-360.
+;
+;
+; etape 1, e)
+;
+   r = convert_coord(glam,gphi,/data,/to_normal) 
+   x0 = r(0, *)                 ; coordonnes normales du debut de la fleche
+   y0 = r(1, *)                 ; 
+   
+   r = convert_coord(glam1,gphi1,/data,/to_normal) 
+   x1 = r(0, *)                 ; coordonnes normales de la fin de la fleche (avant scaling)
+   y1 = r(1, *)                 ; 
+;
+; tests pour eviter que des fleches soient dessineees hors du domaine
+;
+   out = where(x0 LT !p.position[0] OR x0 GT !p.position[2]  $
+               OR y0 LT !p.position[1] OR y0 GT !p.position[3])
+   if out[0] NE -1 THEN x0[out] = !values.f_nan
+;
+; suivant les projections, il peu y a voir des points a nan qd on
+; passe en coordonnes normales. on supprime ces points.
+;
+   nan = finite(x0*y0*x1*y1)
+   number = where(nan EQ 1)
+   x0 = x0[number] & x1 = x1[number]
+   y0 = y0[number] & y1 = y1[number]
+   msk = msk[number]
+   norme = norme[number]
+;
+; on definit le vecteur direction dans le repere normalise
+;
+   dirx = x1-x0
+   diry = y1-y0
+;
+; on passe en polaire pour recuperer l''angle qui etait le but de
+; toute la partie 1!!!
+;
+
+   dirpol = cv_coord(from_rect = transpose([ [dirx[*]], [diry[*]] ]), /to_polar)
+   dirpol = msk*dirpol[0, *]
+;
+; 2eme etape....
+;
+; maintenant on s''occupe de la norme...
+;
+; Mise a l''echelle automatique
+;
+   if NOT keyword_set(cmref) then BEGIN 
+      sizexfeuille = petitfeuille*key_portrait+grandfeuille*(1-key_portrait)
+      sizexfeuille = 10.*sizexfeuille
+      cmref = 5 > floor(sizexfeuille/10.) < 15
+      cmref = cmref/10.
+   ENDIF
+   if NOT keyword_set(normeref) then BEGIN
+      value = max(norme)
+      puissance10 = 10.^floor(alog10(value))
+      normeref = puissance10*floor(value/puissance10)
+   endif
+   cm = 1.*normeref/cmref
+;
+; on modifie le tableau norme de facon a ce que un element qui a la
+; valeur cm soit represente par un trait de longueur 1cm sur le
+; papier.
+; norme contient la norme des vecteur que l''on veut dessiner
+;
+   norme = 1/(1.*cm)*norme*cv_cm2normal(dirpol)
+;
+;
+; 3eme etape....
+; maintenant qu''on a l''angle et la norme, et bien on recupere les
+; coordonnes en rectangulaire et on dessine les fleches.
+;
+   r = cv_coord(from_polar = transpose([ [dirpol[*]], [norme[*]] ]), /to_rect)
+   composantex = r(0, *)
+   composantey = r(1, *)
+;
+   x1 = x0+composantex
+   y1 = y0+composantey
+;
+; c''est parti pour le trace !
+;
+   if NOT KEYWORD_SET(vectcolor) then vectcolor = 0
+
+   points = where(msk EQ 1)
+   IF points[0] NE -1 THEN arrow, x0(points), y0(points), x1(points), y1(points), /norm $
+    , hsize = -.2, COLOR = vectcolor, THICK = vectthick
+;
+;  Dessine une fleche en bas a droite de la figure en guise de legende
+;
+   if NOT keyword_set(novectref) then BEGIN
+      dx = cmref*cv_cm2normal(0) ; longuer du vecteur de reference en coordonnes normalisees.
+      if keyword_set(vectrefformat) then $
+       normelegende = strtrim(string(normeref, format = vectrefformat), 1)+' ' $
+      ELSE normelegende = strtrim(normeref, 1)+' '
+;
+      if keyword_set(vectrefpos) then begin
+         r = convert_coord(vectrefpos,/data, /to_normal)
+         x0 = r[0]
+         y0 = r[1]
+      ENDIF ELSE BEGIN
+         x0 = !x.window[1]-dx
+         r = convert_coord(!d.x_ch_size, !d.y_ch_size, /device, /to_normal)
+         dy = 3*r[1]*!p.charsize
+         y0 = !y.window[0]-dy
+      ENDELSE
+
+      arrow, x0, y0, x0+dx, y0, /norm, hsize = -.2, color = 0
+      xyouts, x0, y0, normelegende, /norm, align = 1, charsize = !p.charsize, color = 0
+
+   endif
+;
+;
+
+   if keyword_set(key_performance) NE 0 THEN print, 'temps vecteur', systime(1)-tempsun 
+;------------------------------------------------------------
+;------------------------------------------------------------
+   return
+END 
+
+
+
+
Index: tags/start/PLOTS/VECTEUR/velovect.pro
===================================================================
--- tags/start/PLOTS/VECTEUR/velovect.pro	(revision 5)
+++ tags/start/PLOTS/VECTEUR/velovect.pro	(revision 5)
@@ -0,0 +1,186 @@
+; $Id$
+;
+; Copyright (c) 1983-1998, Research Systems, Inc.  All rights reserved.
+;	Unauthorized reproduction prohibited.
+
+PRO VELOVECT,U,V,X,Y, Missing = Missing, Length = length, Dots = dots,  $
+        Color=color, CLIP=clip, NOCLIP=noclip, OVERPLOT=overplot, _EXTRA=extra
+;
+;+ 
+; NAME:
+;	VELOVECT
+;
+; PURPOSE:
+;	Produce a two-dimensional velocity field plot.
+;
+;	A directed arrow is drawn at each point showing the direction and 
+;	magnitude of the field.
+;               
+; CATEGORY:
+;	Plotting, two-dimensional.
+;
+; CALLING SEQUENCE:
+;	VELOVECT, U, V [, X, Y]
+;
+; INPUTS:
+;	U:	The X component of the two-dimensional field.  
+;		U must be a two-dimensional array.
+;
+;	V:	The Y component of the two dimensional field.  Y must have
+;		the same dimensions as X.  The vector at point [i,j] has a 
+;		magnitude of:
+;
+;			(U[i,j]^2 + V[i,j]^2)^0.5
+;
+;		and a direction of:
+;
+;			ATAN2(V[i,j],U[i,j]).
+;
+; OPTIONAL INPUT PARAMETERS:
+; 	X:	Optional abcissae values.  X must be a vector with a length 
+;		equal to the first dimension of U and V.
+;
+;	Y:	Optional ordinate values.  Y must be a vector with a length
+;		equal to the first dimension of U and V.
+;
+; KEYWORD INPUT PARAMETERS:
+;	COLOR:	The color index used for the plot.
+;
+;	DOTS:	Set this keyword to 1 to place a dot at each missing point. 
+;		Set this keyword to 0 or omit it to draw nothing for missing
+;		points.  Has effect only if MISSING is specified.
+;
+;	LENGTH:	Length factor.  The default of 1.0 makes the longest (U,V)
+;		vector the length of a cell.
+;
+;       MISSING: Missing data value.  Vectors with a LENGTH greater
+;		than MISSING are ignored.
+;
+;       OVERPLOT: Set this keyword to make VELOVECT "overplot".  That is, the
+;               current graphics screen is not erased, no axes are drawn, and
+;               the previously established scaling remains in effect.
+;
+;
+;	Note:   All other keywords are passed directly to the PLOT procedure
+;		and may be used to set option such as TITLE, POSITION, 
+;		NOERASE, etc.
+; OUTPUTS:
+;	None.
+;
+; COMMON BLOCKS:
+;	None.
+;
+; SIDE EFFECTS:
+;	Plotting on the selected device is performed.  System
+;	variables concerning plotting are changed.
+;
+; RESTRICTIONS:
+;	None.
+;
+; PROCEDURE:
+;	Straightforward.  Unrecognized keywords are passed to the PLOT
+;	procedure.  
+;
+; MODIFICATION HISTORY:
+;	DMS, RSI, Oct., 1983.
+;	For Sun, DMS, RSI, April, 1989.
+;	Added TITLE, Oct, 1990.
+;	Added POSITION, NOERASE, COLOR, Feb 91, RES.
+;	August, 1993.  Vince Patrick, Adv. Visualization Lab, U. of Maryland,
+;		fixed errors in math.
+;	August, 1993. DMS, Added _EXTRA keyword inheritance.
+;	January, 1994, KDB. Fixed integer math which produced 0 and caused
+;		            divide by zero errors.
+;	December, 1994, MWR. Added _EXTRA inheritance for PLOTS and OPLOT.
+;	June, 1995, MWR. Removed _EXTRA inheritance for PLOTS and changed
+;			 OPLOT to PLOTS.
+;       September, 1996, GGS. Changed denominator of x_step and y_step vars. 
+;       February, 1998, DLD.  Add support for CLIP and NO_CLIP keywords.
+;       June, 1998, DLD.  Add support for OVERPLOT keyword.
+;-
+;
+        on_error,2                      ;Return to caller if an error occurs
+        s = size(u)
+        t = size(v)
+        if s[0] ne 2 then begin 
+baduv:   message, 'U and V parameters must be 2D and same size.'
+                endif
+        if total(abs(s[0:2]-t[0:2])) ne 0 then goto,baduv
+;
+        if n_params(0) lt 3 then x = findgen(s[1]) else $
+                if n_elements(x) ne s[1] then begin
+badxy:                  message, 'X and Y arrays have incorrect size.'
+                        endif
+        if n_params(1) lt 4 then y = findgen(s[2]) else $
+                if n_elements(y) ne s[2] then goto,badxy
+;
+        if n_elements(missing) le 0 then missing = 1.0e30
+        if n_elements(length) le 0 then length = 1.0
+
+        mag = sqrt(u^2.+v^2.)             ;magnitude.
+                ;Subscripts of good elements
+        nbad = 0                        ;# of missing points
+        if n_elements(missing) gt 0 then begin
+                good = where(mag lt missing) 
+                if keyword_set(dots) then bad = where(mag ge missing, nbad)
+        endif else begin
+                good = lindgen(n_elements(mag))
+        endelse
+
+        ugood = u[good]
+        vgood = v[good]
+        x0 = min(x)                     ;get scaling
+        x1 = max(x)
+        y0 = min(y)
+        y1 = max(y)
+	x_step=(x1-x0)/(s[1]-1.0)   ; Convert to float. Integer math
+	y_step=(y1-y0)/(s[2]-1.0)   ; could result in divide by 0
+
+	maxmag=max([max(abs(ugood/x_step)),max(abs(vgood/y_step))])
+	sina = length * (ugood/maxmag)
+	cosa = length * (vgood/maxmag)
+;
+        if n_elements(title) le 0 then title = ''
+        ;--------------  plot to get axes  ---------------
+        if n_elements(color) eq 0 then color = !p.color
+        if n_elements(noclip) eq 0 then noclip = 1
+        x_b0=x0-x_step
+	x_b1=x1+x_step
+	y_b0=y0-y_step
+	y_b1=y1+y_step
+        if (not keyword_set(overplot)) then begin
+          if n_elements(position) eq 0 then begin
+            plot,[x_b0,x_b1],[y_b1,y_b0],/nodata,/xst,/yst, $
+              color=color, _EXTRA = extra
+          endif else begin
+            plot,[x_b0,x_b1],[y_b1,y_b0],/nodata,/xst,/yst, $
+              color=color, _EXTRA = extra
+          endelse
+        endif
+        if n_elements(clip) eq 0 then $
+            clip = [!x.crange[0],!y.crange[0],!x.crange[1],!y.crange[1]]
+;
+        r = .3                          ;len of arrow head
+        angle = 22.5 * !dtor            ;Angle of arrowhead
+        st = r * sin(angle)             ;sin 22.5 degs * length of head
+        ct = r * cos(angle)
+;
+        for i=0,n_elements(good)-1 do begin     ;Each point
+                x0 = x[good[i] mod s[1]]        ;get coords of start & end
+                dx = sina[i]
+                x1 = x0 + dx
+                y0 = y[good[i] / s[1]]
+                dy = cosa[i]
+                y1 = y0 + dy
+		xd=x_step
+		yd=y_step
+                plots,[x0,x1,x1-(ct*dx/xd-st*dy/yd)*xd, $
+			x1,x1-(ct*dx/xd+st*dy/yd)*xd], $
+                      [y0,y1,y1-(ct*dy/yd+st*dx/xd)*yd, $
+			y1,y1-(ct*dy/yd-st*dx/xd)*yd], $
+                      color=color,clip=clip,noclip=noclip, _EXTRA = extra
+                endfor
+        if nbad gt 0 then $             ;Dots for missing?
+                PLOTS, x[bad mod s[1]], y[bad / s[1]], psym=3, color=color, $
+                       clip=clip,noclip=noclip, _EXTRA = extra
+end
Index: tags/start/PLOTS/axe.pro
===================================================================
--- tags/start/PLOTS/axe.pro	(revision 5)
+++ tags/start/PLOTS/axe.pro	(revision 5)
@@ -0,0 +1,271 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:axe
+;
+; PURPOSE:gerre les axes pour les differents dessins crees par plt,
+; pltz et pltt
+;
+; CATEGORY:environnement graphique
+;
+; CALLING SEQUENCE:axe,coupe[,tempsmin,tempsmax]
+;
+; INPUTS:
+;        coupe: un string qui designe le type de coupe auquel doit de
+;        raporter les axes que l''on cree. par ex: 'xy','xt'...
+;
+;        tempsmin et tempsmax: ds le cas ou l''on fait une coupe
+;        contenant la dimension temps, il faut specifier le debut et
+;        la fin de l''axe des temps en jours julien.
+;
+; KEYWORD PARAMETERS: /SIN active qd on trace en sinus de la latitude
+;
+;        SEPDATE: string separant les differents constituants de la
+;        date. Par defaut c''est un retour a la ligne qd on fait un
+;        'yt', 'zt' ou 't' dans les autres cas c''est un blanc. 
+;
+; OUTPUTS:les variables globales d''environnement graphique: !x. et !y.
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:modifie !x. et !y.
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       11/12/98
+;                       Eric Guilyardi types x,y,z + amelioration de
+;                       l''axe temporel
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO axe, coupe,tempsmin,tempsmax, REVERSE_X = reverse_x, REVERSE_Y = reverse_y, SIN = sin, SEPDATE = sepdate, _EXTRA = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;--------------------------------------------------------------
+; gestion des ticks de l'axe des temps ds le ces ou tempsmin et
+; tempsmax sont definits
+;--------------------------------------------------------------
+   divday = 0
+   if n_params() EQ 3 then BEGIN
+;
+      if keyword_set(sepdate) then sep = sepdate ELSE $
+       if coupe EQ 'yt' OR coupe EQ 'zt' OR coupe EQ 't' then sep = '!C' ELSE sep = ' '
+;
+      caldat,tempsmin, mmin, dmin, ymin, hmin, mnmin, smin, _EXTRA = ex
+      caldat,tempsmax, mmax, dmax, ymax, hmax, mnmax, smax, _EXTRA = ex
+
+
+      if ymax EQ ymin then BEGIN
+         if mmin ne mmax then BEGIN
+; meme annee mais plusieurs mois
+            nticks = mmax-mmin+1
+            ticknom = lonarr(nticks)
+            for m = 0,nticks-1 do ticknom[m] = julday(m+mmin, 1, ymin, _EXTRA = ex)
+            tminor = 6
+            datfmt = '%M'+sep+'%Z'
+; on verifie que les labels rentrent bien entre tempsmin et tempsmax...
+            ticknom = ticknom[where(ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE -1)]
+            nticks = n_elements(ticknom)
+; cas particulier ou l''on est a cheval sur 2 mois
+            if nticks LE 1 then begin
+               nticks = (dmax+jourdsmois(mmin, ymin)-dmin+1)/2
+               ticknom = lonarr(nticks)
+               for d = 0,nticks-1 do ticknom[d] = julday(mmin, d*2+dmin, ymin, _EXTRA = ex)
+               ticknom = ticknom[where(ticknom GE tempsmin AND ticknom LE tempsmax $
+                                       AND ticknom NE -1)]
+               nticks = n_elements(ticknom)
+               tminor = 2
+               datfmt = '%D'+sep+'%M'
+            endif
+         ENDIF ELSE BEGIN 
+; meme annee et meme mois
+            IF dmax-dmin+1 GT 4 THEN BEGIN ; more than 4 days
+               nticks = dmax-dmin+1
+               ticknom = lonarr(nticks)
+               for d = 0,nticks-1 do ticknom[d] = julday(mmin, d+dmin, ymin, _EXTRA = ex)
+               ticknom = ticknom[where(ticknom GE tempsmin AND ticknom LE tempsmax $
+                                       AND ticknom NE -1)]
+               nticks = n_elements(ticknom)
+               tminor = 2
+               datfmt = '%D'+sep+'%M'
+            ENDIF ELSE BEGIN    ; less than 4 days : divday ticks per day
+               divday = 4
+               nticks = (dmax-dmin)*divday + 1
+               ticknom = fltarr(nticks)
+               for d = 0,nticks-1 do $
+                ticknom[d] = julday(mmin, d/divday+dmin, ymin, _EXTRA = ex) $
+                +(d MOD divday)/float(divday)
+               tminor = 2
+               datfmt = '%H:00'
+            ENDELSE 
+         ENDELSE 
+      ENDIF ELSE BEGIN 
+; plusieurs annees
+         CASE 1 OF
+         ymax-ymin+1 LE 10: BEGIN & freq = 1. & tminor = 12 & datfmt = '%M'+sep+'%Z' & end
+         ymax-ymin+1 LE 20: BEGIN & freq = 2. & tminor = 6 & datfmt = '%M'+sep+'%Z' & end
+         ymax-ymin+1 LE 50: BEGIN & freq = 5. & tminor = 5 & datfmt = '%M'+sep+'%Z' & end
+         ymax-ymin+1 LE 100: BEGIN & freq = 10. & tminor = 10 & datfmt = '%Z' & end
+         ELSE : BEGIN & freq = 20 & tminor = 20 & datfmt = '%Y' & end
+         ENDCASE 
+         nticks = floor((ymax-ymin)/freq)+1
+         IF floor((ymin)/freq) NE (ymin)/freq THEN $
+          yminf = (floor(ymin/freq)+1)*freq ELSE  $
+          yminf = (floor(ymin/freq))*freq
+         ticknom = lonarr(nticks)
+         for y = 0, nticks-1 do ticknom[y] = julday(1, 1, yminf+(y*freq), _EXTRA = ex)
+; on verifie que les labels rentrent bien entre tempsmin et tempsmax...
+         ticknom = ticknom[where(ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE -1)]
+         nticks = n_elements(ticknom)
+; cas particulier ou l''on est a cheval sur 2 annees
+         if nticks LE 1 then begin
+            nticks = (mmax+12)-mmin+1
+            ticknom = lonarr(nticks)
+            for m = 0,nticks-1 do ticknom[m] = julday(m+mmin, 1, ymin, _EXTRA = ex)
+            ticknom = ticknom[where(ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE -1)]
+            nticks = n_elements(ticknom)
+            tminor = 6
+            datfmt = '%M'+sep+'%Z'
+; cas particulier ou l''on est a cheval sur 2 mois
+            if nticks LE 1 then begin
+               nticks = (dmax+jourdsmois(mmin, ymin)-dmin+1)/2
+               ticknom = lonarr(nticks)
+               for d = 0,nticks-1 do ticknom[d] = julday(mmin, d*2+dmin, ymin, _EXTRA = ex)
+               ticknom = ticknom[where(ticknom GE tempsmin AND ticknom LE tempsmax $
+                                       AND ticknom NE -1)]
+               nticks = n_elements(ticknom)
+               tminor = 2
+               datfmt = '%D'+sep+'%M'
+            endif
+         endif
+      ENDELSE 
+      toto = label_date(0, 0, 0, DATE_FORMAT = datfmt, _EXTRA = ex)
+      if chkstru(ex, 'DATE_FORMAT') then ex.DATE_FORMAT = ''
+   ENDIF 
+;--------------------------------------------------------------
+; definition des parametres des axes au cas par cas
+;--------------------------------------------------------------
+   case coupe of
+      'xy':BEGIN 
+         if keyword_set(reverse_x) then !x.range=[lon2,lon1] ELSE !x.range=[lon1,lon2]
+         if keyword_set(reverse_y) then !y.range=[lat2,lat1] ELSE !y.range=[lat1,lat2]
+         !x.tickformat='lonaxe'
+         !y.tickformat='lataxe'
+      END
+      'yz':BEGIN 
+         if keyword_set(reverse_x) then !x.range=[lat2,lat1] ELSE !x.range=[lat1,lat2]
+         if keyword_set(reverse_y) then !y.range=[0, -1] ELSE !y.range = [-1, 0]
+         if keyword_set(sin) then BEGIN
+; nombre de ticks par defaut
+            plot, [0], [0], /noerase, /nodata, xtick_get = xaxe
+; on augmente ce nombre pour qu''il soit autour de 10 
+            ticks = n_elements(xaxe)-1
+            ticks = ticks*[1, 2, 4, 8]
+            ticks = ticks[(sort(abs(ticks-10)))[0]]
+; on recupere l''axex pour ce nouveau nombre de ticks
+            plot, [0], [0],xticks = ticks, /noerase, /nodata, xtick_get = xaxe
+            !x.ticks = ticks
+            !x.tickv = sin(!pi/180.*xaxe)
+            tickname = strarr(ticks+1)
+            for i = 0,ticks do tickname[i] = lataxe(0, 0, xaxe[i])
+            !x.tickname = tickname
+            !x.range = sin(!pi/180.*!x.range)
+         endif
+      end
+      'xz':BEGIN 
+         if keyword_set(reverse_x) then !x.range=[lon2,lon1] ELSE !x.range=[lon1,lon2]
+         if keyword_set(reverse_y) then !y.range=[0, -1] ELSE !y.range = [-1, 0]
+      end
+      'xt' : begin
+         if keyword_set(reverse_x) then !x.range = [lon2,lon1] ELSE !x.range=[lon1,lon2]
+         if keyword_set(reverse_y) then !y.range=[tempsmax, tempsmin]-tempsmin $
+         ELSE !y.range=[tempsmin,tempsmax]-tempsmin
+         !x.tickformat='lonaxe'
+;          result = LABEL_DATE(DATE_FORMAT = '%M'+sep+'%Z')
+;          !y.tickformat='LABEL_DATE'
+         !y.tickname = LABEL_DATE(1, 0,ticknom,_EXTRA = ex) 
+         !y.ticklen=1.
+         !y.gridstyle=2
+         !y.ticks=nticks-1
+         !y.tickv=ticknom-tempsmin
+         !y.minor=tminor
+         IF divday GT 0 THEN !y.title = 'Time from '+strtrim(dmin,1)+' ' $
+          +def_month('1m', strtrim(mmin, 1))+' '+strtrim(ymin,1)
+      end
+      'yt' : begin
+         if keyword_set(reverse_x) then !x.range = [tempsmax,tempsmin]-tempsmin $
+         ELSE !x.range=[tempsmin,tempsmax]-tempsmin
+         if keyword_set(reverse_y) then !y.range=[lat2, lat1] ELSE !y.range=[lat1,lat2]
+         !y.tickformat='lataxe'
+         !x.tickname = LABEL_DATE(0, 0,ticknom,_EXTRA = ex) 
+         !x.ticklen=1.
+         !x.gridstyle=2
+         !x.ticks=nticks-1
+         !x.tickv=ticknom-tempsmin
+         !x.minor=tminor
+         IF divday GT 0 THEN !y.title = 'Time from '+strtrim(dmin,1)+' ' $
+          +def_month('1m', strtrim(mmin, 1))+' '+strtrim(ymin,1)
+      end
+      'zt' : begin
+         if keyword_set(reverse_x) then !x.range = [tempsmax,tempsmin]-tempsmin $
+         ELSE !x.range=[tempsmin,tempsmax]-tempsmin
+         if vargrid EQ 'W' then gdep=gdepw[0:nzw-1] ELSE gdep=gdept[0:nzt-1] 
+         !x.tickname = LABEL_DATE(0, 0,ticknom,_EXTRA = ex) 
+         !x.ticklen=1.
+         !x.gridstyle=2
+         !x.ticks=nticks-1
+         !x.tickv=ticknom-tempsmin
+         !x.minor=tminor
+         IF divday GT 0 THEN !y.title = 'Time from '+strtrim(dmin,1)+' ' $
+          +def_month('1m', strtrim(mmin, 1))+' '+strtrim(ymin,1)
+      end
+      't' : BEGIN
+         if keyword_set(reverse_x) then !x.range = [tempsmax,tempsmin]-tempsmin $
+         ELSE !x.range=[tempsmin,tempsmax]-tempsmin
+         !x.tickname = LABEL_DATE(0, 0,ticknom,_EXTRA = ex) 
+         !x.ticklen=1.
+         !x.gridstyle=2
+         !x.ticks=nticks-1
+         !x.tickv=ticknom-tempsmin
+         !x.minor=tminor
+         IF divday GT 0 THEN !y.title = 'Time from '+strtrim(dmin,1)+' ' $
+          +def_month('1m', strtrim(mmin, 1))+' '+strtrim(ymin,1)
+      end
+      'x' : begin
+         !x.range=[lon1,lon2]
+         !x.tickformat='lonaxe'
+      END
+      'y' : begin
+         if keyword_set(sin) then BEGIN
+; nombre de ticks par defaut
+            plot, [0], [0], /nodata, /noerase, xstyle = 5, ystyle = 5, xtick_get = xaxe
+; on augmente ce nombre pour qu''il soit autour de 10 
+            ticks = n_elements(xaxe)-1
+            ticks = ticks*[1, 2, 4, 8]
+            ticks = ticks[(sort(abs(ticks-10)))[0]]
+; on recupere l''axex pour ce nouveau nombre de ticks
+            plot, [0], [0],xticks = ticks,/nodata,/noerase,xstyle=5,ystyle=5,xtick_get=xaxe
+            !x.ticks = ticks
+            !x.tickv = sin(!pi/180.*xaxe)
+            tickname = strarr(ticks+1)
+            for i = 0,ticks do tickname[i] = lataxe(0, 0, xaxe[i])
+            !x.tickname = tickname
+            !x.range = sin(!pi/180.*!x.range)
+         ENDIF ELSE !x.range=[lat1,lat2]
+         !x.tickformat='lataxe'
+      END
+      'z' : begin
+;          if vargrid EQ 'W' then gdep=gdepw[0:nzw-1] ELSE gdep=gdept[0:nzt-1] 
+;          if keyword_set(reverse_y) then !y.range=[gdep[0], gdep[n_elements(gdep)-1]] $
+;          ELSE !y.range=[gdep[n_elements(gdep)-1], gdep[0]]
+      END 
+   endcase
+   if keyword_set(key_performance) THEN print, 'temps axe', systime(1)-tempsun 
+   return
+end
Index: tags/start/PLOTS/legende.pro
===================================================================
--- tags/start/PLOTS/legende.pro	(revision 5)
+++ tags/start/PLOTS/legende.pro	(revision 5)
@@ -0,0 +1,293 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:legende.pro
+;
+; PURPOSE:fournit les legendes
+;
+; CATEGORY:graph annexe
+;
+; CALLING SEQUENCE:legende, mi,ma,coupe,title,subtitle,xtitle,ytitle
+;
+; INPUTS:mi et ma: le max et le min du dessin (cf plt.pro et pltz.pro)
+;	 coupe=caractere de 2 lettres donnant le type de coupe (par ex:'xz')
+;
+; KEYWORD PARAMETERS:
+;
+;	TITRE: chaine de caracteres qui doit etre le titre du dessin. Par
+; defaut le titre est le nom vairmer du champ
+;
+;       ENDPOINTS:utilise qd on fait des coupes veticales en diagonale
+;
+; OUTPUTS:le titre, sous-titre,titre de x et titre de y
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS: l''utilisation de la variable globale langage permet
+; de changer de langue ou de facon de legender facilement. On peut
+; facilement personnaliser la chose en rajoutant un cas au case sur la
+; valeur de langage.
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			14/8/98
+;                       Eric Guilyardi (ericg@lodyc.jussieu.fr) GB version
+;			11/6/99
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro legende,mi,ma,coupe,CONTOUR = contour,ENDPOINTS = endpoints, DIREC = direc $
+            , VECTLEGENDE = vectlegende $
+            , INTERVALLE = intervalle, YZ_TYPE = yz_type, VARNAME2 = varname2 $
+            , NPTS = npts, _EXTRA = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;------------------------------------------------------------
+   grille, mask, glam, gphi, gdep, nx, ny, nz & mask = 1
+;
+; choose langage
+;
+   if n_elements(langage) EQ 0 then langage = 'non definit'
+   CASE langage OF
+      'gb': BEGIN
+;
+; English legends
+;
+         fmt_mm = '(f12.2)'
+         fmt_bt = '(f7.1)'
+         colorf = ''
+         contourf = 'Contour plot,'
+         vecteurf = 'Vector norm  '
+         expf = ''
+         datef = '   '
+         fieldf = '   '
+         depthf = '   '
+         endpointsf = 'Diag. Section'
+         zonalf = ''
+         latintf = 'latitudes in '
+         timintf = 'time in '
+         onf = ' - '
+         depthf2 = 'Depth (m)'
+         Meridf = 'Zonal Mean  '
+         lonintf = 'longitudes in '
+         hovxt = 'XT-plot   '
+         diaghovxt = 'Diag. XT-plot   '
+         depintf = 'depths in '
+         timef = 'Time'
+         hovyt = 'YT-plot   '
+         diaghovyt = 'Diag. YT-plot   '
+         hovzt = 'ZT-plot   '
+         hovt = ''
+      END 
+;
+; Legendes en francais
+;
+      ELSE: BEGIN 
+         fmt_mm = '(f12.2)'
+         fmt_bt = '(f7.1)'
+         colorf = 'Champ en couleur '
+         contourf = 'Champ en trace noir '
+         vecteurf = 'Norme vecteur '
+         expf = 'exp: '
+         datef = ', date: '
+         fieldf = ', champ: '
+         depthf = ', profondeur: '
+         endpointsf = 'Diag. Section, exp: '
+         zonalf = 'Coupe Zonale, exp: '
+         latintf = 'latitude in '
+         timintf = 'time in '
+         onf = ' - '
+         depthf2 = 'Profondeur (m)'
+         meridf = 'Coupe Meridienne, exp: '
+         lonintf = 'longitude in '
+         hovxt = 'Trace Longitude-Temps, exp: '
+         diaghovxt = 'Trace Diag. Longitude-Temps, exp: '
+         depintf = 'profondeur in '
+         timef = 'Temps'
+         hovyt = 'Trace Latitude-Temps, exp: '
+         diaghovyt = 'Trace Diag. Latitude-Temps, exp: '
+         hovzt = 'Trace Profondeur-Temps, exp: '
+         hovt = 'Evolution Temporelle, exp: '
+      END
+
+   ENDCASE 
+   vertz = depthf2
+   legniv = ' m'
+   IF keyword_set(YZ_TYPE) THEN BEGIN
+      IF yz_type EQ 'hPa' THEN vertz = 'hPa' 
+      IF yz_type EQ 'hPa' THEN legniv = ' hPa' 
+   ENDIF 
+;
+; Start legende
+;
+;------------------------------------------------------------
+; definition et complement eventuelle de !p.subtitle
+;------------------------------------------------------------
+   if n_elements(varunit) ne 0 then unite='('+varunit+')' else unite=''
+   !p.subtitle=colorf+unite+': Min= '+strtrim(string(format=fmt_mm,mi), 2)$
+    +', Max= '+strtrim(string(format=fmt_mm,ma), 2)
+   if keyword_set(intervalle) then BEGIN
+      if intervalle NE -1 then $
+       !p.subtitle=!p.subtitle+', Int= '+strtrim(string(format=fmt_mm,intervalle), 2)
+   endif
+   if size(contour, /type) EQ 8 then BEGIN ; c''est une structure
+      unite='('+contour.(1)+')'
+      !p.subtitle=!p.subtitle+'!C '+contourf+unite $
+       +': Min= '+strtrim(string(format=fmt_mm,contour.(0)[0]), 2)$
+       +', Max= '+strtrim(string(format=fmt_mm,contour.(0)[1]), 2)
+      if contour.inter NE -1  then $
+       !p.subtitle=!p.subtitle+', Int= '+strtrim(string(format=fmt_mm,contour.inter), 2)
+   ENDIF
+   if size(vectlegende, /type) EQ 8  then begin
+      unite='('+vectlegende.(1)+')'
+      !p.subtitle=!p.subtitle+'!C '+vecteurf+unite $
+       +': Min= '+strtrim(string(format=fmt_mm,vectlegende.(0)[0]), 2)$
+       +', Max= '+strtrim(string(format=fmt_mm,vectlegende.(0)[1]), 2)
+   endif
+;------------------------------------------------------------
+; mise en forme des dimensions du sous domaine
+;------------------------------------------------------------
+   la1=strtrim(string(format=fmt_bt, lat1), 2)
+   la2=strtrim(string(format=fmt_bt, lat2), 2)
+   lo1=strtrim(string(format=fmt_bt, lon1), 2)
+   lo2=strtrim(string(format=fmt_bt, lon2), 2)
+   pr1=strtrim(string(format=fmt_bt, prof1), 2)
+   pr2=strtrim(string(format=fmt_bt, prof2), 2)
+;------------------------------------------------------------
+; gestion de la date
+;------------------------------------------------------------
+   if n_elements(vardate) EQ 0 then vardate = ''
+   if NOT keyword_set(direc) then direc = ''
+   if strpos(direc, 't') NE -1 then begin
+      svardate = strtrim(vairdate(time[0]), 1)+' - '+strtrim(vairdate(time[jpt-1]), 1)
+   ENDIF ELSE svardate = vardate
+;------------------------------------------------------------
+; case sur le cas auquel s''applique la legende
+;------------------------------------------------------------
+   case coupe of
+      'xy':begin          
+         if strupcase(vargrid) EQ 'W' then gdep = gdepw ELSE gdep = gdept
+         if n_elements(gdep) GE 2 then begin
+            IF gdep[0] LT gdep[1] THEN niveautest = 1 ELSE niveautest = jpk
+         ENDIF ELSE niveautest = 1 
+         if niveau NE niveautest AND (strpos(direc, 'z') EQ -1 OR nz EQ 1) then BEGIN
+            prof=strtrim(round(gdep[niveau-1]), 1)
+            !p.title = expf+varexp+datef+svardate+fieldf+varname+depthf+prof+legniv
+         ENDIF ELSE !p.title = expf+varexp+datef+svardate+fieldf+varname
+         !x.title = 'Longitude'
+         !y.title = 'Latitude'
+      end
+
+      'xz':begin
+         IF keyword_set(npts) THEN n = strtrim(npts, 1) ELSE n=strtrim(ny, 1)
+         IF long(n) LE 3 THEN zonalf = 'Section   '
+         if keyword_set(endpoints) AND lat1 NE lat2 then $
+          !p.title = endpointsf+varexp+datef+svardate+fieldf+varname ELSE $
+          !p.title = zonalf+varexp+datef+svardate+fieldf+varname
+         !x.title = 'Longitude'
+         if keyword_set(endpoints) AND lat1 EQ lat2 then !x.title = !x.title+' at '+strtrim(lataxe(0, 0, lat1), 1)
+         !y.title = depthf2
+      end
+
+      'yz':begin
+         IF keyword_set(npts) THEN n = strtrim(npts, 1) ELSE n=strtrim(nx, 1)
+         IF long(n) LE 3 THEN meridf = ''
+         if keyword_set(endpoints) AND lon1 NE lon2 then $
+          !p.title = endpointsf+varexp+datef+svardate+fieldf+varname ELSE $
+          !p.title = meridf+varexp+datef+svardate+fieldf+varname
+         !y.title = vertz
+         !x.title = 'Latitude'
+         if keyword_set(endpoints) AND lon1 EQ lon2 then !x.title = !x.title+' at '+strtrim(lonaxe(0, 0, lon1), 1)
+      end
+
+      'xt':begin
+;         IF keyword_set(npts) THEN n = strtrim(npts, 1)
+         if keyword_set(endpoints) AND lat1 NE lat2 then $
+          !p.title = diaghovxt+varexp+fieldf+varname ELSE $
+         !p.title  =     hovxt+varexp+fieldf+varname
+         IF (time[(size(time))[0]-1] - time[0]) GE 10 THEN !y.title = timef
+         !x.title = 'Longitude'
+         if keyword_set(endpoints) AND lat1 EQ lat2 then !x.title = !x.title+' at '+strtrim(lataxe(0, 0, lat1), 1)
+      end
+
+      'yt':begin
+;         IF keyword_set(npts) THEN n = strtrim(npts, 1) 
+         if keyword_set(endpoints) AND lon1 NE lon2 then $
+          !p.title = diaghovyt+varexp+fieldf+varname ELSE $
+         !p.title  =     hovyt+varexp+fieldf+varname
+         IF (time[(size(time))[0]-1] - time[0]) GE 10 THEN !x.title = timef
+         !y.title = 'Latitude'
+         if keyword_set(endpoints) AND lon1 EQ lon2 then !x.title = !x.title+' at '+strtrim(lonaxe(0, 0, lon1), 1)
+      end
+
+      'zt':begin
+;         IF keyword_set(npts) THEN n = strtrim(npts, 1) ELSE n=strtrim(nx*ny, 1)
+         !p.title = hovzt+varexp+fieldf+varname
+         !y.title = depthf2
+         IF (time[(size(time))[0]-1] - time[0]) GE 10 THEN !x.title = timef
+      end
+      't':begin
+;         IF keyword_set(npts) THEN n = strtrim(npts, 1) ELSE BEGIN 
+;            if keyword_set(integration3d) then n=strtrim(nx*ny*nz, 1) ELSE n=strtrim(nx*ny, 1)
+;         ENDELSE 
+         !p.title = hovt+varexp+fieldf+varname
+         !y.title = varname
+         IF (time[(size(time))[0]-1] - time[0]) GE 10 THEN !x.title = timef
+      end
+      'x':begin            
+;         IF keyword_set(npts) THEN n = strtrim(npts, 1) ELSE n=strtrim(ny*nz, 1)
+         if keyword_set(endpoints) AND lat1 NE lat2 then $
+          !p.title = endpointsf+varexp+datef+svardate+fieldf+varname ELSE $
+         !p.title  =            varexp+datef+svardate+fieldf+varname
+         !x.title = 'Longitude'
+         if keyword_set(endpoints) AND lat1 EQ lat2 then !x.title = !x.title+' at '+strtrim(lataxe(0, 0, lat1), 1)
+         !y.title = varname
+      end
+      'y':begin            
+;         IF keyword_set(npts) THEN n = strtrim(npts, 1) ELSE n=strtrim(nx*nz, 1)
+         if keyword_set(endpoints) AND lon1 NE lon2 then $
+          !p.title = endpointsf+varexp+datef+svardate+fieldf+varname ELSE $
+         !p.title  =            varexp+datef+svardate+fieldf+varname
+         !x.title = 'Latitude'
+         if keyword_set(endpoints) AND lon1 EQ lon2 then !x.title = !x.title+' at '+strtrim(lonaxe(0, 0, lon1), 1)
+         !y.title = varname
+      end
+      'z':begin
+         IF keyword_set(npts) THEN n = strtrim(npts, 1) ELSE n=strtrim(nx*ny, 1)
+         !p.title = varexp+datef+svardate+fieldf+varname
+         !y.title = depthf2
+         !x.title = varname
+      end
+      'yfx': BEGIN
+         IF keyword_set(npts) THEN n = strtrim(npts, 1) ELSE n=strtrim(nx*ny*nz, 1)
+         !p.title = varexp+datef+svardate+varunit
+         !x.title = varname2
+         !y.title = varname
+      END 
+      else:
+   ENDCASE
+   if keyword_set(direc) then BEGIN
+      if strpos(direc, 'x') NE -1 then $
+       !p.subtitle = lonintf+'['+lo1+', '+lo2+']'+onf+'('+strtrim(nx, 1)+' points)  !C' +!p.subtitle
+      if strpos(direc, 'y') NE -1 then BEGIN
+         if strpos(!p.subtitle, '[') EQ -1 then $
+          !p.subtitle = latintf+'['+la1+', '+la2+']'+onf+'('+strtrim(ny, 1)+' points)  !C'+!p.subtitle $
+         ELSE !p.subtitle = latintf+'['+la1+', '+la2+']'+onf+'('+strtrim(ny, 1)+' points)  '+!p.subtitle
+      ENDIF
+      if strpos(direc, 'z') NE -1 AND (nz NE 1 OR coupe NE 'xy') then BEGIN 
+         if strpos(!p.subtitle, '[') EQ -1 then $
+          !p.subtitle = depintf+'['+pr1+', '+pr2+']'+onf+'('+strtrim(nz, 1)+' points)  !C'+!p.subtitle $
+         ELSE !p.subtitle = depintf+'['+pr1+', '+pr2+']'+onf+'('+strtrim(nz, 1)+' points)  '+!p.subtitle
+      ENDIF
+   ENDIF
+   if keyword_set(endpoints) AND coupe NE 'yt' AND lat1 NE lat2 then !p.title = !p.title+'!C!C'
+   
+   if keyword_set(key_performance) THEN print, 'temps legende', systime(1)-tempsun 
+   return
+end
Index: tags/start/PLOTS/plotsym.pro
===================================================================
--- tags/start/PLOTS/plotsym.pro	(revision 5)
+++ tags/start/PLOTS/plotsym.pro	(revision 5)
@@ -0,0 +1,55 @@
+function plotsym, circle=circle, triangle=triangle, diamond=diamond, $
+                  angle=angle, box=box, line=line, scale=scale, $
+                  _extra=extra
+;+
+; NAME:
+;  plotsym
+; PURPOSE:
+;  function to make plotting symbols much easier.
+; Usage:
+;   plot,x,y,psym=plotsym(/circle,scale=2,/fill)
+;
+; CATEGORY:
+;   Graphics.
+;
+; Keywords:
+;  circle =  circle symbol
+;  triangle = triangle symbol
+;  diamond = diamond symbold
+;  box = box symbol
+;  line = line symbol
+;  scale = scales the symbol
+;  angle = angle the symbol should be rotated
+;  _extra = extra keywords for usersym.  These are thick, color and fill
+;
+; Written by:
+; Ronn Kling
+; Ronn Kling Consulting
+; 7038 Westmoreland Dr.
+; Warrenton, VA 20187
+; klingrl@juno.com
+; copyright 1999, all rights reserved
+;-
+
+if not keyword_set(scale) then scale=1.0
+if not keyword_set(angle) then angle=0.0
+
+if keyword_set(circle) then begin
+  theta = findgen(30)/29.*360.
+endif else if keyword_set(triangle) then begin
+  theta = [-30.,90.,210., -30.]
+endif else if keyword_set(diamond) then begin
+  theta = [0.,90.,180.,270.,0.]
+endif else if keyword_set(box) then begin
+  theta = [315.,45.,135.,225.,315.]
+endif else if keyword_set(line) then begin
+  theta = [-180.,0.]
+endif
+
+theta = theta + angle
+x = cos(theta * !dtor) * scale
+y = sin(theta * !dtor) * scale
+
+usersym, x,y, _extra=extra
+return,8
+end
Index: tags/start/PLOTS/reinitplt.pro
===================================================================
--- tags/start/PLOTS/reinitplt.pro	(revision 5)
+++ tags/start/PLOTS/reinitplt.pro	(revision 5)
@@ -0,0 +1,143 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:			REINITPLT
+;
+; PURPOSE:		This procedure will reinitialise all or a selection 
+;			ofthe system plot variables
+;
+; CATEGORY:		Plot Utility
+;
+; CALLING SEQUENCE:	clearplt,/all		;clear the !p, !x, !y, !z 
+;			clearplt,/x,/z		;clear the !x and !z variables 
+;			clearplt,/x		;only clear the !x variable
+;			clearplt,/x,/invert	;clear all except the !x 
+;
+; INPUTS:		
+;	KEYWORDS:
+;		x,y,z,p	= clear the appropriate variable
+;		all	= clear all, this is equivalent to /x,/y,/z,/p
+;		invert	= invert the logic. Clear all unselected variables.
+;			  Therefore "clearplt,/all,/invert" does nothing.
+;
+; OUTPUTS:	none
+;
+; COMMON BLOCKS:
+;	common.pro
+; SIDE EFFECTS:
+;		The sytem plot variables are changed.
+;	
+; MODIFICATION HISTORY:
+;	Written by: Trevor Harris, Physics Dept., University of Adelaide,
+;		July, 1990.
+;
+;       Sebastien Masson 7/5/98
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro reinitplt, all=all,x=x,y=y,z=z,p=p, invert=invert
+;------------------------------------------------------------
+	clearx = 0
+	cleary = 0
+	clearz = 0
+	clearp = 0
+	if (keyword_set(x)) then clearx = 1
+	if (keyword_set(y)) then cleary = 1
+	if (keyword_set(z)) then clearz = 1
+	if (keyword_set(p)) then clearp = 1
+	if (keyword_set(all)) $
+            or (not keyword_set(x) and not keyword_set(y) and $
+                not keyword_set(z) and not keyword_set(p)) then begin
+	   	clearx = 1
+		cleary = 1
+		clearz = 1
+		clearp = 1
+	endif
+
+	if (keyword_set(invert)) then begin
+		clearx = not clearx
+		cleary = not cleary
+		clearz = not clearz
+		clearp = not clearp
+	endif
+
+	if (clearx) then begin
+                !x.charsize=0
+                !x.GRIDSTYLE=0
+                !X.MARGIN=[10,3] 
+	        !X.MINOR=0
+                !X.OMARGIN=[0,0]
+                !x.region=0
+         	!X.RANGE=0
+                !x.STYLE=5
+;                !x.tick=1
+                !x.TICKFORMAT=''
+                !x.TICKLEN=0
+                !x.tickname=''
+                !x.ticks=0
+                !X.TICKV[0]=!X.TICKV[1]
+		!x.title=''
+                !x.TYPE=0
+	endif
+	if (cleary) then begin
+                !y.charsize=0
+                !y.GRIDSTYLE=0
+                !Y.MARGIN=[10,3] 
+	        !Y.MINOR=0
+                !Y.OMARGIN=[0,0]
+                !y.region=0
+         	!Y.RANGE=0
+                !y.STYLE=5
+;                !y.tick=1
+                !y.TICKFORMAT=''
+                !y.TICKLEN=0
+                !y.tickname=''
+                !y.ticks=0
+                !Y.TICKV[0]=!Y.TICKV[1]
+		!y.title=''
+                !y.TYPE=0
+	endif
+	if (clearz) then begin
+                !z.charsize=0
+                !z.GRIDSTYLE=0
+                !Z.MARGIN=[10,3] 
+	        !Z.MINOR=0
+                !Z.OMARGIN=[0,0]
+                !z.region=0
+         	!Z.RANGE=0
+                !z.STYLE=1
+;                !z.tick=1
+                !z.TICKFORMAT=''
+                !z.TICKLEN=0
+                !z.tickname=''
+                !z.ticks=0
+                !Z.TICKV[0]=!Z.TICKV[1]
+		!z.title=''
+                !z.TYPE=0
+	endif
+	if (clearp) then begin
+		!p.BACKGROUND=(!d.n_colors-1) < 255
+		!p.CHARSIZE=1.		
+		!p.CHARTHICK=0	
+		!p.LINESTYLE=0		
+		!p.MULTI=replicate(0,5)		
+		!p.NOERASE=0		
+		!p.POSITION=0		
+		!p.region=0		
+                !p.title=''
+		!p.subtitle=''
+		!p.ticklen=0.02
+                !p.thick=0.1
+                !p.color=0
+	endif
+	return
+	end
+
+
+
+
+
+
Index: tags/start/PLOTS/style.pro
===================================================================
--- tags/start/PLOTS/style.pro	(revision 5)
+++ tags/start/PLOTS/style.pro	(revision 5)
@@ -0,0 +1,122 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:style
+;
+; PURPOSE:choisit la facon de tracer les isolignes
+;
+; CATEGORY:graphique
+;
+; CALLING SEQUENCE:style,labstyle,level_z2d,linestyle,thick
+;
+; INPUTS:labstyle: nombre auquel se refaire le styel de trace choisit
+;	 level_z2d:vecteur contenant les valeures des isolignes a tracer
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;	linestyle:vecteur utilise pour definir le style des
+;	isocontours
+;       rq: pour memoire:
+;		Index	Linestyle	
+;		0	Solid	
+;		1	Dotted	
+;		2	Dashed	
+;		3	Dash Dot	
+;		4	Dash Dot Dot Dot	
+;		5	Long Dashes	
+;	thick:vecteur definissant l'epaisseur de l'isoligne 
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro style,labstyle,level_z2d,linestyle,thick
+   case labstyle of
+      0: begin
+;serie: deux lignes continues fines, une ligne continue grasse
+         thick=[1,1,2]
+         linestyle=[0]
+         return
+      end
+      1: begin
+;serie: avant le mileu des levels: tiret fin. apres trait continu fin.
+; si le mileu est dessine il est en trait continu gras
+         impair=n_elements(level_z2d)-2*fix(n_elements(level_z2d)/2)
+         a=replicate(0,fix(n_elements(level_z2d)/2))
+         b=replicate(1,fix(n_elements(level_z2d)/2))
+         c=replicate(2,fix(n_elements(level_z2d)/2))         
+         if impair then begin
+            thick=[b,2,b]
+            linestyle=[c,0,a]
+         endif else begin
+            thick=[0]
+            linestyle=[c,a]
+         endelse
+         return
+      end
+      2: begin
+;serie: avant le seuil (definit en repondant a une question): tiret fin.
+; apres trait continu fin. si le seuil est dessine il est en trait continu gras
+         seuil=xquestion('Quelle est la limite tirets/trait continu? ','0')
+         seuil = float(seuil)
+         rien=where(level_z2d lt seuil,n)
+         a=replicate(0,n_elements(level_z2d)-n)
+         c=replicate(2,n)         
+         if seuil eq level_z2d(n) then begin
+            thick=[replicate(1,n),2,replicate(1,n_elements(level_z2d)-1-n)]
+            linestyle=[c,a]
+         endif else begin
+            thick=[0]
+            linestyle=[c,a]
+         endelse
+         return
+      end
+      3: begin
+         n = n_elements(level_z2d)
+         seuil = level_z2d(1+n/2)
+
+         thick = intarr(n)
+         thick(indgen((n)/4)*4) = 1
+         thick(indgen((n)/4)*4+1) = 1
+         thick(indgen((n)/4)*4+2) = 2
+         thick(indgen((n)/4)*4+3) = 1
+
+         linestyle = intarr(n)
+         linestyle(indgen((n)/4)*4) = 3
+         linestyle(indgen((n)/4)*4+1) = 0
+         linestyle(indgen((n)/4)*4+2) = 0
+         linestyle(indgen((n)/4)*4+3) = 0
+
+         labels = intarr(n)
+         labels(indgen((n)/2)*2) = 1
+         labels(n/2) = 0
+
+         return
+      end
+      4: begin
+; trait continu gras pour 0
+         seuil = 1.e-6
+         thick=replicate(.1,  n_elements(level_z2d))
+         linestyle=[0]
+         rien=where(abs(level_z2d)/max(abs(level_z2d)) LT seuil)
+         if rien[0] NE -1 then thick[rien[0]] = 2
+      end
+      else: begin
+         ras = report('Le numero de labstyle demande n''existe pas')
+         stop
+      end
+   endcase
+   return
+end
Index: tags/start/PLOTS/symbols.pro
===================================================================
--- tags/start/PLOTS/symbols.pro	(revision 5)
+++ tags/start/PLOTS/symbols.pro	(revision 5)
@@ -0,0 +1,161 @@
+;+
+; NAME:
+;
+;         SYMBOLS
+;         
+; PURPOSE:
+;
+;         Create custom plotting symbols
+;         
+; CALLING SEQUENCE:
+; 
+;	  SYMBOLS,SYMBOL_NUMBER,SCALE
+;	    
+; INPUTS:
+;	 SYMBOL_NUMBER:
+;	 
+;                1 = open circle
+;                2 = filled circle
+;                3 = arrow pointing right
+;                4 = arrow pointing left
+;                5 = arrow pointing up
+;                6 = arrow pointing down
+;                7 = arrow pointing up and left (45 degrees)
+;		 8 = arrow pointing down and left
+;		 9 = arrow pointing down and right.
+;		 10 = arrow pointing up and right.
+;		 11 through 18 are bold versions of 3 through 10
+;		 19 = horizontal line
+;		 20 = box
+;		 21 = diamond
+;		 22 = triangle
+;		 30 = filled box
+;		 31 = filled diamond
+;		 32 = filled triangle
+;		 
+;	 SCALE - size of symbols.
+;	 
+; KEYWORD PARAMETERS:
+; 
+;		COLOR - color of symbols
+;		
+; SIDE EFFECTS:
+; 
+;           The desired symbol is stored in the user buffer and 
+;	    will be plotted if !P.PSYM = 8.
+;
+; MODIFICATION HISTORY:
+; 
+;		Jeff Bennett, U of Colorado, 198?
+;-
+pro symbols,nsym,scale,color=col
+on_error,2
+fill = 0
+case 1 of
+     (nsym le 2):   begin                         ;circles
+                      ;for large scales increase number of points for res.
+                      if scale ge 4 then a = findgen(25) else $
+                      a = findgen(13)
+                      a = a * (3.14159 / 6.)       ;(0 - 12 or 24) pi/6
+                      xarr = cos(a)
+                      yarr = sin(a)
+                      if nsym eq 2 then fill = 1
+                    end
+     ((nsym ge 3)*(nsym le 18)):   begin           ;arrow heads
+                      xarr = fltarr(5)
+                      yarr = xarr
+                      xarr(1) = 10.
+                      xarr(2) = 6.
+                      yarr(2) = 2.
+                      ;nsyms greater than 10 should be filled arrows
+                      if nsym gt 10 then begin
+                         xarr(3) = 6. 
+                         xarr(4) = 10.
+                         yarr(3) = -2.
+                         fill = 1
+                      endif else begin
+                         xarr(3) = 10.
+                         xarr(4) = 6.
+                         yarr(4) = -2.
+                      endelse
+                      case 1 of
+                         (nsym eq 3): dummy = 0b
+                         (nsym eq 4): xarr = -1.*xarr
+                         ((nsym eq 11)+(nsym eq 12)): begin
+                            xarr = extrac(xarr,0,11)
+                            yarr = extrac(yarr,0,11)
+                            yarr(6) = 0.5
+                            xarr(7) = 6
+                            yarr(7) = 0.5
+                            xarr(8) = 6
+                            yarr(8) = -0.5
+                            yarr(9) = -0.5
+                            if nsym eq 12 then begin
+                               rotation,xarr,yarr,180,nx,ny
+                               xarr = nx
+                               yarr = ny
+                            endif
+                                                     end
+                         ((nsym eq 5)+(nsym eq 13)): begin
+                            temp = xarr
+                            xarr = yarr
+                            yarr = temp
+                                                     end
+                         ((nsym eq 6)+(nsym eq 14)): begin
+                            temp = -1.*xarr
+                            xarr = yarr
+                            yarr = temp
+                                                     end
+                         ((nsym ge 7)*(nsym le 10) + $
+                         (nsym ge 15)*(nsym le 18)): begin
+                            case 1 of
+                                 ((nsym eq 7)+(nsym eq 15)): deg = 45
+                                 ((nsym eq 8)+(nsym eq 16)): deg = 135
+                                 ((nsym eq 9)+(nsym eq 17)): deg = 225
+                                 ((nsym eq 10)+(nsym eq 18)): deg = 315
+                            endcase
+                            rotation,xarr,yarr,deg,nx,ny
+                            xarr = nx
+                            yarr = ny
+                                                  end   ;end nsym ge 7
+                      endcase
+                                   end    ;nsym between 3 and 18
+     ((nsym eq 20)+(nsym eq 21)+(nsym eq 30)+(nsym eq 31)):  begin
+                      xarr = fltarr(5) + 3
+                      yarr = xarr
+                      xarr(1) = -3.
+                      xarr(2) = -3.
+                      yarr(2) = -3.
+                      yarr(3) = -3.
+                      if (nsym eq 21)+(nsym eq 31) then begin
+                         rotation,xarr,yarr,45,nx,ny
+                         nx = 0.70 * nx     ;shrink the x direction
+                         xarr = nx
+                         yarr = ny
+                      endif
+                      if nsym ge 30 then fill = 1
+                                   end    ;nsym 20,21,30,31
+     ((nsym eq 22)+(nsym eq 32)):  begin  ;side length 6, 0 at centroid
+                      yarr = fltarr(4) - 6./4.
+                      xarr = fltarr(4) - 6./2.
+                      xarr(1) = 6./2.
+                      xarr(2) = 0.
+                      yarr(2) = 6.*sqrt(3.)/2. - 6./4.
+                      if nsym eq 32 then fill = 1
+                                    end
+     else:                          begin
+                      xarr = fltarr(2) + 1
+                      yarr = xarr * 0.
+                      xarr(1) = -1.
+                                    end
+endcase
+;
+xarr = xarr * scale
+yarr = yarr * scale
+;
+;set symbol buffer
+if keyword_set(col) then usersym,xarr,yarr,fill=fill,color=col else $
+  usersym,xarr,yarr,fill=fill
+;
+return
+end
Index: tags/start/POSTSCRIPT/calibre.pro
===================================================================
--- tags/start/POSTSCRIPT/calibre.pro	(revision 5)
+++ tags/start/POSTSCRIPT/calibre.pro	(revision 5)
@@ -0,0 +1,246 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: calibre
+;
+; PURPOSE:a partir d''un rapport d''aspect et des valeurs (en ligne de
+; characteres) des differentes marges, calcul posfenetre et posbar qui
+; servent a placer le dessin et la barre de couleur grace a
+; !p.position sur une feuille petitfeuille*grandfeuille (21*29.7) ou
+; sur une sortie ecran dont la fenetre a les memes proportions
+;
+; CATEGORY: positionnement du graphe
+;
+; CALLING SEQUENCE:
+;     calibre, rapportyx,marge,margebar, petitdessin,posfenetre, posbar 
+;
+; INPUTS:
+;	rapportyx: rapport d''echelle entre la longueur de l''axe des
+;	y et celle des x. par ex pour une carte xy,
+;       rapportyx=(lat2-lat1)/(lon2-lon1)
+;
+;	marge: vecteur de 4 elements contenant la taille des marges a gauche,
+; a droite, en bas et en haut devant entourer le graphe. tout est
+; mesure en lignes de characteres
+;
+;	margebar: vecteur de 4 elements contenant la taille des marges a gauche,
+; a droite, en bas et -ATTENTION- le dernier element est cette fois-ci
+; la position de coin en haut a droite, devant entourer la barre de
+; couleur. tout est mesure en lignes de characteres
+;
+;       petitdessin: 2 possiblites
+;             un vecteur de 4 elements donnant (en portrait ou
+; en landscape) la position de cadre ds lequel doit rentrer le
+; dessin. cette position est donne par les coordonnes des 2 coins du
+; cadre: en bas a gauche et en haut a droite. elle s''exprime tjs
+; (pour un postscript ou une sortie ecran) en cm, l''origine etant le
+; coin en bas a gauche.
+;             un vecteur de 3 elements donnant le nombre de colonnes a
+; faire de le dessin, le nombre de lignes et enfin le numero de la
+; case que doit occuper le dessin (cf matlab). par ex pour faire 6
+; dessin en 2 colonnes et 3 lignes et occuper la 4 eme case, petit=[2,3,4]
+;
+; KEYWORD PARAMETERS:
+;
+;	/REMPLI:oblige le dessin a occuper l'espace maximum definit
+; par petitdessin sans resperter le rapport y sur x.
+;
+;	YSURX: force le rapport y sur x a prendre la valeur
+; rapportyx*ysurx. ce mot cle est utile ds deux cas: 
+;   1) ysurx=1 : oblige rapportyx a etre bien respecte sinon
+;         calibre se reserve le droit de changer un peu celui-ci dans
+;         le cas ou le rapport d''aspect de petit dessin est trop
+;         different de celui de petitdessin.
+;   2) ysurx=n : multiplie par n le rapport d''aspect donne par
+;         defaut.par ex ds plt, rapportyx est calcule pour que le
+;         repere soit orthonorme, pour avoir un repere ou l''axe des y
+;         est 2 fois plus dilate que celui des y YSURX=2
+;	
+;       PORTRAIT et LANDSCAPE: mots cles plus utilises mais tjs fonctionnels
+;
+; OUTPUTS:
+;       posfenetre: un vecteur de 4 elements contenant la position de
+;       cadre contenant les legendes + le graphe en coordonnes
+;       normalises. Rq: pour positionner le dessin il faut apres
+;       l''appelle de calibre faire !p.position=posfenetre
+;
+;       posbar: cf posfentre mais pour la barre de couleur. meme
+;       remarque pour positionner la barre de couleur, !p.position=posbar
+;
+; COMMON BLOCKS:
+;	common.pro		
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			11/12/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro calibre, rapportyx,marge,margebar, petitdessin,posfenetre, posbar $
+             ,REMPLI=rempli,YSURX=ysurx,PORTAIT=portrait,LANDSCAPE=lanscape
+;------------------------------------------------------------
+@common
+   tempsun = systime(1)         ; pour key_performance
+;-------------------------------------------------------------
+   if keyword_set(portrait) then key_portrait=1
+   if keyword_set(landscape) then key_portrait=0
+   if keyword_set(ysurx) then begin
+      rapportyx=rapportyx*ysurx 
+      test2=0
+   endif else begin
+      ysurx=1.
+      test2=1
+   endelse
+;------------------------------------------------------------
+; choix de Landscape ou Portrait
+;------------------------------------------------------------
+   if n_elements(key_portrait) eq 0  then begin
+      if rapportyx ge 1 then key_portrait=1
+      if rapportyx lt 1 then key_portrait=0
+   endif
+;-------------------------------------------------------------
+; si petitdessin est compte comme ds matlab
+;-------------------------------------------------------------
+   if n_elements(petitdessin) EQ 3  then begin
+      if n_elements(margescadre) EQ 0 then margescadre = [1, 1, 1, 1]
+      petitdessin = long(petitdessin)
+      nbrecol = petitdessin[0]
+      nbrelig = petitdessin[1]
+      numero = petitdessin[2]-1
+      numlig = numero/nbrecol
+      numcol = numero-numlig*nbrecol
+      bas = petitfeuille*key_portrait+grandfeuille*(1-key_portrait) 
+      cote = grandfeuille*key_portrait+petitfeuille*(1-key_portrait) 
+      poscol = margescadre[0]+findgen(nbrecol+1)*(1.*(bas-(margescadre[0]+margescadre[1]))/nbrecol)
+      poslig = cote-margescadre[3]-findgen(nbrelig+1)*(1.*(cote-(margescadre[2]+margescadre[3]))/nbrelig)
+      petitdessin = [poscol[numcol], poslig[numlig+1], poscol[numcol+1], poslig[numlig]]
+   endif
+;------------------------------------------------------------
+; determination de la taille des characteres (!p.charsize)
+;------------------------------------------------------------
+   nombre_de_mots_ds_titre = 60.
+   !p.charsize=1.*(petitdessin[2]-petitdessin[0])*!d.x_px_cm / $
+    (nombre_de_mots_ds_titre* !d.y_ch_size)
+   if !p.charsize gt 1 then !p.charsize=1
+;------------------------------------------------------------
+; transfert de marge en cm
+;------------------------------------------------------------
+   cm=1.*!d.x_px_cm
+   marge=1.* marge * !d.y_ch_size * !p.charsize / cm
+   margebar=1.* margebar * !d.y_ch_size * !p.charsize / cm
+;------------------------------------------------------------
+; definition de la portion de feuille ou on dessine
+;------------------------------------------------------------
+   if key_portrait eq 0 then begin
+      grand=petitdessin[2]-petitdessin[0]
+      petit=petitdessin[3]-petitdessin[1]
+   endif else begin
+      petit=petitdessin[2]-petitdessin[0]
+      grand=petitdessin[3]-petitdessin[1]
+   endelse
+   if key_portrait eq 0 then $
+    rapportmax=1.*(petit-marge[3]-marge[1])/(grand-marge[2]-marge[0]) $
+   else rapportmax=1.*(petit-marge[2]-marge[0])/(grand-marge[3]-marge[1])
+;------------------------------------------------------------
+; si ysurx n'est pas specifie on modifie la valeur de rapportyx pour que
+; ca colle un peu plus aux proportions de la feuille
+;------------------------------------------------------------
+   if rapportyx le rapportmax then begin
+      if test2 then begin
+         rap=1.*rapportmax/rapportyx
+         if rap ge 5. and rap lt 6. then rapportyx=rapportyx*1.5
+         if rap ge 6. and rap lt 7. then rapportyx=rapportyx*2.
+         if rap ge 7. and rap lt 8. then rapportyx=rapportyx*2.5
+         if rap ge 8. then rapportyx=rapportyx*3.
+      endif
+   endif else begin
+      if test2 then begin
+         rap=1.*rapportmax/rapportyx
+         if rap lt 1./5. and rap ge 1./6. then rapportyx=rapportyx/1.5
+         if rap lt 1./6. and rap ge 1./7. then rapportyx=rapportyx/2.
+         if rap lt 1./7. and rap ge 1./8. then rapportyx=rapportyx/2.5
+         if rap lt 1./8. then rapportyx=rapportyx*3.
+      endif
+   endelse
+;------------------------------------------------------------
+; dans le cas ou on fait un Landscape:
+;------------------------------------------------------------
+   if key_portrait eq 0 then begin       
+      if keyword_set(rempli) then begin
+         xs=grand
+         ys=petit
+      endif else begin
+         if rapportyx le rapportmax then begin
+            xs=grand
+            ys=1.*(grand-marge[0]-marge[1])*rapportyx+marge[2]+marge[3]
+            if ys gt petit then begin
+               xs=1.*(petit-marge[2]-marge[3])/rapportyx+marge[0]+marge[1]
+               ys=petit
+            endif
+         endif else begin
+            xs=1.*(petit-marge[2]-marge[3])/rapportyx+marge[0]+marge[1]
+            ys=petit
+            if xs gt grand then begin
+               xs=grand
+               ys=1.*(grand-marge[0]-marge[1])*rapportyx+marge[2]+marge[3]
+            endif
+         endelse
+      endelse
+      xoff=1.*(petit-ys)/2.+petitdessin[1]
+      yoff=1.*(grand-xs)/2.+xs+grandfeuille-petitdessin[2]
+      a=1.*(grandfeuille-yoff)/grandfeuille
+      b=1.*xoff/petitfeuille
+      c=a+1.*xs/grandfeuille
+      d=b+1.*ys/petitfeuille
+   endif $
+;------------------------------------------------------------
+; dans le cas ou on fait un portrait:
+;------------------------------------------------------------
+   else begin       
+      if keyword_set(rempli) then begin
+         xs=petit
+         ys=grand
+      endif else begin
+         if rapportyx le rapportmax then begin
+            xs=petit
+            ys=1.*(petit-marge[0]-marge[1])*rapportyx+marge[2]+marge[3]
+            if ys gt grand then begin
+               xs=1.*(grand-marge[2]-marge[3])/rapportyx+marge[0]+marge[1]
+               ys=grand
+            endif
+         endif else begin
+            xs=1.*(grand-marge[2]-marge[3])/rapportyx+marge[0]+marge[1]
+            ys=grand
+            if xs gt petit then begin
+               xs=petit
+               ys=1.*(petit-marge[0]-marge[1])*rapportyx+marge[2]+marge[3]
+            endif
+         endelse
+      endelse
+      xoff=1.*(petit-xs)/2.+petitdessin[0]
+      yoff=1.*(grand-ys)/2.+petitdessin[1]
+      a=1.*xoff/petitfeuille
+      b=1.*yoff/grandfeuille
+      c=a+1.*xs/petitfeuille
+      d=b+1.*ys/grandfeuille
+      xset = xoff
+      yset = yoff
+   endelse
+;------------------------------------------------------------
+   bas=grandfeuille*(1-key_portrait)+petitfeuille*key_portrait
+   cote=petitfeuille*(1-key_portrait)+grandfeuille*key_portrait
+   posfenetre=[a,b,c,d]+[ marge[0]/bas, marge[2]/cote $
+                          ,-marge[1]/bas,-marge[3]/cote ]
+   posbar=[a,b,c,d]+[ margebar[0]/bas, margebar[2]/cote $
+                      ,-margebar[1]/bas,(-ys+margebar[3])/cote ]
+;------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps calibre', systime(1)-tempsun 
+   return
+end
Index: tags/start/POSTSCRIPT/chcolps.pro
===================================================================
--- tags/start/POSTSCRIPT/chcolps.pro	(revision 5)
+++ tags/start/POSTSCRIPT/chcolps.pro	(revision 5)
@@ -0,0 +1,137 @@
+PRO chcolps, n1, n2, file, PALIT1 = palit1, PALIT2 = palit2
+;;
+;; Modifie les couleurs d''un fichier postscript
+;;
+;; Creation : G. Roullet 1999
+;;
+;
+; recupere les palettes
+;
+    lct, n1
+    IF keyword_set(palit1) THEN palit, palit1
+    tvlct, red, green, blue, /get
+
+    lct, n2
+    IF keyword_set(palit2) THEN palit, palit2
+    tvlct, red1, green1, blue1, /get
+;
+;
+;
+    filein = file
+    fileout = file+'.new'
+    
+    openr, numin, filein, /get_lun
+    openw, numout, fileout, /get_lun
+    ligne = ''
+    nl = 0
+    colortab = 0
+;
+; Scan le fichier
+;
+    WHILE NOT(eof(numin)) DO BEGIN 
+          readf, numin, ligne, format = '(A)'
+          nl = nl+1
+;
+; Replace setrgbcolor statements
+;
+          pos = strpos(ligne, 'setrgbcolor')
+          IF pos NE -1 THEN BEGIN 
+                r = round(float(strmid(ligne, pos-18, 6))*255)
+                g = round(float(strmid(ligne, pos-12, 6))*255)
+                b = round(float(strmid(ligne, pos-6, 6))*255)          
+                ind = where(r EQ red AND g EQ green AND b EQ blue)
+                ind = ind[0]
+                IF ind[0] NE -1 THEN BEGIN 
+                      r1 = red1[ind]/255.
+                      g1 = green1[ind]/255.
+                      b1 = blue1[ind]/255.
+                      color = string(r1, g1, b1, format = '(3(F5.3,:,X))')
+                      strput, ligne, color, pos-18
+                ENDIF ELSE BEGIN
+;                      print, 'erreur ligne :', nl
+                      dist = abs(r-red)+abs(g-green)+abs(b-blue)
+                      ind = (where(dist EQ min(dist)))[0]
+                      ind = ind[0]
+;                      print, 'je trouve            ', long([r, g, b])
+;                      print, 'je remplace par ', [red[ind], green[ind], blue[ind]]
+                      r1 = red1[ind]/255.
+                      g1 = green1[ind]/255.
+                      b1 = blue1[ind]/255.
+                      color = string(r1, g1, b1, format = '(3(F5.3,:,X))')
+                      strput, ligne, color, pos-18
+                ENDELSE 
+          ENDIF            
+;
+; Replace COLORTAB
+;
+          pos = strpos(ligne, '/COLORTAB')
+          IF pos NE -1 THEN BEGIN 
+                build_table, table
+                n = 0
+                colortab = 1
+          ENDIF 
+
+          IF colortab THEN BEGIN
+                ligne = table[n]
+                n = n+1
+                IF n EQ 24 THEN colortab = 0
+          ENDIF 
+;
+; Ecrit le fichier de sorti
+;
+          printf, numout, ligne, format = '(A)'
+    ENDWHILE 
+    close, numin
+    close, numout
+    free_lun, numin
+    free_lun, numout
+
+    spawn, 'gs '+fileout
+
+END 
+
+PRO build_table, tableout
+;
+; Fabrique le bloc de colortable
+;
+
+    format_colortable_hexa, table
+
+
+    tableout = strarr(25)
+
+    tableout[0] = '/COLORTAB < '
+    FOR k = 0, 8 DO tableout[0] = tableout[0]+table[k]+' '
+    FOR i = 1, 22 DO BEGIN 
+          FOR k = 11*i-2, 11*i+8 DO tableout[i] = tableout[i]+table[k]+' '
+    ENDFOR 
+    FOR k = 251, 255 DO tableout[i] = tableout[i]+table[k]+' '
+    tableout[i] = tableout[i]+'> def'
+    
+END 
+
+
+PRO format_colortable_hexa, table
+
+    tvlct, r, g, b, /get
+
+    z = strarr(256)
+    y = strarr(256)
+    for k=0,255 do z[k]='00'+strtrim(string(r[k], format = '(Z)'),2)
+    for k=0,255 do y[k]=y[k]+strmid(z[k],strlen(z[k])-2,2)
+
+    for k=0,255 do z[k]='00'+strtrim(string(g[k], format = '(Z)'),2)
+    for k=0,255 do y[k]=y[k]+strmid(z[k],strlen(z[k])-2,2)
+
+    for k=0,255 do z[k]='00'+strtrim(string(b[k], format = '(Z)'),2)
+    for k=0,255 do y[k]=y[k]+strmid(z[k],strlen(z[k])-2,2)
+    
+    table =  strlowcase(y)
+
+END
+
+
+
+
+
+
Index: tags/start/POSTSCRIPT/closeps.pro
===================================================================
--- tags/start/POSTSCRIPT/closeps.pro	(revision 5)
+++ tags/start/POSTSCRIPT/closeps.pro	(revision 5)
@@ -0,0 +1,75 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:closeps
+;
+; PURPOSE:ferme de l'environement Postscript
+;
+; CALLING SEQUENCE:closeps
+;
+; KEYWORD PARAMETERS:
+;         INFOWIDGET: un long integer qui doit etre l''id du windget
+;         que l''on souhaite detruire (cf. openps.pro)
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS: qd sauveps (variable globale) ne 0 les postscript est
+; annopte par un numero qd il s''appelle idl.ps sinon par son nom. le
+; nom est suivit de la date.
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       21/12/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro closeps, INFOWIDGET = infowidget
+@common
+;------------------------------------------------------------
+; si sauve ps different de 0 on sauve le ps sur maia automatiquement
+; ou apres une question.
+;------------------------------------------------------------
+   if sauveps NE 0 then begin
+;------------------------------------------------------------
+; on recupere le nom du fichier postscript qui vient d''etre cree
+; si ce nom est idl.ps on numerote le postscript avec le numero
+; contenu dans derniernumps.dat
+;------------------------------------------------------------
+      spawn,'which "ls"' , ls
+      spawn,ls[0]+' -t '+psdir+'*ps' , nomps
+      nomps = nomps[0]
+      nomps = strmid(nomps,rstrpos(nomps,'/')+1)
+      if nomps EQ 'idl.ps' then begin
+; on recupere le numero du dernier fichier sauvegarde
+; rq: ce numero est incremente uniquement qd on fait une impression
+         restore,'derniernumps.dat'
+         nomps = strtrim(numfichps, 1)
+      endif
+;------------------------------------------------------------
+; on annote le postscript
+;------------------------------------------------------------
+      date = byte(systime(0))   ; on crecupere la date
+      xyouts, !d.x_px_cm,!d.y_px_cm $
+       ,nomps+') '+string(date[4:10])+string(date[20:23]), /device, charsize = .75
+   endif
+;------------------------------------------------------------
+   if !d.name EQ 'PS' then device,/close
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   CASE thisOS of
+      'MAC': SET_PLOT, thisOS
+      'WIN': SET_PLOT, thisOS
+      ELSE: SET_PLOT, 'X'
+   ENDCASE
+   tvlct, rouge, vert,bleu
+   !p.font = -1
+   !p.BACKGROUND=(!d.n_colors-1) < 255
+   !p.color=0
+   if !d.n_colors gt 256 then !p.background='ffffff'x
+;------------------------------------------------------------
+   if keyword_set(infowidget) then $
+    widget_control, long(infowidget), bad_id = toto, /destroy
+;------------------------------------------------------------
+   return
+end
Index: tags/start/POSTSCRIPT/imprime.pro
===================================================================
--- tags/start/POSTSCRIPT/imprime.pro	(revision 5)
+++ tags/start/POSTSCRIPT/imprime.pro	(revision 5)
@@ -0,0 +1,314 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:
+;	imprime
+;
+; PURPOSE:
+;	visualise puis imprime eventuellement un fichier Postcript.
+; depuis rhodes, le LODYC ou L''IPSL vers les imprimantes du LODYC ou
+; de l''IPSL. si le
+; fichier n''est pas ds le repertoire courant, on va voir s''il est
+; sur gaya dans POSTSCRIPT, si oui, on se propose de le rammener.
+;
+; CATEGORY:
+;       traitement fichiers
+;
+; CALLING SEQUENCE:
+;	imprime [,nomfichier]
+;      
+; INPUTS:
+;  
+;	nomfichier: nom du fichier a imprimer. si nomfichier n''est
+;	pas precise on prend le dernier postscript cree ds le
+;	repertoire courant.
+;
+; KEYWORD PARAMETERS:
+;
+;	/TRANS:imprime -si on le desire- sur un transparant
+;
+;       /NB: obsolete
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; dans le cas ou le fichier est imprime, il y a possibilite de faire
+; un archivage sur gaya ds le repertoire POSTSCRIPT. l''archivage se
+; fait en fonction de la valeur de sauveps (variable globale) :
+;     sauveps=1 : achivage automatique
+;     sauveps=0 : on n''archive pas
+;     sauveps a une autre valeur: on demande si on veut archiver a
+;                                 chaque ps imprime.
+;
+; le nom du ps archive est le suivant:
+;     un numero lorsque le ps s''appelle idl.ps
+;     son nom ds les autres cas.
+; ce nom et la date apparaissent en bas a gauche du ps (ainsi que la
+; date de creation)
+;
+; Rq: avant d''etre envoye sur gaya le fichier est zippe.
+;
+; Dans le cas ou loginipsl est definit et la machipsl ne l''est
+; pas, on passe par la liaison ATM (bcp plus rapide) pour rappatrier le
+; fichier en local, sur le repertoire temporaire, avant de l''imprimer.
+;
+; RESTRICTIONS: verifier que rhodes est bien declare ds vos .rhosts en
+; local.
+; sur rhodes ds le .rhosts il faut :
+;     192.168.111.64      ipsllogin
+; a l''ipsl ds le .rhosts il faut :
+;     rhodes-atm          idrislogin
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			21/12/98
+;                       25/8/19999 utilisation des widgets
+;                       8/9/1999 utilisation de cw_bgroup
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO imprime_event, event
+@common
+; quel est le type d''evenement?
+   widget_control, event.id, get_uvalue=uval
+; case sur le type d''evenement
+   case uval.name OF
+;------------------------------------------------------------
+; visualisation du Postscript
+;------------------------------------------------------------
+      'Visualiser':BEGIN 
+         if key_portrait EQ 1 then sens = 'portrait' ELSE sens = 'seascape' 
+         case event.value of
+            'Ghostview':spawn,'ghostview -a4 -quiet -'+sens+' '+psdir+uval.nomfich
+            'Ghostscript':spawn,'gs -sPAPERSIZE=a4 -q '+psdir+uval.nomfich
+            'Kghostview':spawn,'kghostview '+psdir+uval.nomfich
+         endcase
+      end
+      'Imprimer':BEGIN 
+;------------------------------------------------------------
+; sauvegarde eventuelle sur gaya, lorsque sauveps ne 0 et que le
+; fichier vient d''etre cree
+;------------------------------------------------------------
+         cd, current = olddir
+         cd, psdir
+         spawn,'which "ls"' , ls
+         spawn,ls[n_elements(ls)-1]+' -t *ps' , nomps
+         nomps=nomps[n_elements(nomps)-1]
+         cd, olddir
+         if sauveps NE 0 AND nomps[0] EQ uval.nomfich then begin
+;------------------------------------------------------------
+; ds le cas ou sauveps ne 0 et ne 1 on pause une question pour savoir
+; si on doit le sauver
+;------------------------------------------------------------
+            if sauveps NE 1 then begin
+               onsauve = report('Voulez-vous sauver le Postscript ?', /defaul_no,  /question)
+               if onsauve EQ 0 THEN GOTO, passauver
+            endif
+;------------------------------------------------------------
+; on change de nom qd le fichier s''appelle idl.ps
+;------------------------------------------------------------
+; qd le fichier s''appelle idl.ps 
+            if uval.nomfich eq 'idl.ps' then begin
+; on recupere le numero du dernier fichier sauvegarde
+               restore,'derniernumps.dat'
+; on lui change de nom : idl.ps en numero.ps
+               spawn, 'cp '+psdir+uval.nomfich+' '+psdir+strtrim(numfichps, 1)+'.ps'
+               nomfichgaya = strtrim(numfichps, 1)+'.ps'
+; on incremente le numero
+               numfichps = numfichps+1
+               save,numfichps,filename='derniernumps.dat'
+            ENDIF ELSE nomfichgaya = uval.nomfich
+;------------------------------------------------------------
+; on gzip, on envoie sur gaya 
+;------------------------------------------------------------
+            spawn, 'gzip '+psdir+nomfichgaya ; on zip 
+            spawn, 'maiaput '+psdir+nomfichgaya+'.gz POSTSCRIPT/'+nomfichgaya+'.gz' ; envoie sur gaya
+            if uval.nomfich eq 'idl.ps' then spawn, '\rm '+psdir+nomfichgaya+'.gz' $ ; on efface le fichier zipe
+            ELSE spawn, 'gunzip '+psdir+nomfichgaya+'.gz' ; on dezipe
+;------------------------------------------------------------
+         endif
+passauver:
+;------------------------------------------------------------
+; selection de l''imprimante
+;------------------------------------------------------------
+         case event.value of
+            'Phaser 740 T26':imprimante = 'ph26'
+            'Phaser 740 trans T26':imprimante = 'ph26T'
+            'Phaser 740 R/V T26':imprimante = 'ph26RV'
+            'HP Laser Jet Tour 26':imprimante = 'hpl26'
+            'HP Laser Jet Tour 26 R/V':imprimante = 'hpl26RV'
+            'sparc T26':imprimante = 'sparc'
+            'Phaser 740 T15':imprimante = 'ph15'
+            'Phaser 740 trans T15':imprimante = 'ph15T'
+            'Phaser 740 R/V T15':imprimante = 'ph15RV'
+            'HP Laser Jet Tour 15':imprimante = 'hpl15'
+            'HP Laser Jet Tour 15 R/V':imprimante = 'hpl15RV'
+            'sparc T15':imprimante = 'sparc2'
+         'CX T15':BEGIN & imprimante = 'CX' & GOTO, lodyc & end
+         'CX-trans T15':BEGIN & imprimante = 'CXtrans' & GOTO, lodyc & END
+            'SUN IPSL':imprimante = 'SUN'
+            'QMS-IPSL':imprimante = 'QMS'
+            'QMS-trans-IPSL':imprimante = 'QMS-trans'
+            ELSE:
+         endcase
+;------------------------------------------------------------
+; ou je suis ???
+;------------------------------------------------------------
+         spawn, 'hostname', hostname & hostname = hostname[n_elements(hostname)-1]
+         if hostname EQ 'rhodes' then domainname = 'idris.fr' $
+         ELSE spawn, 'domainname', domainname
+         domainname = domainname[n_elements(domainname)-1]
+         if domainname NE 'lodyc.jussieu.fr' AND domainname NE 'ipsl.jussieu.fr' $
+          AND domainname NE 'idris.fr' then return
+         if domainname EQ 'lodyc.jussieu.fr' then GOTO, lodyc
+;------------------------------------------------------------
+; choix du reseau surlequel on renvoie : IPSL ou LODYC et
+; specification du login, de la machine et du repertoire temporel ds
+; les 2 cas
+;------------------------------------------------------------
+         if domainname EQ 'ipsl.jussieu.fr' then begin
+            machipsl = hostname
+            spawn, 'whoami', loginipsl & loginipsl = loginipsl[n_elements(loginipsl)-1]
+         endif
+         if n_elements(loginipsl) NE 0 THEN BEGIN 
+            if loginipsl Eq '' THEN GOTO, lodyc
+            login = loginipsl   ; si on a un login a l''ipsl et que machipsl n''est pas stipule
+; alors on utilise la liaison ATM entre perouse et rhodes.
+            if n_elements(machipsl) EQ 0 then machine = '192.168.111.64' $
+            ELSE BEGIN 
+               if machipsl EQ '' then machine = '192.168.111.64' $
+               ELSE machine = machipsl+'.ipsl.jussieu.fr'
+            ENDELSE
+            reptemp = '/temp/'+login+'/'
+         ENDIF ELSE BEGIN 
+lodyc:
+            if domainname EQ 'lodyc.jussieu.fr' then begin
+               machlodyc = hostname
+               spawn, 'whoami', loginlodyc & loginlodyc = loginlodyc[n_elements(loginlodyc)-1]
+            endif
+            if n_elements(loginlodyc) EQ 0 THEN BEGIN
+               loginlodyc = xquestion('Quel est votre login au LODYC ?')
+            ENDIF
+            login = loginlodyc
+            machine = machlodyc+'.lodyc.jussieu.fr'
+            reptemp = '/usr/temp/'+login+'/'
+; on change le nom des imprimantes qd on est sur le reseau du lodyc
+            case imprimante of
+               'SUN':imprimante = 'sun-ipsl'
+               'QMS':imprimante = 'qms-ipsl'
+               'QMS-trans': imprimante = 'qmst-ipsl'
+               ELSE:
+            endcase
+         ENDELSE
+;------------------------------------------------------------
+; je suis deja sur le bon reseau ou il faut faire des rsh?
+;------------------------------------------------------------
+         spawn, 'whoami', whoami & whoami = whoami[n_elements(whoami)-1]
+         if whoami EQ login then BEGIN
+            spawn,'lpr -P'+imprimante+' '+psdir+uval.nomfich
+            spawn,'lpq -P'+imprimante+' -l', info
+         ENDIF ELSE BEGIN 
+;------------------------------------------------------------
+; copie du Postscript sur le repertoire temporel a jussieu
+;------------------------------------------------------------
+            spawn,'rcp '+psdir+uval.nomfich+' '+login+'@'+machine+':'+reptemp+'.' 
+;------------------------------------------------------------
+; impression puis destruction du Postscript
+;------------------------------------------------------------
+;            print, 'rsh '+machine+' -l '+login+' lpr -P'+imprimante+' '+reptemp+uval.nomfich
+            spawn,'rsh '+machine+' -l '+login+' lpr -P'+imprimante+' '+reptemp+uval.nomfich
+;------------------------------------------------------------
+; squate de l'imprimante utilisee
+;------------------------------------------------------------
+;            print, 'rsh '+machine+' -l '+login+' lpq -P'+imprimante+' -l'
+            spawn,'rsh '+machine+' -l '+login+' lpq -P'+imprimante+' -l', info
+;
+         ENDELSE 
+         xdisplayfile, 'bidon', text = info, title = 'Info impression '+uval.nomfich $
+          , height = n_elements(info) <  24
+         widget_control, event.top, /destroy ; on tue le widget
+
+      END
+      'quit':widget_control, event.top, /destroy ; on tue le widget
+
+   endcase
+   return
+end
+pro imprime,nomfichier,TRANS=trans, NB = nb
+;
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   CASE thisOS OF 
+      'MAC':return
+      'WIN':return
+      ELSE:
+   ENDCASE
+;
+@common
+;------------------------------------------------------------
+; attribution du nom du fichier a imprimer
+;------------------------------------------------------------
+   CASE N_PARAMS() OF
+      0: BEGIN 
+         cd, current = olddir
+         cd, psdir
+         spawn,'which "ls"' , ls
+         spawn,ls[n_elements(ls)-1]+' -t *ps' , nomfich
+         nomfich=nomfich[n_elements(ls)-1]
+         cd, olddir
+      END
+      1: nomfich=nomfichier
+      else: BEGIN 
+         ras = report('Mauvais nombre de parametre dans l''appel de IMPRIME')
+         return
+      END 
+   endcase       
+;------------------------------------------------------------
+; on verifie que le fichier est ds le reertoire courant.
+; si il n''y est pas et on va voir s''il est sur gaya. 
+;------------------------------------------------------------
+   quelsfichiers = findfile(psdir+nomfich)
+   IF quelsfichiers[0] EQ '' THEN BEGIN ; il faut aller chercher le fichier sur gaya
+      spawn, 'whoami', whoami   ; login a l''idris
+                                ; le fichier zippe existe sur gaya ?
+      spawn,'rsh '+whoami+'@gaya.idris.fr ls POSTSCRIPT/'+nomfich+'.gz', resultat
+      if resultat[n_elements(resultat)-1] NE '' then BEGIN ; s''il existe on le rappatrie
+         gaya = report('le postscript est archive sur gaya. faire le gayaget?', /question, /defualt_no)
+         if gaya EQ 0 then return
+         print, 'gayaget POSTSCRIPT/'+nomfich+'.gz '+nomfich+'.gz ...'
+         spawn, 'gayaget POSTSCRIPT/'+nomfich+'.gz '+nomfich+'.gz' ; on le rappatrie sur rhodes
+         spawn, 'gunzip '+nomfich+'.gz ' ; on le dezippe
+      ENDIF ELSE BEGIN 
+         print, 'le fichier '+nomfich+' n''existe pas'
+         print, 'le fichier '+nomfich+'.gz n''existe pas sur gaya ds le repertoire POSTSCRIPT'
+         return
+      ENDELSE 
+   ENDIF
+;------------------------------------------------------------
+;------------------------------------------------------------
+   base = widget_base(/row, title = 'fichier Postscript: '+nomfich)
+   rien = cw_bgroup(base, ['Kghostview', 'Ghostview', 'Ghostscript'], /frame, label_top = 'Visualiser' $
+                    , uvalue = {name:'Visualiser', nomfich:nomfich}, /column, /return_name)
+   rien = cw_bgroup(base, ['Phaser 740 T26','Phaser 740 trans T26', 'Phaser 740 R/V T26' $
+                           , 'HP Laser Jet Tour 26', 'HP Laser Jet Tour 26 R/V' $
+                           , 'sparc T26', 'Phaser 740 T15', 'Phaser 740 trans T15' $
+                           , 'Phaser 740 R/V T15', 'CX T15', 'CX-trans T15'$
+                           , 'HP Laser Jet Tour 15', 'HP Laser Jet Tour 15 R/V', 'sparc T15' $
+                           , 'SUN IPSL', 'QMS-IPSL', 'QMS-trans-IPSL'], /frame $
+                    , label_top = 'Imprimer', uvalue = {name:'Imprimer', nomfich:nomfich} $
+                    , /column, /return_name)
+   rien = widget_button(base,value='quit', uvalue={name:'quit'})
+;------------------------------------------------------------
+;execution de la fentre de base et des sous-fenetres
+   widget_control,base,/realize
+;------------------------------------------------------------
+   xmanager,'imprime',base, /no_block
+;------------------------------------------------------------
+   return
+end
+
+
Index: tags/start/POSTSCRIPT/openps.pro
===================================================================
--- tags/start/POSTSCRIPT/openps.pro	(revision 5)
+++ tags/start/POSTSCRIPT/openps.pro	(revision 5)
@@ -0,0 +1,90 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:openps
+;
+; PURPOSE:ouverture de l''environement Postscript. au passage on sauve
+; la palette dans les vecteurs rouge, vert et bleu puis on palit la
+; couleur a l''aide ce palit.
+;
+; CALLING SEQUENCE:openps[,nomfich]
+;
+; INPUTS:
+;        nomfich: string donnant le nom du fichier ps a ouvrir, evite
+; que openps ose la question :'Nom du fichier Postscript?'
+;
+; KEYWORD PARAMETERS:
+;
+;        FILENAME: meme role que nomfich mais comme c''est un mot cle,
+;        il peut passer a travers les differentes routines via
+;        INFOWIDGET: a egaler a une variable qui contiendra l''id du
+;        widget qui informe qu''un cree un widget.
+;        _EXTRA: tous les mots cles se rapportant a la procedure device
+;  
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;			21/12/98
+; 1/2/98: ajout de nomfich en input
+; 1/9/1999: ajout du mot cle FILENAME et du widget
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro openps, nomfichier, FILENAME = filename, INFOWIDGET = infowidget, _extra = ex
+@common
+   if !d.name EQ 'PS' then device,/close
+   set_plot,'ps'
+;------------------------------------------------------------
+; on sauve la palette ds rou, vert et bleu
+;------------------------------------------------------------
+   tvlct, rouge, vert, bleu, /get
+   palit,coefpalit
+;------------------------------------------------------------
+; on choisit le nom du fichier
+;------------------------------------------------------------
+   if keyword_set(filename) then nomfich = filename
+   if n_elements(nomfichier) NE 0 then nomfich = nomfichier
+; il faut choisir 
+   if n_elements(nomfich) EQ 0 then $
+    nomfich = xquestion('Nom du fichier Postscript?', 'idl.ps', /chkwid)
+   nomfich = isafile(file = nomfich, iodir = psdir, /new)
+;------------------------------------------------------------
+; on determine xsize, ysize, xoffset et  yoffset 
+;------------------------------------------------------------
+   if key_portrait EQ 1  then begin
+      xs = petitfeuille
+      ys = grandfeuille
+      xoff = 0
+      yoff = 0
+   ENDIF ELSE BEGIN 
+      xs = grandfeuille
+      ys = petitfeuille
+      xoff = 0
+      yoff = grandfeuille
+   ENDELSE 
+;------------------------------------------------------------
+; on ouvre le postcript 
+;------------------------------------------------------------
+   device, /color,/palatino,LANDSCAPE=1-key_portrait,PORTRAIT=key_portrait $
+    ,xsize=xs,ysize=ys,xoffset=xoff,yoffset=yoff $
+    ,filename=strcompress(nomfich, /remove_all) $
+    ,bits_per_pixel=8,_extra = ex
+   !p.font=0   
+;
+   if arg_present(infowidget) then $
+    infowidget = xnotice('Creation du Postscript en cours...')
+;
+   return
+END
+
+
+
+
+
+
+
+
+
+
+
+
Index: tags/start/POSTSCRIPT/plein2dessin.pro
===================================================================
--- tags/start/POSTSCRIPT/plein2dessin.pro	(revision 5)
+++ tags/start/POSTSCRIPT/plein2dessin.pro	(revision 5)
@@ -0,0 +1,138 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:plein2dessin
+;
+; PURPOSE:permet de faire plusieurs dessin sur un Postscript
+;
+; CATEGORY:sorties graphiques
+;
+; CALLING SEQUENCE:plein2dessin
+;
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+;       /EPS: pour selectionner le format encapsulated postscript
+;
+;	/PORTRAIT: oblige la feuille a etre en position "debout".
+;
+;	/LANDSCAPE: oblige la feuille a etre en position "allongee".
+;	
+;	/TRANS: fait un postscript et l'imprime -si on le desire- sur un
+; transparant
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       5/7/98
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro plein2dessin,PORTRAIT=portrait,LANDSCAPE=landscape, FILENAME = filename
+@common
+;------------------------------------------------------------
+reinitplt, /z,/invert
+if keyword_set(portrait) then key_portrait = 1
+if keyword_set(landscape) then key_portrait = 0
+openps, FILENAME = filename
+;------------------------------------------------------------
+; partie a changer
+;------------------------------------------------------------
+;plt,lec('VOTEMPER'),petit=[2,1,19,10]
+;plt,lec('VOTEMPER'),petit=[2,1,19,10], /rempli
+;pltz,lec('VOTEMPER'),petit=[5,10,16,28],boite=[100,300,-1,1,500],/rempli
+;plt,lec('VOTEMPER') ,petit=[1,2,14,19]
+;plt,lec('VOSALINE') ,petit=[14,2,27,19]
+;plt,1000000.* lec('VORESTO '),0,TITRE='10E6*VORESTO',petit=[1,1,19,10],/rem
+;plt,1000000.* lec('VORESTO '),0,TITRE='10E6*VORESTO',petit=[1,10,19,19],/rem
+;plt,1000000.* lec('VORESTO '),0,TITRE='10E6*VORESTO',petit=[1,19,19,28],/rem
+;placecolor,[1,1,19,10]
+
+
+; p1=pression(nlec('sn',820803,'AT1',dat=820831,dir='t'),nlec('tn',820803,'AT1',dat=820831,dir='t'),grad='x')
+; p2=pression(nlec('sn',820803,'RE2',dat=820831,dir='t'),nlec('tn',820803,'RE2',dat=820831,dir='t'),grad='x')
+;vardate = 'AUG-82'
+;varname = 'gradiant zonal de pression *1000'
+;pltz,p2*1e3 ,boite=[310,370,-.5,.5,300],-1.,1,int=.2 ,zoom=2000,/nocolor,petit=[1,2,20,16], /post  
+;varexp = 'RE1'
+;pltz,p1*1e3 ,boite=[310,370,-.5,.5,300],-1.,1,int=.2,zoom=2000,/nocolor,petit=[1,15,20,29],/ post 
+
+;bte = [305, 315, 3, 10]
+;;a = nlec('htoth',810101,'AT1',dat=821231,boite=bte,dir='xy')-nlec('hpycn',810101,'AT1',dat=821231,boite=bte,dir='xy')
+;a = nlec('sss',810101,'AT1',dat=821231,boite=bte,dir='xy')
+;varexp = 'REF, RE1 et RE3'
+;pltt, nlec('sss',810101,'RE3',dat=821231,boite=bte,dir='xy'),sty1d=2  
+;pltt, a, /ov1d
+;pltt, nlec('sss',810101,'ATF',dat=821231,boite=bte,dir='xy'),/ov1d,sty1d=1 
+;pltt, nlec('htoth',810101,'RE3',dat=820631,boite=bte,dir='xy')- nlec('hpycn',810101,'RE3',dat=820631,boite=bte,dir='xy'),/ov1d,sty1d=2  
+;pltt, nlec('htoth',810101,'ATF',dat=821231,boite=bte,dir='xy')-nlec('hpycn',810101,'ATF',dat=821231,boite=bte,dir='xy'),/ov1d,sty1d=1 
+
+;a = nlecs('utrend6',810115,'RE5',821215,dir='yt',boite=[305,375,-0.5,0.5])*1e6
+;a = nlecs('un',810115,'RE5',821215,dir='yt',boite=[305,375,-0.5,0.5])
+;vardate = '81-82'
+;varname = varname+'*1e6'
+;pltz, a, -1, 1,petit=[1,2,1],/nocolor, nite = 5
+;a = nlecs('utrend6',810115,'RE6',821215,dir='yt',boite=[305,375,-0.5,0.5])*1e6
+;a = nlecs('un',810115,'RE6',821215,dir='yt',boite=[305,375,-0.5,0.5])
+;varname = varname+'*1e6'
+;pltz,a,-1,1,/por,petit=[1,2,2],/nocolor,/noerase , nite = 5
+;placecolor,[4,1.75,17,2.25]
+;plt,(nlecs('vtrend1',810815,'RE5')-reform((nlecs('spgv',810815,'RE5'))[*]#replicate(1,jpk),nxv,nyv,jpk))*1e6,-5,5,/nocolor ,petit=[1,2,1]
+; plt,(nlecs('vtrend1',810815,'RE6')-reform((nlecs('spgv',810815,'RE6'))[*]#replicate(1,jpk),nxv,nyv,jpk))*1e6,-5,5,/nocolor ,petit=[1,2,2]
+
+;plt, nlecs('sst',810715,'RE5'),20,28,int=.5,petit=[1,3,1],/nocolo,/por,/rempli         
+;plt, nlecs('sst',810715,'RE7'),20,28,int=.5,petit=[1,3,2],/nocolo,/por,/rempli,/noerase          
+
+;a = nlecs('sst',810715,'RE5')-nlecs('sst',810715,'RE7')
+;varexp = 'RE5-RE7'
+;set_plot, 'x'
+;lct,  64
+;set_plot, 'ps'
+;plt, a,-1,1,petit=[1,3,3],/nocolo,/por,/rempli,/noerase           
+
+; plt,hdyn(nlecs('sn',810615,'RE5')<1e6,nlecs('tn',810615,'RE5')<1e6)-hdyn(nlecs('sn',810615,'RE6')<1e6,nlecs('tn',810615,'RE6')<1e6) , 0,10,/inv ,/por,petit=[2,2,1],/nocolor,ysurx=2 
+; plt,hdyn(nlecs('sn',810715,'RE5')<1e6,nlecs('tn',810715,'RE5')<1e6)-hdyn(nlecs('sn',810715,'RE6')<1e6,nlecs('tn',810715,'RE6')<1e6) , 0,10,/inv ,/por,petit=[2,2,2],/nocolor,ysurx=2,/noerase 
+; plt,hdyn(nlecs('sn',810815,'RE5')<1e6,nlecs('tn',810815,'RE5')<1e6)-hdyn(nlecs('sn',810815,'RE6')<1e6,nlecs('tn',810815,'RE6')<1e6) , 0,10,/inv ,/por,petit=[2,2,3],/nocolor,ysurx=2,/noerase 
+; plt,hdyn(nlecs('sn',810915,'RE5')<1e6,nlecs('tn',810915,'RE5')<1e6)-hdyn(nlecs('sn',810915,'RE6')<1e6,nlecs('tn',810915,'RE6')<1e6) , 0,10,/inv ,/por,petit=[2,2,4],/nocolor,ysurx=2,/noerase 
+;placecolor,[4,15,17,15.5] 
+
+
+;a = nlecs('utrend1',810715,'RE5',boite=[305,375,-1, 1],dir='y')*1e6
+;;b = nlecs('spgu',810815,'RE5',boite=[300,330,7,8],dir='y')*1e6
+;;b = b#replicate(1, jpk)
+;;a = a-b
+;;varname = 'gradient, zonal de pression (totale)'
+;pltz, a, -1, 1,/nocolor, /rempli,petit=[1,3,1]  
+
+;c = nlecs('utrend1',810715,'RE7',boite=[305,375,-1, 1],dir='y')*1e6
+;;d = nlecs('spgu',810815,'RE7',boite=[300,330,7,8],dir='y')*1e6
+;;d = d#replicate(1, jpk)
+;;c = c-d
+;;varname = 'gradient, zonal de pression (totale)'
+;pltz,c,-1, 1,/nocolor, /rempli,petit=[1,3,2], /noerase  
+;varexp = 'RE5-RE7'
+;pltz, a-c, -1, 1,/nocolor, /rempli,petit=[1,3,3],/noerase  
+
+p = nlec('gps',810813,'REF')*1000
+plt, p-moyenne(p,'xy') ,/land,petit=[1,2,1],-8,8,/rempli
+ h=hdyn(nlec('sn'),nlec('tn')) 
+plt, h-moyenne(h, 'xy'), petit=[1,2,2], /rempli
+;------------------------------------------------------------
+; fin de la partie a changer
+;------------------------------------------------------------
+closeps
+imprime,TRANS=trans
+return
+end
Index: tags/start/POSTSCRIPT/ps.pro
===================================================================
--- tags/start/POSTSCRIPT/ps.pro	(revision 5)
+++ tags/start/POSTSCRIPT/ps.pro	(revision 5)
@@ -0,0 +1,111 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:ps
+;
+; PURPOSE:redirige le contenu de la fenetre graphique ds un postcript,
+; en reeffectuant les commandes ds l''environnement postscript.
+;
+; CATEGORY:pour faire un ps
+;
+; CALLING SEQUENCE:@ps
+;
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS: on utilise journal qui perment de stoker les commandes
+; que l''on passe. 
+;
+; RESTRICTIONS:peut planter si des commandes bizarres sont passees...
+; rq: on efface les Syntax error, les Illegal character, commapatible
+; avec oups, text_box... 
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       5/3/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; il faut fermer le journal!
+;------------------------------------------------------------
+;   if !journal EQ 0 then begin
+;      print, 'Il n''y a pas de journal ouvert !!'
+;      GOTO, sortie
+journal
+;------------------------------------------------------------
+; on complete le journal ...
+;------------------------------------------------------------
+; on recupere le journal sous la forme d''un vecteur de string:
+vectjournal = getfile(homedir+'idlsave.pro')
+;FOR i = 0,n_elements(vectjournal)-1 DO  print, vectjournal[i]
+;------------------------------------------------------------
+; on coupe la derniere ligne qui est @ps
+;------------------------------------------------------------
+vectjournal = vectjournal[0:n_elements(vectjournal)-2 ]
+;------------------------------------------------------------
+; on le corrige si besoin est...
+;------------------------------------------------------------
+for i = 0, n_elements(vectjournal)-1 do $
+ if strpos(vectjournal[i],'text_box' ) EQ -1 then $
+ vectjournal[i] = strtrim(strcompress(vectjournal[i]), 2)
+;FOR i = 0,n_elements(vectjournal)-1 DO print, vectjournal[i]
+;2 lignes sont identiques ??
+for i = 0, n_elements(vectjournal)-2 do $
+ if vectjournal[i] EQ vectjournal[i+1] then vectjournal[i] = ' '
+;FOR i = 0,n_elements(vectjournal)-1 DO print, vectjournal[i]
+
+for i = 0, n_elements(vectjournal)-1 do BEGIN & $
+ if strpos(vectjournal[i],'oups' ) NE -1 $
+ OR strpos(vectjournal[i],'Syntax error' ) NE -1 $
+ OR strpos(vectjournal[i],'Illegal character' ) NE -1 $
+ then BEGIN vectjournal[i] = ' ' & vectjournal[i-1] = ' ' & endif & endfor
+;FOR i = 0,n_elements(vectjournal)-1 DO print, vectjournal[i]
+for i = 0, n_elements(vectjournal)-1 do BEGIN & $
+ if strpos(strtrim(vectjournal[i], 1),'retall' ) EQ 0 $
+ OR strpos(vectjournal[i],'@ps' ) NE -1 $
+ OR strpos(vectjournal[i],'@oups' ) NE -1 $
+ OR strpos(vectjournal[i],'@vzoom' ) NE -1 $
+ OR strpos(vectjournal[i],'help' ) NE -1 $
+ OR strpos(vectjournal[i],'print' ) NE -1 $
+ then  vectjournal[i] = ' ' & endfor
+;FOR i = 0,n_elements(vectjournal)-1 DO print, vectjournal[i]
+for i = 0, n_elements(vectjournal)-1 do BEGIN & $
+ if strpos(strtrim(vectjournal[i], 1),'plt' ) NE -1 THEN BEGIN & $
+ if strpos(strtrim(vectjournal[i], 1),'noerase') NE -1 then $
+ vectjournal[i] = chkeywd(vectjournal[i],'noerase',1) ELSE $
+ vectjournal[i] = vectjournal[i]+',/noerase' & $
+ ENDIF & endfor
+;FOR i = 0,n_elements(vectjournal)-1 DO print, vectjournal[i]
+for i = 0, n_elements(vectjournal)-1 do BEGIN & $
+ if strpos(vectjournal[i],'text_box' ) NE -1 then $
+ IF strpos(vectjournal[i],',pos=' ) EQ -1 then $
+ vectjournal[i] = vectjournal[i]+strmid(vectjournal[i+1], 1) & endfor
+
+; on le complete pour le transformer en une procedure equivalente a plein2dessin
+   vectjournal = ['reinitplt, /z,/invert' $
+                  ,'openps, infowidget= infowidget' $
+                  , vectjournal $
+                  ,'closeps, infowidget= infowidget' $
+                  ,'imprime' ]
+;FOR i = 0,n_elements(vectjournal)-1 DO print, vectjournal[i]
+; on reecrit idlsave.pro
+   putfile, homedir+'idlsave.pro', vectjournal
+; applique idlsave
+   cd, homedir
+@idlsave   
+; on reouvre le journal et on y met les elements de
+; vectjournal sauf les 2 premieres lignes et les 3 dernieres lignes
+journal
+for i = 2, n_elements(vectjournal)-3 DO $
+printf,  !journal, vectjournal[i]
+
+;------------------------------------------------------------
Index: tags/start/STATISTICS/a2_correlate.pro
===================================================================
--- tags/start/STATISTICS/a2_correlate.pro	(revision 5)
+++ tags/start/STATISTICS/a2_correlate.pro	(revision 5)
@@ -0,0 +1,128 @@
+; $Id$
+; Copyright (c) 1995-1997, Research Systems, Inc.  All rights reserved.
+;       Unauthorized reproduction prohibited.
+;+
+; NAME:
+;       a2_correlate
+;
+; PURPOSE:
+;       This function computes the autocorrelation Px(L) or autocovariance
+;       Rx(L) of a sample population X as a function of the lag (L).
+;
+; CATEGORY:
+;       Statistics.
+;
+; CALLING SEQUENCE:
+;       Result = A_correlate(X, Lag)
+;
+; INPUTS:
+;       X:    An n-element vector of type integer, float or double.
+;
+;     LAG:    A scalar or n-element vector, in the interval [-(n-2), (n-2)],
+;             of type integer that specifies the absolute distance(s) between
+;             indexed elements of X.
+;
+; KEYWORD PARAMETERS:
+;       COVARIANCE:    If set to a non-zero value, the sample autocovariance
+;                      is computed.
+;
+;       DOUBLE:        If set to a non-zero value, computations are done in
+;                      double precision arithmetic.
+;
+; EXAMPLE
+;       Define an n-element sample population.
+;         x = [3.73, 3.67, 3.77, 3.83, 4.67, 5.87, 6.70, 6.97, 6.40, 5.57]
+;
+;       Compute the autocorrelation of X for LAG = -3, 0, 1, 3, 4, 8
+;         lag = [-3, 0, 1, 3, 4, 8]
+;         result = a_correlate(x, lag)
+;
+;       The result should be:
+;         [0.0146185, 1.00000, 0.810879, 0.0146185, -0.325279, -0.151684]
+;
+; PROCEDURE:
+;       See computational formula published in IDL manual.
+;
+; REFERENCE:
+;       INTRODUCTION TO STATISTICAL TIME SERIES
+;       Wayne A. Fuller
+;       ISBN 0-471-28715-6
+;
+; MODIFICATION HISTORY:
+;       Written by:  GGS, RSI, October 1994
+;       Modified:    GGS, RSI, August 1995
+;                    Corrected a condition which excluded the last term of the
+;                    time-series.
+;       Modified:    GGS, RSI, April 1996
+;                    Simplified AUTO_COV function. Added DOUBLE keyword.
+;                    Modified keyword checking and use of double precision.
+;       Modified:    W. Biagiotti,  Advanced Testing Technologies Inc., Hauppauge, NY, July 1997
+;                    Moved all constant calculations out of main loop for greatly
+;                    reduced processing time.
+;
+; DISCLAIMER:  This routine has been modified from its original form as it was
+;              supplied by Research Systems, Inc (RSI).  As such, RSI is not responsible
+;              for any errors existing in this code.
+;-
+
+FUNCTION Auto_Cov, X, M, nX, Double = Double
+
+COMMON data, Xmean
+
+    ;Sample autocovariance function.
+  RETURN, TOTAL((X[0:nX - M] - Xmean) * (X[M:nX] - Xmean), Double = Double)
+
+END
+
+FUNCTION a2_correlate, X, Lag, Covariance = Covariance, Double = Double
+
+COMMON data, Xmean
+
+  ;Compute the sample-autocorrelation or autocovariance of (Xt, Xt+l)
+  ;as a function of the lag (l).
+
+  ON_ERROR, 2
+
+  TypeX = SIZE(X)
+  nX = TypeX[TypeX[0]+2]
+
+  ;Check length.
+  if nX lt 2 then $
+    MESSAGE, "X array must contain 2 or more elements."
+
+  ;If the DOUBLE keyword is not set then the internal precision and
+  ;result are identical to the type of input.
+  if N_ELEMENTS(Double) eq 0 then $
+    Double = (TypeX[TypeX[0]+1] eq 5)
+
+  nLag = N_ELEMENTS(Lag)
+
+  if nLag eq 1 then Lag = [Lag] ;Create a 1-element vector.
+
+  if Double eq 0 then Auto = FLTARR(nLag) else Auto = DBLARR(nLag)
+
+  ; Calculate constants OUTSIDE of main loop
+  Xmean = TOTAL(X, Double = Double) / nX
+  nX = nX - 1         ; Translate into last index (avoid redundancy)
+  last_idx = nLag - 1 ; Last loop indice
+  Lag = ABS(Lag)      ; Calculate with vector ops
+
+  if KEYWORD_SET(Covariance) eq 0 then begin ;Compute Autocorrelation.
+
+    for k = 0, last_idx do $
+      Auto[k] = Auto_Cov(X, Lag[k], nX, Double = Double)
+
+    temp_Corr = Auto_Cov(X, 0L, nX, Double = Double)
+    Auto = Auto / temp_Corr
+
+  endif else begin ;Compute Autocovariance.
+    for k = 0, last_idx do $
+      Auto[k] = Auto_Cov(X, Lag[k], nX, Double = Double)
+
+    Auto = Auto / nX
+  endelse
+
+  if Double eq 0 then RETURN, FLOAT(Auto) else $
+  RETURN, Auto
+
+END
Index: tags/start/STATISTICS/a_correlate2d.pro
===================================================================
--- tags/start/STATISTICS/a_correlate2d.pro	(revision 5)
+++ tags/start/STATISTICS/a_correlate2d.pro	(revision 5)
@@ -0,0 +1,113 @@
+;+
+; NAME:
+;       A_CORRELATE2d
+;
+; PURPOSE:
+;
+;       This function computes the autocorrelation Px(K,L) or
+;       autocovariance Rx(K,L) of a sample population X[nx,ny] as a
+;       function of the lag (K,L).
+;
+; CATEGORY:
+;       Statistics.
+;
+; CALLING SEQUENCE:
+;       Result = a_correlate2d(X, Lag)
+;
+; INPUTS:
+;       X:    an 2 dimension Array [nx,ny]
+;
+;     LAG:    2-element vector, in the intervals [-(nx-2), (nx-2)],[-(ny-2), (ny-2)],
+;             of type integer that specifies the absolute distance(s) between 
+;             indexed elements of X.
+;
+; KEYWORD PARAMETERS:
+;       COVARIANCE:    If set to a non-zero value, the sample autocovariance
+;                      is computed.
+;
+;       DOUBLE:        If set to a non-zero value, computations are done in
+;                      double precision arithmetic.
+;
+; EXAMPLE:
+;
+; PROCEDURE:
+;
+;
+;                          nx-k-1  ny-l-1 
+;                          sigma   sigma  (X[i,j]-Xmean)(X[i+k,j+l]-Ymean)
+;                           i=0     j=0
+;   correlation(X,[k,l])=------------------------------------------------------
+;                                  nx-1   ny-1                  
+;                                 sigma  sigma  (X[i,j]-Xmean)^2)
+;                                  i=0    j=0                      
+;
+;
+;                          nx-k-1  ny-l-1 
+;                          sigma   sigma  (X[i,j]-Xmean)(Y[i+k,j+l]-Ymean)
+;                           i=0     j=0
+;   covariance(X,[k,l])=------------------------------------------------------
+;                                            nx*ny
+;
+;   Where Xmean is the mens of the sample population
+;   x=(x[0,0],x[1,0],...,x[nx-1,ny-1]).
+;
+;
+; REFERENCE:
+;
+; MODIFICATION HISTORY:
+;       28/2/2000 Sebastien Masson (smasson@lodyc.jussieu.fr)
+;       Based on the A_CORRELATE procedure of IDL
+;-
+
+FUNCTION Auto_Cov2d, X, Lag, Double = Double, zero2nan = zero2nan
+   XDim = SIZE(X, /dimensions)
+   nx = XDim[0]
+   ny = XDim[1]
+;Sample autocovariance function
+   Xmean = TOTAL(X, Double = Double) / (1.*nx*ny)
+;
+   res = TOTAL( (X[0:nx-1-lag[0], 0:ny-1-lag[1]] - Xmean) * $
+                (X[lag[0]:nx-1, lag[1]:ny-1] - Xmean) $
+                , Double = Double )
+   if keyword_set(zero2nan) AND res EQ 0 then res = !values.f_nan
+   RETURN, res
+
+END
+
+FUNCTION A_Correlate2d, X, Lag, Covariance = Covariance, Double = Double
+
+;Compute the sample-autocorrelation or autocovariance of (Xt, Xt+l)
+;as a function of the lag (l).
+
+   ON_ERROR, 2
+
+   XDim = SIZE(X, /dimensions)
+   XNDim = SIZE(X, /n_dimensions)
+   nx = XDim[0]
+   ny = XDim[1]
+   if XNDim NE 2 then $
+    MESSAGE, "X array must contain 2 dimensions."
+;Check length.
+   if nx lt 2 then $
+    MESSAGE, "first dimension of X array must contain 2 or more elements."
+   if ny lt 2 then $
+    MESSAGE, "second dimension of X array must contain 2 or more elements."
+   if n_elements(Lag) NE 2 THEN $
+    MESSAGE, "Lag array must contain 2 elements."
+   
+;If the DOUBLE keyword is not set then the internal precision and
+;result are identical to the type of input.
+   if N_ELEMENTS(Double) eq 0 then $
+    Double = (SIZE(X, /type) eq 5)
+
+   if KEYWORD_SET(Covariance) eq 0 then begin ;Compute Autocorrelation.
+      Auto = Auto_Cov2d(X, ABS(Lag), Double = Double) / $
+          Auto_Cov2d(X, [0L, 0L], Double = Double, /zero2nan)
+   endif else begin             ;Compute Autocovariance.
+      Auto = Auto_Cov2d(X, ABS(Lag), Double = Double) / n_elements(X) 
+   endelse
+
+   if Double eq 0 then RETURN, FLOAT(Auto) else $
+    RETURN, Auto
+
+END
Index: tags/start/STATISTICS/a_timecorrelate.pro
===================================================================
--- tags/start/STATISTICS/a_timecorrelate.pro	(revision 5)
+++ tags/start/STATISTICS/a_timecorrelate.pro	(revision 5)
@@ -0,0 +1,167 @@
+;+
+; NAME:
+;       A_TIMECORRELATE
+;
+; PURPOSE:
+;       Same function as A_CORRELATE but accept array (until 4
+;       dimension) for input and do the autocorrelation or the
+;       autocovariance along the time dimension which must be the last
+;       one of the input array.
+;
+;       This function computes the autocorrelation Px(L) or autocovariance
+;       Rx(L) of a sample population X as a function of the lag (L).
+;
+; CATEGORY:
+;       Statistics.
+;
+; CALLING SEQUENCE:
+;       Result = a_timecorrelate(X, Lag)
+;
+; INPUTS:
+;       X:    an Array which last dimension is the time dimension os
+;       size n.
+;
+;     LAG:    A scalar or n-element vector, in the interval [-(n-2), (n-2)],
+;             of type integer that specifies the absolute distance(s) between 
+;             indexed elements of X.
+;
+; KEYWORD PARAMETERS:
+;       COVARIANCE:    If set to a non-zero value, the sample autocovariance
+;                      is computed.
+;
+;       DOUBLE:        If set to a non-zero value, computations are done in
+;                      double precision arithmetic.
+;
+; EXAMPLE
+;       Define an n-element sample population.
+;         x = [3.73, 3.67, 3.77, 3.83, 4.67, 5.87, 6.70, 6.97, 6.40, 5.57]
+;
+;       Compute the autocorrelation of X for LAG = -3, 0, 1, 3, 4, 8
+;         lag = [-3, 0, 1, 3, 4, 8]
+;         result = a_correlate(x, lag)
+;
+;       The result should be:
+;         [0.0146185, 1.00000, 0.810879, 0.0146185, -0.325279, -0.151684]
+;
+; PROCEDURE:
+;
+;
+;                         n-L-1 
+;                         sigma  (X[k]-Xmean)(X[k+L]-Xmean)
+;                          k=0
+;   correlation(X,L)=----------------------------------------
+;                            n-1                   
+;                           sigma  (X[k]-Xmean)^2
+;                            k=0                   
+;
+;
+;
+;                        n-L-1 
+;                        sigma  (X[k]-Xmean)(X[k+L]-Xmean)
+;                         k=0
+;   covariance(X,L)=-------------------------------------------
+;                                     n
+;
+;   Where Xmean is the Time mean of the sample population
+;   x=(x[t=0],x[t=1],...,x[t=n-1])
+;
+;
+; REFERENCE:
+;       INTRODUCTION TO STATISTICAL TIME SERIES
+;       Wayne A. Fuller
+;       ISBN 0-471-28715-6
+;
+; MODIFICATION HISTORY:
+;       24/2/2000 Sebastien Masson (smasson@lodyc.jussieu.fr)
+;       Based on the A_CORRELATE procedure of IDL
+;-
+
+FUNCTION TimeAuto_Cov, X, M, nT, Double = Double, zero2nan = zero2nan
+;Sample autocovariance function
+   TimeDim = size(X, /n_dimensions)
+   Xmean = TOTAL(X, TimeDim, Double = Double) / nT
+   if double then one = 1.0d ELSE one = 1.0
+   Xmean = Xmean[*]#replicate(one, nT - M)
+;
+;
+   case TimeDim of
+      1:res = TOTAL((X[0:nT - M - 1L] - Xmean) * (X[M:nT - 1L] - Xmean), $
+                    TimeDim, Double = Double)
+      2:res = TOTAL((X[*, 0:nT - M - 1L] - Xmean) * $
+                    (X[*, M:nT - 1L] - Xmean) $
+                    , TimeDim, Double = Double)
+      3:res = TOTAL((X[*, *, 0:nT - M - 1L] - Xmean) * $
+                    (X[*, *, M:nT - 1L] - Xmean) $
+                    , TimeDim, Double = Double)
+      4:res = TOTAL((X[*, *, *, 0:nT - M - 1L] - Xmean) * $
+                    (X[*, *, *, M:nT - 1L] - Xmean) $
+                    , TimeDim, Double = Double)
+   ENDCASE
+   if keyword_set(zero2nan) then begin
+      zero = where(res EQ 0)
+      if zero[0] NE -1 then res[zero] = !values.f_nan
+   endif
+   RETURN, res
+
+END
+
+FUNCTION A_TimeCorrelate, X, Lag, COVARIANCE = Covariance, DOUBLE = Double
+
+;Compute the sample-autocorrelation or autocovariance of (Xt, Xt+l)
+;as a function of the lag (l).
+
+   ON_ERROR, 2
+
+   XDim = SIZE(X, /dimensions)
+   XNDim = SIZE(X, /n_dimensions)
+   nT = XDim[XNDim-1]
+                                ;Check length.
+   if nT lt 2 then $
+    MESSAGE, "Time axis of X array must contain 2 or more elements."
+   
+;If the DOUBLE keyword is not set then the internal precision and
+;result are identical to the type of input.
+   if N_ELEMENTS(Double) eq 0 then $
+    Double = (SIZE(X, /type) eq 5)
+
+   
+   if n_elements(lag) EQ 0 then lag = 0
+   nLag = N_ELEMENTS(Lag)
+
+   if nLag eq 1 then Lag = [Lag] ;Create a 1-element vector.
+
+   case XNDim of
+      1:if Double eq 0 then Auto = FLTARR(nLag) else Auto = DBLARR(nLag)
+      2:if Double eq 0 then Auto = FLTARR(XDim[0], nLag) else Auto = DBLARR(XDim[0], nLag)
+      3:if Double eq 0 then Auto = FLTARR(XDim[0], XDim[1], nLag) $
+      else Auto = DBLARR(XDim[0], XDim[1], nLag)
+      4:if Double eq 0 then Auto = FLTARR(XDim[0], XDim[1], XDim[2], nLag) $
+      else Auto = DBLARR(XDim[0], XDim[1], XDim[2], nLag)
+   endcase
+
+   if KEYWORD_SET(Covariance) eq 0 then begin ;Compute Autocorrelation.
+      for k = 0, nLag-1 do $
+       case XNDim of
+         1:Auto[k] = TimeAuto_Cov(X, ABS(Lag[k]), nT, Double = Double) / $
+          TimeAuto_Cov(X, 0L, nT, Double = Double, /zero2nan)
+         2:Auto[*, k] = TimeAuto_Cov(X, ABS(Lag[k]), nT, Double = Double) / $
+          TimeAuto_Cov(X, 0L, nT, Double = Double, /zero2nan)
+         3:Auto[*, *, k] = TimeAuto_Cov(X, ABS(Lag[k]), nT, Double = Double) / $
+          TimeAuto_Cov(X, 0L, nT, Double = Double, /zero2nan)
+         4:Auto[*, *, *, k] = TimeAuto_Cov(X, ABS(Lag[k]), nT, Double = Double) / $
+          TimeAuto_Cov(X, 0L, nT, Double = Double, /zero2nan)
+      endcase
+   endif else begin             ;Compute Autocovariance.
+      for k = 0, nLag-1 do $ 
+       case XNDim of
+         1:Auto[k] = TimeAuto_Cov(X, ABS(Lag[k]), nT, Double = Double) / nT
+         2:Auto[*, k] = TimeAuto_Cov(X, ABS(Lag[k]), nT, Double = Double) / nT
+         3:Auto[*, *, k] = TimeAuto_Cov(X, ABS(Lag[k]), nT, Double = Double) / nT
+         4:Auto[*, *, *, k] = TimeAuto_Cov(X, ABS(Lag[k]), nT, Double = Double) / nT
+      endcase
+   endelse
+
+   if Double eq 0 then RETURN, FLOAT(Auto) else $
+    RETURN, Auto
+
+END
Index: tags/start/STATISTICS/c2_correlate.pro
===================================================================
--- tags/start/STATISTICS/c2_correlate.pro	(revision 5)
+++ tags/start/STATISTICS/c2_correlate.pro	(revision 5)
@@ -0,0 +1,137 @@
+; $Id$
+;
+; Copyright (c) 1995-1997, Research Systems, Inc.  All rights reserved.
+;       Unauthorized reproduction prohibited.
+;+
+; NAME:
+;       c2_correlate
+;
+; PURPOSE:
+;       This function computes the cross correlation Pxy(L) or cross
+;       covariance Rxy(L) of two sample populations X and Y as a function
+;       of the lag (L).
+;
+; CATEGORY:
+;       Statistics.
+;
+; CALLING SEQUENCE:
+;       Result = c2_correlate(X, Y, Lag)
+;
+; INPUTS:
+;       X:    An n-element vector of type integer, float or double.
+;
+;       Y:    An n-element vector of type integer, float or double.
+;
+;     LAG:    A scalar or n-element vector, in the interval [-(n-2), (n-2)],
+;             of type integer that specifies the absolute distance(s) between
+;             indexed elements of X.
+;
+; KEYWORD PARAMETERS:
+;       COVARIANCE:    If set to a non-zero value, the sample cross
+;                      covariance is computed.
+;
+;       DOUBLE:        If set to a non-zero value, computations are done in
+;                      double precision arithmetic.
+;
+; EXAMPLE
+;       Define two n-element sample populations.
+;         x = [3.73, 3.67, 3.77, 3.83, 4.67, 5.87, 6.70, 6.97, 6.40, 5.57]
+;         y = [2.31, 2.76, 3.02, 3.13, 3.72, 3.88, 3.97, 4.39, 4.34, 3.95]
+;
+;       Compute the cross correlation of X and Y for LAG = -5, 0, 1, 5, 6, 7
+;         lag = [-5, 0, 1, 5, 6, 7]
+;         result = c2_correlate(x, y, lag)
+;
+;       The result should be:
+;         [-0.428246, 0.914755, 0.674547, -0.405140, -0.403100, -0.339685]
+;
+; PROCEDURE:
+;       See computational formula published in IDL manual.
+;
+; REFERENCE:
+;       INTRODUCTION TO STATISTICAL TIME SERIES
+;       Wayne A. Fuller
+;       ISBN 0-471-28715-6
+;
+; MODIFICATION HISTORY:
+;       Written by:  GGS, RSI, October 1994
+;       Modified:    GGS, RSI, August 1995
+;                    Corrected a condition which excluded the last term of the
+;                    time-series.
+;       Modified:    GGS, RSI, April 1996
+;                    Simplified CROSS_COV function. Added DOUBLE keyword.
+;                    Modified keyword checking and use of double precision.
+;       Modified:    W. Biagiotti,  Advanced Testing Technologies Inc., Hauppauge, NY, July 1997
+;                    Moved all constant calculations out of main loop for greatly
+;                    reduced processing time.
+;
+;
+; DISCLAIMER:  This routine has been modified from its original form as it was
+;              supplied by Research Systems, Inc (RSI).  As such, RSI is not responsible
+;              for any errors existing in this code.
+;-
+
+FUNCTION Cross_Cov, X, Y, M, nX, Double = Double
+  ;Sample cross covariance function.
+
+  Xmean = TOTAL(X, Double = Double) / nX
+  Ymean = TOTAL(Y, Double = Double) / nX
+  RETURN, TOTAL((X[0:nX - M - 1L] - Xmean) * (Y[M:nX - 1L] - Ymean), $
+                 Double = Double)
+
+END
+
+FUNCTION c2_correlate, X, Y, Lag, Covariance = Covariance, Double = Double
+
+  ;Compute the sample cross correlation or cross covariance of
+  ;(Xt, Xt+l) and (Yt, Yt+l) as a function of the lag (l).
+
+  ON_ERROR, 2
+
+  TypeX = SIZE(X)
+  TypeY = SIZE(Y)
+  nX = TypeX[TypeX[0]+2]
+  nY = TypeY[TypeY[0]+2]
+
+  if nX ne nY then $
+    MESSAGE, "X and Y arrays must have the same number of elements."
+
+  ;Check length.
+  if nX lt 2 then $
+    MESSAGE, "X and Y arrays must contain 2 or more elements."
+
+  ;If the DOUBLE keyword is not set then the internal precision and
+  ;result are identical to the type of input.
+  if N_ELEMENTS(Double) eq 0 then $
+    Double = (TypeX[TypeX[0]+1] eq 5 or TypeY[TypeY[0]+1] eq 5)
+
+  nLag = N_ELEMENTS(Lag)
+
+  if nLag eq 1 then Lag = [Lag] ;Create a 1-element vector.
+
+  if Double eq 0 then Cross = FLTARR(nLag) else Cross = DBLARR(nLag)
+
+  if KEYWORD_SET(Covariance) eq 0 then begin ;Compute Cross Correlation.
+
+    denom = SQRT(Cross_Cov(X, X, 0L, nX, Double = Double) * $
+                   Cross_Cov(Y, Y, 0L, nY, Double = Double))
+
+    for k = 0, nLag-1 do begin
+      if Lag[k] ge 0 $
+        then Cross[k] = Cross_Cov(x, y, Lag[k], nX, Double = Double) / denom  $
+        else Cross[k] = Cross_Cov(Y, X, ABS(Lag[k]), nY, Double = Double) / denom
+
+    endfor
+  endif else begin ;Compute Cross Covariance.
+    for k = 0, nLag-1 do begin
+      if Lag[k] ge 0 then $
+        Cross[k] = Cross_Cov(X, Y, Lag[k], nX, Double = Double) / nX $
+      else Cross[k] = Cross_Cov(Y, X, ABS(Lag[k]), nX, Double = Double) / nX
+    endfor
+  endelse
+
+  if Double eq 0 then RETURN, FLOAT(Cross) else $
+  RETURN, Cross
+
+END
+
Index: tags/start/STATISTICS/c_timecorrelate.pro
===================================================================
--- tags/start/STATISTICS/c_timecorrelate.pro	(revision 5)
+++ tags/start/STATISTICS/c_timecorrelate.pro	(revision 5)
@@ -0,0 +1,228 @@
+;+
+; NAME:
+;       C_TIMECORRELATE
+;
+; PURPOSE:
+;       This function computes the "time cross correlation" Pxy(L) or
+;       the "time cross covariance" between 2 arrays (this is some
+;       kind of c_correlate but for multidimenstionals arrays) as a
+;       function of the lag (L).
+;
+; CATEGORY:
+;       Statistics.
+;
+; CALLING SEQUENCE:
+;       Result = c_timecorrelate(X, Y, Lag)
+;
+; INPUTS:
+;       X:   an Array which last dimension is the time dimension of
+;       size n, float or double.
+;
+;       Y:    an Array which last dimension is the time dimension of
+;       size n, float or double.
+;
+;     LAG:    A scalar or n-element vector, in the interval [-(n-2), (n-2)],
+;             of type integer that specifies the absolute distance(s) between
+;             indexed elements of X.
+;
+; KEYWORD PARAMETERS:
+;       COVARIANCE:    If set to a non-zero value, the sample cross 
+;                      covariance is computed.
+;
+;       DOUBLE:        If set to a non-zero value, computations are done in
+;                      double precision arithmetic.
+;
+; EXAMPLE
+;       Define two n-element sample populations.
+;         x = [3.73, 3.67, 3.77, 3.83, 4.67, 5.87, 6.70, 6.97, 6.40, 5.57]
+;         y = [2.31, 2.76, 3.02, 3.13, 3.72, 3.88, 3.97, 4.39, 4.34, 3.95]
+;
+;       Compute the cross correlation of X and Y for LAG = -5, 0, 1, 5, 6, 7
+;         lag = [-5, 0, 1, 5, 6, 7]
+;         result = c_timecorrelate(x, y, lag)
+;
+;       The result should be:
+;         [-0.428246, 0.914755, 0.674547, -0.405140, -0.403100, -0.339685]
+;
+; PROCEDURE:
+;
+;
+;   FOR L>=0 
+;
+;                              n-L-1 
+;                              sigma  (X[k]-Xmean)(Y[k+L]-Ymean)
+;                               k=0
+;   correlation(X,Y,L)=------------------------------------------------------
+;                              n-1                     n-1
+;                      sqrt( (sigma  (X[k]-Xmean)^2)*(sigma  (Y[k]-Ymean)^2))
+;                              k=0                     k=0
+;
+;
+;
+;                              n-L-1 
+;                              sigma  (X[k]-Xmean)(Y[k+L]-Ymean)
+;                               k=0
+;   covariance(X,Y,L)=------------------------------------------------------
+;                                            n
+;
+;   FOR L<0
+;
+;
+;                              n-L-1 
+;                              sigma  (X[k+L]-Xmean)(Y[k]-Ymean)
+;                               k=0
+;   correlation(X,Y,L)=------------------------------------------------------
+;                              n-1                     n-1
+;                      sqrt( (sigma  (X[k]-Xmean)^2)*(sigma  (Y[k]-Ymean)^2))
+;                              k=0                     k=0
+;
+;
+;
+;                              n-L-1 
+;                              sigma  (X[k+L]-Xmean)(Y[k]-Ymean)
+;                               k=0
+;   covariance(X,Y,L)=------------------------------------------------------
+;                                            n
+;
+;   Where Xmean and Ymean are the time means of the sample populations
+;   x=(x[t=0],x[t=1],...,x[t=n-1]) and y=(y[t=0],y[t=1],...,y[t=n-1]),
+;   respectively.
+;
+;
+;
+; REFERENCE:
+;       INTRODUCTION TO STATISTICAL TIME SERIES
+;       Wayne A. Fuller
+;       ISBN 0-471-28715-6
+;
+; MODIFICATION HISTORY:
+;       01/03/2000 Sebastien Masson (smasson@lodyc.jussieu.fr)
+;       Based on the C_CORRELATE procedure of IDL
+;-
+
+FUNCTION TimeCross_Cov, X, Y, M, nT, Double = Double, ZERO2NAN = zero2nan
+;
+   if double then one = 1.0d ELSE one = 1.0
+; Sample cross covariance function.
+   TimeDim = size(X, /n_dimensions)
+   Xmean = TOTAL(X, TimeDim, Double = Double) / nT
+   Xmean = Xmean[*]#replicate(one,  nT - M)
+   Ymean = TOTAL(Y, TimeDim, Double = Double) / nT
+   Ymean = Ymean[*]#replicate(one,  nT - M)
+;
+   case TimeDim of
+      1:res = TOTAL((X[0:nT - M - 1L] - Xmean) * (Y[M:nT - 1L] - Ymean) $
+                    , Double = Double)
+      2:res = TOTAL((X[*, 0:nT - M - 1L] - Xmean) * (Y[*, M:nT - 1L] - Ymean) $
+                    , TimeDim, Double = Double)
+      3:res = TOTAL((X[*, *, 0:nT - M - 1L] - Xmean) * (Y[*, *, M:nT - 1L] - Ymean) $
+                    , TimeDim, Double = Double)
+      4:res = TOTAL((X[*, *, *, 0:nT - M - 1L] - Xmean) * (Y[*, *, *, M:nT - 1L] - Ymean) $
+                    , TimeDim, Double = Double)
+   ENDCASE
+   if keyword_set(zero2nan) then begin
+      zero = where(res EQ 0)
+      if zero[0] NE -1 then res[zero] = !values.f_nan
+   ENDIF
+;
+   RETURN, res
+
+END
+
+FUNCTION C_Timecorrelate, X, Y, Lag, Covariance = Covariance, Double = Double
+
+;Compute the sample cross correlation or cross covariance of 
+;(Xt, Xt+l) and (Yt, Yt+l) as a function of the lag (l).
+
+   ON_ERROR, 2
+
+   xsize = SIZE(X)
+   ysize = SIZE(Y)
+   nt = float(xsize[xsize[0]])
+   NDim = xsize[0]
+
+   if total(xsize[0:xsize[0]] NE ysize[0:ysize[0]]) NE 0 then $
+    MESSAGE, "X and Y arrays must have the same size and the same dimensions"
+
+;Check length.
+   if nt lt 2 then $
+    MESSAGE, "Time dimension of X and Y arrays must contain 2 or more elements."
+   
+;If the DOUBLE keyword is not set then the internal precision and
+;result are identical to the type of input.
+   if N_ELEMENTS(Double) eq 0 then $
+    Double = (Xsize[Xsize[0]+1] eq 5 or ysize[ysize[0]+1] eq 5)
+
+   if n_elements(lag) EQ 0 then lag = 0
+   nLag = N_ELEMENTS(Lag)
+
+   if nLag eq 1 then Lag = [Lag] ;Create a 1-element vector.
+
+   case NDim of
+      1:if Double eq 0 then Correl = FLTARR(nLag) else Correl = DBLARR(nLag)
+      2:if Double eq 0 then Correl = FLTARR(Xsize[1], nLag) else Correl = DBLARR(Xsize[1], nLag)
+      3:if Double eq 0 then Correl = FLTARR(Xsize[1], Xsize[2], nLag) $
+      else Correl = DBLARR(Xsize[1], Xsize[2], nLag)
+      4:if Double eq 0 then Correl = FLTARR(Xsize[1], Xsize[2], Xsize[3], nLag) $
+      else Correl = DBLARR(Xsize[1], Xsize[2], Xsize[3], nLag)
+   endcase
+
+   if KEYWORD_SET(Covariance) eq 0 then begin ;Compute Cross Correlation.
+      for k = 0, nLag-1 do begin
+         if Lag[k] ge 0 then BEGIN 
+            case NDim of
+               1:Correl[k] = TimeCross_Cov(X, Y, Lag[k], nT, Double = Double) / $
+                sqrt(TimeCross_Cov(X,X, 0L, nT, Double = Double, /zero2nan) * $
+                     TimeCross_Cov(Y,Y, 0L, nT, Double = Double, /zero2nan))
+               2:Correl[*, k] = TimeCross_Cov(X, Y, Lag[k], nT, Double = Double) / $
+                sqrt(TimeCross_Cov(X,X, 0L, nT, Double = Double, /zero2nan) * $
+                     TimeCross_Cov(Y,Y, 0L, nT, Double = Double, /zero2nan))
+               3:Correl[*, *, k] = TimeCross_Cov(X, Y, Lag[k], nT, Double = Double) / $
+                sqrt(TimeCross_Cov(X,X, 0L, nT, Double = Double, /zero2nan) * $
+                     TimeCross_Cov(Y,Y, 0L, nT, Double = Double, /zero2nan))
+               4:Correl[*, *, *, k] = TimeCross_Cov(X, Y, Lag[k], nT, Double = Double) / $
+                sqrt(TimeCross_Cov(X,X, 0L, nT, Double = Double, /zero2nan) * $
+                     TimeCross_Cov(Y,Y, 0L, nT, Double = Double, /zero2nan))
+            endcase
+         ENDIF else BEGIN 
+            case NDim of
+               1:Correl[k] = TimeCross_Cov(y, x, ABS(Lag[k]), nT, Double = Double) / $
+                sqrt(TimeCross_Cov(X,X, 0L, nT, Double = Double, /zero2nan) * $
+                     TimeCross_Cov(Y,Y, 0L, nT, Double = Double, /zero2nan))
+               2:Correl[*, k] = TimeCross_Cov(y, x, ABS(Lag[k]), nT, Double = Double) / $
+                sqrt(TimeCross_Cov(X,X, 0L, nT, Double = Double, /zero2nan) * $
+                     TimeCross_Cov(Y,Y, 0L, nT, Double = Double, /zero2nan))
+               3:Correl[*, *, k] = TimeCross_Cov(y, x, ABS(Lag[k]), nT, Double = Double) / $
+                sqrt(TimeCross_Cov(X,X, 0L, nT, Double = Double, /zero2nan) * $
+                     TimeCross_Cov(Y,Y, 0L, nT, Double = Double, /zero2nan))
+               4:Correl[*, *, *, k] = TimeCross_Cov(y, x, ABS(Lag[k]), nT, Double = Double) / $
+                sqrt(TimeCross_Cov(X,X, 0L, nT, Double = Double, /zero2nan) * $
+                     TimeCross_Cov(Y,Y, 0L, nT, Double = Double, /zero2nan))
+            endcase
+         ENDELSE 
+      endfor
+   endif else begin             ;Compute Cross Covariance.
+      for k = 0, nLag-1 do begin
+         if Lag[k] ge 0 then BEGIN
+            case NDim of
+               1:Correl[k] = TimeCross_Cov(X, Y, Lag[k], nT, Double = Double) / nT
+               2:Correl[*, k] = TimeCross_Cov(X, Y, Lag[k], nT, Double = Double) / nT
+               3:Correl[*, *, k] = TimeCross_Cov(X, Y, Lag[k], nT, Double = Double) / nT
+               4:Correl[*, *, *, k] = TimeCross_Cov(X, Y, Lag[k], nT, Double = Double) / nT
+            ENDCASE
+         ENDIF else BEGIN 
+            case NDim of
+               1:Correl[k] = TimeCross_Cov(y, x, ABS(Lag[k]), nT, Double = Double) / nT
+               2:Correl[*, k] = TimeCross_Cov(y, x, ABS(Lag[k]), nT, Double = Double) / nT
+               3:Correl[*, *, k] = TimeCross_Cov(y, x, ABS(Lag[k]), nT, Double = Double) / nT
+               4:Correl[*, *, *, k] = TimeCross_Cov(y, x, ABS(Lag[k]), nT, Double = Double) / nT
+            ENDCASE
+         ENDELSE 
+      endfor
+   endelse
+
+   if Double eq 0 then RETURN, FLOAT(Correl) else $
+    RETURN, Correl
+
+END
+  
Index: tags/start/STRING/chkeywd.pro
===================================================================
--- tags/start/STRING/chkeywd.pro	(revision 5)
+++ tags/start/STRING/chkeywd.pro	(revision 5)
@@ -0,0 +1,104 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: chkeywd (change keyword)
+;
+; PURPOSE: ds un string qui contient une commande a executer avec
+; EXECUTE par ex. On change la valeur d''un des mot cle.
+; Plus generalement, ds un string, on cherche la chaine de
+; chacarteres: ', keywdname= ..., et on change la valeur de ...
+;
+; CATEGORY: pour bidouiller des commandes passees par execute
+;
+; CALLING SEQUENCE: stringout=chkeywd(stringin, keywdname, keywdvalue)
+; 
+; INPUTS:
+;      stringin: un string
+;      keywdname: un string designant le nom du mot clef a chercher.
+;      keywdvalue: nouvelle valeur du mot clef a considerer ds stringin
+;
+; KEYWORD PARAMETERS:
+;      pour chercher le mot cle, on cherche le premier signe = qui
+;      suit la position de keywdname. on substitue
+;      pardefaut tout le bout de string qui suit jusqu''a la prochaine
+;      virgule. avec les mots cles SEPARATOR et AFTER on peut modifier
+;      cette decoupe du string:
+;      SEPARATOR donne un chatactere avant (ou apres si AFTER est
+;      active) lequel il faut chercher la virgule qui delimite le mot
+;      cle ds le string. cf. les exemples
+;
+; OUTPUTS:stringout=stringin modifie si keywdname a ete trouve ds
+; stringin
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;   
+;   Si keywdvalue est un tableau, il sera convertit en vecteur.
+;
+; RESTRICTIONS:
+;
+;   attention cette fonction comporte des boucles, des if et des cases
+;   ds tous les sens. Elle ne doit donc pas etre utilisee avec des
+;   mots clefs de grosse taille (avec bcp d''elements et avec des
+;   elements etant de gros tableaux).
+;   le mot clef en entree ne doit pas contenir de Complex floating, de
+;   structure, de Double-precision complex, de Pointer, de Object
+;   reference, de Unsigned Integer, de Unsigned Longword Integer, de
+;   64-bit Integer, de Unsigned 64-bit Integer	
+;
+; EXAMPLE:
+;
+;   IDL> b='ok=111, year=[1997,1998,1999], age_capitaine=35'
+;   IDL> print, b
+;   ok=111, year=[1997,1998,1999], age_capitaine=35
+;   IDL> print, chkeywd(b,'ok','c''est bon')
+;   ok='c''est bon', year=[1997,1998,1999], age_capitaine=35
+;   IDL> print, chkeywd(b,'YEAR',indgen(5),sep='=')
+;   ok=111, year=[0,1,2,3,4], age_capitaine=35
+;   IDL> print, chkeywd(b,'YEAR',indgen(5),sep=']',/after)
+;   ok=111, year=[0,1,2,3,4], age_capitaine=35
+;   IDL> b='ok=111, /year, /age_capitaine'
+;   IDL> print, chkeywd(b,'year','c''est bon')
+;   ok=111, year='c''est bon', /age_capitaine
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      18/10/1999
+;                      24/11/1999: adaptation pour les mots cles
+;                      commencant par /
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION chkeywd, stringin, keywdname, keywdvalue, SEPARATOR = separator, AFTER = after
+
+   stringout = stringin
+   poskeywd = strpos(strlowcase(stringout), strlowcase(keywdname))
+   if poskeywd EQ -1 then return, stringout
+   while poskeywd NE -1 do BEGIN
+; changer un mot cle qui commence par /toto
+      if strmid(stringout,poskeywd-1,1) EQ '/' then BEGIN
+         ajoute = keywdname+'='+tostr(keywdvalue)
+         stringout = strmid(stringout, 0, poskeywd-1)+ajoute+strmid(stringout,poskeywd+strlen(keywdname) )
+         poskeywd = poskeywd+strlen(ajoute)
+         poskeywd = strpos(stringout, keywdname, poskeywd)
+      ENDIF ELSE BEGIN 
+; changer un mot cle qui commence par toto=
+         posegal = strpos(stringout, '=', poskeywd)
+         if posegal EQ -1 then return, stringout
+
+         if NOT keyword_set(separator) then separator = ','
+         posvirgule = strpos(stringout, separator, posegal+1)
+         if keyword_set(after) then posvirgule = strpos(stringout, ',', posvirgule-1) $
+         ELSE posvirgule = rstrpos(stringout, ',', posvirgule+1)
+         if posvirgule EQ -1 then posvirgule = strlen(stringout)
+;
+         stringout = strmid(stringout, 0, posegal+1)+tostr(keywdvalue)+strmid(stringout, posvirgule)
+;
+         poskeywd = strpos(stringout, keywdname, posvirgule+1)
+      ENDELSE 
+   endwhile
+
+   return,  stringout
+end
Index: tags/start/STRING/delchr.pro
===================================================================
--- tags/start/STRING/delchr.pro	(revision 5)
+++ tags/start/STRING/delchr.pro	(revision 5)
@@ -0,0 +1,48 @@
+;-------------------------------------------------------------
+;+
+; NAME:
+;       DELCHR
+; PURPOSE:
+;       Delete all occurrences of a character from a text string.
+; CATEGORY:
+; CALLING SEQUENCE:
+;       new = delchr(old, char)
+; INPUTS:
+;       old = original text string.     in
+;       char = character to delete.     in
+; KEYWORD PARAMETERS:
+; OUTPUTS:
+;       new = resulting string.         out
+; COMMON BLOCKS:
+; NOTES:
+; MODIFICATION HISTORY:
+;       R. Sterner.  5 Jul, 1988.
+;       Johns Hopkins Applied Physics Lab.
+;       RES 11 Sep, 1989 --- converted to SUN.
+;       R. Sterner, 27 Jan, 1993 --- dropped reference to array.
+;
+; Copyright (C) 1988, Johns Hopkins University/Applied Physics Laboratory
+; This software may be used, copied, or redistributed as long as it is not
+; sold and this copyright notice is reproduced on each copy made.  This
+; routine is provided as is without any express or implied warranties
+; whatsoever.  Other limitations apply as described in the file disclaimer.txt.
+;-
+;-------------------------------------------------------------
+ 
+	FUNCTION DELCHR, OLD, C, help=hlp
+ 
+	if (n_params(0) lt 2) or keyword_set(hlp) then begin
+	  print,' Delete all occurrences of a character from a text string.'
+	  print,' new = delchr(old, char)'
+	  print,'   old = original text string.     in'
+	  print,'   char = character to delete.     in'
+	  print,'   new = resulting string.         out'
+	  return, -1
+	endif
+ 
+	B = BYTE(OLD)			   ; convert string to a byte array.
+	CB = BYTE(C)			   ; convert char to byte.
+	w = where(b ne cb(0))
+	if w(0) eq -1 then return, ''	   ; Nothing left.
+	return, string(b(w))		   ; Return new string.
+	END
Index: tags/start/STRING/getfile.pro
===================================================================
--- tags/start/STRING/getfile.pro	(revision 5)
+++ tags/start/STRING/getfile.pro	(revision 5)
@@ -0,0 +1,91 @@
+;-------------------------------------------------------------
+;+
+; NAME:
+;       GETFILE
+; PURPOSE:
+;       Read a text file into a string array.
+; CATEGORY:
+; CALLING SEQUENCE:
+;       s = getfile(f)
+; INPUTS:
+;       f = text file name.      in
+; KEYWORD PARAMETERS:
+;       Keywords:
+;         ERROR=err  error flag: 0=ok, 1=file not opened,
+;           2=no lines in file.
+;         /QUIET means give no error message.
+; OUTPUTS:
+;       s = string array.        out
+; COMMON BLOCKS:
+; NOTES:
+; MODIFICATION HISTORY:
+;       R. Sterner, 20 Mar, 1990
+;
+;       S. Masson (smasson@lodyc.jussieu.fr) 13 Mar, 2000
+;       search te file in the all !path directories (use find.pro)
+;
+; Copyright (C) 1990, Johns Hopkins University/Applied Physics Laboratory
+; This software may be used, copied, or redistributed as long as it is not
+; sold and this copyright notice is reproduced on each copy made.  This
+; routine is provided as is without any express or implied warranties
+; whatsoever.  Other limitations apply as described in the file disclaimer.txt.
+;-
+;-------------------------------------------------------------
+ 
+	function getfile, filein, error=err, help=hlp, quiet=quiet
+ 
+	if (n_params(0) lt 1) or keyword_set(hlp) then begin
+	  print,' Read a text file into a string array.'
+	  print,' s = getfile(f)'
+	  print,'   f = text file name.      in'
+	  print,'   s = string array.        out'
+	  print,' Keywords:'
+	  print,'   ERROR=err  error flag: 0=ok, 1=file not opened,'
+	  print,'     2=no lines in file.'
+	  print,'   /QUIET means give no error message.'
+	  return, -1
+	endif
+;
+        file = find(filein)
+        file = file[0]
+        if file EQ 'NOT FOUND' then begin
+           print, ' Error in getfile: File '+filein+' not fouond.'
+           return, -1
+        endif
+        
+; 
+	get_lun, lun
+	on_ioerror, err
+	openr, lun, file
+ 
+	s = [' ']
+	t = ''
+ 
+	while not eof(lun) do begin
+	  readf, lun, t
+	  s = [s,t]
+	endwhile
+ 
+	close, lun
+	free_lun, lun
+	if n_elements(s) eq 1 then begin
+	  if not keyword_set(quiet) then print,' No lines in file.'
+	  err = 2
+	  return,-1
+	endif
+ 
+	err = 0
+	return, s(1:*)
+ 
+err:	if !err eq -168 then begin
+	  if not keyword_set(quiet) then print,' Non-standard text file format.'
+	  free_lun, lun
+	  return, s(1:*)
+	endif
+	if not keyword_set(quiet) then print,$
+	  ' Error in getfile: File '+file+' not opened.'
+	free_lun, lun
+	err = 1
+	return, -1
+ 
+	end
Index: tags/start/STRING/getwrd.pro
===================================================================
--- tags/start/STRING/getwrd.pro	(revision 5)
+++ tags/start/STRING/getwrd.pro	(revision 5)
@@ -0,0 +1,151 @@
+;-------------------------------------------------------------
+;+
+; NAME:
+;       GETWRD
+; PURPOSE:
+;       Return the n'th word from a text string.
+; CATEGORY:
+; CALLING SEQUENCE:
+;       wrd = getwrd(txt, n, [m])
+; INPUTS:
+;       txt = text string to extract from.         in
+;       n = word number to get (first = 0 = def).  in
+;       m = optional last word number to get.      in
+; KEYWORD PARAMETERS:
+;       Keywords:
+;         LOCATION = l.  Return word n string location.
+;         DELIMITER = d. Set word delimiter (def = space & tab).
+;         /LAST means n is offset from last word.  So n=0 gives
+;           last word, n=-1 gives next to last, ...
+;           If n=-2 and m=0 then last 3 words are returned.
+;         /NOTRIM suppresses whitespace trimming on ends.
+;         NWORDS=n.  Returns number of words in string.
+; OUTPUTS:
+;       wrd = returned word or words.              out
+; COMMON BLOCKS:
+;       getwrd_com
+; NOTES:
+;       Note: If a NULL string is given (txt="") then the last string
+;             given is used.  This saves finding the words again.
+;             If m > n wrd will be a string of words from word n to
+;             word m.  If no m is given wrd will be a single word.
+;             n<0 returns text starting at word abs(n) to string end
+;             If n is out of range then a null string is returned.
+;             See also nwrds.
+; MODIFICATION HISTORY:
+;       Ray Sterner,  6 Jan, 1985.
+;       R. Sterner, Fall 1989 --- converted to SUN.
+;       R. Sterner, Jan 1990 --- added delimiter.
+;       R. Sterner, 18 Mar, 1990 --- added /LAST.
+;       R. Sterner, 31 Jan, 1991 --- added /NOTRIM.
+;       R. Sterner, 20 May, 1991 --- Added common and NULL string.
+;       R. Sterner, 13 Dec, 1992 --- Made tabs equivalent to spaces.
+;       R. Sterner,  4 Jan, 1993 --- Added NWORDS keyword.
+;       Johns Hopkins University Applied Physics Laboratory.
+;
+; Copyright (C) 1985, Johns Hopkins University/Applied Physics Laboratory
+; This software may be used, copied, or redistributed as long as it is not
+; sold and this copyright notice is reproduced on each copy made.  This
+; routine is provided as is without any express or implied warranties
+; whatsoever.  Other limitations apply as described in the file disclaimer.txt.
+;-
+;-------------------------------------------------------------
+ 
+ 
+	FUNCTION GETWRD, TXTSTR, NTH, MTH, help=hlp, location=ll,$
+	   delimiter=delim, notrim=notrim, last=last, nwords=nwords
+ 
+	common getwrd_com, txtstr0, nwds, loc, len
+ 
+	if (n_params(0) lt 1) or keyword_set(hlp) then begin
+	  print," Return the n'th word from a text string."
+	  print,' wrd = getwrd(txt, n, [m])'
+	  print,'   txt = text string to extract from.         in'
+	  print,'   n = word number to get (first = 0 = def).  in'
+	  print,'   m = optional last word number to get.      in'
+	  print,'   wrd = returned word or words.              out'
+	  print,' Keywords:'
+	  print,'   LOCATION = l.  Return word n string location.'
+	  print,'   DELIMITER = d. Set word delimiter (def = space & tab).'
+	  print,'   /LAST means n is offset from last word.  So n=0 gives'
+	  print,'     last word, n=-1 gives next to last, ...'
+	  print,'     If n=-2 and m=0 then last 3 words are returned.'
+	  print,'   /NOTRIM suppresses whitespace trimming on ends.'
+	  print,'   NWORDS=n.  Returns number of words in string.'
+	  print,'Note: If a NULL string is given (txt="") then the last string'
+	  print,'      given is used.  This saves finding the words again.'
+	  print,'      If m > n wrd will be a string of words from word n to'
+	  print,'      word m.  If no m is given wrd will be a single word.'
+	  print,'      n<0 returns text starting at word abs(n) to string end'
+	  print,'      If n is out of range then a null string is returned.'
+	  print,'      See also nwrds.'
+	  return, -1
+	endif
+ 
+	if n_params(0) lt 2 then nth = 0		; Def is first word.
+	IF N_PARAMS(0) LT 3 THEN MTH = NTH		; Def is one word.
+ 
+	if strlen(txtstr) gt 0 then begin
+	  ddel = ' '					; Def del is a space.
+	  if n_elements(delim) ne 0 then ddel = delim	; Use given delimiter.
+	  TST = (byte(ddel))(0)				; Del to byte value.
+	  tb = byte(txtstr)				; String to bytes.
+	  if ddel eq ' ' then begin		        ; Check for tabs?
+	    w = where(tb eq 9B, cnt)			; Yes.
+	    if cnt gt 0 then tb(w) = 32B		; Convert any to space.
+	  endif
+	  X = tb NE TST					; Non-delchar (=words).
+	  X = [0,X,0]					; 0s at ends.
+ 
+	  Y = (X-SHIFT(X,1)) EQ 1			; Diff=1: word start.
+	  Z = WHERE(SHIFT(Y,-1) EQ 1)			; Word start locations.
+	  Y2 = (X-SHIFT(X,-1)) EQ 1			; Diff=1: word end.
+	  Z2 = WHERE(SHIFT(Y2,1) EQ 1)			; Word end locations.
+ 
+	  txtstr0 = txtstr				; Move string to common.
+	  NWDS = long(TOTAL(Y))				; Number of words.
+	  LOC = Z					; Word start locations.
+	  LEN = Z2 - Z - 1				; Word lengths.
+	endif else begin
+	  if n_elements(nwds) eq 0 then begin		; Check if first call.
+	    print,' Error in getwrd: must give a '+$
+	      'non-NULL string on the first call.'
+	    return, -1					; -1 = error flag.
+	  endif
+	endelse
+ 
+	nwords = nwds					; Set nwords
+ 
+	if keyword_set(last) then begin			; Offset from last.
+	  lst = nwds - 1
+	  in = lst + nth				; Nth word.
+	  im = lst + mth				; Mth word.
+	  if (in lt 0) and (im lt 0) then return, ''	; Out of range.
+	  in = in > 0					; Smaller of in and im
+	  im = im > 0					;  to zero.
+	  if (in gt lst) and (im gt lst) then return,'' ; Out of range.
+	  in = in < lst					; Larger of in and im
+	  im = im < lst					;  to be last.
+	  ll = loc(in)					; Nth word start.
+	  return, strtrim(strmid(txtstr0,ll,loc(im)-loc(in)+len(im)), 2) 
+	endif
+ 
+	N = ABS(NTH)					; Allow nth<0.
+	IF N GT NWDS-1 THEN RETURN,''			; out of range, null.
+	ll = loc(n)					; N'th word position.
+	IF NTH LT 0 THEN GOTO, NEG			; Handle nth<0.
+	IF MTH GT NWDS-1 THEN MTH = NWDS-1		; Words to end.
+ 
+	if keyword_set(notrim) then begin
+	  RETURN, STRMID(TXTSTR0,ll,LOC(MTH)-LOC(NTH)+LEN(MTH))
+	endif else begin
+	  RETURN, strtrim(STRMID(TXTSTR0,ll,LOC(MTH)-LOC(NTH)+LEN(MTH)), 2)
+ 	endelse
+ 
+NEG:	if keyword_set(notrim) then begin
+	  RETURN, STRMID(TXTSTR0,ll,9999)
+	endif else begin
+	  RETURN, strtrim(STRMID(TXTSTR0,ll,9999), 2)
+	endelse
+ 
+	END
Index: tags/start/STRING/isnumber.pro
===================================================================
--- tags/start/STRING/isnumber.pro	(revision 5)
+++ tags/start/STRING/isnumber.pro	(revision 5)
@@ -0,0 +1,108 @@
+;-------------------------------------------------------------
+;+
+; NAME:
+;       ISNUMBER
+; PURPOSE:
+;       Determine if a text string is a valid number.
+; CATEGORY:
+; CALLING SEQUENCE:
+;       i = isnumber(txt, [x])
+; INPUTS:
+;       txt = text string to test.                      in
+; KEYWORD PARAMETERS:
+; OUTPUTS:
+;       x = optionaly returned numeric value if valid.  out
+;       i = test flag:                                  out
+;           0: not a number.
+;           1: txt is a long integer.
+;           2: txt is a float.
+;           -1: first word of txt is a long integer.
+;           -2: first word of txt is a float.
+; COMMON BLOCKS:
+; NOTES:
+; MODIFICATION HISTORY:
+;       R. Sterner.  15 Oct, 1986.
+;       Johns Hopkins Applied Physics Lab.
+;       R. Sterner, 12 Mar, 1990 --- upgraded.
+;	Richard Garrett, 14 June, 1992 --- fixed bug in returned float value.
+;
+; Copyright (C) 1986, Johns Hopkins University/Applied Physics Laboratory
+; This software may be used, copied, or redistributed as long as it is not
+; sold and this copyright notice is reproduced on each copy made.  This
+; routine is provided as is without any express or implied warranties
+; whatsoever.  Other limitations apply as described in the file disclaimer.txt.
+;-
+;-------------------------------------------------------------
+ 
+	FUNCTION ISNUMBER, TXT0, X, help=hlp
+	
+        if (n_params(0) lt 1) or keyword_set(hlp) then begin
+	  print,' Determine if a text string is a valid number.'
+	  print,' i = isnumber(txt, [x])'
+	  print,'   txt = text string to test.                      in'
+	  print,'   x = optionaly returned numeric value if valid.  out'
+	  print,'   i = test flag:                                  out'
+	  print,'       0: not a number.'
+	  print,'       1: txt is a long integer.'
+	  print,'       2: txt is a float.'
+	  print,'       -1: first word of txt is a long integer.'
+	  print,'       -2: first word of txt is a float.'
+	  return, -1
+	endif
+ 
+	TXT = STRTRIM(TXT0,2)	; trim blanks.
+	X = 0			; define X.
+ 
+	IF TXT EQ '' THEN RETURN, 0	; null string not a number.
+ 
+	SN = 1
+	IF NWRDS(TXT) GT 1 THEN BEGIN	; get first word if more than one.
+	  SN = -1
+	  TXT = GETWRD(TXT,0)
+	ENDIF
+	  
+	f_flag = 0		; Floating flag.
+	b = byte(txt)
+	w = where(b eq 43, cnt)
+	if cnt gt 1 then return, 0
+	t = delchr(txt,'+')
+	w = where(b eq 45, cnt)
+	if cnt gt 1 then return, 0
+	t = delchr(t,'-')
+	w = where(b eq 46, cnt)			; '.'
+	if cnt gt 1 then return, 0		; May only be 1.
+	if cnt eq 1 then f_flag = 1		; If one then floating.
+	t = delchr(t,'.')
+	w = where(b eq 101, cnt)		; 'e'
+	if cnt gt 1 then return, 0
+	if cnt eq 1 then f_flag = 1
+	t = delchr(t,'e')
+	w = where(b eq 69, cnt)			; 'E'
+	if cnt gt 1 then return, 0
+	if cnt eq 1 then f_flag = 1
+	t = delchr(t,'E')
+	w = where(b eq 100, cnt)		; 'd'
+	if cnt gt 1 then return, 0
+	if cnt eq 1 then f_flag = 1
+	t = delchr(t,'d')
+	w = where(b eq 68, cnt)			; 'D'
+	if cnt gt 1 then return, 0
+	if cnt eq 1 then f_flag = 1
+	t = delchr(t,'D')
+	if total((b eq 101)+(b eq 69)+(b eq 100)+(b eq 68)) gt 1 then return,0
+	b = byte(t)
+	if total((b ge 65) and (b le 122)) ne 0 then return, 0
+ 
+	c = strmid(t,0,1)
+	if (c lt '0') or (c gt '9') then return, 0  ; First char not a digit.
+ 
+	x = txt + 0.0				    ; Convert to a float.
+	if f_flag eq 1 then return, 2*sn	    ; Was floating.
+	if x eq long(x) then begin
+	  x = long(x)
+	  return, sn
+	endif else begin
+	  return, 2*sn
+	endelse
+ 
+	END
Index: tags/start/STRING/lenstr.pro
===================================================================
--- tags/start/STRING/lenstr.pro	(revision 5)
+++ tags/start/STRING/lenstr.pro	(revision 5)
@@ -0,0 +1,76 @@
+function lenstr,str
+;+
+; ROUTINE:         lenstr
+; USEAGE:          result=lenstr(str)
+;
+; input:
+;  str             a single string or string array.
+; 
+; output:
+;  result          length of the string(s) in normalized units
+;                  the number of elements of RESULT matches the number of 
+;                  elements of STRING. 
+;
+; procedure:
+;                  This function returns the physical length of the
+;                  string on the output device, not the number of
+;                  characters.  This is done by first switching to 'X'
+;                  and writing the string(s) with XYOUTS in graphics
+;                  mode 5, which disables display to the screen but
+;                  does not interfere with operation of XYOUTS.  The
+;                  WIDTH keyword parameter of XYOUTS is used to
+;                  retrieve the physical length of the string(s).
+;
+;  author:  Paul Ricchiazzi                            7apr93
+;           Institute for Computational Earth System Science
+;           University of California, Santa Barbara
+;-
+
+   dsave=!d.name
+
+   thisOS = !VERSION.OS_FAMILY
+   thisOS = STRMID(thisOS, 0, 3)
+   thisOS = STRUPCASE(thisOS)
+   CASE thisOS of
+      'MAC': SET_PLOT, thisOS
+      'WIN': SET_PLOT, thisOS
+      ELSE: SET_PLOT, 'X'
+   ENDCASE
+   !p.BACKGROUND=(!d.n_colors-1) < 255
+   !p.color=0
+   if !d.n_colors gt 256 then !p.background='ffffff'x
+
+   device,get_graphics=oldg,set_graphics=5
+   if keyword_set(charsize) eq 0 then charsize=1
+   nn=n_elements(str)
+
+   case nn of
+
+      0:w=0
+
+      1:xyouts,0,0,/device,str,width=w
+
+      else:begin
+         w=fltarr(nn)
+         for i=0,nn-1 do begin
+            xyouts,0,0,/device,str(i),width=ww
+            w(i)=ww
+         endfor
+      end
+   endcase
+
+   fac1=float(!d.x_ch_size)/!d.x_vsize ; ratio of char width to device1 width
+
+   device,set_graphics=oldg
+   set_plot,dsave
+   IF dsave EQ 'X' OR dsave EQ 'MAC' OR dsave EQ 'WIN' then BEGIN
+      !p.BACKGROUND=(!d.n_colors-1) < 255
+      !p.color=0
+      if !d.n_colors gt 256 then !p.background='ffffff'x
+   ENDIF
+
+   fac2=float(!d.x_ch_size)/!d.x_vsize ; ratio of char width to device2 width
+
+   return,w*fac2/fac1           ; string width adjusted for device width
+end
+
Index: tags/start/STRING/nwrds.pro
===================================================================
--- tags/start/STRING/nwrds.pro	(revision 5)
+++ tags/start/STRING/nwrds.pro	(revision 5)
@@ -0,0 +1,65 @@
+;-------------------------------------------------------------
+;+
+; NAME:
+;       NWRDS
+; PURPOSE:
+;       Return the number of words in the given text string.
+; CATEGORY:
+; CALLING SEQUENCE:
+;       n = nwrds(txt)
+; INPUTS:
+;       txt = text string to examine.             in
+; KEYWORD PARAMETERS:
+;       Keywords:
+;         DELIMITER = d.  Set delimiter character (def = space).
+; OUTPUTS:
+;       n = number of words found.                out
+; COMMON BLOCKS:
+; NOTES:
+;       Notes: See also getwrd.
+; MODIFICATION HISTORY:
+;       R. Sterner,  7 Feb, 1985.
+;       Johns Hopkins University Applied Physics Laboratory.
+;       RES 4 Sep, 1989 --- converted to SUN.
+;
+; Copyright (C) 1985, Johns Hopkins University/Applied Physics Laboratory
+; This software may be used, copied, or redistributed as long as it is not
+; sold and this copyright notice is reproduced on each copy made.  This
+; routine is provided as is without any express or implied warranties
+; whatsoever.  Other limitations apply as described in the file disclaimer.txt.
+;-
+;-------------------------------------------------------------
+ 
+ 
+	function nwrds,txtstr, help=hlp, delimiter=delim
+ 
+	if (n_params(0) lt 1) or keyword_set(hlp) then begin
+	  print,' Return the number of words in the given text string.'
+	  print,' n = nwrds(txt)'
+	  print,'   txt = text string to examine.             in'
+	  print,'   n = number of words found.                out'
+	  print,' Keywords:'
+	  print,'   DELIMITER = d.  Set delimiter character (def = space).'
+	  print,' Notes: See also getwrd.'
+	  return, -1
+	endif
+ 
+	if strlen(txtstr) eq 0 then return,0	; A null string has 0 words.
+	ddel = ' '			; Default word delimiter is a space.
+	if n_elements(delim) ne 0 then ddel = delim ; Use given word delimiter.
+	tst = (byte(ddel))(0)			; Delimiter as a byte value.
+        tb = byte(txtstr)                             ; String to bytes.
+        if ddel eq ' ' then begin                     ; Check for tabs?
+          w = where(tb eq 9B, cnt)                    ; Yes.
+          if cnt gt 0 then tb(w) = 32B                ; Convert any to space.
+        endif
+	x = tb ne tst				; Locate words.
+	x = [0,x,0]				; Pad ends with delimiters.
+ 
+	y = (x-shift(x,1)) eq 1			; Look for word beginnings.
+ 
+	n = fix(total(y))			; Count word beginnings.
+ 
+	return, n
+ 
+	end
Index: tags/start/STRING/putfile.pro
===================================================================
--- tags/start/STRING/putfile.pro	(revision 5)
+++ tags/start/STRING/putfile.pro	(revision 5)
@@ -0,0 +1,68 @@
+;-------------------------------------------------------------
+;+
+; NAME:
+;       PUTFILE
+; PURPOSE:
+;       Write a text file from a string array.
+; CATEGORY:
+; CALLING SEQUENCE:
+;       putfile, f, s
+; INPUTS:
+;       f = text file name.      in
+;       s = string array.        in
+; KEYWORD PARAMETERS:
+;       Keywords:
+;         ERROR=err  error flag: 0=ok, 1=invalid string array.
+; OUTPUTS:
+; COMMON BLOCKS:
+; NOTES:
+; MODIFICATION HISTORY:
+;       R. Sterner, 20 Mar, 1990
+;       R. Sterner,  4 Nov, 1992 --- allowed scalar strings.
+;
+; Copyright (C) 1990, Johns Hopkins University/Applied Physics Laboratory
+; This software may be used, copied, or redistributed as long as it is not
+; sold and this copyright notice is reproduced on each copy made.  This
+; routine is provided as is without any express or implied warranties
+; whatsoever.  Other limitations apply as described in the file disclaimer.txt.
+;-
+;-------------------------------------------------------------
+ 
+	pro putfile, file, s, error=err, help=hlp
+ 
+	if (n_params(0) lt 1) or keyword_set(hlp) then begin
+	  print,' Write a text file from a string array.'
+	  print,' putfile, f, s'
+	  print,'   f = text file name.      in'
+	  print,'   s = string array.        in'
+	  print,' Keywords:'
+	  print,'   ERROR=err  error flag: 0=ok, 1=invalid string array.'
+	  return
+	endif
+;
+        if lmgr(/demo) then begin
+           print, 'you are in Demo mode. It is impossible to write a file'
+           return
+        endif
+; 
+	if size(s, /type) ne 7 then begin
+	  print,' Error in putfile: argument must be a string array.'
+	  err = 1
+	  return
+	endif
+ 
+	get_lun, lun
+	openw, lun, file
+ 
+	for i = 0, n_elements(s)-1 do begin
+	  t = s(i)
+	  if t eq '' then t = ' '
+	  printf, lun, t
+	endfor
+ 
+	close, lun
+	free_lun, lun
+	err = 0
+	return
+ 
+	end
Index: tags/start/STRING/str_size.pro
===================================================================
--- tags/start/STRING/str_size.pro	(revision 5)
+++ tags/start/STRING/str_size.pro	(revision 5)
@@ -0,0 +1,116 @@
+; $Id$
+;+
+; NAME:
+;  STR_SIZE
+;
+; PURPOSE:
+;
+;  The purpose of this function is to return the proper
+;  character size to make a specified string a specifed
+;  width in a window. The width is specified in normalized
+;  coordinates. The function is extremely useful for sizing
+;  strings and labels in resizeable graphics windows.
+;
+; CATEGORY:
+;
+;  Graphics Programs, Widgets.
+;
+; CALLING SEQUENCE:
+;
+;  thisCharSize = STR_SIZE(thisSting, targetWidth)
+;
+; INPUTS:
+;
+;  thisString:  This is the string that you want to make a specifed
+;     target size or width.
+;
+; OPTIONAL INPUTS:
+;
+;  targetWidth:  This is the target width of the string in normalized
+;     coordinates in the current graphics window. The character
+;     size of the string (returned as thisCharSize) will be
+;     calculated to get the string width as close as possible to
+;     the target width. The default is 0.25.
+;
+; KEYWORD PARAMETERS:
+;
+;  INITSIZE:  This is the initial size of the string. Default is 1.0.
+;
+;  STEP:   This is the amount the string size will change in each step
+;     of the interative process of calculating the string size.
+;     The default value is 0.05.
+;
+; OUTPUTS:
+;
+;  thisCharSize:  This is the size the specified string should be set
+;     to if you want to produce output of the specified target
+;     width. The value is in standard character size units where
+;     1.0 is the standard character size.
+;
+; EXAMPLE:
+;
+;  To make the string "Happy Holidays" take up 30% of the width of
+;  the current graphics window, type this:
+;
+;               XYOUTS, 0.5, 0.5, ALIGN=0.5, "Happy Holidays", $
+;        CHARSIZE=STR_SIZE("Happy Holidays", 0.3)
+;
+; MODIFICATION HISTORY:
+;
+;  Written by: David Fanning, 17 DEC 96.
+;  Added a scaling factor to take into account the aspect ratio
+;     of the window in determing the character size. 28 Oct 97. DWF
+;-
+
+FUNCTION STR_SIZE, string, targetWidth, INITSIZE=initsize, STEP=step
+
+ON_ERROR, 1
+
+   ; Check positional parameters.
+
+np = N_PARAMS()
+CASE np OF
+   0: MESSAGE, 'One string parameter is required.'
+   1: targetWidth = 0.25
+   ELSE:
+ENDCASE
+
+   ; Check keywords. Assign default values.
+
+IF N_ELEMENTS(step) EQ 0 THEN step = 0.05
+IF N_ELEMENTS(initsize) EQ 0 THEN initsize = 1.0
+
+   ; Calculate a trial width.
+
+size = initsize
+XYOUTS, 0.5, 0.5, ALIGN=0.5, string, WIDTH=thisWidth, $
+      CHARSIZE=-size, /NORMAL
+
+   ; Size is perfect.
+
+IF thisWidth EQ targetWidth THEN RETURN, size * Float(!D.Y_Size)/!D.X_Size
+
+   ; Initial size is too big.
+
+IF thisWidth GT targetWidth THEN BEGIN
+   REPEAT BEGIN
+     XYOUTS, 0.5, 0.5, ALIGN=0.5, string, WIDTH=thisWidth, $
+        CHARSIZE=-size, /NORMAL
+      size = size - step
+   ENDREP UNTIL thisWidth LE targetWidth
+   RETURN, size * Float(!D.Y_Size)/!D.X_Size
+ENDIF
+
+   ; Initial size is too small.
+
+IF thisWidth LT targetWidth THEN BEGIN
+   REPEAT BEGIN
+     XYOUTS, 0.5, 0.5, ALIGN=0.5, string, WIDTH=thisWidth, $
+        CHARSIZE=-size, /NORMAL
+      size = size + step
+   ENDREP UNTIL thisWidth GT targetWidth
+   size = size - step ; Need a value slightly smaller than target.
+   RETURN, size * Float(!D.Y_Size)/!D.X_Size
+ENDIF
+
+END
Index: tags/start/STRING/strcnt.pro
===================================================================
--- tags/start/STRING/strcnt.pro	(revision 5)
+++ tags/start/STRING/strcnt.pro	(revision 5)
@@ -0,0 +1,112 @@
+;
+;+
+; NAME:
+;       STRCNT
+; PURPOSE:
+;       Count number of occurrences of a substring in a string.
+; CATEGORY:
+;       text/strings
+; CALLING SEQUENCE:
+;       num = strcnt(strn, substring, [pos])
+; INPUTS:
+;       string    -- The string in which to count occurences.     in
+;       substring -- The substring to count occurrences of.       in
+;       pos       -- the position at which to begin the search.   [in]
+;                    If not supplied, start at beginning of
+;                    string.
+; KEYWORD PARAMETERS:
+;       /HELP     -- Print useful message and return.
+; OUTPUTS:
+;       num       -- Number of occurances of substring in string. out
+; COMMON BLOCKS:
+; SIDE EFFECTS:
+; NOTES:
+;       Overlapping occurances are not counted separately.  For
+;       example, counting occurances of 'bb' in 'blah bbb' returns one
+;       occurance. 
+; EXAMPLE:
+; MODIFICATION HISTORY:
+;       $Id$
+;       $Log$
+;       Revision 1.1  2002/09/11 10:17:16  opalod
+;       Initial revision
+;
+;       Revision 1.3  1996/06/14 20:00:27  mcraig
+;       Updated Copyright info.
+;
+;       Revision 1.2  1996/05/09 00:22:17  mcraig
+;       Added fast processing using BYTE arrays if we are counting occurences of
+;       a single character.  Added error handling.
+;
+;       Revision 1.1  1996/01/31 18:47:37  mcraig
+;       Initial revision
+;
+; RELEASE:
+;       $Name$
+;
+; COPYRIGHT:
+;  Copyright (C) 1996 The Regents of the University of California, All
+;  Rights Reserved.  Written by Matthew W. Craig.
+;  See the file COPYRIGHT for restrictions on distrubting this code.
+;  This code comes with absolutely NO warranty; see DISCLAIMER for details.
+;-
+FUNCTION Strcnt, strn, substrn, startpos, $
+                 HELP=Help
+
+; Return to caller if error.
+    On_error, 2
+
+; Help user, if needed.
+    IF (n_params() LT 2) OR keyword_set(Help) THEN BEGIN
+        offset = '   '
+        print, offset+'Count number of occurrences of a substring in a string.'
+        print, offset+'num = strcnt(strn, substring, [pos])'
+        print, offset+'Inputs:'
+        print,offset+offset+'string    -- The string in which to count occurences.     in'
+        print,offset+offset+'substring -- The substring to count occurrences of.       in'
+        print,offset+offset+'pos       -- the position at which to begin the search.   [in]'
+        print,offset+offset+'             If not supplied, start at beginning of'
+        print,offset+offset+'             string.'
+        print, offset+'Keywords:'
+        print,offset+offset+'/HELP     -- Print useful message and return.'
+        print, offset+'Outputs:'
+        print,offset+offset+'num       -- Number of occurances of substring in string. out'
+        return, -1
+    ENDIF 
+
+    IF n_params() EQ 2 THEN startpos = 0
+
+;  return if we weren't really given a substring to search for. . .
+    IF strlen(substrn) EQ 0 THEN BEGIN 
+        print, "Error: Can't count occurances of null string."
+        return, -1
+    ENDIF 
+
+; . . .or if we were told to start at the end of the string.
+    tmpstrn = strmid(strn, startpos, strlen(strn))
+    IF strlen(tmpstrn) EQ 0 THEN return, 0
+
+; If looking for occurences of single character, process using BYTE
+; array.
+    IF strlen(substrn) EQ 1 THEN BEGIN
+        tmpstrn = byte(TmpStrn)
+        count = n_elements(where(TmpStrn EQ (byte(substrn))(0))) 
+    ENDIF ELSE BEGIN 
+        count = 0L
+        pos = rstrpos(tmpstrn, substrn)
+        WHILE pos GE 0 DO BEGIN
+            count = count + 1
+            pos = rstrpos(tmpstrn, substrn, pos)
+        ENDWHILE
+    ENDELSE 
+
+    return, count
+END 
+
+
+
+
+
+
+
+
Index: tags/start/STRING/string2struct.pro
===================================================================
--- tags/start/STRING/string2struct.pro	(revision 5)
+++ tags/start/STRING/string2struct.pro	(revision 5)
@@ -0,0 +1,79 @@
+function too_cool,_extra=extra
+;
+; This is a really, really cool way to turn keywords into
+; a structure.
+;
+return,extra
+end
+
+function string2struct,strVal
+;+
+; NAME:
+;       stringToStructure
+;
+; PURPOSE:
+;       Takes an input string set up as keywords and returns an anonymous structure.
+;               This is particularly useful for taking keywords entered by a user in a text
+;               field and passing then to other routines.
+;
+; CATEGORY:
+;       Utility
+;
+; CALLING SEQUENCE:
+;       extra=stringToStructure('xrange=[0,10],linestyle=2')
+;       plot,findgen(100),_extra=extra
+;
+; INPUTS:
+;       String set up as keywords. Keywords require a little special treatment. Such as
+;       plot,findgen(100),_extra=stringToStructure('title="testing"')
+;
+; KEYWORD PARAMETERS:
+;
+;       None
+;
+; OUTPUTS:
+;       This function returns the string as an anonymous structure. If an
+;       error was found then this function returns a structure with a null field.
+;
+; COMMON BLOCKS:
+;       None.
+;
+; EXAMPLE:
+;       The code below creates a widget that uses this routine.
+;       pro tPlot,event
+;       widget_control,event.top,get_uvalue=field
+;       widget_control,field,get_value=strVal
+;       extra = stringToStructure(strVal)
+;       plot,findgen(100),_extra=extra
+;       wshow
+;       return
+;       end
+;
+;       pro testWid
+;       ;enter any keyword to plot and see how it works
+;       base = widget_base(/col)
+;       field = cw_field(base,title='test',value='ax=0',/string)
+;       void = widget_button(base,value='plot',event_pro='tPlot')
+;       widget_control,base,/realize,set_uvalue=field
+;       xmanager,'testWid',base,/no_block
+;       return
+;       end
+;
+; MODIFICATION HISTORY:
+;       Written by:
+;       RLK, Ronn Kling Consulting.
+;       ronn@rlkling.com
+;       www.rlkling.com
+;               May, 1999
+;-
+
+r = execute('extra = too_cool(' + strVal[0] +')')
+;if r = 0 then user did not enter keywords correctly so
+;return a structure with a null field.
+if r eq 0 then begin
+  print,'Error in input string'
+  return,{null:0}
+endif
+return,extra
+end
+
Index: tags/start/STRING/strkeywd.pro
===================================================================
--- tags/start/STRING/strkeywd.pro	(revision 5)
+++ tags/start/STRING/strkeywd.pro	(revision 5)
@@ -0,0 +1,87 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: strkeywd (string keywords)
+;
+; PURPOSE: traduit une sturcture en un string pouvant etre utilise
+; pour specifier des keywords ds l''appelle d''une fonction qd on
+; utilise execute (cf l''exemple)
+;
+; CATEGORY: pour passer des mots cles avec execute !
+;
+; CALLING SEQUENCE:res=strkeywd(struct)
+; 
+; INPUTS:struct: une structure
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:un string compose de la facon suivante:
+;         pour chaque element de la structure, on ecrit une partie du
+;         string sous la forme: 
+;         'nom_de_l''element=contennu de l''element'
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+;   Si un element de la structure contient un tableau, il sera
+;   convertit en vecteur.
+;
+; RESTRICTIONS:
+;
+;   attention cette fonction comporte des boucles, des if et des cases
+;   ds tous les sens. Elle ne doit donc pas etre utilisee avec des
+;   structure de grosse taille (avec bcp d''elements et avec des
+;   elements etant de gros tableaux).
+;   la structure en entree ne doit pas contenir de Complex floating, de
+;   structure, de Double-precision complex, de Pointer, de Object
+;   reference, de Unsigned Integer, de Unsigned Longword Integer, de
+;   64-bit Integer, de Unsigned 64-bit Integer	
+;
+;
+;
+; EXAMPLE:
+;
+; on cree une structure
+;       IDL> b=get_extra(ok=111, year=[1997,1998,1999], age_capitaine=35)
+;       IDL> help, b,/struct
+;       ** Structure <817f4bc>, 3 tags, length=10, refs=1:
+;          AGE_CAPITAINE   INT             35
+;          OK              INT            111
+;          YEAR            INT       Array[3]
+; on met cette structure sous forme de string
+;       IDL> a=strkeywd(b)
+;       IDL> print, a
+;       AGE_CAPITAINE=35, OK=111, YEAR=[1997,1998,1999]
+; maintenant on peut utiliser le string a pour passer des mots cles ds
+; une fonction a l''aide de execute!!
+;       IDL> test=execute('c=get_extra('+a+')')
+;       IDL> help, c,/struct
+;       ** Structure <817f2dc>, 3 tags, length=10, refs=1:
+;          AGE_CAPITAINE   INT             35
+;          OK              INT            111
+;          YEAR            INT       Array[3]
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      11/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION strkeywd, struct
+   if size(struct, /type) NE 8 then return,  ''
+   tname = tag_names(struct)
+   if n_elements(tname) EQ 0 then return,  ''
+;------------------------------------------------------------
+; on s''occupe du premier element
+;------------------------------------------------------------
+   res = strlowcase(tname[0])+'='+tostr(struct.(0))
+   if n_elements(tname) EQ 1 then return,  res
+;------------------------------------------------------------
+; on s''occupe des autres elements
+;------------------------------------------------------------
+   for n = 1,n_elements(tname)-1 do res = res+', '+strlowcase(tname[n])+'='+tostr(struct.(n))
+;
+   return,  res
+end
Index: tags/start/STRING/strrepl.pro
===================================================================
--- tags/start/STRING/strrepl.pro	(revision 5)
+++ tags/start/STRING/strrepl.pro	(revision 5)
@@ -0,0 +1,118 @@
+; $Id$
+;-------------------------------------------------------------
+;+
+; NAME:
+;        STRREPL (function)
+;
+; PURPOSE:
+;        replace one (or more) character(s)/string(s) in a string
+;
+; CATEGORY:
+;        string routines
+;
+; CALLING SEQUENCE:
+;        Result = STRREPL(str, index, rchar)
+;
+; INPUTS:
+;        STR -> the string to be changed
+;
+;        INDEX -> position of the character(s) to be replaced or a
+;        string to be changed in STR.
+;
+;        RCHAR -> replacement character/string
+;
+; KEYWORD PARAMETERS: none
+;
+;
+; OUTPUTS:
+;        another string
+;
+; SUBROUTINES:
+;
+; REQUIREMENTS:
+;
+; NOTES:
+;        Known shortcoming: if index is an array, it must contain all
+;        valid elements (only the first entry is checked).
+;
+; EXAMPLE:
+;        ; Convert one letter into upper case
+;
+;        abc = 'abcdefghijklmnopqrstuvwxyz'
+;        print,strrepl(abc,strpos(abc,'m'),'M')
+;
+;        ; prints "abcdefghijklMnopqrstuvwxyz"
+;
+;
+;        ; Use with strwhere function
+;        a = 'abcabcabc'
+;        print,strrepl(a,strwhere(a,'a'),'#')
+;
+;        ; prints  "#bc#bc#bc#bc#bc"
+;
+;       IDL> print, strrepl(a,'bc','!eeee!')
+;       a!eeee!a!eeee!a!eeee!
+;       IDL> print, strrepl(a,'b','0000')
+;       a0000ca0000ca0000
+;       IDL> print, strrepl(a,'toto','0000')
+;       abcabcabc
+;
+; MODIFICATION HISTORY:
+;        mgs, 02 Jun 1998: VERSION 1.00
+;        sebastien Masson (smlod@ipsl.jussieu.fr)
+;
+;-
+; Copyright (C) 1998, Martin Schultz, Harvard University
+; This software is provided as is without any warranty
+; whatsoever. It may be freely used, copied or distributed
+; for non-commercial purposes. This copyright notice must be
+; kept with any copy of this software. If this software shall
+; be used commercially or sold as part of a larger package,
+; please contact the author to arrange payment.
+; Bugs and comments should be directed to mgs@io.harvard.edu
+; with subject "IDL routine strrepl"
+;-------------------------------------------------------------
+
+
+function strrepl,str,agument1,rchar
+   
+   if (n_elements(str) eq 0) then return,''
+   
+                                ; convert strign and replace character to byte
+   BStr = byte(str)
+   new = byte(rchar)
+   if size(agument1, /type) EQ 7 then begin
+      old = byte(agument1)
+      index = strpos(str, agument1)
+      pos = index
+      while strpos(str, agument1, pos+1) NE -1 do BEGIN
+         pos = strpos(str, agument1, pos+1)
+         index = [index, pos]
+      ENDWHILE
+; make sure index is in range
+      if (index[0] lt 0 OR index[0] ge n_elements(BStr)) THEN return,Str
+   ENDIF ELSE BEGIN
+      index = agument1
+      if (index[0] lt 0 OR index[0] ge n_elements(BStr)) then return,Str
+      old = BStr[index[0]]
+   ENDELSE
+                                ; replace indexed characters in string
+   nelenew = n_elements(new)
+   neleold = n_elements(old)
+   nindex = n_elements(index)
+   if nelenew*neleold NE 1 then begin
+      if index[0] EQ 0 then $
+       BStr = [NEW,  BStr[index[0]+neleold: n_elements(BStr)-1] ] ELSE $
+       BStr = [BStr[0:index[0]-1], NEW,  BStr[index[0]+neleold: n_elements(BStr)-1] ]
+      if nindex EQ 1 then return,string(BStr)
+      if nindex GT 2 then $
+       for i = 1, nindex-2 do $
+       BStr = [BStr[0:index[i]+i*(nelenew-neleold)-1], NEW $
+               , BStr[index[i]+i*(nelenew-neleold)+neleold: n_elements(BStr)-1] ]
+      BStr = [BStr[0:index[n_elements(index)-1]+(nindex-1)*(nelenew-neleold)-1], NEW]
+
+   ENDIF ELSE BStr[index] = NEW
+                                ; return result as string
+   return,string(BStr)
+   
+end
Index: tags/start/STRING/strright.pro
===================================================================
--- tags/start/STRING/strright.pro	(revision 5)
+++ tags/start/STRING/strright.pro	(revision 5)
@@ -0,0 +1,67 @@
+; $Id$
+;-------------------------------------------------------------
+;+
+; NAME:
+;        STRRIGHT
+;
+; PURPOSE:
+;        return right subportion from a string
+;
+; CATEGORY:
+;        string handling 
+;
+; CALLING SEQUENCE:
+;        res = STRRIGHT(string [,nlast])
+;
+; INPUTS:
+;        STRING --> the string to be searched
+;
+;        NLAST --> the number of characters to be returned. Default
+;           is 1. If NLAST is ge strlen(STRING), the complete string
+;           is returned.
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;        The portion of NLAST characters of STRING counted from the back.
+;
+; SUBROUTINES:
+;
+; REQUIREMENTS:
+;
+; NOTES:
+;
+; EXAMPLE:
+;        if (strright(path) ne '/') then path = path + '/'
+;
+; MODIFICATION HISTORY:
+;        mgs, 19 Nov 1997: VERSION 1.00
+;
+;-
+; Copyright (C) 1997, Martin Schultz, Harvard University
+; This software is provided as is without any warranty
+; whatsoever. It may be freely used, copied or distributed
+; for non-commercial purposes. This copyright notice must be
+; kept with any copy of this software. If this software shall
+; be used commercially or sold as part of a larger package,
+; please contact the author to arrange payment.
+; Bugs and comments should be directed to mgs@io.harvard.edu
+; with subject "IDL routine strright"
+;-------------------------------------------------------------
+
+
+function strright,s,lastn
+ 
+    on_error,2   ; return to caller
+ 
+    if (n_elements(s) le 0) then return,-1L
+ 
+    l = strlen(s)
+ 
+    if (n_elements(lastn) le 0) then lastn = 1
+    if lastn gt l then lastn = l
+ 
+    result = strmid(s,l-lastn,l)
+ 
+    return,result
+end
Index: tags/start/STRING/strsci.pro
===================================================================
--- tags/start/STRING/strsci.pro	(revision 5)
+++ tags/start/STRING/strsci.pro	(revision 5)
@@ -0,0 +1,200 @@
+; $Id$
+;-------------------------------------------------------------
+;+
+; NAME:
+;        STRSCI (function)
+;
+; PURPOSE:                                                 
+;        Given a number, returns a string of that          B
+;        number in scientific notation format ( e.g. A x 10  )
+;
+; CATEGORY:
+;        String Utilities
+;
+; CALLING SEQUENCE:
+;        Result = STRSCI( DATA [,keywords] )
+;
+; INPUTS:
+;        DATA      -> A floating point or integer number to be
+;                     converted into a power of 10.
+;
+; KEYWORD PARAMETERS:
+;        FORMAT    -> The format specification used in the string
+;                     conversion for the mantissa (i.e. the
+;                     "A" of "A x 10^B").  Default is '(f12.2)'.  
+;
+;        /POT_ONLY -> Will return only the "power of 10" part of the
+;                     string (i.e. the "10^B").  Default is to return
+;                     the entire string (e.g. "A x 10^B" )
+;
+;        /MANTISSA_ONLY -> return only mantissa of the string
+;
+;        /SHORT -> return 10^0 as '1' and 10^1 as '10'
+;
+;        /TRIM -> don't insert blanks (i.e. return Ax10^B)
+;
+; OUTPUTS:
+;        None
+;
+; SUBROUTINES:
+;        None
+;
+; REQUIREMENTS:
+;        None
+;
+; NOTES:
+;        This function does not "evaluate" the format statement thoroughly
+;        which can result in somewhat quirky strings. Example:
+;        print,strsci(-9.999) results in -10.0x10^0 instead of -1.0x10^1.
+;
+;        Need a better symbol than the 'x' for the multiplier...
+;
+; EXAMPLE:
+;        Result = STRSCI( 2000000, format='(i1)' )
+;        print, result                
+;        ;                                                     6
+;        ;     prints 2 x 10!u6!n, which gets plotted as 2 x 10 
+;        
+;        Result = STRSCI( -0.0001 )
+;        print, result
+;        ;                                                            4
+;        ;     prints -1.00 x 10!u-4!n, which gets plotted as 1.00 x 10
+;
+;        Result = STRSCI( 0d0, format='(f13.8)' )
+;        print, result
+;        ;
+;        ;     prints, 0.00000000
+; 
+;
+; MODIFICATION HISTORY:
+;        bmy, 28 May 1998: VERSION 1.00            B
+;           - now returns string of the form A x 10
+;        mgs, 29 May 1998:
+;           - bug fix: now allows negative numbers
+;           - keyword MANTISSA_ONLY added
+;           - default format changed to f12.2
+;        bmy, 02 Jun 1998:
+;           - renamed to STRSCI ("STRing SCIentific notation"),
+;        mgs, 03 Jun 1998:
+;           - added TRIM keyword
+;        mgs, 22 Sep 1998:
+;           - added SHORT keyword
+;           - modified handling of TRIM keyword
+;        mgs, 24 Sep 1998:
+;           - bug fix with SHORT flag
+;        bmy & mgs, 02 Jun 1999:
+;           - now can handle DATA=0.0 correctly
+;           - updated comments
+;        mgs, 03 Jun 1999: 
+;           - can now also handle values lt 1 ;-)
+;           - and doesn't choke on arrays
+;
+;-
+; Copyright (C) 1998, 1999 Bob Yantosca and Martin Schultz, 
+; Harvard University
+; This software is provided as is without any warranty
+; whatsoever. It may be freely used, copied or distributed
+; for non-commercial purposes. This copyright notice must be
+; kept with any copy of this software. If this software shall
+; be used commercially or sold as part of a larger package,
+; please contact the author to arrange payment.
+; Bugs and comments should be directed to bmy@io.harvard.edu
+; or mgs@io.harvard.edu with subject "IDL routine strsci"
+;-------------------------------------------------------------
+
+
+function StrSci, Data, Format=Format, POT_Only=POT_Only, $
+             MANTISSA_ONLY=MANTISSA_ONLY,SHORT=SHORT,TRIM=TRIM
+
+   ;====================================================================
+   ; Error checking / Keyword settings
+   ;====================================================================
+   ;on_error, 2
+
+   if ( n_elements( Data ) eq 0 ) then begin
+      return, ''
+   endif
+
+   if ( not Keyword_Set( Format ) ) then Format   = '(f12.2)'
+
+   POT_Only      = keyword_set( POT_Only      )
+   MANTISSA_Only = keyword_set( MANTISSA_Only )
+   Short         = Keyword_Set( Short         )
+   Trim          = Keyword_Set( Trim          )
+
+   NDat = n_elements(Data)
+   Result = strarr(NDat)
+
+   for i=0,NDat-1 do begin
+      ;====================================================================
+      ; If ABS( DATA ) > 0 then we can proceed to take the common log.
+      ; For DATA < 0, place a "-" sign in front of the number
+      ;====================================================================
+      if ( Abs( Data[i] ) ne 0.0 ) then begin
+   
+         ; take the common log and store in LOG10DATA
+         Log10Data = ALog10( Abs( Data[i] ) )  
+   
+         ; Boolean flag if data < 0
+         sign = ( Data[i] lt 0.0 ) 
+   
+         ; Compute the characteristic (int part)
+         ; Add the 1d-6 to prevent roundoff errors
+         Characteristic = Fix( Log10Data + 1.0d-6 )
+         if (Log10Data lt 0) then $
+            Characteristic = Characteristic - 1 
+   
+         ; Compute the Mantissa (frac part) and take its antilog.
+         Mantissa = Log10Data - Characteristic 
+         Mantissa = 10.0^Mantissa
+   
+   ;  print,data[i],log10data,mantissa,characteristic,format='(3f24.14,i8)'
+   
+         ; String for the coefficient part, 
+         ; The coefficient is just antilog of the Mantissa
+         ; Add the minus sign if DATA < 0.0
+         A = StrTrim( String( Mantissa, Format=Format ), 2 )
+         if ( Sign ) then A = '-' + A
+   
+         ; String for the power of 10 part
+         B = '10!u' + strtrim( string( Characteristic ), 2 ) + '!n'
+         if ( Short ) then begin
+            if ( Characteristic eq 0 ) then B = '1'
+            if ( Characteristic eq 1 ) then B = '10'
+         endif
+   
+         ; composite string
+         Result[i] = A + ' x ' + B
+         if ( Short AND B eq '1') then Result[i] = A
+   
+   
+      ;====================================================================
+      ; If DATA = 0, then we cannot take the common log, so return
+      ; zeroes for the result strings.  Use the FORMAT string.
+      ;====================================================================
+      endif else begin
+         A      = String( 0d0, Format=Format )
+         B      = A
+         Result[i] = A
+   
+      endelse
+   
+      ;====================================================================
+      ; Return result to calling program (depending on keyword settings)
+      ; Eliminate blanks if TRIM keyword is set
+      ;====================================================================
+      if ( POT_Only ) then $
+         Result[i] = B
+      if ( MANTISSA_Only ) then $
+         Result[i] = A
+      if ( Trim ) then $
+         Result[i] = StrCompress( Result[i], /Remove_All )
+     
+   endfor
+
+   if (n_elements(Result) eq 1) then $
+      Result = Result[0]
+ 
+   return, Result
+
+end
Index: tags/start/STRING/strtok.pro
===================================================================
--- tags/start/STRING/strtok.pro	(revision 5)
+++ tags/start/STRING/strtok.pro	(revision 5)
@@ -0,0 +1,112 @@
+;
+;+
+; NAME:
+;       STRTOK
+; PURPOSE:
+;       Retrieve portion of string up to token.
+; CATEGORY:
+;       text/strings
+; CALLING SEQUENCE:
+;       new = strtok( old, token )
+; INPUTS:
+;       old   -- String to be split.  Contains text after    in, out
+;                token on output.
+;       token -- Token to use in splitting old.              in
+; KEYWORD PARAMETERS:
+;       /TRIM -- set to remove leading blanks from old 
+;                before returning.
+;       /HELP -- print useful message and exit.
+; OUTPUTS:
+;       new   -- portion of string up to token.              out
+;       old   -- portion of old after token.                 out, in
+; COMMON BLOCKS:
+; SIDE EFFECTS:
+;       Input parameter old is modified.
+; NOTES:
+;       Token may be one or more characters.
+;       If token is not found, returns old and sets old to ''.
+; EXAMPLE:
+;       If old is 'foo44 bar', then strtok( old, '44' ) would return
+;       'foo', and upon return, old will be left with ' bar'.  If /TRIM
+;       were set, old would be 'bar' on return.
+;
+;       If old='xyz', then new=strtok(old,'a') would return with
+;       new='xyz' and old=''.
+; THANKS:
+;       To D. Linder who wrote GETTOK, part of the goddard library,
+;       upon which this is based.
+; MODIFICATION HISTORY:
+;       $Id$
+;       $Log$
+;       Revision 1.1  2002/09/11 10:17:16  opalod
+;       Initial revision
+;
+;       Revision 1.3  1996/06/14 20:00:27  mcraig
+;       Updated Copyright info.
+;
+;       Revision 1.2  1996/05/09 00:22:17  mcraig
+;       Added built in help.
+;
+;       Revision 1.1  1996/01/31 18:47:37  mcraig
+;       Initial revision
+;
+; RELEASE:
+;       $Name$
+;
+; COPYRIGHT:
+;  Copyright (C) 1996 The Regents of the University of California, All
+;  Rights Reserved.  Written by Matthew W. Craig.
+;  See the file COPYRIGHT for restrictions on distrubting this code.
+;  This code comes with absolutely NO warranty; see DISCLAIMER for details.
+;-
+FUNCTION Strtok, string, token, $
+                 TRIM=trim, HELP=Help
+
+; Back to the caller if error occurs.
+    On_error, 2
+
+    IF (n_params() NE 2) OR keyword_set(Help) THEN BEGIN 
+        offset = '   '
+        print, offset+'Retrieve portion of string up to token.'
+        print, offset+'new = strtok( old, token )'
+        print, offset+'Inputs:'
+        print, offset+offset+'old   -- String to be split.  Contains text after    in, out'
+        print, offset+offset+'         token on output.'
+        print, offset+offset+'token -- Token to use in splitting old.              in'
+        print, offset+'Keywords:'
+        print, offset+offset+'/TRIM -- set to remove leading blanks from old '
+        print, offset+offset+'         before returning.'
+        print, offset+offset+'/HELP -- print useful message and exit.'
+        print, offset+'Outputs:'
+        print, offset+offset+'new   -- portion of string up to token.              out'
+        print, offset+offset+'old   -- portion of old after token.                 out, in'
+        print, offset+'Side effects:'
+        print, offset+offset+'Input parameter old is modified.'
+        print, offset+'Notes:'
+        print, offset+offset+'Token may be one or more characters.'
+        print, offset+offset+"If token is not found, returns old and sets old to ''."
+        print, offset+'Examples:'
+        print, offset+offset+"If old is 'foo44 bar', then strtok( old, '44' ) would return'"
+        print, offset+offset+"  'foo', and upon return, old will be left with ' bar'.  If /TRIM"
+        print, offset+offset+"  were set, old would be 'bar' on return."
+;'
+        print, offset+offset+"If old='xyz', then new=strtok(old,'a') would return with"
+        print, offset+offset+"  new='xyz' and old=''."
+        return, -1
+    ENDIF 
+
+    pos = strpos(string, token)
+
+    IF (pos GE 0) THEN BEGIN
+        front = strmid(string, 0, pos) 
+        string = strmid(string, pos + strlen(token), strlen(string))
+        IF keyword_set(trim) THEN string = strtrim(string, 1)
+        return, front
+    ENDIF
+    
+    front = string
+    string = ''
+    return, front
+    
+END
+
Index: tags/start/STRING/strtrans.pro
===================================================================
--- tags/start/STRING/strtrans.pro	(revision 5)
+++ tags/start/STRING/strtrans.pro	(revision 5)
@@ -0,0 +1,131 @@
+;
+;+
+; NAME:
+;       STRTRANS
+; PURPOSE:
+;       Translate all occurences of one substring to another.
+; CATEGORY:
+;       text/strings
+; CALLING SEQUENCE:
+;       new = strtrans(oldstr,from,to,ned)
+; INPUTS:
+;       oldstr -- string on which to operate.              in
+;                 May be an array.
+;       from   -- substrings to be translated. May be      in
+;                 an array.
+;       to     -- what strings in from should be           in
+;                 translated to. May be an array.
+; KEYWORD PARAMETERS:
+;       /HELP  -- Set this to print useful message and 
+;                 exit.
+; OUTPUTS:
+;       new    -- Translated string. Array if oldstr is    out          
+;                 an array.
+;       ned    -- number of substitutions performed in     out
+;                 oldstr.  Array if oldstr is an array.
+; COMMON BLOCKS:
+; SIDE EFFECTS:
+; NOTES:
+;       - Any of old, from, and to can be arrays.  
+;       - from and to must have the same number of elements.
+; EXAMPLE:
+;       inp='Many*bad!chars+in_here'
+;       from=['*','!','+','_']
+;       to  =[' ',' ',' ',' ']
+;       out = strtrans(inp,from,to,ned)
+;       Will produce out='Many bad chars in here', and set ned to 4.
+; MODIFICATION HISTORY:
+;       $Id$
+;       $Log$
+;       Revision 1.1  2002/09/11 10:17:16  opalod
+;       Initial revision
+;
+;       Revision 1.3  1996/06/14 20:00:27  mcraig
+;       Updated Copyright info.
+;
+;       Revision 1.2  1996/05/09 00:22:17  mcraig
+;       Sped up significantly by using str_sep to handle the translation.  No longer
+;       relies on routines fromother user libraries.
+;
+;       Revision 1.1  1996/01/31 18:47:37  mcraig
+;       Initial revision
+;
+; RELEASE:
+;       $Name$
+;
+; COPYRIGHT:
+;  Copyright (C) 1996 The Regents of the University of California, All
+;  Rights Reserved.  Written by Matthew W. Craig.
+;  See the file COPYRIGHT for restrictions on distrubting this code.
+;  This code comes with absolutely NO warranty; see DISCLAIMER for details.
+;-
+;
+FUNCTION strtrans, InputString, from, to, ned,  $
+                   HELP=Help
+
+; Bomb out to caller if error.
+    On_error, 2
+
+; Offer help if we don't have at least InputString, from, and to, or
+; if the user asks for it.
+    IF (n_params() LT 3) OR keyword_set(help) THEN BEGIN
+        offset = '   '
+        print, offset+'Translate all occurences of one substring to another.'
+        print, offset+'new = strtrans(oldstr,from,to,ned)'
+        print, offset+'Inputs:'
+        print, offset+offset+'oldstr -- string on which to operate.              in'
+        print, offset+offset+'          May be an array.'
+        print, offset+offset+'from   -- substrings to be translated. May be      in'
+        print, offset+offset+'          an array.'
+        print, offset+offset+'to     -- what strings in from should be           in'
+        print, offset+offset+'          translated to. May be an array.'
+        print, offset+'Outputs:'
+        print, offset+offset+'new    -- Translated string. Array if oldstr is    out'
+        print, offset+offset+'          an array.'
+        print, offset+offset+'ned    -- number of substitutions performed in     out'
+        print, offset+offset+'          oldstr.  Array if oldstr is an array.'
+        print, offset+'Notes:'
+        print, offset+offset+'- Any of old, from, and to can be arrays. ' 
+        print, offset+offset+'- from and to must have the same number of elements.'
+        return, -1
+    ENDIF 
+    
+    strn = InputString
+
+;  Check that From/To have same number of elements.  RETURN if they don't.
+    NFrom = n_elements(from)
+    NTo = n_elements(to)
+    IF (NFrom EQ 0) OR (NTo EQ 0) THEN return, strn
+    IF NFrom NE NTo THEN BEGIN
+        print,'Error: Number of elements in from/to unequal'
+        return,-1
+    ENDIF
+
+;  Make sure there are no null strings in From.  RETURN if there are.   
+    FromLen = strlen(From)
+    IF (total(FromLen EQ 0) GT 0) THEN BEGIN
+        print, 'Error: elements of From must have nonzero length.'
+        return, -1
+    ENDIF 
+
+    NStrings = n_elements(strn)
+    ned = lonarr(NStrings)
+    tmpned = 0L
+
+; Say strn='a#b#c', from='#' and to='@'.  Then the approach here is to
+; first split strn at all occurances of '#', then recombine the pieces
+; with '@' inserted instead.  Do this for all elements of strn, and
+; all elements of from.
+    FOR i = 0L, NStrings-1 DO BEGIN
+        ned(i) = 0L
+        FOR j=0L, NFrom-1 DO BEGIN
+            SepStr = str_sep(strn(i), from(j))
+            NSubs = n_elements(SepStr) - 1
+            strn(i) = SepStr(0)
+            FOR k=1L, NSubs DO strn(i) = strn(i) + To(j) + SepStr(k)
+            ned(i) =  ned(i) + NSubs
+        ENDFOR 
+    ENDFOR
+
+    return, strn
+END 
Index: tags/start/STRING/strwhere.pro
===================================================================
--- tags/start/STRING/strwhere.pro	(revision 5)
+++ tags/start/STRING/strwhere.pro	(revision 5)
@@ -0,0 +1,77 @@
+; $Id$
+;-------------------------------------------------------------
+;+
+; NAME:
+;        STRWHERE  (function)
+;
+; PURPOSE:
+;        return position *array* for occurence of a character in
+;        a string
+;
+; CATEGORY:
+;        string tools
+;
+; CALLING SEQUENCE:
+;        pos = STRWHERE(str, schar [,Count] )
+;
+; INPUTS:
+;        STR -> the string
+;
+;        SCHAR -> the character to look for
+;
+; KEYWORD PARAMETERS:
+;        none.
+;
+; OUTPUTS:
+;        COUNT -> (optional) The number of matches that were found 
+;
+;        The function returns an index array similar to the 
+;        result of the where function
+;
+; SUBROUTINES:
+;
+; REQUIREMENTS:
+;
+; NOTES:
+;
+; EXAMPLE:
+;        ind = strwhere('abcabcabc','a')
+;
+;        ; returns [ 0, 3, 6 ]
+;
+; MODIFICATION HISTORY:
+;        mgs, 02 Jun 1998: VERSION 1.00
+;        bmy, 30 Jun 1998: - now returns COUNT, the number 
+;                            of matches that are found (this is
+;                            analogous to the WHERE command)
+;
+;-
+; Copyright (C) 1998, Martin Schultz, Harvard University
+; This software is provided as is without any warranty
+; whatsoever. It may be freely used, copied or distributed
+; for non-commercial purposes. This copyright notice must be
+; kept with any copy of this software. If this software shall
+; be used commercially or sold as part of a larger package,
+; please contact the author to arrange payment.
+; Bugs and comments should be directed to mgs@io.harvard.edu
+; with subject "IDL routine strwhere"
+;-------------------------------------------------------------
+
+
+function strwhere,str,schar,Count
+ 
+ 
+   if (n_elements(str) eq 0) then return,-1
+ 
+   ; convert to byte
+   BStr = byte(Str)
+   BSC  = (byte(schar))[0]
+ 
+   ; Search for matches
+   Ind = where( Bstr eq BSC, Count )
+
+   ;### bmy ### return,where(BStr eq BSC)
+   return, Ind
+
+end
+   
Index: tags/start/STRING/tostr.pro
===================================================================
--- tags/start/STRING/tostr.pro	(revision 5)
+++ tags/start/STRING/tostr.pro	(revision 5)
@@ -0,0 +1,80 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: tostr (to string)
+;
+; PURPOSE: convertit un input en un string.
+;
+; CATEGORY: 
+;
+; CALLING SEQUENCE: res=tostr(input)
+; 
+; INPUTS: input ne peut pas contenir ou etre de type:
+;
+;   Complex floating, structure, Double-precision complex, Pointer, Object
+;   reference, Unsigned Integer, Unsigned Longword Integer, 64-bit
+;   Integer, Unsigned 64-bit Integer	
+;
+; KEYWORD PARAMETERS: none
+;
+; OUTPUTS: un string
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+;   Si un element de input contient un tableau, il sera
+;   convertit en vecteur.
+;
+; RESTRICTIONS:
+;
+;   attention cette fonction comporte des boucles, des if et des cases
+;   ds tous les sens. Elle ne doit donc pas etre utilisee avec des
+;   inputs de grosse taille (avec bcp d''elements et avec des
+;   elements etant de gros tableaux).
+; EXAMPLE:
+;    IDL> help, tostr(1),tostr('a'),tostr(indgen(4)),tostr(['a','jkfjo'])
+;    <Expression>    STRING    = '1'
+;    <Expression>    STRING    = ''a''
+;    <Expression>    STRING    = '[0,1,2,3]'
+;    <Expression>    STRING    = '['a','jkfjo']'
+;    IDL> print, tostr(['c''est bon','c''est bon'])
+;    ['c''est bon','c''est bon']
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      18/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION tostr, input
+
+   case 1 of
+      size(input, /type) LE 5:BEGIN 
+         if size(input, /type) EQ 1 then input = long(input)
+         if n_elements(input) EQ 1 then res = strtrim(input, 1) $
+         ELSE BEGIN 
+            res = '['+strtrim((input)[0], 1)
+            for i = 1,  n_elements(input)-1 do res = res+','+strtrim((input)[i], 1)
+            res = res+']'
+         ENDELSE 
+      END
+      size(input, /type) eq 7:BEGIN 
+         if n_elements(input) EQ 1 then BEGIN
+            sinput = strrepl(input, '''', '''''')
+            res = ''''+sinput+''''
+         ENDIF ELSE BEGIN 
+            res = '['''+strrepl(input[0], '''', '''''')+''''
+            for i = 1,  n_elements(input)-1 do res = res+','''+strrepl(input[i], '''', '''''')+''''
+            res = res+']'
+         ENDELSE 
+      END
+      ELSE:BEGIN 
+         ras = report('la fonction tostr ne marche pas pour input qui est de type '+size(input, /tname))
+         res = ''
+      END
+   ENDCASE
+
+   return, res
+end
Index: tags/start/STRUCTURE/chkstru.pro
===================================================================
--- tags/start/STRUCTURE/chkstru.pro	(revision 5)
+++ tags/start/STRUCTURE/chkstru.pro	(revision 5)
@@ -0,0 +1,125 @@
+; $Id$
+;-------------------------------------------------------------
+;+
+; NAME:
+;        CHKSTRU  (function)
+;
+; PURPOSE:
+;        check validity of a structure and test if necessary
+;        fields are contained
+;
+; CATEGORY:
+;        tools
+;
+; CALLING SEQUENCE:
+;        res=CHKSTRU(STRUCTURE,FIELDS [,/VERBOSE]) 
+;
+; INPUTS:
+;        STRUCTURE --> the structure to be tested. If STRUCTURE is
+;             not of type structure, the function will return 0
+;
+;        FIELDS --> a string or string array with field names to 
+;             be contained in STRUCTURE. CHKSTRU returns 1 (true)
+;             only if all field names are contained in STRUCTURE.
+;             The entries of FIELDS may be upper or lowercase.
+;
+; KEYWORD PARAMETERS:
+;        INDEX --> a named variable that will contain the indices of
+;             the required field names in the structure. They can then
+;             be assessed through structure.(index(i)) . Index will
+;             contain -1 for all fields entries that are not in the
+;             structure.
+;
+;        /VERBOSE --> set this keyword to return an error message 
+;             in case of an error.
+;
+;        /EXTRACT --> set this keyword to extract a fields from the
+;        structure.  -1 is return is fields or structure. are
+;        incorrect.
+;
+; OUTPUTS:
+;        CHKSTRU returns 1 if successful, otherwise 0.
+;
+; SUBROUTINES:
+;
+; REQUIREMENTS:
+;
+; NOTES:
+;
+; EXAMPLE:
+;        test = { a:1, b:2, c:3 }
+;        required = ['a','c']
+;        if CHKSTRU(test,required) then print,'found a and c.'
+;        IDL> print, CHKSTRU(test,'b')
+;           1
+;        IDL> print, CHKSTRU(test,'b',/extract)
+;               2
+;
+; MODIFICATION HISTORY:
+;        mgs, 02 Mar 1998: VERSION 1.00
+;        mgs, 07 Apr 1998: - second parameter (FIELDS) now optional
+;        12 Jan 2001: EXTRACT keyword by S. Masson (smasson@lodyc.jussieu.fr) 
+;
+;-
+; Copyright (C) 1998, Martin Schultz, Harvard University
+; This software is provided as is without any warranty
+; whatsoever. It may be freely used, copied or distributed
+; for non-commercial purposes. This copyright notice must be
+; kept with any copy of this software. If this software shall
+; be used commercially or sold as part of a larger package,
+; please contact the author to arrange payment.
+; Bugs and comments should be directed to mgs@io.harvard.edu
+; with subject "IDL routine chkstru"
+;-------------------------------------------------------------
+
+
+function chkstru,structure,fields,index=index,verbose=verbose, extract = extract
+ 
+
+     ; default index
+     index = -1
+ 
+     ; first check number of parameters (must be at least 1)
+     if (n_params() lt 1) then begin
+         if(keyword_set(verbose)) then $
+             ras = report('CHKSTRU: ** invalid number of parameters ! **')
+         if keyword_set(extract) THEN return,-1 ELSE return,0 
+         endif
+ 
+ 
+     ; check if the user really passed a structure
+ 
+     s = size(structure)
+     if (s(1+s(0)) ne 8) then begin
+         if(keyword_set(verbose)) then $
+             ras = report('CHKSTRU: ** No structure passed ! **')
+         if keyword_set(extract) THEN return,-1 ELSE return,0 
+     endif
+ 
+     ; only one parameter: then we are finished
+     if (n_params() eq 1) then return,1
+
+
+ 
+     ; see if required field names are contained in the structure
+     ; and return indices of these fields
+ 
+     names = tag_names(structure)
+     index = intarr(n_elements(fields)) - 1   ; default index to 'not found'
+
+     for i=0,n_elements(fields)-1 do begin
+         ind = where(names eq strupcase(fields(i)))
+         if (ind(0) lt 0) then begin
+             if(keyword_set(verbose)) then $
+                ras = report('CHKSTRU: ** Cannot find field '+fields(i)+' ! **')  
+         endif else index(i) = ind(0)
+     endfor
+ 
+ 
+     ; check minimum value of index field: -1 indicates error
+     if keyword_set(extract) then BEGIN
+        if index[0] NE -1 THEN return, structure.(index[0]) ELSE return, -1
+     ENDIF ELSE return,(min(index) ge 0)
+ 
+end
+ 
Index: tags/start/STRUCTURE/extractstru.pro
===================================================================
--- tags/start/STRUCTURE/extractstru.pro	(revision 5)
+++ tags/start/STRUCTURE/extractstru.pro	(revision 5)
@@ -0,0 +1,89 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:extractstru
+;
+; PURPOSE:extrait des elements d''une structure pour constituer une
+;         nouvelle structure
+;
+; CATEGORY: dibouille sur les structures
+;
+; CALLING SEQUENCE: res = extractstru(stru, liste)
+; 
+; INPUTS:
+;
+;    stru: une structure
+;
+;    liste: un vecteur de string comportant les noms des elements de
+;    stru a virer (par DEFAUT) ou a garder (si GARDE est active)
+;
+; KEYWORD PARAMETERS:
+;
+;    /GARDE: specifie que la liste donnee concerne les elements de
+;    stru a garder
+;
+;    /VIRE: specifie que la liste donnee concerne les elements de
+;    stru a virer. Ce mot cle est active par defaut
+;
+; OUTPUTS:une stucture ou -1 en cas de pb
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS: none !!!
+;    liste peut contenir des noms d''elements qui ne sont pas ds stru,
+;    le programme se debrouille avec
+;
+; EXAMPLE:
+;
+;    IDL> extra=get_extra(/ok, year=1999, age_capitaine=35 )
+;    IDL> help, extra,/struct
+;    ** Structure <83e66bc>, 3 tags, length=6, refs=1:
+;       AGE_CAPITAINE   INT             35
+;       OK              INT              1
+;       YEAR            INT           1999
+;    IDL> help, extractstru(extra,['ok','hhuihi','YEAR']),/stru
+;    ** Structure <831afac>, 1 tags, length=2, refs=1:
+;       AGE_CAPITAINE   INT             35
+;    IDL> help, extractstru(extra,['ok','hhuihi','YEAR'],/garde),/stru
+;    ** Structure <834bbc4>, 2 tags, length=4, refs=1:
+;       OK              INT              1
+;       YEAR            INT           1999
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      8/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION extractstru, stru, liste, GARDE = garde, VIRE = vire
+   if size(stru, /type) NE 8 then return,  -1
+   if size(liste, /type) NE 7 then return,  -1
+; cheking for garde and vire keywords
+   garde = keyword_set(garde)*(1-keyword_set(vire))
+   vire = keyword_set(vire)*(1-keyword_set(garde)) +(keyword_set(vire) EQ garde)
+;
+   tname = tag_names(stru)
+   index = make_selection(tname, strupcase(liste), /only_valid, /quiet)
+;
+   if garde then BEGIN ; on garde que la liste
+      if index[0] EQ -1 then return,  -1
+      if n_elements(index) EQ n_elements(tname) then return, stru
+      res = create_struct(tname[index[0]], stru.(index[0]))
+      if n_elements(index) GT 1 then for i = 1, n_elements(index)-1 do $
+            res = create_struct(res, tname[index[i]], stru.(index[i]))
+   ENDIF ELSE BEGIN ; on vire la liste
+      if n_elements(index) EQ n_elements(tname) then return,  -1
+      if index[0] EQ -1 then return, stru
+; on prend le complementaire de index pour obtenir les indices que
+; l''on garde
+      index = different(indgen(n_elements(tname)), index)
+      res = create_struct(tname[index[0]], stru.(index[0]))
+      if n_elements(index) GT 1 then for i = 1, n_elements(index)-1 do $
+            res = create_struct(res, tname[index[i]], stru.(index[i]))
+   ENDELSE 
+
+   return, res
+end
Index: tags/start/STRUCTURE/mixstru.pro
===================================================================
--- tags/start/STRUCTURE/mixstru.pro	(revision 5)
+++ tags/start/STRUCTURE/mixstru.pro	(revision 5)
@@ -0,0 +1,77 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: mixstru
+;
+; PURPOSE: concatene 2 structures ensemble. La difference avec
+; CREATE_STRUCT etant que si les 2 stuctures ont les memes noms
+; d''elements alors mixstru ne plante pas mais choisit pour valeur de
+; l''element commun celle specifiee par la premiere structure.
+;
+; CATEGORY: structure
+;
+; CALLING SEQUENCE: rs=mixstru(stru1,stru2)
+; 
+; INPUTS: stru1 et stu2 sont 2 structures qui peuvent avoir des
+; elements portant le meme nom mais avec une valeur differente.
+;
+; KEYWORD PARAMETERS: none
+;
+; OUTPUTS: une stucture
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS: si stru1 ou stru2 ne sont pas des structures mixstru
+; renvoie -1
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;     
+;     IDL> a=get_extra(/toto,ok=123)
+;     IDL> b=get_extra(ok=111, year=1999, age_capitaine=35)
+;     IDL> help, a,b,/struct
+;     ** Structure <8334424>, 2 tags, length=4, refs=1:
+;        OK              INT            123
+;        TOTO            INT              1
+;     ** Structure <8373da4>, 3 tags, length=6, refs=1:
+;        AGE_CAPITAINE   INT             35
+;        OK              INT            111
+;        YEAR            INT           1999
+;     IDL> help, mixstru(a,b),/struct
+;     ** Structure <82f25ac>, 4 tags, length=8, refs=1:
+;        AGE_CAPITAINE   INT             35
+;        YEAR            INT           1999
+;        OK              INT            123
+;        TOTO            INT              1
+;     IDL> help, mixstru(b,a),/struct
+;     ** Structure <834604c>, 4 tags, length=8, refs=1:
+;        TOTO            INT              1
+;        AGE_CAPITAINE   INT             35
+;        OK              INT            111
+;        YEAR            INT           1999
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      7/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION mixstru, stru1, stru2
+   IF size(stru1, /type) EQ 0 AND size(stru2, /type) EQ 8 THEN return, stru2
+   IF size(stru2, /type) EQ 0 AND size(stru1, /type) EQ 8 THEN return, stru1
+   if size(stru1, /type) NE 8 then return,  -1
+   if size(stru2, /type) NE 8 then return,  -1
+   tname = tag_names(stru2)
+   res = ''
+   rien = execute('res = get_extra('+tname[0]+'=stru2.(0), _extra = stru1)')
+   if rien EQ 0 then stop
+   if n_tags(stru2) GT 1 then begin
+      FOR i = 1, n_tags(stru2)-1 DO BEGIN 
+         rien = execute('res = get_extra('+tname[i]+'=stru2.(i), _extra = res)')
+         if rien EQ 0 then stop
+      endfor
+   endif
+   return, res
+end
Index: tags/start/STRUCTURE/struct2string.pro
===================================================================
--- tags/start/STRUCTURE/struct2string.pro	(revision 5)
+++ tags/start/STRUCTURE/struct2string.pro	(revision 5)
@@ -0,0 +1,83 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:struct2string
+;
+; PURPOSE:convert a structure to an "executable string"
+;
+; CATEGORY:bidouille
+;
+; CALLING SEQUENCE:sting=struct2string(struct)
+; 
+; INPUTS:struct: a structure
+;
+; KEYWORD PARAMETERS:
+;
+;      MAX_STRUCT_LENGTH : the maximum length of the structure
+;      permetted to convert the structure to string. Default is
+;      10000l.
+;
+;      /DIRECT2STRING: to get a string instead an "executable string"
+;
+;      /CUT_IN_STRING: try it
+;
+; OUTPUTS:
+;
+; SIDE EFFECTS:use tostr.pro, cf this function header!
+;
+; RESTRICTIONS:use tostr.pro, cf this function header!
+;
+; EXAMPLE:
+;
+;      IDL> print, struct2string(!d)
+;      create_struct('NAME','X','X_SIZE',891,'Y_SIZE',630,'X_VSIZE'
+;      ,891,'Y_VSIZE',630,'X_CH_SIZE',6,'Y_CH_SIZE',10,'X_PX_CM'
+;      ,40.0000,'Y_PX_CM',40.0000,'N_COLORS',16777216,'TABLE_SIZE' 
+;      ,256,'FILL_DIST',1,'WINDOW',32,'UNIT',0,'FLAGS',328124,'ORIGIN'
+;      ,[0,0],'ZOOM',[1,1])
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      2000 07 03
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION struct2string, struct, CUT_IN_STRING = cut_in_string, MAX_STRUCT_LENGTH = max_struct_length, DIRECT2STRING = direct2string 
+   if size(struct, /type) NE 8 then return,  ''
+   if NOT keyword_set(max_struct_length) then max_struct_length = 10000l
+   if n_tags(struct, /length) GT max_struct_length then begin
+      rien = report('The structure is too big to be converted to string! !C See the MAX_STRUCT_LENGTH keyword')
+      return, ''
+   endif
+   names = tag_names(struct)
+   case 1 of
+      keyword_set(direct2string):BEGIN
+         res = names[0]+'='+tostr(struct.(0))
+         if n_tags(struct) GT 1 then begin
+            FOR i = 1, n_tags(struct)-1 do begin
+               res = res+', '+names[i]+'='+tostr(struct.(i))
+            endfor
+         endif
+         
+      END
+      keyword_set(CUT_IN_STRING):BEGIN
+         res = 'create_struct('''+names[0]+''','+tostr(struct.(0))+')'
+         if n_tags(struct) GT 1 then begin
+            FOR i = 1, n_tags(struct)-1 do begin
+               res = [res, 'create_struct(res,'''+names[i]+''','+tostr(struct.(i))+')']
+            endfor
+         endif
+      END
+      ELSE:BEGIN
+         res = 'create_struct('''+names[0]+''','+tostr(struct.(0))
+         if n_tags(struct) GT 1 then begin
+            FOR i = 1, n_tags(struct)-1 do begin
+               res = res+','''+names[i]+''','+tostr(struct.(i))
+            endfor
+         endif
+         res = res+')'
+      END
+   endcase
+   return, res
+end
Index: tags/start/STRUCTURE/where_tag.pro
===================================================================
--- tags/start/STRUCTURE/where_tag.pro	(revision 5)
+++ tags/start/STRUCTURE/where_tag.pro	(revision 5)
@@ -0,0 +1,169 @@
+function where_Tag, Struct, Nfound,     TAG_NAME=Tag_Name,      $
+                                        TAG_NUMBER=Tag_Num,     $
+                                        ISELECT=ipart, NOPRINT=noprint, $
+                                        RANGE=range, VALUES=values
+;+
+; NAME:
+;       WHERE_TAG
+; PURPOSE:
+;       Like WHERE but works on structure tag names
+; EXPLANATION:
+;       Obtain subscripts of elements in structure array for which
+;       a particular Tag has values in a range or matching specified values.
+;       Like the WHERE function but for use with structures
+; CATEGORY:
+;                       Structures
+; CALLING SEQUENCE:
+;        w = where_tag( struct, [ Nfound,  TAG_NAME=, TAG_NUMBER = , RANGE =, 
+;                               VALUES =, RANGE =, ISELECT =, /NOPRINT ]
+;
+; INPUTS:
+;       Struct = structure array to search.
+;
+; INPUT KEYWORDS:
+;       User *must* specify (1) TAG_NAME or TAG_NUMBER to search, and (2)
+;               the VALUES or RANGE to search on
+;
+;       TAG_NAME = Scalar string specifying Tag Name
+;       TAG_NUMBER = otherwise give the Tag Number,
+;       RANGE = [min,max] range to search for in Struct,
+;       VALUES = one or array of numbers to match for in Struct,
+;       ISELECT= specifies indices to select only part of structure array,
+;               (use it to recycle subscripts from previous searches).
+;       /NOPRINT = suppress informational messages about nothing found.
+;
+; OUTPUTS:
+;       Nfound = # of occurences found.
+;
+; RESULT:
+;       Function returns subscripts (indices) to desired elements.
+;
+; EXAMPLES:
+;       Suppose STR is a structure with tags CAT_NO:indgen(10), and 
+;               NAME:strarr(10).   Find the indices where STR.CAT_NO is
+;               between 3 and 5.
+;
+;       IDL> print, WHERE_TAG( str, TAG_NAME = 'CAT_NO', VALUE = [3,4,5] )  ;or
+;       IDL> print, WHERE_TAG( str, TAG_NUM = 0, RANGE = [3,5]) 
+;
+; PROCEDURE:
+;       Get tag number and apply the WHERE function appropriately.
+;
+; MODIFICATION HISTORY:
+;       written 1990 Frank Varosi STX @ NASA/GSFC
+;       Stop printing "Tag <xxx> not found" with /NOPRINT, CD Pike 8-Jun-93
+;-
+;First check required parameters...
+
+        Ntag = N_tags( Struct )
+
+        if (Ntag LE 1) then begin
+                message,"expecting a Structure Array, try again...",/CONTIN
+                return,[-1]
+           endif
+
+        if (N_elements( Tag_Num ) NE 1) AND $
+           (N_elements( Tag_Name ) NE 1) then begin
+                message,"specify TAG_NAME= or TAG_NUMBER= to search",/CONTIN
+                return,[-1]
+           endif
+
+        Tags = Tag_names( Struct )
+
+        if N_elements( Tag_Name ) EQ 1 then begin
+                Tag_Name = strupcase( Tag_Name )
+                Tag_Num = where( Tags EQ Tag_Name )
+                Tag_Num = Tag_Num[0]
+                if (Tag_Num LT 0) then begin
+                 if NOT keyword_set( noprint ) then $
+                        message,"Tag <"+Tag_Name+"> not found",/CONTIN
+                        return,[-2]
+                   endif
+           endif
+
+        if (Tag_Num LT 0) OR (Tag_Num GE Ntag) then begin
+                message,"Tag# " + strtrim(Tag_Num,2) + " exceeds Max Tag# " $
+                        + strtrim(Ntag-1,2) + " in structure",/CONTIN
+                return,[-1]
+           endif
+
+        if N_elements( ipart ) GT 0 then begin          ;check if any searching 
+                                                        ;on a subset of input.
+                w = where( ipart GE 0, nf )
+                if (nf LE 0) then return,[-1]
+                if (nf LT N_elements( ipart )) then ipart = ipart[w]
+           endif
+
+;Now find out where for RANGE :
+
+        if N_elements( range ) EQ 2 then begin
+
+                if N_elements( ipart ) GT 0 then begin
+
+                     w = where( (Struct[ipart].(Tag_Num) GE range[0]) AND $
+                                (Struct[ipart].(Tag_Num) LE range[1]), Nfound )
+
+                     if (Nfound GT 0) then windex = ipart[w] else windex = w
+
+                 endif $
+                  else  windex = where( (Struct.(Tag_Num) GE range[0]) AND $
+                                        (Struct.(Tag_Num) LE range[1]), Nfound )
+
+                if (Nfound LE 0) AND (NOT keyword_set( noprint ) ) then begin
+                        strnums = strtrim( range, 2 )
+                        string = strnums[0] + "," + strnums[1]
+                        message," NO values of <" + Tags[Tag_num] + $
+                                "> found in the Range [" + string + "]",/CONTIN
+                   endif
+;where Values:
+
+         endif else if N_elements( values ) GE 1 then begin
+
+                Nval = N_elements( values )
+                vals = [values]
+                Nfound = 0
+
+                if N_elements( ipart ) GT 0 then begin
+
+                    for v=0,Nval-1 do begin
+                        w = where( Struct[ipart].(Tag_Num) EQ vals[v], Nf )
+                        if (Nf GT 0) then begin
+                                if (Nfound GT 0) then ww = [ww,w] else ww = w
+                           endif
+                        Nfound = Nfound + Nf
+                      endfor
+
+                    if (Nfound GT 0) then windex = ipart[ww[sort( ww )]] $
+                                     else windex = w
+
+                 endif else begin
+
+                    for v=0,Nval-1 do begin
+                        w = where( Struct.(Tag_Num) EQ vals[v], Nf )
+                        if (Nf GT 0) then begin
+                                if (Nfound GT 0) then ww = [ww,w] else ww = w
+                           endif
+                        Nfound = Nfound + Nf
+                      endfor
+
+                    if (Nfound GT 0) then windex = ww[sort( ww )] $
+                                     else windex = w
+
+                  endelse
+
+                if (Nfound LE 0) AND (NOT keyword_set( noprint ) ) then begin
+                        strnums = strtrim( vals, 2 )
+                        string = strnums[0]
+                        for i=1,Nval-1 do string = string + "," + strnums[i]
+                        message," NO values of <" + Tags[Tag_num] + $
+                                "> found Equaling [" + string + "]",/CONTIN
+                   endif
+
+           endif else begin
+
+                message,"must specify a RANGE=[#,#]  or VALUES=#('s)",/CONTIN
+                windex=[-1]
+            endelse
+
+return, windex
+end
Index: tags/start/TEXT2IDL/matchdelim.pro
===================================================================
--- tags/start/TEXT2IDL/matchdelim.pro	(revision 5)
+++ tags/start/TEXT2IDL/matchdelim.pro	(revision 5)
@@ -0,0 +1,141 @@
+;
+;+
+; NAME:
+;       MATCHDELIM
+; PURPOSE:
+;        Match open/close delimiters in a string.
+; CATEGORY:
+;        text/strings
+; CALLING SEQUENCE:
+;        position = matchdelim( strn, [openpos])
+; INPUTS:
+;        strn        -- a string containing an open                 in
+;                       delimiter (e.g. '{') in which you 
+;                       want to find the matching closing  
+;                       delimiter (e.g. '}')
+; KEYWORD PARAMETERS:
+;        OPEN_DELIM  -- A single character containing the opening   in
+;                       delimiter (e.g. '(').  Default is '{'
+;        CLOSE_DELIM -- A single character containing the closing   in
+;                       delimiter (e.g. ')').  Default is '}'
+; OUTPUTS:
+;        position -- returns the position in strn of the            out
+;                    closing delimiter, -1 if no closing found.
+;        openpos  -- Set to a named variable to receive the         out
+;                    position of the first opening delimiter.
+;                    Optional.
+; COMMON BLOCKS:
+; SIDE EFFECTS:
+; NOTES:
+;        - Any pair of (nonidentical) characters can be used as
+;          delimiters. 
+; EXAMPLE:
+;        matchdelim('{one{two}}three') returns 9, the character just
+;        before 'three'.  
+; MODIFICATION HISTORY:
+;       $Id$
+;       $Log$
+;       Revision 1.1  2002/09/11 10:17:16  opalod
+;       Initial revision
+;
+;       Revision 1.3  1996/06/14 20:00:27  mcraig
+;       Updated Copyright info.
+;
+;       Revision 1.2  1996/05/09 00:22:17  mcraig
+;       Removed restriction that open delim must be first char.  Added argument
+;       to allow for return of position of open delim.
+;
+;       Revision 1.1  1996/01/31 18:41:06  mcraig
+;       Initial revision
+;
+; RELEASE:
+;       $Name$
+;
+; COPYRIGHT:
+;  Copyright (C) 1996 The Regents of the University of California, All
+;  Rights Reserved.  Written by Matthew W. Craig.
+;  See the file COPYRIGHT for restrictions on distrubting this code.
+;  This code comes with absolutely NO warranty; see DISCLAIMER for details.
+;-
+;
+FUNCTION Matchdelim, InString, OpenPos, $
+                     OPEN_DELIM=OpenDelim, $
+                     CLOSE_DELIM=CloseDelim, $
+                     HELP=Help
+
+; Return to caller if error.
+    On_error, 2
+
+    IF (n_params() LT 1) OR keyword_set(Help) THEN BEGIN
+        offset = '   '
+        print, offset+'Match open/close delimiters in a string.'
+        print, offset+'position = matchdelim( strn, [openpos])'
+        print, offset+'Inputs:'
+        print, offset+offset+'strn        -- a string containing an open                 in'
+        print, offset+offset+"               delimiter (e.g. '{') in which you "
+        print, offset+offset+'               want to find the matching closing  '
+        print, offset+offset+"               delimiter (e.g. '}')"
+        print, offset+'Keywords:'
+        print, offset+offset+'OPEN_DELIM  -- A single character containing the opening   in'
+        print, offset+offset+"               delimiter (e.g. '(').  Default is '{'"
+        print, offset+offset+'CLOSE_DELIM -- A single character containing the closing   in'
+        print, offset+offset+"               delimiter (e.g. ')').  Default is '}'"
+        print, offset+'Outputs:'
+        print, offset+offset+'position -- returns the position in strn of the            out'
+        print, offset+offset+'            closing delimiter, -1 if no closing found.'
+        print, offset+offset+'openpos  -- Set to a named variable to receive the         out'
+        print, offset+offset+'            position of the first opening delimiter.'
+        print, offset+offset+'            Optional.'
+        print, offset+'Example:'
+        print, offset+offset+"matchdelim('a{one{two}}three') returns 10, the character just"
+        print, offset+offset+"  before 'three'.  "
+        print, offset+offset+$
+          "a=matchdelim('aaa[bbb(ccc)]ddd[eee]',f,OP='[',CL=']')"
+        print, offset+offset+"  returns a=12 (just before ddd), f=3 "+$
+          "(just before bbb)."  
+        return, -1
+    ENDIF 
+
+; Set default delimiters.
+    IF n_elements(OpenDelim) EQ 0 THEN OpenDelim =  '{'
+    IF n_elements(CloseDelim) EQ 0 THEN CloseDelim =  '}'
+
+; Make sure InString has more than 1 character.
+    length = strlen(InString) 
+    IF (length LE 1) THEN return,-1
+
+; Return if no open delimiter
+    OpenPos = strpos( InString, OpenDelim )
+    IF (OpenPos EQ -1) THEN BEGIN 
+        print, 'Error: No opening delimiter'
+        return, -1
+    ENDIF 
+    
+; Convert strings to array of integers to speed processing.
+    OpenDelim = fix((byte(OpenDelim))(0))
+    CloseDelim = fix((byte(CloseDelim))(0))
+    TmpStr = fix(byte(strmid( InString, OpenPos, length)))
+; Leave the -1* in here.  This forces conversion from BYTE to INTEGER,
+; necessary because there are no negative BYTEs.
+    TmpStr = (TmpStr EQ OpenDelim) $
+              -1*(TmpStr EQ CloseDelim)
+    length = n_elements(TmpStr) 
+
+; Initialize count of number of delimiters.  We've found one, the
+; first opener.
+    BraceCnt = 1
+    i=0
+    WHILE (BraceCnt GT 0) AND (i LT length-1) DO BEGIN 
+        i = i+1
+        BraceCnt = BraceCnt + TmpStr(i)
+    ENDWHILE 
+    
+    i = i + OpenPos
+    IF (BraceCnt GT 0) THEN i = -1
+    return, i
+END
+
+	
+
+
+
Index: tags/start/TEXT2IDL/nexttok.pro
===================================================================
--- tags/start/TEXT2IDL/nexttok.pro	(revision 5)
+++ tags/start/TEXT2IDL/nexttok.pro	(revision 5)
@@ -0,0 +1,119 @@
+;
+;+
+; NAME:
+;       NEXTTOK
+; PURPOSE:
+;       Find the next occurance of any of a set of characters in a
+;       string and return the character which occurs next.
+; CATEGORY:
+;       text/strings
+; CALLING SEQUENCE:
+;       tok = nexttok( strn, tokens )
+; INPUTS:
+;       strn   -- string to be searched for sub/superscripts    in
+;       tokens -- string containing characters to be found.     in
+; KEYWORD PARAMETERS:
+;       POSITION -- Set to a named variable to get position     out
+;                   of next token, or -1 if none found.
+;       /HELP    -- Print useful message and exit.
+; OUTPUTS:
+;       tok    -- Contains the character among tokens which     out
+;                 occurs next in strn, or null '' if none found.
+; COMMON BLOCKS:
+; SIDE EFFECTS:
+; NOTES:
+; EXAMPLE:
+;       nexttok( 'x^2 + N_j^3', '^_', position=pos ) returns '^' and sets
+;       pos to 1.
+; MODIFICATION HISTORY:
+;       $Id$
+;       $Log$
+;       Revision 1.1  2002/09/11 10:17:16  opalod
+;       Initial revision
+;
+;       Revision 1.3  1996/06/14 20:00:27  mcraig
+;       Updated Copyright info.
+;
+;       Revision 1.2  1996/05/09 00:22:17  mcraig
+;       Generalized so that the next occurence of any of a set of characters will
+;       be returned.
+;
+;       Revision 1.1  1996/01/31 18:41:06  mcraig
+;       Initial revision
+;
+; RELEASE:
+;       $Name$
+;
+; COPYRIGHT:
+;  Copyright (C) 1996 The Regents of the University of California, All
+;  Rights Reserved.  Written by Matthew W. Craig.
+;  See the file COPYRIGHT for restrictions on distrubting this code.
+;  This code comes with absolutely NO warranty; see DISCLAIMER for details.
+;-
+FUNCTION nexttok, strn, tokens, $
+                  POSITION=position, $
+                  HELP=Help
+
+;  Return to caller on error.
+    On_error, 2
+
+;  Help those in need of it.
+    IF (n_params() NE 2) OR keyword_set(Help) THEN BEGIN 
+        offset = '   '
+        print, offset+'Find the next occurance of any of a set of characters in a'
+        print, offset+'string and return the character which occurs next.'
+; CALLING SEQUENCE:
+        print, offset+'tok = nexttok( strn, tokens )'
+; INPUTS:
+        print, offset+'Inputs:'
+        print, offset+offset+'strn   -- string to be searched for sub/superscripts    in'
+        print, offset+offset+'tokens -- string containing characters to be found.     in'
+; KEYWORD PARAMETERS:
+        print, offset+'Keywords:'
+        print, offset+offset+'POSITION -- Set to a named variable to get position     out'
+        print, offset+offset+'            of next token, or -1 if none found.'
+        print, offset+offset+'/HELP    -- Print useful message and exit.'
+; OUTPUTS:
+        print, offset+'Outputs:'
+        print, offset+offset+'tok   -- Contains the character among tokens which      out'
+        print, offset+offset+"         occurs next in strn, or null '' if none found."
+; EXAMPLE:
+        print, offset+'Example:'
+        print, offset+offset+"nexttok( 'x^2 + N_j^3', '^_', position=pos ) returns '^' and sets"
+        print, offset+offset+'pos to 1.'
+        return, ''
+    ENDIF 
+
+    TmpStr = byte(strn)
+    TmpTok = byte(tokens)
+    NumToks = n_elements(TmpTok) 
+
+    MatchIdx = 0L
+    Matches = 0L
+    FOR j=0, NumToks-1 DO BEGIN 
+        TmpMatch = where(TmpStr EQ TmpTok(j),  TmpCnt)
+        IF (TmpCnt GT 0) THEN BEGIN
+            MatchIdx = [MatchIdx, Replicate(j, TmpCnt)]
+            Matches = [Matches, TmpMatch]
+        ENDIF 
+    ENDFOR 
+
+    IF n_elements(MatchIdx) EQ 1 THEN BEGIN 
+        Position = -1
+        return, ''
+    ENDIF 
+
+    MatchIdx = MatchIdx(1:*)
+    Matches = Matches(1:*)
+
+    SortInd = sort(Matches)
+
+    Position = Matches(SortInd(0))
+
+    Tok = string(TmpTok(MatchIdx(SortInd(0))))
+    
+    return, Tok
+END
+
+
+
Index: tags/start/TEXT2IDL/showtex.pro
===================================================================
--- tags/start/TEXT2IDL/showtex.pro	(revision 5)
+++ tags/start/TEXT2IDL/showtex.pro	(revision 5)
@@ -0,0 +1,120 @@
+;
+;+
+; NAME:
+;       SHOWTEX
+; PURPOSE:
+;       Display TeX sequence translation table on current graphics device.
+; CATEGORY:
+;       text/strings
+; CALLING SEQUENCE:
+;       showtex
+; INPUTS:
+; KEYWORD PARAMETERS:
+;       /HELP -- print out info on use of the function
+;                and exit.
+;       FONT  -- Set to 0 to use hardware font, -1 to use vector.
+;                Note that the only hardware font supported is
+;                Postscript
+; OUTPUTS:
+; COMMON BLOCKS:
+; SIDE EFFECTS:
+;       Plot is created.
+; NOTES:
+;       Hardware fonts are supported only for device PS (PostScript)
+; EXAMPLE:
+; MODIFICATION HISTORY:
+;       $Id$
+;       $Log$
+;       Revision 1.1  2002/09/11 10:17:16  opalod
+;       Initial revision
+;
+;       Revision 1.3  1996/06/14 20:00:27  mcraig
+;       Updated Copyright info.
+;
+;       Revision 1.2  1996/05/09 00:22:17  mcraig
+;       Added error handling and updated built in help.
+;
+;       Revision 1.1  1996/02/08 18:55:12  mcraig
+;       Initial revision
+;
+; RELEASE:
+;       $Name$
+;
+; COPYRIGHT:
+;  Copyright (C) 1996 The Regents of the University of California, All
+;  Rights Reserved.  Written by Matthew W. Craig.
+;  See the file COPYRIGHT for restrictions on distrubting this code.
+;  This code comes with absolutely NO warranty; see DISCLAIMER for details.
+;-
+;
+PRO Showtex, FONT=fnt, HELP=help
+
+; Return to caller on error.
+    On_error, 2
+
+; Print help if needed.
+    IF keyword_set(help) THEN BEGIN
+        print, '    Display TeX sequence translation table on current graphics device.'
+        print, '    showtex'
+        print, '    Keywords:'
+        print, '       /HELP       print this message and return'
+        print, '       FONT        set to 0 to use hardware fonts for current device,'
+        print, '                   -1 to use vector fonts (DEFAULT)'
+        print, '    NOTES:  - The only hardware font supported is PostScript.'
+        print, '            - The FONT keyword overrides the font selected in !p.font'
+        return
+    ENDIF
+    
+;  We begin by deciding on the font.  PostScript = 0 means use vector.
+    PostScript = 0
+    PlotTitle = 'Vector Fonts'
+    IF n_elements(fnt) EQ 0 THEN BEGIN ; get font from !p.font
+        IF !P.font NE -1 THEN BEGIN ; User wants hardware font.
+            PostScript = 1
+            PlotTitle = 'PostScript Fonts'
+        ENDIF 
+    ENDIF ELSE BEGIN            ; get font from FONT keyword
+        IF fnt NE -1 THEN BEGIN
+            PostScript = 1
+            PlotTitle = 'PostScript Fonts'
+        ENDIF
+    ENDELSE
+    
+;  Bomb out if user wants hardware font for non-PostScript device.
+    IF (PostScript EQ 1) AND (strupcase(!D.name) NE 'PS') THEN BEGIN   
+                                              ; Device isn't postscript 
+                                              ; and user wants hardware
+                                              ; font.  Not good.
+        print, 'Warning: No translation for device: ', !D.name
+        return
+    ENDIF
+   
+; Set !P.font to value indicated by FONT keyword, saving surrent
+; setting to reset at end.
+    OldPFont = !p.font
+    !p.font = PostScript - 1
+
+    erase
+    seq = textoidl(/tex)
+    DisplayString = seq + '  ' + textoidl(seq)
+
+    nseq = n_elements(seq)
+    nrows = nseq/5 + 1          ; Five sequences per row.
+    dx = .9/5.
+    dy = .9/nrows
+    y=.95
+    xyouts,.5,y,PlotTitle,align=.5,/norm,size=2.5
+    count=0
+    FOR i = 1L, nrows DO BEGIN
+        y= y - dy
+        x = .1
+        FOR j = 1, 5 DO BEGIN
+            IF (count LT nseq ) THEN xyouts, x, y, DisplayString(count), align = .5, /norm
+            count = count+1
+            x = x + dx
+        ENDFOR
+    ENDFOR
+
+; Restore old !P.font.
+    !p.font = OldPFont
+END
Index: tags/start/TEXT2IDL/textable.pro
===================================================================
--- tags/start/TEXT2IDL/textable.pro	(revision 5)
+++ tags/start/TEXT2IDL/textable.pro	(revision 5)
@@ -0,0 +1,227 @@
+;
+;+
+; NAME:
+;       TEXTABLE
+; PURPOSE:
+;       Returns a translation table from TeX to IDL.
+; CATEGORY:
+;       text/strings
+; CALLING SEQUENCE:
+;       table = textable()
+; INPUTS:
+;       None
+; KEYWORD PARAMETERS:
+;       /POSTSCRIPT -- If set, return postscript translation
+;                      table rather than vector fonts table.
+;                      Default is translations for vector
+;                      fonts.
+;       /HELP       -- Print help and exit.
+; OUTPUTS:
+;       table -- a 2D text array.  table(0,*) contains          out
+;                the words to be translated away, table(1,*)
+;                contains the words to translate them to.   
+; COMMON BLOCKS:
+; SIDE EFFECTS:
+; NOTES:
+;       To find out what TeX sequences are available, look at
+;       table(0,*).
+; EXAMPLE:
+; MODIFICATION HISTORY:
+;       $Id$
+;       $Log$
+;       Revision 1.1  2002/09/11 10:17:16  opalod
+;       Initial revision
+;
+;       Revision 1.7  1996/07/22 23:56:08  mcraig
+;       Added \vartheta.
+;
+;       Revision 1.6  1996/07/12 21:31:42  mcraig
+;       Fixed \varphi in vector font, added \circ.
+;
+;       Revision 1.5  1996/06/14 20:00:27  mcraig
+;       Updated Copyright info.
+;
+;       Revision 1.4  1996/05/09 00:22:17  mcraig
+;       Added command to return to previous font after switching to Greek or
+;       symbol font.
+;
+;       Revision 1.3  1996/02/08 19:49:35  mcraig
+;       Removed control sequence \perp because the postscript code for it is '^'.
+;
+;       Revision 1.2  1996/02/08 18:53:38  mcraig
+;       Added translations for PostScript fonts, and added several new TeX
+;       control sequences.
+;
+;       Revision 1.1  1996/01/31 18:47:37  mcraig
+;       Initial revision
+;
+; RELEASE:
+;       $Name$
+;
+; COPYRIGHT:
+;  Copyright (C) 1996 The Regents of the University of California, All
+;  Rights Reserved.  Written by Matthew W. Craig.
+;  See the file COPYRIGHT for restrictions on distrubting this code.
+;  This code comes with absolutely NO warranty; see DISCLAIMER for details.
+;-
+;
+FUNCTION textable, POSTSCRIPT=ps, VECTOR=vec,  HELP=Help
+
+; Return to caller if error.
+    On_error, 2
+
+; Print help if necessary.
+    IF keyword_set(Help)  THEN BEGIN
+        offset = '   '
+        print, offset+'Returns a translation table from TeX to IDL.'
+        print, offset+'table = textable()'
+        print, offset+'Keywords:'
+        print, offset+offset+'/POSTSCRIPT -- If set, return postscript translation'
+        print, offset+offset+'               table rather than vector fonts table.'
+        print, offset+offset+'               Default is translations for vector'
+        print, offset+offset+'               fonts.'
+        print, offset+offset+'/HELP       -- Print help and exit.'
+        print, offset+'Outputs:'
+        print, offset+offset+'table -- a 2D text array.  table(0,*) contains          out'
+        print, offset+offset+'         the words to be translated away, table(1,*)'
+        print, offset+offset+'         contains the words to translate them to.'
+        print, offset+'Notes:'
+        print, offset+offset+'To find out what TeX sequences are available, look at'
+        print, offset+offset+'table(0,*).'
+    ENDIF 
+
+    VECFONT=1                   ; index of vector font in translation table
+    PSFONT=2			; index of postscript font in trans table
+    IF keyword_set(ps) THEN FontSelection=PSFONT ELSE FontSelection=VECFONT
+
+;  Set IDL font sequence needed to switch to Greek letters.
+    GreekFont = strarr(3)
+    GreekFont(VECFONT) = '!7'
+    GreekFont(PSFONT) = '!M'
+
+;  Set IDL font sequence needed to switch to special symbol font.
+    SymbolFont = strarr(3)
+    SymbolFont(VECFONT) = '!M'
+    SymbolFont(PSFONT) = '!M'
+
+;  Set IDL font sequence needed to switch back to initial font.
+    PreviousFont = strarr(3)
+    PreviousFont(VECFONT) = '!X'
+    PreviousFont(PSFONT) = '!X'
+
+;lowercase Greek -- 
+;    Note there is some trickery involved in getting \varphi
+;    to work in the vector fonts, because it is actually
+;    a member of the symbol font set, not the Greek font
+;    set.  Go figure.  Solution is just to make the vector
+;    character a switch to symbol, the proper character from
+;    that font, and a switch back out of symbol.  Same comment holds
+;    for \vartheta.
+;;        TeX SEQUENCE       VECTOR       POSTSCRIPT
+    LowercaseGreek = [$
+	[ '\alpha',     	'a'     ,     'a'     ],$
+	[ '\beta',      	'b'     ,     'b'     ],$
+	[ '\gamma',     	'c'     ,     'g'     ],$
+	[ '\delta',     	'd'     ,     'd'     ],$
+	[ '\epsilon',   	'e'     ,     'e'     ],$
+	[ '\zeta',      	'f'     ,     'z'     ],$
+	[ '\eta', 		'g'	,     'h'     ],$
+	[ '\theta', 		'h'	,     'q'     ],$
+	[ '\iota', 		'i'	,     'i'     ],$
+	[ '\kappa', 		'j'	,     'k'     ],$
+	[ '\lambda', 		'k'	,     'l'     ],$
+	[ '\mu', 		'l'	,     'm'     ],$
+	[ '\nu', 		'm'	,     'n'     ],$
+	[ '\xi', 		'n'	,  '!S !Rx'   ],$
+	[ '\pi', 		'p'	,     'p'     ],$
+	[ '\rho', 		'q'	,     'r'     ],$
+	[ '\sigma', 		'r'	,     's'     ],$
+	[ '\tau', 		's'	,     't'     ],$
+	[ '\upsilon', 		't'	,     'u'     ],$
+	[ '\phi', 		'u'	,     'f'     ],$
+	[ '\chi', 		'v'	,     'c'     ],$
+	[ '\psi', 		'w'	,     'y'     ],$
+	[ '\omega', 		'x'	,     'w'     ],$
+	[ '\varpi', 		'p'	,     'v'     ],$
+	[ '\varepsilon', 	'e'     ,     'e'     ],$
+	[ '\varphi', 	$
+            SymbolFont(VECFONT)+'P'+PreviousFont(VECFONT) $
+                                        ,     'j'     ],$
+	[ '\vartheta', 	$
+            SymbolFont(VECFONT)+'t'+PreviousFont(VECFONT) $
+                                        ,     'J'     ]$
+	                     ]
+;Uppercase Greek -- 
+;;        TeX SEQUENCE        VECTOR          POSTSCRIPT
+    UppercaseGreek = [$
+	[ '\Gamma', 		'C'   ,	        'G'         ],$
+	[ '\Delta', 		'D'   ,	        'D'         ],$
+	[ '\Theta', 		'H'   ,	        'Q'         ],$
+	[ '\Lambda', 		'K'   ,	        'L'         ],$
+	[ '\Xi', 		'N'   ,      '!S !RX'       ],$
+	[ '\Pi', 		'P'   ,	        'P'         ],$
+	[ '\Sigma', 		'R'   ,	        'S'         ],$
+	[ '\Upsilon', 		'T'   ,  string(byte(161))  ],$
+	[ '\Phi', 		'U'   ,	        'F'         ],$
+	[ '\Psi', 		'W'   ,	        'Y'         ],$
+	[ '\Omega', 		'X'   ,	        'W'         ]$
+			   ]
+;Special symbols -- 
+;  NOTES -- You must leave \infty before \in in the translatation
+;           table to avoid having the \in part of \infty translated
+;           away. 
+;           
+;           DO NOT blindly add the control sequence \perp.  Its
+;           PostScript code is '^', which leads to thing being
+;           interpreted as superscripts which shouldn't be.
+;
+;;        TeX SEQUENCE        VECTOR          POSTSCRIPT
+    Symbols = [$
+	[ '\aleph', 		'@'   ,	 string(byte(192))  ],$
+	[ '\ast', 		'*'   ,	        '*'         ],$
+	[ '\cap', 		'3'   ,	 string(byte(199))  ],$
+	[ '\cdot', 		'.'   ,	 string(byte(215))  ],$
+	[ '\cup', 		'1'   ,	 string(byte(200))  ],$
+	[ '\exists', 		'E'   ,	        '$'         ],$
+	[ '\infty', 		'$'   ,	 string(byte(165))  ],$
+	[ '\in', 		'e'   ,	 string(byte(206))  ],$
+	[ '\equiv', 		':'   ,	 string(byte(186))  ],$
+	[ '\pm', 		'+'   ,	 string(byte(177))  ],$
+	[ '\div', 		'/'   ,	 string(byte(184))  ],$
+	[ '\subset', 		'0'   ,	 string(byte(204))  ],$
+	[ '\superset', 		'2'   ,	 string(byte(201))  ],$
+	[ '\leftarrow', 	'4'   ,	 string(byte(172))  ],$
+	[ '\downarrow', 	'5'   ,	 string(byte(175))  ],$
+	[ '\rightarrow', 	'6'   ,	 string(byte(174))  ],$
+	[ '\uparrow', 		'7'   ,	 string(byte(173))  ],$
+	[ '\neq', 		'='   ,	 string(byte(185))  ],$
+	[ '\propto', 		'?'   ,	 string(byte(181))  ],$
+	[ '\sim', 		'A'   ,	 string(byte(126))  ],$
+	[ '\partial', 		'D'   ,	 string(byte(182))  ],$
+	[ '\nabla', 		'G'   ,	 string(byte(209))  ],$
+	[ '\angle', 		'a'   ,	 string(byte(208))  ],$
+	[ '\times', 		'X'   ,	 string(byte(180))  ],$
+	[ '\geq', 		'b'   ,	 string(byte(179))  ],$
+	[ '\leq', 		'l'   ,	 string(byte(163))  ],$
+	[ "\'", 		"'"   ,	 string(byte(162))  ],$
+	[ '\prime', 		"'"   ,	 string(byte(162))  ],$
+	[ '\circ', 		"%"   ,	 string(byte(176))  ]$
+	                  ]
+    LowercaseGreek(1,*) = $
+      GreekFont(FontSelection) $
+      + LowercaseGreek(FontSelection,*) $
+      + PreviousFont(FontSelection)
+    UppercaseGreek(1,*) = $
+      GreekFont(FontSelection) +$
+      UppercaseGreek(FontSelection,*) $
+      + PreviousFont(FontSelection)
+    Symbols(1,*) = $
+      SymbolFont(FontSelection) $
+      + Symbols(FontSelection,*) $
+      + PreviousFont(FontSelection)
+
+    TranslationTable = [[LowercaseGreek],[UppercaseGreek],[Symbols]]
+    return,TranslationTable(0:1,*)
+
+END 
+
Index: tags/start/TEXT2IDL/textoidl.pro
===================================================================
--- tags/start/TEXT2IDL/textoidl.pro	(revision 5)
+++ tags/start/TEXT2IDL/textoidl.pro	(revision 5)
@@ -0,0 +1,140 @@
+;
+;+
+; NAME:
+;       TEXTOIDL
+; PURPOSE:
+;       Convert a valid TeX string to a valid IDL string for plot labels.
+; CATEGORY:
+;       text/strings
+; CALLING SEQUENCE:
+;       new = textoidl(old)
+; INPUTS:
+;       old            -- TeX string to be converted.  Will not be     in
+;                         modified.  old may be a string array.
+; KEYWORD PARAMETERS:
+;       FONT           -- Set to 0 to use hardware font, -1 to use 
+;                         vector.  Note that the only hardware font 
+;                         supported is PostScript.
+;       /TEX_SEQUENCES -- return the available TeX sequences
+;       /HELP          -- print out info on use of the function
+;                         and exit.
+; OUTPUTS:
+;       new            -- IDL string corresponding to old.             out
+; COMMON BLOCKS:
+; SIDE EFFECTS:
+; NOTES:
+;       - Use the procedure SHOWTEX to get a list of the available TeX
+;         control sequences.  
+;       - The only hardware font for which translation is available is
+;         PostScript. 
+;       - The only device for which hardware font'
+;         translation is available is PostScript.'
+;       - The FONT keyword overrides the font selected'
+;         by !p.font'
+; EXAMPLE:
+;       out = TeXtoIDL('\Gamma^2 + 5N_{ed}')
+;       The string out may be used in XYOUTS or other IDL text
+;       display routines.  It will be an uppercase Gamma, with an
+;       exponent of 2, then a plus sign, then an N with the subscript
+;       ed.
+; MODIFICATION HISTORY:
+;       $Id$
+;       $Log$
+;       Revision 1.1  2002/09/11 10:17:16  opalod
+;       Initial revision
+;
+;       Revision 1.4  1996/06/14 20:00:27  mcraig
+;       Updated Copyright info.
+;
+;       Revision 1.3  1996/05/09 00:22:17  mcraig
+;       Added error handling, cleaned up documentation.
+;
+;       Revision 1.2  1996/02/08 18:52:50  mcraig
+;       Added ability to use hardware fonts for PostScript device.
+;
+;       Revision 1.1  1996/01/31 18:47:37  mcraig
+;       Initial revision
+;
+; RELEASE:
+;       $Name$
+;
+; COPYRIGHT:
+;  Copyright (C) 1996 The Regents of the University of California, All
+;  Rights Reserved.  Written by Matthew W. Craig.
+;  See the file COPYRIGHT for restrictions on distrubting this code.
+;  This code comes with absolutely NO warranty; see DISCLAIMER for details.
+;-
+;
+FUNCTION Textoidl, InputString, $
+                   FONT=fnt, $
+                   HELP=hlp, $
+                   TEX_SEQUENCES=tex_seq
+
+;  Return to caller if there is an error.
+    On_error, 2
+;  We begin by deciding on the font.  PostScript = 0 means use vector.
+    PostScript = 0
+    IF n_elements(fnt) EQ 0 THEN BEGIN     ; get font from !p.font
+        IF !p.font NE -1 THEN BEGIN        ; User wants hardware font.
+            PostScript=1
+        ENDIF
+    ENDIF ELSE BEGIN                       ; get font from FONT keyword
+        IF fnt NE -1 THEN PostScript = 1
+    ENDELSE
+
+;  Bomb out if user wants non-PostScript hardware font.
+    IF (PostScript EQ 1) AND (!d.name NE 'PS') THEN BEGIN   
+                                              ; Device isn't postscript 
+                                              ; and user wants hardware
+                                              ; font.  Not good.
+        print,'Warning: No translation for device: ',!d.name
+        return,InputString               
+    ENDIF 
+    
+    IF keyword_set (tex_seq) THEN BEGIN
+        table=textable()
+        return,table(0,*)
+    ENDIF 
+
+    IF keyword_set(hlp) OR (n_params() EQ 0) THEN BEGIN
+        print, '   Convert a TeX string to an IDL string'
+        print, '   new = TeXtoIDL(old)'
+        print, '     old = TeX string to translate.                 in'
+        print, '     new = resulting IDL string.                    out'
+        print, '   Keywords:'
+        print, '      FONT       set to -1 to translate for vector fonts '
+        print, '                 (DEFAULT) .  Set to 0 to translate for'
+        print, '                 hardware font.'
+        print, '      /TEX_SEQUENCES -- return the available TeX sequences'
+        print, '      /HELP      print this message and exit.'
+        print, '   NOTES:  '
+        print, '      - Use SHOWTEX to obtain a list of the available'
+        print, '        TeX control sequences.'
+        print, '      - old may be a string array.  If so, new is too.'
+        print, '      - The only device for which hardware font'
+        print, '        translation is available is PostScript.'
+        print, '      - The FONT keyword overrides the font selected'
+        print, '        by !p.font'
+        return, -1
+    ENDIF
+    
+; PostScript has been set to 1 if PostScript fonts are desired.
+    strn = InputString
+    table = textable(POSTSCRIPT=PostScript)
+    
+;   Greek sub/superscripts need to be protected by putting braces
+;   around them if they are unbraced.  This will have the result the
+;   it will be difficult to use \ as a sub/superscript.  Get over it.
+    strn =  strtrans(strn, '^'+table(0, *), '^{'+table(0, *)+'}')
+    strn =  strtrans(strn, '_'+table(0, *), '_{'+table(0, *)+'}')
+
+;  First we translate Greek letters and the like.  This makes guessing
+;  alignment of sub/superscripts easier, as all special characters will then
+;  be one character long.
+    strn = strtrans(strn, table(0, *), table(1, *))
+
+    FOR i = 0L, n_elements(strn)-1 DO $
+      strn(i) = translate_sub_super(strn(i)) ; Take care of sub/superscripts
+
+    return,strn
+END 
Index: tags/start/TEXT2IDL/translate_sub_super.pro
===================================================================
--- tags/start/TEXT2IDL/translate_sub_super.pro	(revision 5)
+++ tags/start/TEXT2IDL/translate_sub_super.pro	(revision 5)
@@ -0,0 +1,304 @@
+;  NOTE to future maintainers:
+;   Make sure sub_sup_idl stays before translate_sub_super.  At least
+;   for now, when IDL encounters a function and automatically compiles
+;   it, it only compiles the functions in the file up to the named
+;   function.  So even if sub_sup_idl was declared with
+;   FORWARD_FUNCTION in translate_sub_super, it would not properly
+;   compile. 
+;
+;+
+; SPECIAL NOTE: 
+;       The file translate_sub_super.pro contains two functions,
+;       translate_sub_super, and sub_sup_idl.  The former is the
+;       generic routine for processing TeX sub/superscripts, the
+;       latter is used only by translate_sub_super and has no general
+;       utility.  Hence it lives here.  You will see documentation for
+;       translate_sub_super second if you use DOC_LIBRARY.
+;-
+;
+;
+;+
+; NAME:
+;       SUB_SUP_IDL
+; PURPOSE:
+;       Return the proper IDL font positioning command for TeX
+;       sub/superscripts. 
+; CATEGORY:
+;       TeXtoIDL
+; CALLING SEQUENCE:
+;       fnt = sub_sup_idl( strn )
+; INPUTS:
+;       strn      -- Either '^' or '_', the TeX super/subscript       in
+;                    characters
+; KEYWORD PARAMETERS:
+;       /FORCE_UD -- Set this to use !U/!D instead of !E/!I for
+;                    sub/superscripts .
+;       /HELP     -- Set to print useful message and exit.
+; OUTPUTS:
+;       fnt       -- Either '!U' or !E' for superscripts,             out
+;                    or '!D' or '!I' for subscripts.
+; COMMON BLOCKS:
+; SIDE EFFECTS:
+; NOTES:
+;       Used only by translate_sub_super.  Should be kept in same
+;       file. 
+; EXAMPLE:
+; MODIFICATION HISTORY:
+;       $Id$
+;       $Log$
+;       Revision 1.1  2002/09/11 10:17:16  opalod
+;       Initial revision
+;
+;       Revision 1.4  1996/06/14 20:00:27  mcraig
+;       Updated Copyright info.
+;
+;       Revision 1.3  1996/05/09 00:22:17  mcraig
+;       Changed some function calls to reflect changes in those functions, moved
+;       some code out of the main loop that didn't need to be there, added
+;       documentation.
+;
+;       Revision 1.1  1996/01/31 18:47:37  mcraig
+;       Initial revision
+;
+; RELEASE:
+;       $Name$
+; COPYRIGHT:
+;  Copyright (C) 1996 The Regents of the University of California, All
+;  Rights Reserved.  Written by Matthew W. Craig.
+;  See the file COPYRIGHT for restrictions on distrubting this code.
+;  This code comes with absolutely NO warranty; see DISCLAIMER for details.
+;-
+FUNCTION Sub_sup_idl, token,  FORCE_UD = force_ud
+
+; provide help if needed.
+    IF (n_params() NE 1) OR keyword_set(Help) THEN BEGIN
+        offset = '   '
+        print, offset+'Return the proper IDL font positioning command for TeX'
+        print, offset+'sub/superscripts. '
+        print, offset+'fnt = sub_sup_idl( strn )'
+        print, offset+'Inputs:'
+        print, offset+offset+"strn      -- Either '^' or '_', the TeX super/subscript       in"
+        print, offset+offset+'             characters'
+        print, offset+'Keywords:'
+        print, offset+offset+'/FORCE_UD -- Set this to use !U/!D instead of !E/!I for'
+        print, offset+offset+'             sub/superscripts .'
+        print, offset+offset+'/HELP     -- Set to print useful message and exit.'
+        print, offset+'Outputs:'
+        print, offset+offset+"fnt       -- Either '!U' or !E' for superscripts,             out"
+        print, offset+offset+"             or '!D' or '!I' for subscripts."
+        return, -1
+    ENDIF 
+
+    IF keyword_set(force_ud) THEN BEGIN 
+        IF (token EQ '^') THEN return, '!U' 
+        IF (token EQ '_') THEN return, '!D'
+        return, ''
+    ENDIF ELSE BEGIN
+        IF (token EQ '^') THEN return, '!E' 
+        IF (token EQ '_') THEN return, '!I'
+        return, ''
+    ENDELSE
+    
+END
+
+;
+;+
+; NAME:
+;       TRANSLATE_SUB_SUPER
+; PURPOSE:
+;       Translate TeX sub/superscripts to IDL sub/superscripts.
+; CATEGORY:
+;       text/strings
+; CALLING SEQUENCE:
+;       new = translate_sub_super( old )
+; INPUTS:
+;       old       -- string to be translated from TeX to IDL.   in
+; KEYWORD PARAMETERS:
+;       /RECURSED -- set if this function is being called 
+;                    recursively.                  
+;       /HELP     -- Set to print useful message and exit.
+; OUTPUTS:
+;       new       -- string old converted from TeX to IDL       out
+; COMMON BLOCKS:
+; SIDE EFFECTS:
+; NOTES:
+;       - For best results, when both a sub and superscript are used,
+;         place the shorter of the two first (e.g. 'N^{a}_{bbbb}' is
+;         better than 'N_{bbbb}^{a}').
+;       - Single character sub/super scripts do not need to be
+;         protected by braces.
+;       - Sub/superscripts may be nested (e.g. 'N^{N_1^N}').
+; EXAMPLE:
+;       out = translate_sub_super( 'N^2_{big}' )
+;       Then out='N!U2!N!Dbig!N' which looks like it should on the
+;       display. 
+; LIBRARY FUNCTIONS CALLED:
+;       strtok      -- Text/string (mcraig)
+;       sub_sup_idl -- contained in this file
+; MODIFICATION HISTORY:
+;       $Id$
+;       $Log$
+;       Revision 1.1  2002/09/11 10:17:16  opalod
+;       Initial revision
+;
+;       Revision 1.4  1996/06/14 20:00:27  mcraig
+;       Updated Copyright info.
+;
+;       Revision 1.3  1996/05/09 00:22:17  mcraig
+;       Changed some function calls to reflect changes in those functions, moved
+;       some code out of the main loop that didn't need to be there, added
+;       documentation.
+;
+;       Revision 1.2  1996/02/08 18:54:20  mcraig
+;       Changed default sub/superscript size to be !D/!U rather than !I/!E to
+;       improve readability of plat annotations.
+;
+;       Revision 1.1  1996/01/31 18:47:37  mcraig
+;       Initial revision
+;
+; RELEASE:
+;       $Name$
+;
+; COPYRIGHT:
+;  Copyright (C) 1996 The Regents of the University of California, All
+;  Rights Reserved.  Written by Matthew W. Craig.
+;  See the file COPYRIGHT for restrictions on distrubting this code.
+;  This code comes with absolutely NO warranty; see DISCLAIMER for details.
+;-
+FUNCTION Translate_sub_super, InputString, $
+                              RECURSED=recursed, $
+                              HELP=Help
+
+; Return to caller if error.
+    On_error, 2
+
+; Offer help if needed and/or desired
+    IF (n_params() NE 1) OR keyword_set(help) THEN BEGIN
+        offset = '   '
+        print, offset+'Translate TeX sub/superscripts to IDL sub/superscripts.'
+        print, offset+'new = translate_sub_super( old )'
+        print, offset+'Inputs:'
+        print, offset+offset+'old       -- string to be translated from TeX to IDL.   in'
+        print, offset+'Keywords:'
+        print, offset+offset+'/RECURSED -- set if this function is being called '
+        print, offset+offset+'             recursively.                  '
+        print, offset+offset+'/HELP     -- Set to print useful message and exit.'
+        print, offset+'Outputs:'
+        print, offset+offset+'new       -- string old converted from TeX to IDL       out'
+        print, offset+'Notes:'
+        print, offset+offset+'- For best results, when both a sub and superscript are used,'
+        print, offset+offset+"  place the shorter of the two first (e.g. 'N^{a}_{bbbb}' is"
+        print, offset+offset+"  better than 'N_{bbbb}^{a}')."
+        print, offset+offset+'- Single character sub/super scripts do not need to be'
+        print, offset+offset+'  protected by braces.'
+        print, offset+offset+"- Sub/superscripts may be nested (e.g. 'N^{N_1^N}')."
+        return, -1
+    ENDIF 
+
+;  To allow for nested scripts, use !E/!I instead of !U/!D for scripts
+;  when called recursively.
+    IF (NOT keyword_set(recursed)) THEN $
+      ud = 1 $
+    ELSE $
+      ud = 0
+
+;  Return to the normal level after making sub/superscript unless we
+;  are recursed, which indicates we are processing a nested script.
+    IF keyword_set(recursed) THEN fontRestore = '' ELSE fontRestore = '!N'
+
+;  Initialize vars for processing scripts.
+    SpcByte = (byte(' '))(0)    ;We need the BYTE value for a space below.
+    strn = InputString
+    pos = 0
+    StorePos = ''
+    RecallPos = ''
+    OldToken =  ''
+    LenLastScript = 0
+
+; Grab next sub/superscript.  Token will be either '^' or '_'.
+; RETURN if no scripts.
+    Token = nexttok(strn,  '^_', pos = pos)
+    if pos EQ -1 then return, InputString ;nothing to process.
+
+    FntChange =  sub_sup_idl(Token)
+
+; Our approach will be to grab the input string up to the next '^' or
+; '_', then process the script we've found.
+    NewString=strtok(strn,Token)
+
+    WHILE  strlen(strn) GT  0 DO  BEGIN
+;  Grab first char of sub/superscript.
+        Script = strmid(strn, 0, 1)
+        EndOfScript = 0         ;Position of end of this script.
+        IF (Script EQ '{') THEN BEGIN   ; Scripts of more than 1 char.
+            EndOfScript = matchdelim(strn)      
+            Script = translate_sub_super(strmid(strn, 1, EndOfScript-1), $
+                                         /recursed )
+        ENDIF 
+;     Grab rest of string _after_ the end of the script.        
+        strn = strmid(strn, EndOfScript+1, $
+                      strlen(strn)-EndOfScript-1)
+
+;     Find the next script and prepare for processing it.
+        FntChange = sub_sup_idl(Token, FORCE_UD = ud)
+        OldToken = Token
+        Token = nexttok(strn, '^_', POS = pos)
+
+;     If the input is 'n^2_j', we want the '2' to be directly above
+;     the 'j', rather than having the 'j' below and to the right of
+;     the 2.  In other words, we want the first below, not the second.
+;              2               2
+;             N               N
+;              J                J
+;     To accomplish this, we need to save the position at which we
+;     begin writing the 2 with a !S, and restore that position with a
+;     !R after writing the 2.  The first section in the IF block below
+;     handles the 'J' above, the thing after the first script.  We
+;     don't care if there is another script following.  We also padd
+;     the second script with spaces if it is shorter than the first to
+;     make sure that whatever comes out after the scripts starts in
+;     the proper place.  The worry is that without the spaces, the
+;     input 'N^{looong}_{s} + 1' will end up with the + starting right
+;     the 's' ends.
+        IF (StorePos EQ '!S') THEN BEGIN
+            StorePos = ''
+            RecallPos = ''
+;     calculate the difference in length between this script and the 
+;     previous stacked one, removing font change commands (crudely by
+;     guessing that the number of characters this takes is twice the
+;     number of exclamation points).  The  + 1 below is a kludge.  I
+;     don't know why, but I need one extra space.
+            NumSpaces = LenLastScript - (strlen(script) - 2*strcnt(Script,'!'))
+            NumSpaces = (NumSpaces + 1) > 0
+            IF NumSpaces GT 0 THEN $
+              Script = Script + string( replicate(SpcByte, NumSpaces) )
+        ENDIF ELSE BEGIN
+            IF (Token NE OldToken) AND (pos EQ 0) THEN BEGIN
+;             The next script immediately folows this one.  Arrange to
+;             save the position of the current script so that both begin
+;             with the same horizontal position.
+                StorePos = '!S'
+                RecallPos = '!R'
+                LenLastScript = strlen(Script) - 2*strcnt(Script,'!')
+            ENDIF
+        ENDELSE  
+
+;  Continue building the IDL string, adding on our just processed script.
+        NewString = NewString + StorePos + FntChange + Script + RecallPos $
+          + FontRestore
+
+        IF ( pos NE -1 ) THEN BEGIN     ; more left to process     
+            NewString = NewString $
+              + strtok(strn, Token)   
+        ENDIF ELSE BEGIN                ; we are done
+            NewString = NewString + strn
+            strn = ''
+        ENDELSE
+    ENDWHILE 
+    
+    return, NewString
+END
+
+
+
+
Index: tags/start/TRIANGULATION/ciseauxtri.pro
===================================================================
--- tags/start/TRIANGULATION/ciseauxtri.pro	(revision 5)
+++ tags/start/TRIANGULATION/ciseauxtri.pro	(revision 5)
@@ -0,0 +1,202 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:
+;
+; PURPOSE:vire les tableaux qui ne doivent pas etre dessines grace a 2
+; tests:
+;     1) les coins du tableau doivent etre ds la fenetre
+;     2) les clongeurs des cotes des triangfles exprimes en
+;     coordonnees normalisesne doivent pas depasser une certaine
+;     longueur seuil. 
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:
+;
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       20/2/99
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION ciseauxtri, triang, glam, gphi, TOUT = tout, _EXTRA = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+   taille = size(glam)
+   nx = taille[1]
+   ny = taille[2]
+
+   tempdeux = systime(1)        ; pour key_performance =2
+   z = convert_coord(glam(*),gphi(*),/data,/to_normal) 
+   x = z(0, *)
+   y = z(1, *)
+   tempvar = SIZE(TEMPORARY(z)) ; delete z
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps ciseauxtri: convert_coord data to_normal', systime(1)-tempdeux
+;
+; attention, suivant la projection certains points x ou y peuvent
+; devenir NaN (cf. points deriere la terre ds une projection
+; orthographique) il faut dans ce cas enlever tous les triangles qui
+; contiennent un de ces points
+;
+   if (!map.projection LE 7 AND !map.projection NE 0) $
+    OR !map.projection EQ 14 OR !map.projection EQ 15 OR !map.projection EQ 18 then begin
+      tempdeux = systime(1)     ; pour key_performance =2
+
+      ind = where(( finite((x*y)[triang[0, *]])$ ; points NaN ds la premiere colonne
+                    *finite((x*y)[triang[1, *]]) $ ; points NaN ds la 2eme colonne
+                    *finite((x*y)[triang[2, *]]) ) EQ 1) ; points NaN ds la 3eme colonne
+
+      if ind[0] NE -1 then triang = triang[*, ind] ELSE return,  -1
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps ciseauxtri: recherche points a NAN', systime(1)-tempdeux
+   endif
+;
+
+   seuil = 5.
+;
+; maintenant on vire les triangles dont un des cotes a une taille
+; superieure a 1/seuil du domaine reserve au dessin.
+;
+
+   if keyword_set(key_periodique)  then begin
+      tempdeux = systime(1)     ; pour key_performance =2
+      ind=where( (abs(x[triang[1,*]]-x[triang[0,*]]) LE (!p.position[2]-!p.position[0])/seuil) $
+                 AND (abs(x[triang[2,*]]-x[triang[1,*]]) LE (!p.position[2]-!p.position[0])/seuil) $
+                 AND (abs(x[triang[0,*]]-x[triang[2,*]]) LE (!p.position[2]-!p.position[0])/seuil) $
+;
+      AND (abs(y[triang[0,*]]-y[triang[1,*]]) LE (!p.position[3]-!p.position[1])/seuil) $
+       AND (abs(y[triang[1,*]]-y[triang[2,*]]) LE (!p.position[3]-!p.position[1])/seuil) $ 
+       AND (abs(y[triang[2,*]]-y[triang[0,*]]) LE (!p.position[3]-!p.position[1])/seuil) ) 
+
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps ciseauxtri: trouver les triangles trop grands', systime(1)-tempdeux
+;
+      tempdeux = systime(1)     ; pour key_performance =2
+      if ind[0] NE -1 then triang = triang[*, ind] ELSE return,  -1
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps ciseauxtri: virer les triangles trop grands', systime(1)-tempdeux
+   endif
+;
+; on supprime les triangles qui sont un peu trop hors du cadre
+; valable qd /TOUT est active
+;
+;    if keyword_set(key_irregular) then begin
+
+;       tempdeux = systime(1)     ; pour key_performance =2
+;       seuil = 0
+;       seuil = .1*max([!p.position[2]-!p.position[0],!p.position[3]-!p.position[1]])
+;       ind=where(x[triang[0,*]] GE !p.position[0]-seuil AND x[triang[0,*]] LE !p.position[2]+seuil $
+;                 AND x[triang[1,*]] GE !p.position[0]-seuil AND x[triang[1,*]] LE !p.position[2]+seuil $
+;                 AND x[triang[2,*]] GE !p.position[0]-seuil AND x[triang[2,*]] LE !p.position[2]+seuil $
+; ;
+;       AND y[triang[0,*]] GE !p.position[1]-seuil AND y[triang[0,*]] LE !p.position[3]+seuil $
+;        AND y[triang[1,*]] GE !p.position[1]-seuil AND y[triang[1,*]] LE !p.position[3]+seuil $
+;        AND y[triang[2,*]] GE !p.position[1]-seuil AND y[triang[2,*]] LE !p.position[3]+seuil )
+;       IF testvar(var = key_performance) EQ 2 THEN $
+;        print, 'temps ciseauxtri: trouver les triangles hors du cadre', systime(1)-tempdeux
+; ;
+;       tempdeux = systime(1)     ; pour key_performance =2
+;       if ind[0] NE -1 then triang = triang[*, ind] ELSE return,  -1
+;       IF testvar(var = key_performance) EQ 2 THEN $
+;        print, 'temps ciseauxtri: virer les triangles hors du cadre', systime(1)-tempdeux
+;    ENDIF
+;
+;        dernier tri
+;
+   if n_elements(ind) GT 1 then BEGIN
+;
+; il faut verifier que les triangles que l''on garde ne
+; forment pas une triangulation dans laquelle 2 triangles ont un
+; sommet en commun sans avoir de cote de commun.
+;
+; on constitue la liste des rectangles que l''on souhaite garder (on
+; garde un rectangle des qu''il y a un triangle dedans)
+;
+; dans definetri, on a construit les triangles tels que le premier et 
+; le dernier sommets soient ceux de la diagonale du rectangle definit
+; par le maillage.
+; pour retouver de quel rectangle provient un triangle, on cherche le
+; min de l''indice suivant x et suivant y de chaque triangle. Apres on
+; repasse cette indissage suivant x et y en indicage suivant nx*ny
+;
+      tempdeux = systime(1)     ; pour key_performance =2
+; indices en y des rectangles
+      indytriang = (triang[0, *]/nx) < (triang[2, *]/nx)
+; indices en x des rectangles
+      indxtriang0 = triang[0, *]-nx*(triang[0, *]/nx)
+      indxtriang2 = triang[2, *]-nx*(triang[2, *]/nx)
+      indxmin = indxtriang0 < indxtriang2
+; attention dans le cas ou la grille est periodique et ou on a tous
+; les points suivant x, les triangles qui assurent la periodicite en x
+; ont des indices suivant x qui sont 0 et nx-1. Ils appatienent au
+; rectangles de la colonne nx-1 et non de la colonne 0
+      if keyword_set(key_periodique) AND nx EQ jpi then BEGIN
+      indxmax = indxtriang0 > indxtriang2
+      indxtriang = indxmin + (nx-1)*(indxmin EQ 0 AND indxmax EQ (nx-1))
+      ENDIF ELSE indxtriang = indxmin 
+      listrect = nx*indytriang+indxtriang
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps ciseauxtri: liste des rectangles', systime(1)-tempdeux
+;
+; maintenant qu''on a cette liste on va s''assuter que l''on a pas de
+; triangles qui n''ont qu''on sommet en commun.
+;
+      test = bytarr(nx, ny)
+      test[listrect] = 1
+      dejavire = 1b-test
+;
+      tempdeux = systime(1)     ; pour key_performance =2
+      vire1 = 0
+      vire2 = 0
+      while (vire1[0] NE -1 OR vire2[0] NE -1) ne 0 do begin
+         vire1 = where( (test*shift(test, -1, -1) $
+                         *(1-shift(test, 0, -1))*(1-shift(test, -1, 0))) EQ 1)
+         if vire1[0] NE -1 THEN test[vire1] = 0 ; on vire le rectangle 
+         vire2 = where( ((1-test)*(1-shift(test, -1, -1)) $
+                         *shift(test, 0, -1)*shift(test, -1, 0)) EQ 1)
+; on vire le rectangle du dessus (meme indice x mais egale a 1)
+         if vire2[0] NE -1 THEN test[vire2+nx] = 0 
+      ENDWHILE
+;stop
+      test = test+temporary(dejavire)
+;
+      avirer = where(temporary(test) EQ 0)
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps ciseauxtri: determinationdes rectangles a virer', systime(1)-tempdeux
+;
+      if avirer[0] NE -1 then begin
+      tempdeux = systime(1)     ; pour key_performance =2
+      indnx = n_elements(listrect)
+      indny = n_elements(avirer)
+      ind = listrect[*]#replicate(1l, indny) 
+      ind = ind EQ replicate(1, indnx)#avirer[*]
+      if indny GT 1 then ind = total(ind, 2)
+      ind = where(ind EQ 0)
+      if ind[0] NE -1 then triang = triang[*, ind] ELSE return,  -1
+      endif
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps ciseauxtri: derniere retouche de la triangulation', systime(1)-tempdeux
+   endif
+;    
+;
+   if keyword_set(key_performance) THEN print, 'temps ciseauxtri', systime(1)-tempsun 
+   return,  triang
+end
Index: tags/start/TRIANGULATION/completecointerre.pro
===================================================================
--- tags/start/TRIANGULATION/completecointerre.pro	(revision 5)
+++ tags/start/TRIANGULATION/completecointerre.pro	(revision 5)
@@ -0,0 +1,138 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: COMPLETECOINTERRE
+;
+; PURPOSE: pour colorier proprement les continents! (c''est une longue
+; histoire...)
+;
+; CATEGORY: pour plt
+;
+; CALLING SEQUENCE: completecointerre
+; 
+; INPUTS: non
+;
+; KEYWORD PARAMETERS:  _EXTRA 
+;
+; OUTPUTS: non
+;
+; COMMON BLOCKS: common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      01/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO completecointerre, COINMONTE = coinmonte, COINDESCEND = coindescend, INDICEZOOM = indicezoom $
+                       , _extra = ex
+@common
+;------------------------------------------------------------
+   tempsun = systime(1)         ; pour key_performance
+;------------------------------------------------------------
+; definitions des vecteurs coinmont et coindesc
+;------------------------------------------------------------
+   if keyword_set(coinmonte) then coinmont = coinmonte $
+   ELSE coinmont = cointerremont
+   if keyword_set(coindescend) then coindesc = coindescend $
+   ELSE coindesc = cointerredesc
+;------------------------------------------------------------
+; definition descoordonnees des points numerotes 1,2,3,4,5,6 cf. les
+; schemas en dessous!
+;------------------------------------------------------------
+   tempdeux = systime(1)        ; pour key_performance =2
+   if coinmont[0] NE -1 OR coindesc[0] NE -1 then BEGIN
+      if keyword_set(indicezoom) then begin
+         long1 = glamv[indicezoom] & lati1 = gphiv[indicezoom]
+         long2 = glamu[indicezoom] & lati2 = gphiu[indicezoom]
+         long3 = glamf[indicezoom] & lati3 = gphif[indicezoom]
+         taille = size(indicezoom)
+         nx = taille[1]
+      ENDIF ELSE BEGIN 
+         long1 = glamv & lati1 = gphiv
+         long2 = glamu & lati2 = gphiu
+         long3 = glamf & lati3 = gphif
+         nx = jpi
+      ENDELSE 
+      long4 = long2  & lati4 = lati2
+      long5 = long1 & lati5 = lati1
+   endif
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps completecointerre: positions des points', systime(1)-tempdeux
+;
+;
+; cas coin terre en montee:
+;      2 points terre en diagonale montante avec 2 points mer sur
+;      la diagonale descendante.
+;
+;                     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)     ; pour key_performance =2
+      for id = 0, n_elements(coinmont)-1 do BEGIN
+         i = coinmont[id]
+         if long1[i] GE lon1 AND long5[i+1] LE lon2 $
+          AND lati2[i] GE lat1 AND lati4[i+nx] LE lat2 then begin
+            polyfill, [long1[i], long2[i], long3[i], long4[i+nx], long5[i+1], long3[i]] $
+             , [lati1[i], lati2[i], lati3[i], lati4[i+nx], lati5[i+1], lati3[i]] $
+             , color = c_cont, _extra = ex
+         endif
+      endfor
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps completecointerre: trace de cointerremonte', systime(1)-tempdeux
+   endif
+;------------------------------------------------------------
+; cas coin terre en descendante.:
+;      2 points terre en diagonale descendante avec 2 points mer sur
+;      la diagonale montante
+;
+;                     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 keyword_set(coindescend) then coindesc = coindescend $
+   ELSE coindesc = cointerredesc
+   if coindesc[0] NE -1 then begin
+      tempdeux = systime(1)     ; pour key_performance =2
+      for id = 0, n_elements(coindesc)-1 do BEGIN
+         i = coindesc[id]
+         if long1[i] GE lon1 AND long5[i+1] LE lon2 $
+          AND lati2[i] GE lat1 AND lati4[i+nx] LE lat2 then begin
+            polyfill, [long1[i], long4[i+nx], long3[i], long2[i], long5[i+1], long3[i]] $
+             , [lati1[i], lati4[i+nx], lati3[i], lati2[i], lati5[i+1], lati3[i]] $
+             , color = c_cont, _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
Index: tags/start/TRIANGULATION/decoupeterre.pro
===================================================================
--- tags/start/TRIANGULATION/decoupeterre.pro	(revision 5)
+++ tags/start/TRIANGULATION/decoupeterre.pro	(revision 5)
@@ -0,0 +1,125 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:decoupeterre
+;
+; PURPOSE:tres semblable a grille. Ici qd vargrid ne 'T' ou 'W' alors
+; pour le trace il faut recuperer Tmask, glamt, gphit et le tableau de
+; triangulation sur le sous domaine considerer. La specificite de
+; decoupeterre par rapport a grille, c''est que l''on prend ds la
+; mesure du possible un sous domaine juste un peu plus grand que celui
+; definit par domdef de facon a etre sur que le masque que l''on trace
+; recouvrira bien tout le dessin.
+;
+; CATEGORY:pour plt
+;
+; CALLING SEQUENCE:decoupeterre, mask, glam, gphi, TRI = tri
+;
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;         TRI si ce mot clef sert a obtenir grace a grille la
+;         triangulation qui se rapporte a la grille mais uniquement
+;         sur la partie du zoom. ce tableau de triangulation reduit
+;         est passe ds la variable que l''on a egalee a tri.par ex:
+;         grille,...,tri=triangulation_reduite. ne mot clef est
+;         utilise dans plt.pro
+;
+;         /NOTRI: utile seulement qd TRI est active. dans ce cas
+;         grille retourne -1 ds la variable tri meme si la variable du
+;         common triangles est definie et differente de -1
+;
+;
+; OUTPUTS:le masque et ses coordonnees
+;
+; COMMON BLOCKS:
+;	common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       24/2/99
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO decoupeterre, mask, glam, gphi, TRI = tri, TOUT = tout, INDICEZOOM = indicezoom, coinmonte = coinmonte, coindescend = coindescend, _extra = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;------------------------------------------------------------
+   if keyword_set(tout) then begin
+      oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
+      domdef
+   endif
+;------------------------------------------------------------
+;
+   case vargrid of
+      'U':BEGIN
+         premierx = 0 > (min([premierxt, premierxu])-1)
+         dernierx = (max([dernierxt, dernierxu])+1) < (jpi-1)
+         premiery = premieryt
+         derniery = dernieryt
+      end
+      'V':BEGIN
+         premierx = premierxt
+         dernierx = dernierxt
+         premiery = 0 > (min([premieryt, premieryv])-1)
+         derniery = (max([dernieryt, dernieryv])+1) < (jpj-1)
+      end
+      'F':BEGIN
+         premierx = 0 > (min([premierxt, premierxu])-1)
+         dernierx = (max([dernierxt, dernierxu])+1) < (jpi-1)
+         premiery = 0 > (min([premieryt, premieryv])-1)
+         derniery = (max([dernieryt, dernieryv])+1) < (jpj-1)
+      END
+   ENDCASE
+   nx = dernierx-premierx+1
+   ny = derniery-premiery+1
+   premierz = premierzt
+   dernierz = dernierzt
+   glam=glamt[premierx:dernierx, premiery:derniery]
+   gphi=gphit[premierx:dernierx, premiery:derniery]
+;
+   premierz = premierzt
+   dernierz = dernierzt
+   nz = nzt
+   mask=tmask[premierx:dernierx, premiery:derniery, niveau-1]
+   profond = niveau-1
+;------------------------------------------------------------
+; vecteur triangulation Qd TRI est active
+;------------------------------------------------------------
+   IF arg_present(TRI) then $
+    if triangles[0] EQ -1 OR keyword_set(notri) then tri = -1 ELSE BEGIN
+; si on est en train de tracer un niveau profond on refait la
+; triangulation
+      if keyword_set(profond) then begin
+         tri = triangule(mask, periodique = keyword_set(key_periodique)*(nx EQ jpi), coinmonte = coinmonte, coindescend = coindescend, _extra = ex)
+         indicezoom = (lindgen(jpi, jpj))[premierx:dernierx, premiery:derniery]
+      ENDIF ELSE BEGIN 
+; sinon on recupere la partie de triangulation qui nous interesse et
+; on la numerote convenablement!
+         if nx EQ jpi AND ny EQ jpj then tri = triangles ELSE BEGIN 
+            msk = bytarr(jpi, jpj)
+            msk[premierx:dernierx,premiery:derniery] = 1
+            ind = where( msk[triangles[0, *]] EQ 1 $
+                         AND msk[triangles[1, *]] EQ 1 $
+                         AND msk[triangles[2, *]] EQ 1 )
+            tri =triangles[*, ind]-(premierx+premiery*jpi)
+            y = tri/jpi
+            x = tri-y*jpi
+            tri = x+y*nx
+         ENDELSE
+      ENDELSE
+   ENDELSE
+   if keyword_set(tout) then domdef, oldboite
+;-------------------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps decoupeterre', systime(1)-tempsun 
+;------------------------------------------------------------
+   return
+end
+
Index: tags/start/TRIANGULATION/definetri.pro
===================================================================
--- tags/start/TRIANGULATION/definetri.pro	(revision 5)
+++ tags/start/TRIANGULATION/definetri.pro	(revision 5)
@@ -0,0 +1,154 @@
+;+
+; NAME:definetri
+;
+; PURPOSE:Define a triangulation array like TRIANGULATE. 
+;         But in a VERY SIMPLE CASE:
+; the points are regulary-gridded on nx*ny array.
+; Find a Delaunay triangulation for this set of points is easy:
+; Points define (nx-1)*(ny-1) rectangles which we can cut in 2
+; triangles. cf. figure above
+;
+;
+;      ny-1*---*---*. . . . . .*---*---*
+;          |  /|  /|           |  /|  /|      
+;          | / | / |           | / | / |
+;          |/  |/  |           |/  |/  |
+;      ny-2*---*---*. . . . . .*---*---*   
+;          .       .           .       .
+;          .       .           .       .
+;          .       .           .       .
+;         1*---*---*. . . . . .*---*---*
+;          |  /|  /|           |  /|  /|
+;          | / | / |           | / | / |
+;          |/  |/  |           |/  |/  |
+;         0*---*---*. . . . . .*---*---*  
+;          0   1   2        nx-3  nx-2 nx-1
+;
+;  You have 2 ways to cut a rectangle:
+;      1) the upward diagonal       2) the downward diagonal
+;
+;          *---*                        *---*
+;          |  /|                        |\  |
+;          | / |                        | \ |
+;          |/  |                        |  \|
+;          *---*                        *---*  
+;
+;
+; CATEGORY: to understand how TRIANGULATE and TRIANGULATION work!
+;
+; CALLING SEQUENCE:triangles=definetri(nx, ny [,downward])
+; 
+; INPUTS: nx and ny are the array dimensions 
+;
+; OPTIONAL INPUTS:
+;
+;        downward: When downward is undefine all rectangles are cut
+;        in using the upward diagonal. Downward is a vector which
+;        contains the rectangles numbers which are cut in using the
+;        downward diagonal.
+;        The rectangle number is define by the index (in a nx*ny
+;        vector) of the lower-left corner of the rectangle.
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;        triangles is a 2d array and is dimensions are 3 and
+;        2*(nx-1)*(ny-1)
+;        triangles is define like in the TRIANGULATE procedure.
+;        
+;
+; OPTIONAL OUTPUTS:
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; PROCEDURE:
+;
+; EXAMPLE:
+;
+; triangles=definetri(3,3,[1,3])
+; triangles will be a this kind of triangulation:
+;
+;          *---*---*
+;          |\  |  /|
+;          | \ | / |
+;          |  \|/  |
+;          *---*---*
+;          |  /|\  |
+;          | / | \ |
+;          |/  |  \|
+;          *---*---*
+;
+;
+; MODIFICATION HISTORY: sebastien Masson (smlod@ipsl.jussieu.fr)
+;                       4/3/1999
+;
+;-
+FUNCTION definetri, nx, ny, downward
+   nx = long(nx)
+   ny = long(ny)
+   if n_elements(downward) NE 0 THEN BEGIN 
+      if n_elements(downward) GT (nx-1)*(ny-1) then begin
+         print, 'downward a trop d''elements par rapport a nx et ny!'
+         return,  -1
+      endif
+      downward = long(downward)
+   ENDIF
+; we define triangles 
+   triangles = lonarr(3, 2*(nx-1)*(ny-1))
+;----------------------------------------------------------------------------------
+; we cut the rectangles with the upward diagonal
+;----------------------------------------------------------------------------------
+   if n_elements(downward) NE (nx-1)*(ny-1) then BEGIN ; there is some rectangle to cut.
+; we define upward: upward is a vector which contains the rectangles
+; numbers which are cut in using the upward diagonal.
+; The rectangle number is define by the index (in a nx*ny vector) of
+; the lower-left corner of the rectangle.
+      upward = bytarr(nx, ny)+1
+      upward(*, ny-1) = 0
+      upward(nx-1, *) = 0
+      if n_elements(downward) NE 0 then upward[downward] = 0
+      upward = where(upward EQ 1)
+      n1 = n_elements(upward) 
+;
+; 4 corners indexes of a rectangle number i are
+;
+;       i+nx  i+nx+1
+;          *---*                    
+;          |  /|                   
+;          | / |                   
+;          |/  |                  
+;          *---*                
+;          i   i+1
+;
+      trinumber = 2*(upward-upward/nx)
+;; we define the right triangles
+      triangles[0, trinumber] = upward
+      triangles[1, trinumber] = upward+1
+      triangles[2, trinumber] = upward+1+nx
+; we define the left triangles
+      triangles[0, trinumber+1] = upward+1+nx
+      triangles[1, trinumber+1] = upward+nx
+      triangles[2, trinumber+1] = upward
+   ENDIF ELSE n1 = 0
+;----------------------------------------------------------------------------------
+; we cut the rectangles with the downward diagonal
+;----------------------------------------------------------------------------------
+   if n_elements(downward) NE 0 then BEGIN
+      n2 = n_elements(downward) 
+      trinumber = 2*(downward-downward/nx)
+; we define the right triangles
+      triangles[0, trinumber] = downward+1
+      triangles[1, trinumber] = downward+nx+1
+      triangles[2, trinumber] = downward+nx
+; we define the left triangles
+      triangles[0, trinumber+1] = downward+nx
+      triangles[1, trinumber+1] = downward
+      triangles[2, trinumber+1] = downward+1
+   endif
+
+   return, triangles
+end
Index: tags/start/TRIANGULATION/definetri_e.pro
===================================================================
--- tags/start/TRIANGULATION/definetri_e.pro	(revision 5)
+++ tags/start/TRIANGULATION/definetri_e.pro	(revision 5)
@@ -0,0 +1,113 @@
+function numtri, index, nx, ny
+
+   y=index/nx
+   x=index-y*nx
+   numtri = (y NE 0)*(nx-1)*(2*(y-1)+1) + (2-(y EQ (ny-1) OR y EQ (ny-1)))*x
+
+   return, numtri
+end
+
+
+;+
+; NAME:definetri
+;
+; PURPOSE:Define a triangulation array like TRIANGULATE but for a
+; E-grid type
+;
+; CATEGORY: make contours with E-grid type
+;
+; CALLING SEQUENCE:triangles=definetri(nx, ny [,vertical])
+; 
+; INPUTS: nx and ny are the array dimensions 
+;
+; OPTIONAL INPUTS:
+;
+;        vertical: When vertical is undefine all rectangles are cut
+;        in using the horizontal diagonal. Vertical is a vector which
+;        contains the rectangles numbers which are cut in using the
+;        vertical diagonal.
+;        The rectangle number is define by the index (in a nx*ny
+;        vector) of the lower-left corner of the rectangle.
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;        triangles is a 2d array and is dimensions are 3 and
+;        2*(nx-1)*(ny-1)
+;        triangles is define like in the TRIANGULATE procedure.
+;        
+;
+; OPTIONAL OUTPUTS:
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; PROCEDURE:
+;
+; EXAMPLE:
+;
+;
+; MODIFICATION HISTORY: sebastien Masson (smlod@ipsl.jussieu.fr)
+;                       June 2001
+;
+;-
+FUNCTION definetri_e, nx, ny, singular, SHIFTED = shifted
+   nx = long(nx)
+   ny = long(ny)
+   triangles = lonarr(3, 2*(nx-1)*(ny-1))
+;
+; build the base triangulation with the diamond cut in two triangles
+; by the vertical diagonal
+;
+; first line
+   index = lindgen(nx-1)
+   trinumber = index
+   triangles[0, trinumber] = index
+   triangles[1, trinumber] = index+1
+   triangles[2, trinumber] = index+(nx+1-shifted)
+; last line
+   index = (ny-1)*nx+lindgen(nx-1)
+   trinumber = numtri(index, nx, ny)
+   triangles[0, trinumber] = index
+   triangles[1, trinumber] = index+(-nx+((index/nx+1-shifted) MOD 2))
+   triangles[2, trinumber] = index+1
+; other lines
+   if ny GT 2 then begin
+      index = lindgen(nx, ny)
+      index = index[0:nx-2, 1:ny-2]
+      index = index[*]
+      oddeven = (index/nx+1-shifted) MOD 2
+      trinumber = numtri(index, nx, ny)
+      triangles[0, trinumber] = index
+      triangles[1, trinumber] = index-nx+oddeven
+      triangles[2, trinumber] = index+nx+oddeven
+      triangles[0, trinumber+1] = index+nx+oddeven
+      triangles[1, trinumber+1] = index-nx+oddeven
+      triangles[2, trinumber+1] = index+1
+   endif
+;
+; cut the diamond specified by singular in two triangles
+; by the horizontal diagonal
+;
+   IF keyword_set(singular) then BEGIN
+      yindex = singular/nx
+      otherline = where(yindex NE 0 AND yindex NE (ny-1))
+      if otherline[0] NE -1 then begin
+         index = singular[otherline]
+         oddeven = (index/nx+1-shifted) MOD 2
+         trinumber = numtri(index, nx, ny)
+         triangles[0, trinumber] = index
+         triangles[1, trinumber] = index-nx+oddeven
+         triangles[2, trinumber] = index+1
+         triangles[0, trinumber+1] = index
+         triangles[1, trinumber+1] = index+1
+         triangles[2, trinumber+1] = index+nx+oddeven
+      endif
+
+   endif
+   return, triangles
+end
+
Index: tags/start/TRIANGULATION/dessinetri.pro
===================================================================
--- tags/start/TRIANGULATION/dessinetri.pro	(revision 5)
+++ tags/start/TRIANGULATION/dessinetri.pro	(revision 5)
@@ -0,0 +1,69 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:dessinetri
+;
+; PURPOSE:dessine la triangulation
+;
+; CATEGORY:pour comprendre comment ca marche
+;
+; CALLING SEQUENCE:dessinetri [, tri, x, y]
+; 
+; INPUTS:optionnels
+;        par defaut on choisit la triangulation qui est utilise pour
+;        les plots et on la trace aux points definites par vargrid
+;
+;        sinon il faut fournir les tableaux 
+;        tri definissant la triangulation (fournis par triangule.pro
+;        ou triangulate) 
+;        x et y qui sont les positions de points a laquelle se raporte
+;        la triangulation (cf. les tableau x et y fournis ds
+;        triangulate)
+;
+; KEYWORD PARAMETERS: tous ceux de plots
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+
+PRO dessinetri, tri, x, y, _extra = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+
+   if n_params() EQ 3 then begin
+      glam = x
+      gphi = y
+   ENDIF ELSE BEGIN 
+      grille,mask,glam,gphi, tri = tri
+      undefine, mask
+      tri = ciseauxtri(tri, glam, gphi)
+   ENDELSE 
+
+   tempdeux = systime(1)         ; pour key_performance =2
+   for i = 0L, n_elements(tri)/3-1 do begin
+      t = [tri[*, i], tri[0, i]]
+;      plots, glam[t], gphi[t], color = i MOD 255, _extra = ex
+;      wait, .1
+      plots, glam[t], gphi[t], color = 0, _extra = ex
+   ENDFOR
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps dessinetri: trace des triangles', systime(1)-tempdeux
+;
+   if keyword_set(key_performance) THEN print, 'temps dessinetri', systime(1)-tempsun 
+
+   return
+end
Index: tags/start/TRIANGULATION/drawcoast_c.pro
===================================================================
--- tags/start/TRIANGULATION/drawcoast_c.pro	(revision 5)
+++ tags/start/TRIANGULATION/drawcoast_c.pro	(revision 5)
@@ -0,0 +1,77 @@
+PRO drawcoast_c, mask, xf, yf, nx, ny, CONT_THICK = cont_thick, YSEUIL = yseuil, XSEUIL = xseuil, _extra = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;---------------------------------------------------------
+;
+; on trace les segments verticaux:
+;
+   if NOT keyword_set(xseuil) then xseuil = 5.
+   distanceseuil = (!p.position[2]-!p.position[0])/xseuil
+; liste: liste des points i pourlesquels on va tracer un segment entre
+; le point i,j-1 et i,j
+   tempdeux = systime(1)        ; pour key_performance =2
+   liste = where(mask+shift(mask, -1, 0) EQ 1 $
+                 AND (xf-shift(xf, 0, 1))^2+(yf-shift(yf, 0, 1))^2 LE distanceseuil)
+   IF liste[0] NE -1 THEN BEGIN
+; on recupere lx et ly qui sont les indices ds un tableau 2d des
+; points donnes par liste
+      ly = liste/nx & lx = temporary(liste)-nx*ly
+      indice = where(ly NE 0)   ; on ne prend pas les points concernant
+      if indice[0] NE -1 then begin
+; la premiere ligne car ds ce cas le pt j-1 n''est pas definit
+         lx = lx[indice] & ly = ly[temporary(indice)]
+; boucle sur les points concernes et trace du segment
+; rq: on utilise plost au lieu de plot car plots est bcp plus rapide.
+         IF testvar(var = key_performance) EQ 2 THEN $
+          print, 'temps tracecote: determiner liste des points concernes par un trait vertical', systime(1)-tempdeux
+         tempdeux = systime(1)  ; pour key_performance =2
+         for pt = 0, n_elements(lx)-1 do BEGIN 
+            i = lx[pt] & j = ly[pt]
+            plots, [xf[i, j-1], xf[i, j]], [yf[i, j-1], yf[i, j]] $
+             , color=c_cote,thick=cont_thick, /normal, _extra = ex
+         endfor
+         IF testvar(var = key_performance) EQ 2 THEN $
+          print, 'temps tracecote: trace des traits verticaux', systime(1)-tempdeux
+      endif
+   ENDIF
+;
+; pour le trace des segments horizontaux, c''est la meme chose sauf
+; qu'il faut faire attention si on est periodique: 
+;
+; si on est periodique on duplique la premiere colonne et on la met a
+; la fin. (ceci est fait non pas pour le shift qui est par defaut
+; periodique mais pour le plots 
+   tempdeux = systime(1)        ; pour key_performance =2
+   if keyword_set(key_periodique) AND nx EQ jpi then begin
+      mask = [mask, mask[0, *]]
+      xf = [xf, xf[0, *]]
+      yf = [yf, yf[0, *]]
+      nx = nx+1
+   ENDIF
+   if NOT keyword_set(yseuil) then yseuil = 5.
+   distanceseuil = (!p.position[3]-!p.position[1])/yseuil
+   liste = where(mask+shift(mask, 0, -1) EQ 1 $
+                 AND (xf-shift(xf, 1, 0))^2+(yf-shift(yf, 1, 0))^2 LE distanceseuil)
+   IF liste[0] NE -1 THEN BEGIN
+      ly = liste/nx & lx = temporary(liste)-nx*ly
+      indice = where(ly NE ny-1 AND lx NE 0)
+      if indice[0] NE -1 then begin
+; on ne prend pas les points de la 
+; premiere colonne et de la derniere ligne (car on l''a rajoute artificiellement!))
+         lx = lx[indice] & ly = ly[temporary(indice)]
+         IF testvar(var = key_performance) EQ 2 THEN $
+          print, 'temps tracecote: determiner liste des points concernes par un trait horizontal', systime(1)-tempdeux
+         tempdeux = systime(1)  ; pour key_performance =2
+         for pt = 0, n_elements(lx)-1 do BEGIN 
+            i = lx[pt] & j = ly[pt]
+            plots, [xf[i-1, j], xf[i, j]], [yf[i-1, j], yf[i, j]] $
+             , color=c_cote,thick=cont_thick, /normal, _extra = ex
+         endfor
+         IF testvar(var = key_performance) EQ 2 THEN $
+          print, 'temps tracecote: trace des traits horizontaux', systime(1)-tempdeux
+      endif
+   endif
+;---------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps drawcoast_c', systime(1)-tempsun
+   return
+end
Index: tags/start/TRIANGULATION/drawcoast_e.pro
===================================================================
--- tags/start/TRIANGULATION/drawcoast_e.pro	(revision 5)
+++ tags/start/TRIANGULATION/drawcoast_e.pro	(revision 5)
@@ -0,0 +1,54 @@
+PRO drawcoast_e, mask, xf, yf, nx, ny, CONT_THICK = cont_thick, YSEUIL = yseuil, XSEUIL = xseuil, onemore = onemore, _extra = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+;---------------------------------------------------------
+   if keyword_set(key_periodique) AND nx EQ jpi then begin
+      mask = [mask, mask[0, *]]
+      xf = [xf, xf[0, *]]
+      yf = [yf, yf[0, *]]
+      nx = nx+1
+   ENDIF
+;
+; we plot the borders of the diamond in this sense : \
+;
+   if NOT keyword_set(onemore) then onemore = 0
+   if NOT keyword_set(xseuil) then xseuil = 5.
+   distanceseuil = (!p.position[2]-!p.position[0])/xseuil
+; liste: liste des points i pourlesquels on va tracer un segment 
+   index = lindgen(nx, ny)
+   index = index[0:nx-2, 1:ny-1]
+   indexbis = index-nx+((index/nx+onemore) MOD 2)
+   liste = where(mask[index+1]+mask[indexbis] EQ 1 $
+                 AND (xf[index]-xf[indexbis])^2+(yf[index]-yf[indexbis])^2 LE distanceseuil)
+   IF liste[0] NE -1 THEN BEGIN
+      index = index[liste]
+      indexbis = indexbis[liste]
+      for pt = 0, n_elements(index)-1 do begin
+         plots, [xf[index[pt]], xf[indexbis[pt]]], [yf[index[pt]], yf[indexbis[pt]]] $
+          , color=c_cote,thick=cont_thick, /normal, _extra = ex
+      endfor
+   ENDIF
+;
+; we plot the borders of the diamond in this sense : /
+;
+   if NOT keyword_set(xseuil) then xseuil = 5.
+   distanceseuil = (!p.position[2]-!p.position[0])/xseuil
+; liste: liste des points i pourlesquels on va tracer un segment 
+   index = lindgen(nx, ny-1)
+   index = index[0:nx-2, *]
+   indexbis = index+nx+((index/nx+onemore) MOD 2)
+   liste = where(mask[index+1]+mask[indexbis] EQ 1 $
+                 AND (xf[index]-xf[indexbis])^2+(yf[index]-yf[indexbis])^2 LE distanceseuil)
+   IF liste[0] NE -1 THEN BEGIN
+      index = index[liste]
+      indexbis = indexbis[liste]
+      for pt = 0, n_elements(index)-1 do begin
+         plots, [xf[index[pt]], xf[indexbis[pt]]], [yf[index[pt]], yf[indexbis[pt]]] $
+          , color=c_cote,thick=cont_thick, /normal, _extra = ex
+      endfor
+   ENDIF
+
+;---------------------------------------------------------
+   if keyword_set(key_performance) THEN print, 'temps drawcoast_e', systime(1)-tempsun
+   return
+end
Index: tags/start/TRIANGULATION/section.pro
===================================================================
--- tags/start/TRIANGULATION/section.pro	(revision 5)
+++ tags/start/TRIANGULATION/section.pro	(revision 5)
@@ -0,0 +1,295 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:
+;
+; PURPOSE:
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:
+; 
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+
+PRO section, field, res, glamaxe, gphiaxe, ENDPOINTS = endpoints, BOITE = boite, TYPE = type, DIREC = direc
+@common
+; 
+;---------------------
+   array = litchamp(field)
+;---------------------
+; definition de boite en fonction de endpoints
+; puis redefinition du domaine
+   boite2d = [min([endpoints[0], endpoints[2]]), max([endpoints[0], endpoints[2]]), min([endpoints[1], endpoints[3]]), max([endpoints[1], endpoints[3]])]
+;
+   minprof = 0
+   profdefault = 200
+   if n_elements(type) EQ 0 then type = 'nothing'
+   Case N_Elements(Boite) OF
+      1:boite=[boite2d, minprof, boite[0]]
+      2:boite=[boite2d, boite[0],boite[1]]
+      Else:$ 
+       if strpos(type, 'z') NE -1 THEN boite=[boite2d, minprof, profdefault] $
+      ELSE boite=[boite2d, prof1, prof2]
+   ENDCASE
+   if strpos(type, 'z') NE -1 THEN BEGIN
+      !y.range = [boite[5], boite[4]] ;on garde les yranges (axe z) avant de changer la boite.
+      profmax = boite[5]
+      vraiboite = boite
+      if vargrid EQ 'W' then gdep = gdepw ELSE gdep = gdept
+; check with vertical grid limits (nearest level)
+      gwork = gdep
+; check the increse or decrese of the z axis
+      IF gwork[1] LE gwork[0] THEN gwork = reverse(gdep, 1)
+      niveauprof = where(gwork ge boite[5]) & niveauprof = niveauprof[0]
+      if niveauprof NE -1 then boite[5] = gwork[niveauprof]+1
+   ENDIF
+   domdef, boite, GRILLE=[vargrid], /findalways, _extra = ex
+; on redefinit lon1, ... au cas ou findalways ait ete utilise ds domdef
+   lon1 = min([endpoints[0], endpoints[2]])
+   lon2 = max([endpoints[0], endpoints[2]])
+   lat1 = min([endpoints[1], endpoints[3]])
+   lat2 = max([endpoints[1], endpoints[3]])
+; on recupere la grille sur la boite
+   grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery, dernierz
+;---------------------
+; on definit la triangulation qui va nous permetre de determiner la
+; section. on la recalcule car elle doit etre definie sur la terre
+; aussi bien que sur la mer. suivant le sens de la section -plutot
+; longitude ou plutot latitude- on definit la facon de trianguler
+   if strpos(type, 'x') NE -1 then BEGIN 
+      downward = (lindgen(nx, ny))[0:nx-2, 0:ny-2]
+      tri = definetri(nx, ny, (downward)[*]) 
+   ENDIF ELSE tri = definetri(nx, ny)
+;---------------------
+; equation de la droite suivant laquelle on fait la section
+;---------------------
+   abc = linearequation(endpoints[0:1], endpoints[2:3])
+   glamtri = glam[tri]
+   gphitri = gphi[tri]
+; quels sont les points de la triangulation qui sont au dessus et au
+; dessous de la droite ?
+   if abc[1] NE 0 THEN $
+    test = temporary(gphitri) GE (-abc[0]/abc[1]*temporary(glamtri)-abc[2]/abc[1]) $
+   ELSE test = temporary(glamtri) GE (-abc[1]/abc[0]*temporary(gphitri)-abc[2]/abc[0])
+
+   zero123 = total(test, 1)
+; to keep: triangles de la triangulation qui sont a cheval sur la droite.
+   tokeep1 = where(zero123 EQ 1)
+   tokeep2 = where(temporary(zero123) EQ 2)
+   tokeep = [tokeep1, tokeep2]
+
+   test = test[*, tokeep]
+   tri = tri[*, tokeep]
+; quel est le sommet du triangle qui est seul d''un cote de la droite?
+   single1 = where(test[*, 0:n_elements(tokeep1)-1] EQ 1)
+   single1 = single1-(single1/3)*3
+   single2 = where(test[*, n_elements(tokeep1):n_elements(tokeep)-1] EQ 0)
+   single2 = single2-(single2/3)*3
+
+   undefine, tokeep
+   undefine, tokeep1
+   undefine, tokeep2
+   undefine, test
+
+   single = [temporary(single1), temporary(single2)]
+; points1 le point du triangles qui est seul d''un cote de la droite.
+; point2 l''autre point du triangle de l''autre cote de la droite
+   point1 = [single, single]
+   point2 = [single EQ 0, 1 + (single LE 1)]
+
+   undefine,  single
+
+   ntri = (size(tri))[2]
+   index = [lindgen(ntri), lindgen(ntri)]
+
+   points1 = tri[point1, index]
+   points2 = tri[point2, temporary(index)]
+; points : complexe contenant les couples de points de part et
+; d''autre de la droite. Ils faut supprimer les doublons.
+   points = dcomplex(points1, points2)
+   points = points[uniq(points, sort(points))]
+   symetrique = dcomplex(imaginary(points), double(points))
+   points = points[where(points-shift(temporary(symetrique), 1) NE 0)]
+; points1 les coordnnees du point du triangles qui est seul d''un cote de la droite.
+; point2 les coordnnees de l''autre point du triangle de l''autre cote de la droite
+   points1 = complex(glam[   double(points)], gphi[   double(points)])
+   points2 = complex(glam[imaginary(points)], gphi[imaginary(points)])
+; droites les equations des droites dont on cherche l''intersection
+; avec la section.
+   droites = linearequation(points1, points2)
+   inter = lineintersection(droites, abc#replicate(1, n_elements(points1) ) )
+
+; les ccordonnes geographiques des points que l''on cherche sur la section.
+   glamaxe = float(inter)
+   gphiaxe = imaginary(inter)
+; on les range ds l''ordre croissant entre les bornes de la section
+   if strpos(type, 'x') NE -1 then BEGIN 
+      sort = sort(glamaxe)
+      glamaxe = glamaxe[sort]
+      inbox = where(glamaxe GE lon1 AND glamaxe LE lon2)
+      glamaxe = glamaxe[inbox]
+      sort = sort[inbox]
+      gphiaxe = gphiaxe[sort]
+   ENDIF ELSE BEGIN
+      sort = sort(gphiaxe)
+      gphiaxe = gphiaxe[sort]
+      inbox = where(gphiaxe GE lat1 AND gphiaxe LE lat2)
+      gphiaxe = gphiaxe[inbox]
+      sort = sort[inbox]
+      glamaxe = glamaxe[sort]
+   ENDELSE
+   points = points[sort]
+   points1 = points1[sort]
+   points2 = points2[sort]
+   inter = inter[sort]
+   poids = abs(points2-inter)/abs(points2-points1)
+
+;---------------------
+   array = fitintobox(array)
+   if array[0] EQ -1 THEN BEGIN
+      res = -1
+      return
+   ENDIF
+   if n_elements(valmask) EQ 0 THEN valmask = 1e20
+   taille=size(array)
+   if jpt GT 1 AND taille[0] GE 3 AND strpos(type, 't') EQ -1 then BEGIN
+      direc = 't'
+      array = grossemoyenne(array, 't')
+      taille=size(array)
+      jpt = 1
+   ENDIF
+   case 1 of
+;----------------------------------------------------------------------------
+;xy
+;----------------------------------------------------------------------------
+      taille[0] EQ 2:BEGIN
+         value1 = array[double(points)]
+         terre = where(value1 GT valmask/10)
+         if terre[0] NE -1 then value1[terre] = !values.f_nan
+         value2 = array[imaginary(points)]
+         terre = where(value2 GT valmask/10)
+         if terre[0] NE -1 then value2[terre] = !values.f_nan
+         res = poids*value1+(1-poids)*value2
+      END
+;----------------------------------------------------------------------------
+;xyz
+;----------------------------------------------------------------------------
+      taille[0] EQ 3 AND jpt EQ 1:BEGIN
+         npoints = n_elements(points) 
+         index = double(points)#replicate(1, nz)+replicate(nx*ny, npoints)#lindgen(nz)
+         value1 = array[index]
+         terre = where(value1 GT valmask/10)
+         if terre[0] NE -1 then value1[terre] = !values.f_nan
+         index = imaginary(points)#replicate(1, nz)+replicate(nx*ny, npoints)#lindgen(nz)
+         value2 = array[index]
+         terre = where(value2 GT valmask/10)
+         if terre[0] NE -1 then value2[terre] = !values.f_nan
+         poids = poids#replicate(1, nz)
+         res = poids*value1+(1-poids)*value2
+; moyenne suivant z ?
+         if strpos(type, 'z') EQ -1 then begin
+            nan = where(finite(res) EQ 0)
+            if vargrid EQ 'W' then e3 = e3w[premierzw:dernierzw] ELSE e3 = e3t[premierzt:dernierzt]
+            weight = replicate(1, npoints)#e3
+            if nan[0] NE -1 then weight[nan] = !values.f_nan
+            totalweight = total(weight, 2, /nan)
+            zero = where(totalweight EQ 0)
+            if zero[0] NE -1 then totalweight[zero] = !values.f_nan
+            res = total(res*weight, 2, /nan)/totalweight
+            direc = 'z'+string(byte(testvar(var=toto)))
+         endif
+      END
+;----------------------------------------------------------------------------
+;xyt
+;----------------------------------------------------------------------------
+      taille[0] EQ 3 AND jpt NE 1:BEGIN
+         npoints = n_elements(points) 
+         index = double(points)#replicate(1, jpt)+replicate(nx*ny, npoints)#lindgen(jpt)
+         value1 = array[index]
+         terre = where(value1 GT valmask/10)
+         if terre[0] NE -1 then value1[terre] = !values.f_nan
+         index = imaginary(points)#replicate(1, jpt)+replicate(nx*ny, npoints)#lindgen(jpt)
+         value2 = array[index]
+         terre = where(value2 GT valmask/10)
+         if terre[0] NE -1 then value2[terre] = !values.f_nan
+         poids = poids#replicate(1, jpt)
+         res = poids*value1+(1-poids)*value2
+      END
+;----------------------------------------------------------------------------
+;xyzt
+;----------------------------------------------------------------------------
+      taille[0] EQ 4:BEGIN
+         npoints = n_elements(points) 
+         index = double(points)#replicate(1, nz*jpt)+replicate(nx*ny, npoints)#lindgen(nz*jpt)
+         index = reform(index, npoints, nz, jpt, /over)
+         value1 = array[index]
+         terre = where(value1 GT valmask/10)
+         if terre[0] NE -1 then value1[terre] = !values.f_nan
+         index = imaginary(points)#replicate(1, nz*jpt)+replicate(nx*ny, npoints)#lindgen(nz*jpt)
+         index = reform(index, npoints, nz, jpt, /over)
+         value2 = array[index]
+         terre = where(value2 GT valmask/10)
+         if terre[0] NE -1 then value2[terre] = !values.f_nan
+         poids = poids#replicate(1, nz*jpt)
+         poids = reform(poids, npoints, nz, jpt, /over)
+         res = poids*value1+(1-poids)*value2
+; moyenne suivant z ?
+         if strpos(type, 'z') EQ -1 then begin
+            nan = where(finite(res) EQ 0)
+            if vargrid EQ 'W' then e3 = e3w[premierzw:dernierzw] ELSE e3 = e3t[premierzt:dernierzt]
+            weight = replicate(1, npoints)#e3
+            weight = weight[*]#replicate(1, jpt)
+            weight = reform(weight, npoints, nz, jpt, /over)
+            if nan[0] NE -1 then weight[nan] = !values.f_nan
+            totalweight = total(weight, 2, /nan)
+            zero = where(totalweight EQ 0)
+            if zero[0] NE -1 then totalweight[zero] = !values.f_nan
+            res = total(res*weight, 2, /nan)/totalweight
+            direc = 'z'+string(byte(testvar(var=toto)))
+         endif
+      END
+   endcase
+;---------------------
+
+   terre = where(finite(res) EQ 0)
+   if terre[0] NE -1 then res[terre] = valmask
+
+
+;    plt, tmask[*,*,0],/nocouleur, /rempli, title = '', subtitle = ''
+;    !p.title=''
+;    !p.subtitle=''
+;    dessinetri
+;    plot,[endpoints[0],endpoints[2]],[endpoints[1],endpoints[3]],/noerase,color=50
+
+;    plot,float(points1),imaginary(points1),/noerase,color=150,psym=1
+;    plot,float(points2),imaginary(points2),/noerase,color=150,psym=1
+;    plot,float(inter),imaginary(inter),/noerase,color=250,psym=1
+
+;    plot,[float(points1[0])],[imaginary(points1[0])],/noerase,color=150,psym=1
+;    plot,[float(points2[0])],[imaginary(points2[0])],/noerase,color=150,psym=1
+;    plot,[float(inter[0])],[imaginary(inter[0])],/noerase,color=250,psym=1
+
+
+;---------------------
+   return
+end
Index: tags/start/TRIANGULATION/tracecote.pro
===================================================================
--- tags/start/TRIANGULATION/tracecote.pro	(revision 5)
+++ tags/start/TRIANGULATION/tracecote.pro	(revision 5)
@@ -0,0 +1,191 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:tracecote
+;
+; PURPOSE: dessine les cotes ds plt
+;
+; CATEGORY: pour faire un joli dessin
+;
+; CALLING SEQUENCE:tracecote,mask
+; 
+; INPUTS:mask le tableau mask sur la zone consideree pour le dessin
+;
+; KEYWORD PARAMETERS: 
+;
+;        CONT_THICK: l''epaisseur du trait pour tracer les
+;        continents. par defaut c''est 1.
+;
+;        XSEUIL: pour eliminer les segments de cote qui sont trop
+;        grand (qui relient des points qui peuvent etre tres proches
+;        sur la sphere mais tres eloignes sur le dessin) on supprime
+;        tous les egments dot la taille depasse:
+;              taille de la fenetre suivant X/ xseuil.
+;        Par defaut xseuil est egale a 5. masi peut etre trop grand si
+;        on fait un fort zoom ou trout petit pour certaines
+;        projections... le specifier alors a l''aide de ce mot cle!
+;
+;        YSEUIL: cf. xseuil
+;
+; OUTPUTS: rien
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      30/9/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; PRO tracecote, CONT_THICK = cont_thick, YSEUIL = yseuil, XSEUIL = xseuil, _extra = ex
+PRO tracecote, _extra = ex
+@common
+   tempsun = systime(1)         ; pour key_performance
+   if n_elements(key_gridtype) EQ 0 then key_gridtype = 'c'
+;
+; on agrandi un peu le cadre definit par les premier..., dernier... de
+; facon a bien recuperer les bords de cote qui sont en bordure du
+; domaine a tracer
+;   
+   tempdeux = systime(1)        ; pour key_performance =2
+   premierx = 0 > (min([premierxt, premierxu])-1)
+   dernierx = (max([dernierxt, dernierxu])+1) < (jpi-1)
+   premiery = 0 > (min([premieryt, premieryv])-1)
+   derniery = (max([dernieryt, dernieryv])+1) < (jpj-1)
+   nx = dernierx-premierx+1
+   ny = derniery-premiery+1
+; quel niveau vertical choisir ?
+   IF strupcase(vargrid) eq 'W' THEN BEGIN 
+      nz = nzw & premierz = premierzw & dernierz = dernierzw
+   ENDIF ELSE BEGIN 
+      nz = nzt & premierz = premierzt & dernierz = dernierzt
+   ENDELSE 
+   if nz eq jpk then nivz = niveau-1 ELSE nivz = nz-1
+; attribution du masque et des coordonnes delimitant les limites de la
+; terre (coordonnees f)
+   mask = tmask[premierx:dernierx, premiery:derniery, niveau-1]
+   xf = glamf[premierx:dernierx, premiery:derniery]
+   yf = gphif[premierx:dernierx, premiery:derniery] ;
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps tracecote: determiner mask xf yf', systime(1)-tempdeux
+;
+   if key_gridtype EQ 'e' then onemore = xf[0, 0] gT xf[0, 1]
+; on passe en coordonnee normaliser pour pouvoir s'affranchir du type
+; de projection choisie et du suport surlequel on fait le dessin
+; (ecran ou postscript)
+   z = convert_coord(xf(*),yf(*),/data,/to_normal) 
+   xf = reform(z[0, *], nx, ny)
+   yf = reform(z[1, *], nx, ny)
+   tempvar = SIZE(TEMPORARY(z))
+;
+; attention, suivant la projection certains points x ou y peuvent
+; devenir NaN (cf. points deriere la terre ds une projection
+; orthographique)
+;
+; on met les points a eliminer a une tres gande valeur comme ca il ne
+; passerons pas le test avec distanceseuil (cf. plus bas)
+;
+   if (!map.projection LE 7 AND !map.projection NE 0) $
+    OR !map.projection EQ 14 OR !map.projection EQ 15 OR !map.projection EQ 18 then begin
+      ind = where(finite(xf*yf) EQ 0)
+      IF ind[0] NE -1 THEN BEGIN 
+         xf[ind] = 1e5
+         yf[ind] = 1e5
+      ENDIF
+   ENDIF
+   ind = where(xf LT !p.position[0] OR xf GT !p.position[2])
+   IF ind[0] NE -1 THEN xf[ind] = 1e5
+   ind = where(yf LT !p.position[1] OR yf GT !p.position[3])
+   IF ind[0] NE -1 THEN yf[ind] = 1e5
+   tempvar = SIZE(TEMPORARY(ind)) ; on efface ind
+;
+; pour eviter d'avoir des traits de cotes qui travessent tout l''ecran
+; (qui peuvent etre tres proches sur la sphere mais tres eloignes sur
+; le dessin suivant la projection) on va selectionner uniquements les
+; segments de trait de cote qui ne sont pas trop grand, cad qui ne
+; depassent pas la taille de la fenetre/seuil et pour lesquel le
+; maskque change de valeur entre les extremites du segment.
+;
+; on trace les segments verticaux:
+;
+;    if NOT keyword_set(xseuil) then xseuil = 5.
+;    distanceseuil = (!p.position[2]-!p.position[0])/xseuil
+; ; liste: liste des points i pourlesquels on va tracer un segment entre
+; ; le point i,j-1 et i,j
+;    tempdeux = systime(1)        ; pour key_performance =2
+;    liste = where(mask+shift(mask, -1, 0) EQ 1 $
+;                  AND (xf-shift(xf, 0, 1))^2+(yf-shift(yf, 0, 1))^2 LE distanceseuil)
+;    IF liste[0] NE -1 THEN BEGIN
+; ; on recupere lx et ly qui sont les indices ds un tableau 2d des
+; ; points donnes par liste
+;       ly = liste/nx & lx = temporary(liste)-nx*ly
+;       indice = where(ly NE 0)   ; on ne prend pas les points concernant
+;       if indice[0] NE -1 then begin
+; ; la premiere ligne car ds ce cas le pt j-1 n''est pas definit
+;          lx = lx[indice] & ly = ly[temporary(indice)]
+; ; boucle sur les points concernes et trace du segment
+; ; rq: on utilise plost au lieu de plot car plots est bcp plus rapide.
+;          IF testvar(var = key_performance) EQ 2 THEN $
+;           print, 'temps tracecote: determiner liste des points concernes par un trait vertical', systime(1)-tempdeux
+;          tempdeux = systime(1)  ; pour key_performance =2
+;          for pt = 0, n_elements(lx)-1 do BEGIN 
+;             i = lx[pt] & j = ly[pt]
+;             plots, [xf[i, j-1], xf[i, j]], [yf[i, j-1], yf[i, j]] $
+;              , color=c_cote,thick=cont_thick, /normal, _extra = ex
+;          endfor
+;          IF testvar(var = key_performance) EQ 2 THEN $
+;           print, 'temps tracecote: trace des traits verticaux', systime(1)-tempdeux
+;       endif
+;    ENDIF
+; ;
+; ; pour le trace des segments horizontaux, c''est la meme chose sauf
+; ; qu'il faut faire attention si on est periodique: 
+; ;
+; ; si on est periodique on duplique la premiere colonne et on la met a
+; ; la fin. (ceci est fait non pas pour le shift qui est par defaut
+; ; periodique mais pour le plots 
+;    tempdeux = systime(1)        ; pour key_performance =2
+;    if keyword_set(key_periodique) AND nx EQ jpi then begin
+;       mask = [mask, mask[0, *]]
+;       xf = [xf, xf[0, *]]
+;       yf = [yf, yf[0, *]]
+;       nx = nx+1
+;    ENDIF
+;    if NOT keyword_set(yseuil) then yseuil = 5.
+;    distanceseuil = (!p.position[3]-!p.position[1])/yseuil
+;    liste = where(mask+shift(mask, 0, -1) EQ 1 $
+;                  AND (xf-shift(xf, 1, 0))^2+(yf-shift(yf, 1, 0))^2 LE distanceseuil)
+;    IF liste[0] NE -1 THEN BEGIN
+;       ly = liste/nx & lx = temporary(liste)-nx*ly
+;       indice = where(ly NE ny-1 AND lx NE 0)
+;       if indice[0] NE -1 then begin
+; ; on ne prend pas les points de la 
+; ; premiere colonne et de la derniere ligne (car on l''a rajoute artificiellement!))
+;          lx = lx[indice] & ly = ly[temporary(indice)]
+;          IF testvar(var = key_performance) EQ 2 THEN $
+;           print, 'temps tracecote: determiner liste des points concernes par un trait horizontal', systime(1)-tempdeux
+;          tempdeux = systime(1)  ; pour key_performance =2
+;          for pt = 0, n_elements(lx)-1 do BEGIN 
+;             i = lx[pt] & j = ly[pt]
+;             plots, [xf[i-1, j], xf[i, j]], [yf[i-1, j], yf[i, j]] $
+;              , color=c_cote,thick=cont_thick, /normal, _extra = ex
+;          endfor
+;          IF testvar(var = key_performance) EQ 2 THEN $
+;           print, 'temps tracecote: trace des traits horizontaux', systime(1)-tempdeux
+;       endif
+;    endif
+   if n_elements(key_gridtype) EQ 0 then key_gridtype = 'c'
+   case key_gridtype of
+      'c':drawcoast_c, mask, xf, yf, nx, ny, _extra = ex
+      'e':drawcoast_e, mask, xf, yf, nx, ny, onemore = onemore, _extra = ex
+   endcase
+   if keyword_set(key_performance) THEN print, 'temps tracecote', systime(1)-tempsun
+   return
+end
Index: tags/start/TRIANGULATION/tracemask.pro
===================================================================
--- tags/start/TRIANGULATION/tracemask.pro	(revision 5)
+++ tags/start/TRIANGULATION/tracemask.pro	(revision 5)
@@ -0,0 +1,149 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:tracemask
+;
+; PURPOSE:dessiner des contour d''un mask
+;
+; CATEGORY:plus simple que tracecote, car ne s''occuppe pas du type de
+; projection et de la periodicite de la grille
+;
+; CALLING SEQUENCE: tracemask, maskentree, xentree, yentree
+; 
+; INPUTS:maskentree, xentree, yentree tableaux 2d specifiant le mask
+; et ses coordonees en longitude te latitude.
+;
+; KEYWORD PARAMETERS:
+;
+;        CONT_THICK: l''epaisseur du trait pour tracer les
+;        continents. par defaut c''est 1.
+;
+; OUTPUTS: none
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO tracemask, maskentree, xin, yin, CONT_THICK = cont_thick, OVERPLOT = overplot, _extra = ex
+   xentree = xin
+   yentree = yin
+   if keyword_set(overplot) then return
+@common
+   tempsun = systime(1)         ; pour key_performance
+; on s''afranchit des problemes de bord:
+   tempdeux = systime(1)        ; pour key_performance =2
+   tailleentree = size(maskentree)
+   nx = tailleentree[1]+1
+   ny = tailleentree[2]+1
+; on agrandi le mask de une colonne a gauche et de une colonne a droite.
+   mask = intarr(tailleentree[1]+1, tailleentree[2]+1)
+   mask[1:tailleentree[1], 1:tailleentree[2]] = maskentree
+; les 2 premieres colonnes sont identiques
+   mask[0, 1:tailleentree[2]] = maskentree[0, *]
+; les 2 premieres lignes sont identiques
+   mask[1:tailleentree[1], 0] = maskentree[*, 0]
+; on calcul la position suivant x des points qui seviront a tracer le
+; masque. ils sont situes entre chaque points du masque, sauf pour la
+; derniere colonne que l''on ne peut pas calculer et que l''on met
+; donc a max(!x.range)
+   xrange = !x.range[sort(!x.range)] ; si reverse_x est utilise!
+   xentree = .5*(xentree+shift(xentree, -1, 0))
+   IF not keyword_set(overplot) THEN xentree[nx-2, *] = xrange[1] $
+   ELSE xentree[nx-2, *] = xentree[nx-3, *]
+; on seuil
+   xentree = xrange[0] > xentree < xrange[1]
+; on agrandit le tableau
+   xf = fltarr(nx, ny)
+   xf[1:nx-1, 1:ny-1] = xentree
+   IF not keyword_set(overplot) THEN xf[0, *] = xrange[0] $
+   ELSE xf[0, *] = xf[1, *]
+   xf[1:nx-1, 0] = xentree[*, 0]
+;
+   yinverse = yentree[0, 0] GT yentree[0, ny-2]
+   yrange = !y.range[sort(!y.range)]
+   yentree = .5*(yentree+shift(yentree, 0, -1))
+   IF not keyword_set(overplot) THEN BEGIN 
+      if yinverse then yentree[*, ny-2] = yrange[0] ELSE yentree[*, ny-2] = yrange[1]
+   ENDIF ELSE yentree[*, ny-2] = yentree[*, ny-3]
+   yentree = yrange[0] > yentree < yrange[1]
+   yf = fltarr(nx, ny)
+   yf[1:nx-1, 1:ny-1] = yentree
+   yf[0, 1:ny-1] = yentree[0, *]
+   IF not keyword_set(overplot) THEN BEGIN 
+      if yinverse then yf[*, 0] = yrange[1] ELSE yf[*, 0] = yrange[0]
+   ENDIF ELSE yentree[*, 0] = yentree[*, 1]
+;
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps tracemask: determination du mask et des ses coordonnes', systime(1)-tempdeux
+;
+; on trace les segments verticaux:
+;
+   tempdeux = systime(1)        ; pour key_performance =2
+   liste = where(mask+shift(mask, -1, 0) EQ 1)
+   IF liste[0] NE -1 THEN BEGIN
+; on recupere lx et ly qui sont les indices ds un tableau 2d des
+; points donnes par liste
+      ly = liste/nx & lx = temporary(liste)-nx*ly
+      indice = where(ly NE 0)   ; on ne prend pas les points concernant 
+; la premiere ligne car ds ce cas le pt j-1 n''est pas definit
+      if indice[0] NE -1 then begin
+         lx = lx[indice] & ly = ly[temporary(indice)]
+         IF testvar(var = key_performance) EQ 2 THEN $
+          print, 'temps tracemask: liste traits verticaux', systime(1)-tempdeux
+         tempdeux = systime(1)  ; pour key_performance =2
+; boucle sur les points concernes et trace du segment
+; rq: on utilise plots au lieu de plot car plots est bcp plus rapide.
+         for pt = 0, n_elements(lx)-1 do BEGIN 
+            i = lx[pt] & j = ly[pt]
+            plots, [xf[i, j-1], xf[i, j]], [yf[i, j-1], yf[i, j]] $
+             , color=c_cote,thick=cont_thick, _extra = ex
+            if pt LT 5 then begin
+            endif
+         endfor
+         IF testvar(var = key_performance) EQ 2 THEN $
+          print, 'temps tracemask: trace traits verticaux', systime(1)-tempdeux
+      endif
+   ENDIF
+;
+; on trace les segments horizontaux:
+;
+   tempdeux = systime(1)        ; pour key_performance =2
+   liste = where(mask+shift(mask, 0, -1) EQ 1)
+   IF liste[0] NE -1 THEN BEGIN
+      ly = liste/nx & lx = temporary(liste)-nx*ly
+      indice = where(lx NE 0)   ; on ne prend pas les points de la  premiere colonne
+      if indice[0] EQ -1 then return
+      lx = lx[indice] & ly = ly[temporary(indice)]
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps tracemask: liste traits horizontaux', systime(1)-tempdeux
+      tempdeux = systime(1)     ; pour key_performance =2
+      for pt = 0, n_elements(lx)-1 do BEGIN 
+         i = lx[pt] & j = ly[pt]
+         plots, [xf[i-1, j], xf[i, j]], [yf[i-1, j], yf[i, j]] $
+          , color=c_cote,thick=cont_thick, _extra = ex
+      endfor
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps tracemask: trace traits horizontaux', systime(1)-tempdeux
+   endif
+;
+;
+   if keyword_set(key_performance) THEN print, 'temps tracemask', systime(1)-tempsun 
+   
+   return
+end
+
+
+
+
+
Index: tags/start/TRIANGULATION/triangule.pro
===================================================================
--- tags/start/TRIANGULATION/triangule.pro	(revision 5)
+++ tags/start/TRIANGULATION/triangule.pro	(revision 5)
@@ -0,0 +1,11 @@
+FUNCTION triangule, maskentree, REGULIER = regulier, _extra = ex
+@common
+   if keyword_set(regulier) then return, triangule_c(maskentree, REGULIER = regulier, _extra = ex)
+   if n_elements(key_gridtype) EQ 0 then key_gridtype = 'c'
+   if n_elements(maskentree) EQ 0 then maskentree = tmask[*, *, 0]
+   case key_gridtype of
+      'e':res = triangule_e(maskentree, _extra = ex)
+      'c':res = triangule_c(maskentree, REGULIER = regulier, _extra = ex)
+   endcase
+   return, res
+end
Index: tags/start/TRIANGULATION/triangule_c.pro
===================================================================
--- tags/start/TRIANGULATION/triangule_c.pro	(revision 5)
+++ tags/start/TRIANGULATION/triangule_c.pro	(revision 5)
@@ -0,0 +1,315 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:triangule_c
+;
+; PURPOSE:construit le tableau de triangulation.
+;
+; L''idee est de
+; construire une liste de triangles qui relient les points entre
+; eux. Ceci est fait automatiquement avec la fonction TRIANGULATE.
+;  ICI:
+; on tient compte du fait que les points sont disposes sur une grille
+; (reguliere ou pas, mais pas destructuree, cad que les points sont
+; ecrits suivant une matrice rectangulaire). Un moyen tres simple de
+; faire des triangles entre tous les points est alors:
+;
+;     pour chaque point (i,j) de la matrice -sauf ceux de la derniere
+;     ligne et de la derniere colonne- on on appelle le rectangle
+;     (i,j) le rectangle forme par les 4 points (i,j), (i+1,j),
+;     (i,j+1), (i+1,j+1). Pour tracer tous les triangles, il suffit de
+;     tracer les 2 triangles contenus ds les rectangles (i,j)
+;
+; au passage on remarque que chaque rectangle (i,j) possede 2 diagonales (si
+; si faites un dessin c''est vrai), il y a donc 2 choix possibles pour
+; chaque rectangles qd on veut le couper en 2 triangles...
+; 
+; C''est grace a ce choix que l''on va pouvoir tracer les cotes avec
+; des angles droits. A chaque angle de cote remarquable par
+; l''existance d''un unique point terre ou d''un unique point mer sur
+; les 4 cotes d''un rectangle (i,j), il faut couper le rectangle
+; suivant la diagonale qui qui passe par le point singulier.
+; 
+; CATEGORY:pour faire de beaux graphiques masques
+;
+; CALLING SEQUENCE:res=triangule([mask])
+;
+; INPUTS:optionnel:mask c''est le tableau 2d qui sevira a masquer le
+; champ que l''on tracera apres avec CONTOUR,
+; ...TRIANGULATION=triangule(mask)
+; si cet argument n''est pas specifie, la function utilise tmask.
+;
+; KEYWORD PARAMETERS:
+;       /REGULIER: specifie que le masque est sur une grille reguliere
+;       (utiliser pour la triangulation ds les coupes verticales et
+;       des hovmoellers)
+;
+;       COINMONTE=tableau, pour obtenir le tableau de "coins de terre
+;       montant" a traiter avec completecointerre.pro ds la variable
+;       tableau plutot que de la faire passer par la variable globale
+;       cointerremont.
+;
+;       COINDESCEND=tableau cf COINMONTE
+;
+; OUTPUTS:
+;       res: tableau 2d (3,nbre de triangles).
+;    chaque ligne de res represente les indices des points
+;    constituants les sommets d''un triangle.
+;    cf. comment on trace les triangles ds dessinetri.pro
+;
+; COMMON BLOCKS:
+;	common.pro different.pro definetri.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:les donnees dont un veut ensuite faire le contour
+; doivent etre disposees dans une matrice. Par contre dans la matrice,
+; la disposition des points peut ne pas etre irreguliere. Si les
+; donnees sont disposees completement de facon irreguliere, utiliser
+; TRIANGULE.
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       26/4/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION triangule_c, maskentree, COINMONTE = coinmonte, COINDESCEND = coindescend $
+                  , REGULIER = regulier, PERIODIQUE = periodique
+   tempsun = systime(1)         ; pour key_performance
+@common
+   ;;
+;------------------------------------------------------------
+; le masque est donne ou il faut prendre tmask?
+;------------------------------------------------------------
+;
+   msk = maskentree
+   taille = size(msk)
+   nx = taille[1]
+   ny = taille[2]
+;
+;------------------------------------------------------------
+   if n_elements(periodique) EQ 0 then periodique = keyword_set(key_periodique)
+   if keyword_set(key_periodique) and keyword_set(periodique) $
+    AND NOT keyword_set(regulier) then BEGIN 
+      msk = [msk, msk[0, *]]
+      nx = nx+1
+   ENDIF
+;------------------------------------------------------------
+; on va trouver la liste des rectangles (i,j) (reperes par leur coin
+; en bas a gauche) qu''il faut couper suivant une diagonale descendante
+; on appellera cette liste : pts_downward
+; 
+   pts_downward = 0
+
+; on construit le test qui permet de trouver un tel triangle:
+;
+;
+;       shift(msk,  0, -1)------------shift(msk, -1, -1)
+;              |                             |
+;              |                             |
+;              |                             |
+;              |                             |
+;             msk---------------------shift(msk, -1,  0)
+;
+   sum1 = msk+shift(msk, -1, 0)+shift(msk, -1, -1) ;pts qui entourrent le pt en haut a gauche
+   sum2 = msk+shift(msk, 0, -1)+shift(msk, -1, -1) ;pts qui entourrent le pt en bas a droite
+
+
+   tempdeux = systime(1)        ; pour key_performance =2
+; pt terre en haut a gauche entoure de pts mer
+   liste = where( (4-sum1)*(1-shift(msk, 0, -1)) EQ 1 )
+   if liste[0] NE -1 THEN pts_downward = [pts_downward,liste ]
+; pt mer en haut a gauche entoure de pts terre
+   liste = where( (1-sum1)*shift(msk, 0, -1) EQ 1)
+   if liste[0] NE -1 THEN pts_downward = [pts_downward,liste ]
+; pt terre en bas a droite entoure de pts mer
+   liste = where( (4-sum2)*(1-shift(msk, -1,  0)) EQ 1)
+   if liste[0] NE -1 THEN pts_downward = [pts_downward,liste ]
+; pt mer en bas a droite entoure de pts terre
+   liste = where( (1-sum2)*shift(msk, -1,  0) EQ 1)
+   if liste[0] NE -1 THEN pts_downward = [pts_downward,liste ]
+   undefine, liste
+;
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps triangule: trouver pts_downward', systime(1)-tempdeux
+;
+   if NOT keyword_set(regulier) then begin
+      tempdeux = systime(1)     ; pour key_performance =2
+;2 points terre en diagonale montante avec 2 points mer sur la diagonale descendante
+      coinmont = where( (1-msk)*(1-shift(msk, -1, -1)) $
+                        *(shift(msk, 0, -1)*shift(msk, -1,  0) EQ 1) )
+      if coinmont[0] NE -1 THEN pts_downward = [pts_downward, coinmont]
+;
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps triangule: trouver coinmont', systime(1)-tempdeux
+      tempdeux = systime(1)     ; pour key_performance =2
+;
+;2 points terre en diagonale descendante avec 2 points mer sur la diagonale montante
+      coindesc = where( ((1-shift(msk,  0, -1))*(1-shift(msk, -1, 0)) $
+                         *msk*shift(msk, -1, -1) EQ 1) )
+;
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps triangule: trouver coindesc', systime(1)-tempdeux
+;
+   endif
+;
+   if n_elements(pts_downward) EQ 1 then BEGIN 
+      tempdeux = systime(1)     ; pour key_performance =2
+;
+      triang = definetri(nx, ny)
+;
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps triangule: definetri', systime(1)-tempdeux
+      coinmont = -1
+      coindesc = -1
+   ENDIF ELSE BEGIN 
+      tempdeux = systime(1)     ; pour key_performance =2
+      pts_downward = pts_downward[1:n_elements(pts_downward)-1]
+      pts_downward = pts_downward(uniq(pts_downward, sort(pts_downward)))
+; aucun rectangle ne peut avoir comme coin en bas a gauche un element
+; de la derniere colonne ou de la derniere ligne.
+; il faut donc enlever ces points si ils ont ete selectionnes dans
+; pts_downward.
+      derniere_colonne = (lindgen(ny)+1)*nx-1 
+      derniere_ligne = lindgen(nx)+(ny-1)*nx 
+      pts_downward =different(pts_downward,derniere_colonne )
+      pts_downward =different(pts_downward,derniere_ligne )
+      if NOT keyword_set(regulier) then begin
+         if coinmont[0] NE -1 then begin
+            coinmont =different(coinmont,derniere_colonne )
+            coinmont =different(coinmont,derniere_ligne )
+         endif
+         if coindesc[0] NE -1 then begin
+            coindesc =different(coindesc,derniere_colonne )
+            coindesc =different(coindesc,derniere_ligne )
+         endif
+      ENDIF ELSE BEGIN 
+         coinmont = -1
+         coindesc = -1
+      ENDELSE 
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps triangule: menage ds pts_downward coinmont et coindesc', systime(1)-tempdeux
+;
+      tempdeux = systime(1)     ; pour key_performance =2
+      if  pts_downward[0] EQ -1 then triang = definetri(nx, ny) $
+      ELSE triang = definetri(nx, ny, pts_downward)
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps triangule: definetri', systime(1)-tempdeux
+   ENDELSE 
+;------------------------------------------------------------
+; on vire les triangles qui ne contiennent que des points terre
+;------------------------------------------------------------
+;
+;  tres bonne idee qui ne marche pas encore a 200% avec IDL 5.2
+;  ca devrait aller mieux dans les prochaines versions d''IDL...
+;
+   tempdeux = systime(1)        ; pour key_performance =2
+; on enleve les rectangles qui sont entierement dans la terre
+   recdsterre = where((1-msk)*(1-shift(msk, -1, 0))*(1-shift(msk, 0, -1))*(1-shift(msk, -1, -1)) EQ 1)
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps triangule: tous les recdsterre', systime(1)-tempdeux
+
+; en attendant une version qui marche parfaitement, on est contraint
+; de faire un nouveau tri:
+; il ne faut pas enlever les rectangles qui n''ont qu''un sommet en
+; commun.
+; t1 = systime(1)
+   indice = intarr(nx, ny)
+   trimask = intarr(nx, ny)
+   trimask[0:nx-2, 0:ny-2] = 1
+   IF recdsterre[0] NE -1 then BEGIN 
+      tempdeux = systime(1)     ; pour key_performance =2
+      indice[recdsterre] = 1
+      if NOT keyword_set(regulier) then begin
+         vire1 = 0
+         vire2 = 0
+         while (vire1[0] NE -1 OR vire2[0] NE -1) ne 0 do begin
+; vire sont les rectangles qu''il faut retirer de recsterre (en fait
+; qu''il faut garder bien qu''ils soient entirement dans la terre)  
+            vire1 = where( (indice*shift(indice, -1, -1) $
+                            *(1-shift(indice, 0, -1))*(1-shift(indice, -1, 0))*trimask) EQ 1)
+            if vire1[0] NE -1 THEN BEGIN 
+               indice[vire1] = 0
+;               indice[vire1+nx+1] = 0
+            endif
+            
+            vire2 = where( ((1-indice)*(1-shift(indice, -1, -1)) $
+                            *shift(indice, 0, -1)*shift(indice, -1, 0)*trimask) EQ 1)
+            if vire2[0] NE -1 THEN BEGIN 
+               indice[vire2+1] = 0
+;               indice[vire2+nx] = 0
+            endif
+         endwhile
+         IF testvar(var = key_performance) EQ 2 THEN $
+          print, 'temps triangule: trier les recdsterre', systime(1)-tempdeux
+      endif
+      indice[*, ny-1] = 1       ; la deriere colonne te la derniere ligne
+      indice[nx-1, *] = 1       ; ne peuvent definirde rectangle.
+;
+      tempdeux = systime(1)     ; pour key_performance =2
+      recgarde = where(indice EQ 0)
+; on recupere les numeros des triangles que l'' on va garder
+      trigarde = 2*[recgarde-recgarde/nx]
+      trigarde = [trigarde, trigarde+1]
+      trigarde = trigarde[sort(trigarde)]
+; 
+      triang = triang[*, trigarde]
+      IF testvar(var = key_performance) EQ 2 THEN $
+       print, 'temps triangule: virer les triangle de la liste', systime(1)-tempdeux
+   endif
+; print, 'temps tri triangles', systime(1)-t1 
+;------------------------------------------------------------
+; quand key_periodique eq 1, triang est une liste d''indice d'un
+; tableau qui a une colonne de trop.
+; il faut ramener ca a la matrice initiale en mettant les indivces de
+; la derniere colonne egaux a ceux de la derniere colonne...
+;------------------------------------------------------------
+   tempdeux = systime(1)        ; pour key_performance =2
+   if keyword_set(key_periodique) and keyword_set(periodique) $
+    AND NOT keyword_set(regulier) then BEGIN 
+      indicey = triang/nx
+      indicex = triang-indicey*nx
+      nx = nx-1
+      liste = where(indicex EQ nx)
+      if liste[0] NE -1 then indicex[liste] = 0
+      triang = indicex+nx*indicey
+      nx = nx+1
+      if coinmont[0] NE -1 then begin
+         indicey = coinmont/nx
+         indicex = coinmont-indicey*nx
+         nx = nx-1
+         liste = where(indicex EQ nx)
+         if liste[0] NE -1 THEN indicex[liste] = 0
+         coinmont = indicex+nx*indicey
+         nx = nx+1
+      endif
+      if coindesc[0] NE -1 then begin
+         indicey = coindesc/nx
+         indicex = coindesc-indicey*nx
+         nx = nx-1
+         liste = where(indicex EQ nx)
+         if liste[0] NE -1 THEN indicex[liste] = 0
+         coindesc = indicex+nx*indicey
+         nx = nx+1
+      endif
+   endif
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps triangule: finitions', systime(1)-tempdeux
+
+;------------------------------------------------------------
+   if arg_present(coinmonte) THEN coinmonte = coinmont ELSE cointerremont = coinmont
+   if arg_present(coindescend) THEN coindescend = coindesc ELSE cointerredesc = coindesc
+;
+; 
+;------------------------------------------------------------
+
+
+   IF keyword_set(key_performance) THEN print, 'temps triangule', systime(1)-tempsun 
+
+   return, triang
+
+END 
Index: tags/start/TRIANGULATION/triangule_e.pro
===================================================================
--- tags/start/TRIANGULATION/triangule_e.pro	(revision 5)
+++ tags/start/TRIANGULATION/triangule_e.pro	(revision 5)
@@ -0,0 +1,183 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:triangule_e
+;
+; PURPOSE:buid the triangulation for a E-grid type
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:
+; 
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      june 2001
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION triangule_e, maskentree, COINMONTE = coinmonte, COINDESCEND = coindescend $
+                  , SHIFTED = shifted, REGULIER = regulier, PERIODIQUE = periodique
+   tempsun = systime(1)         ; pour key_performance
+@common
+   ;;
+;------------------------------------------------------------
+; le masque est donne ou il faut prendre tmask?
+;------------------------------------------------------------
+;
+   msk = maskentree
+   sizem = size(msk)
+   nx = sizem[1]
+   ny = sizem[2]
+;------------------------------------------------------------
+   if n_elements(periodique) EQ 0 then periodique = keyword_set(key_periodique)
+   if keyword_set(key_periodique) and keyword_set(periodique) $
+    AND NOT keyword_set(regulier) then BEGIN 
+      msk = [msk, msk[0, *]]
+      nx = nx+1
+   ENDIF
+;
+; we will find the diamond that must be cut in two triangle using the
+; horizontal diagonal.
+;
+   index = lindgen(nx, ny)
+   index = index[0:nx-2, 1:ny-2]
+   if n_elements(shifted) EQ 0 then shifted = 1
+   oddeven = (index/nx+1-shifted) MOD 2
+   msk1 = msk[index]
+   msk2 = msk[index+1]
+   sum = msk[index-nx+oddeven]+msk[index+nx+oddeven]
+   sum1 = msk2+sum
+   sum2 = msk1+sum
+;
+; horizontal
+;
+   singularpoint = where((msk1 EQ 0 AND sum1 EQ 3) OR (msk1 EQ 1 AND sum1 EQ 0) $
+                         OR (msk2 EQ 0 AND sum2 EQ 3) OR (msk2 EQ 1 AND sum2 EQ 0) $
+                         OR (sum EQ 0 AND (msk1+msk2) EQ 2) )
+   if singularpoint[0] NE -1 then begin
+      horizontal = index[singularpoint]
+      triang = definetri_e(nx, ny, horizontal, SHIFTED = shifted)
+   ENDIF ELSE triang = definetri_e(nx, ny, SHIFTED = shifted)
+;    coinmont = index[where(sum EQ 2 AND (msk1+msk2) EQ 0)]
+;    coindesc = index[where(sum EQ 0 AND (msk1+msk2) EQ 2)]
+;
+; we keep only the triangles which are outside the land
+; but for some reasons we will in fact delete the land diamond
+;
+;    allrecinland = where(sum1+msk1 EQ 0)
+;    indexallinland = index[allrecinland]
+;    otherrec = (lindgen(nx, ny))[0:nx-2, 1:ny-2]
+;    otherrec = different(otherrec, indexallinland)
+; ;
+;    index = lindgen(nx, ny)
+;    index = index[0:nx-3, 2:ny-3]
+;    out = inter(index, indexallinland)
+;    IF out[0] NE -1 THEN begin
+;       out = inter(out+1, indexallinland)
+;       IF out[0] NE -1 THEN begin
+;          out = out-1
+;          oddeven = (out/nx+1-shifted) MOD 2
+;          out = inter(out-nx+oddeven, otherrec)
+;          IF out[0] NE -1 THEN begin
+;             out = inter(out+2*nx, otherrec)
+;             IF out[0] NE -1 THEN begin
+;                out = out-(nx+((out/nx+shifted) MOD 2))
+;             endif
+;          endif
+;       endif
+;    ENDIF
+;    help,  out
+; ;
+;    index = lindgen(nx, ny)
+;    index = index[0:nx-3, 2:ny-3]
+;    out = inter(index, otherrec)
+;    IF out[0] NE -1 THEN begin
+;       out = inter(out+1, otherrec)
+;       IF out[0] NE -1 THEN begin
+;          out = out-1
+;          oddeven = (out/nx+1-shifted) MOD 2
+;          out = inter(out-nx+oddeven, indexallinland)
+;          IF out[0] NE -1 THEN begin
+;             out = inter(out+2*nx, indexallinland)
+;             IF out[0] NE -1 THEN begin
+;                out = out-(nx+((out/nx+shifted) MOD 2))
+;             endif
+;          endif
+;       endif
+;    endif
+;    help,  out
+; ;
+;    IF out[0] EQ -1 THEN out = different(indexallinland, out) ELSE out = indexallinland
+;    triout = numtri(out, nx, ny)
+;    triout = [triout, triout+1]
+;    goodtri = lindgen(2*(nx-1)*(ny-1))
+;    goodtri = different(goodtri, triout)
+;    triang = triang[*, temporary(goodtri)]
+
+; ;
+;------------------------------------------------------------
+; quand key_periodique eq 1, triang est une liste d''indice d'un
+; tableau qui a une colonne de trop.
+; il faut ramener ca a la matrice initiale en mettant les indivces de
+; la derniere colonne egaux a ceux de la derniere colonne...
+;------------------------------------------------------------
+   tempdeux = systime(1)        ; pour key_performance =2
+   if keyword_set(key_periodique) and keyword_set(periodique) $
+    AND NOT keyword_set(regulier) then BEGIN 
+      indicey = triang/nx
+      indicex = triang-indicey*nx
+      nx = nx-1
+      liste = where(indicex EQ nx)
+      if liste[0] NE -1 then indicex[liste] = 0
+      triang = indicex+nx*indicey
+      nx = nx+1
+;       if coinmont[0] NE -1 then begin
+;          indicey = coinmont/nx
+;          indicex = coinmont-indicey*nx
+;          nx = nx-1
+;          liste = where(indicex EQ nx)
+;          if liste[0] NE -1 THEN indicex[liste] = 0
+;          coinmont = indicex+nx*indicey
+;          nx = nx+1
+;       endif
+;       if coindesc[0] NE -1 then begin
+;          indicey = coindesc/nx
+;          indicex = coindesc-indicey*nx
+;          nx = nx-1
+;          liste = where(indicex EQ nx)
+;          if liste[0] NE -1 THEN indicex[liste] = 0
+;          coindesc = indicex+nx*indicey
+;          nx = nx+1
+;       endif
+   endif
+   IF testvar(var = key_performance) EQ 2 THEN $
+    print, 'temps triangule: finitions', systime(1)-tempdeux
+
+;------------------------------------------------------------
+;    if arg_present(coinmonte) THEN coinmonte = coinmont ELSE cointerremont = coinmont
+;    if arg_present(coindescend) THEN coindescend = coindesc ELSE cointerredesc = coindesc
+;
+; 
+;------------------------------------------------------------
+
+
+   IF keyword_set(key_performance) THEN print, 'temps triangule', systime(1)-tempsun 
+
+   return, triang
+
+END 
Index: tags/start/UTILITAIRE/cp.pro
===================================================================
--- tags/start/UTILITAIRE/cp.pro	(revision 5)
+++ tags/start/UTILITAIRE/cp.pro	(revision 5)
@@ -0,0 +1,51 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: cp
+;
+; PURPOSE: copy files
+;
+; CATEGORY: commande unix
+;
+; CALLING SEQUENCE: cp, filenamein, filenameout
+; 
+; INPUTS:filenamein, filenameout: 2 strings.
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO cp, filenamein, filenameout
+;
+   if size(filenamein, /type) NE 7 then begin
+      rien = report('filenamein must be a string')
+      return
+   endif
+   if size(filenameout, /type) NE 7 then begin
+      rien = report('filenameout must be a string')
+      return
+   endif
+;
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   if thisOS eq 'MAC' or thisOS eq 'WIN' then begin
+      text = getfile(filenamein)
+      putfile, filenameout, text
+   ENDIF ELSE spawn, 'cp '+filenamein+' '+filenameout
+
+   return
+end
Index: tags/start/UTILITAIRE/createpro.pro
===================================================================
--- tags/start/UTILITAIRE/createpro.pro	(revision 5)
+++ tags/start/UTILITAIRE/createpro.pro	(revision 5)
@@ -0,0 +1,62 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:createpro
+;
+; PURPOSE:ecrit un .pro le compile et l''execute
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:createpro, command
+; 
+; INPUTS:
+;       command:un vecteur de string contenant les intructions a
+;       passer pour construire la procedure
+;
+; KEYWORD PARAMETERS:
+;       filenamein: un string donnant le nom de la procedure a ecrire
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:complete filename par '.pro' si besion
+;
+; RESTRICTIONS:de marche pas pour les fonctions
+;
+; EXAMPLE:
+;      IDL> createpro, ['print,''OK'''],filename='test'
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO createpro, command, filenamein = filenamein
+
+   if NOT keyword_set(filenamein) then filename = 'for_createpro.pro' $
+   ELSE BEGIN
+      filename = filenamein
+      if rstrpos(filename, '.pro') NE strlen(filename)-4 then $
+       filename = filename+'.pro'
+   ENDELSE
+   shortfilename = strmid(filename,  0, strlen(filename)-4)
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   CASE thisOS of
+      'MAC':sep = ':'
+      'WIN':sep = '\'
+      ELSE:sep = '/'
+   ENDCASE
+   shortfilename = strmid(shortfilename, rstrpos(shortfilename, sep)+1)
+   if rstrpos(shortfilename, sep) GE 1 then begin
+      directory = strmid(filename,  0,  rstrpos(shortfilename, sep))
+      directory = isadirectory(io = directory, $
+                               title = 'Bad definition of Directory: '+directory)
+   endif
+   putfile, filename, ['pro '+shortfilename, command, 'return', 'end']
+   resolve_routine, shortfilename
+   rien = execute(shortfilename)
+   return
+end
Index: tags/start/UTILITAIRE/find.pro
===================================================================
--- tags/start/UTILITAIRE/find.pro	(revision 5)
+++ tags/start/UTILITAIRE/find.pro	(revision 5)
@@ -0,0 +1,101 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:find
+;
+; PURPOSE:similaire a la commance unix find. On donne un nom de
+; fichier et en retour la fonction renvoie le nom du fichier entier
+; (avec tous les repertoires) si le fichier existe dans un des
+; repertoires definit par !path. Dans le cas contraire la function
+; renvoie 'NOT FOUND'
+;
+; CATEGORY:trouver un fichier
+;
+; CALLING SEQUENCE: nom_entier=find('nom_fichier')
+;
+; INPUTS:
+;     nom_fichier: un string contenant le nom du fichier. Si ce
+; fichier ne contient pas une extension (.bidule) on essaie de
+; chercher un fichier nom_fichier.pro. Ce string peut contenir le
+; caractere * qui, comme sous unix, remplace n''importe quelle chaine
+; de charactere. 
+;
+; KEYWORD PARAMETERS:
+;     REPERTOIRE: activer ce mot cle si on veut que find donne
+;     uniquement les differents repertoires ou on peut trouver le
+;     fichier 
+;
+;     NOPRO: activer si on ne veut pas que nom_fichier soit complete
+;     automatiquement par .pro si il ne contient pas d''extension
+;
+; OUTPUTS:
+;     nom_entier: un string ou un vecteur de string. il contient le
+;     nom entier du fichier avec tout le chemin depuis le debut de
+;     l''arborescence. Si plusieurs fichiers sont trouves (dans
+;     differents repertoires ou lors de l''utilisation de *)
+;     nom_entier est un vecteur dont chacun de ses elements est une
+;     solution possible. Si Le fichier n''est pas trouve nom_entier
+;     est egale a 'NOT FOUND'. 
+;
+; COMMON BLOCKS: none
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+;     IDL> print, find('*loadct')   
+;     /local/idl/lib/loadct.pro /local/idl/lib/xloadct.pro
+;     IDL> print, find('toto')   
+;     NOT FOUND
+;     IDL> print, find('find')   
+;     /home/1997001/smasso01/IDL_RD/find.pro
+;     IDL> print, find('l*',/rep)   
+;     /home/1997001/smasso01/IDL_RD/ /local/idl/lib/ /local/idl/lib/obsolete/
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       28/4/1999
+;                       6/7/1999: compatibilite mac et windows
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION find,  nomfichier, REPERTOIRE = repertoire, NOPRO = nopro
+   nomfich = nomfichier
+; il faut completer le nom par .pro???
+   if NOT keyword_set(nopro) THEN $
+    if strpos(nomfich,'.') EQ -1 then nomfich=nomfich+".pro" 
+; on cree tous les noms entiers possibles avec les repertoires
+; contenus dans !path
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   CASE thisOS of
+      'MAC':BEGIN & sep = ':' & pathsep = ',' & end
+      'WIN':BEGIN & sep = '\' & pathsep = ';' & end
+      ELSE: BEGIN & sep = '/' & pathsep = ':' & end
+   ENDCASE
+   cd, current = current
+   if strpos(nomfich,sep) lt 0 then BEGIN
+      if rstrpos(current,sep) NE strlen(current)-1 then current = current+sep
+      multipath = str_sep(!path,pathsep)
+      if rstrpos(multipath[0],sep) NE strlen(multipath[0])-1 then multipath = multipath +sep
+      nomfich = [current, multipath]+ nomfich
+   ENDIF
+; on test tous les noms possibles pour trouver ou est le fichier
+   res = [' ']
+   for n = 0, n_elements(nomfich)-1 do BEGIN 
+      tmp = findfile(nomfich[n])
+      if tmp[0] NE '' then res = [res, tmp] 
+   ENDFOR
+   if n_elements(res) EQ 1 then return, 'NOT FOUND' ELSE BEGIN 
+      res = res[1:n_elements(res)-1]
+      IF keyword_set(repertoire) then BEGIN
+; on extrait le nom des repertoires
+         for i = 0,n_elements(res)-1 do res[i] = strmid(res[i], 0, rstrpos(res[i],sep)+1)
+; on supprime les repertoires en double
+         res = res[uniq(res, sort(res))]
+      ENDIF
+      return, res
+   ENDELSE 
+end
Index: tags/start/UTILITAIRE/fitintobox.pro
===================================================================
--- tags/start/UTILITAIRE/fitintobox.pro	(revision 5)
+++ tags/start/UTILITAIRE/fitintobox.pro	(revision 5)
@@ -0,0 +1,103 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:fitintobox
+;
+; PURPOSE:verifie qu''un tableau correspond bien au domaine 4d
+; specifie lors du dernier domdef et pat jpt.
+;
+; CATEGORY:pour les debuts de noumbreux programme (blindage)
+;
+; CALLING SEQUENCE:res=fitintobox(field)
+; 
+; INPUTS:field un tableau ou une structure verifiant les
+; caracteristiques speficfies ds litchamp.pro
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:un tableau a la taille du domaine 4d.
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:utilise pour se reperer dans l''espace les variables
+; globales jpi,jpj,jpk,premier...,dernier...,nx...,ny...,nz,...
+; pour differencier un tableau 3d xyz d''un tableau 3d xyt, on utilise
+; jpt qui doit etre egale a 1 ds le cas xyz et different de 1 dans
+; l''autre cas.
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                     10 juin 2000.
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION fitintobox, field
+@common
+;---------------------
+   array = litchamp(field)
+   grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery, dernierz
+
+;---------------------
+   taille=size(array)
+   case 1 of
+;----------------------------------------------------------------------------
+;xy
+;----------------------------------------------------------------------------
+      taille[0] EQ 2:BEGIN
+         case 1 of
+            taille[1] eq  nx and taille[2] eq  ny:
+            taille[1] eq jpi and taille[2] eq jpj:array=array[premierx:dernierx, premiery:derniery]
+            else:return, report('Probleme d''adequation entre les tailles !C du domaine nx*ny '+strtrim(nx, 1)+'*'+strtrim(ny, 1)+' !C et du tableau '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
+         endcase
+      END
+;----------------------------------------------------------------------------
+;xyz
+;----------------------------------------------------------------------------
+      taille[0] EQ 3 AND jpt EQ 1:BEGIN
+         case 1 of
+            taille[1] eq  nx and taille[2] eq  ny and taille[3] eq  nz:
+            taille[1] eq  nx and taille[2] eq  ny and taille[3] eq  jpk: $
+             array=array[*, *, premierz:dernierz]
+            taille[1] eq jpi and taille[2] eq jpj and taille[3] eq  jpk: $
+             array=array[premierx:dernierx, premiery:derniery, premierz:dernierz]
+            taille[1] eq nx and taille[2] eq ny and taille[3] eq  jpk: $
+             array=array[premierx:dernierx, premiery:derniery, *]
+            else:return, report('Probleme d''adequation entre les tailles !C du domaine nx*ny*nz '+strtrim(nx, 1)+'*'+strtrim(ny, 1)+'*'+strtrim(nz, 1)+' !C et du tableau '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+         endcase
+      END
+;----------------------------------------------------------------------------
+;xyt
+;----------------------------------------------------------------------------
+      taille[0] EQ 3 AND jpt NE 1:BEGIN
+         case 1 of
+            taille[1] eq  nx and taille[2] eq  ny AND taille[3] eq jpt:
+            taille[1] eq jpi and taille[2] eq jpj AND taille[3] eq jpt:array=array[premierx:dernierx, premiery:derniery, *]
+            else:return, report('Probleme d''adequation entre les tailles !C du domaine nx*ny*jpt '+strtrim(nx, 1)+'*'+strtrim(ny, 1)+'*'+strtrim(jpt, 1)+'!C et du tableau '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
+         endcase
+      END
+;----------------------------------------------------------------------------
+;xyzt
+;----------------------------------------------------------------------------
+      taille[0] EQ 4:BEGIN
+         case 1 of
+            taille[1] eq  nx and taille[2] eq  ny and taille[3] eq  nz AND taille[4] eq jpt:
+            taille[1] eq  nx and taille[2] eq  ny and taille[3] eq  jpk AND taille[4] eq jpt: $
+             array=array[*, *, premierz:dernierz, *]
+            taille[1] eq jpi and taille[2] eq jpj and taille[3] eq  jpk AND taille[4] eq jpt: $
+             array=array[premierx:dernierx, premiery:derniery, premierz:dernierz, *]
+            taille[1] eq nx and taille[2] eq ny and taille[3] eq  jpk AND taille[4] eq jpt: $
+             array=array[premierx:dernierx, premiery:derniery, *, *]
+            else:return, report('Probleme d''adequation entre les tailles  !C du domainenx*ny*nz*jpt '+strtrim(nx, 1)+'*'+strtrim(ny, 1)+'*'+strtrim(nz, 1)+'*'+strtrim(jpt, 1)+' !C et du tableau '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1)+'*'+strtrim(taille[4], 1))
+         endcase
+      END
+   endcase
+;----------------------------------------------------------------------------
+
+
+   return, array
+end
Index: tags/start/UTILITAIRE/get_extra.pro
===================================================================
--- tags/start/UTILITAIRE/get_extra.pro	(revision 5)
+++ tags/start/UTILITAIRE/get_extra.pro	(revision 5)
@@ -0,0 +1,26 @@
+; elle fait quoi ?
+
+; elle permet :
+;  - soit de creer une variable extra contenant les mots clefs que tu
+; desires
+;  - soit de completer une variable extra avec des mots clefs que tu
+; rajoutes.
+
+; imagine :
+
+; tu es dans une routine et tu veux passer un mot clef en extra car la
+; routine que tu appelles ne le connait pas mais la routine suivante oui,
+; tu fais
+
+
+; extra=get_extra(/ok, year=1999, age_capitaine=35 )
+
+; et tu obtiens la bonne variable extra (fait un help,extra,/struc)
+
+; ou alors, tu completes un extra existant :
+
+; extra=get_extra(_extra=extra, name='Guillaume' )
+
+FUNCTION get_extra, _extra = extra
+    return, extra
+END 
Index: tags/start/UTILITAIRE/isadirectory.pro
===================================================================
--- tags/start/UTILITAIRE/isadirectory.pro	(revision 5)
+++ tags/start/UTILITAIRE/isadirectory.pro	(revision 5)
@@ -0,0 +1,72 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:isadirectory
+;
+; PURPOSE:check if a directory is in the !path variable or is the
+; common. end it by '/' under Unix/Linux, ':' under Mac and '\' under
+; Windows.
+;
+; CATEGORY: io
+;
+; CALLING SEQUENCE: directory=isadirectory()
+; 
+; INPUTS:none
+;
+; KEYWORD PARAMETERS:
+;       IODIRECTORY:a proposed directory
+;       TITLE: the title of the widget open if we need to choose a
+;       directory.
+;       /NOPATH:do not check if the directory is in the !path
+;       variable.
+;
+; OUTPUTS: de directory name
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:while statement until we found a good directory...
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      June 28, 2000
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION isadirectory, IODIRECTORY = iodirectory, NOPATH = nopath, TITLE = title
+
+   cd, current = current
+; if directory is undefine, we get the current directory.
+   if  keyword_set(iodirectory) THEN directory = iodirectory ELSE directory = current 
+;
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   CASE thisOS of
+   'MAC':BEGIN & sep = ':' & pathsep = ',' & end
+   'WIN':BEGIN & sep = '\' & pathsep = ';' & end
+   ELSE: BEGIN & sep = '/' & pathsep = ':' & end
+   ENDCASE
+; si directory ou current ne finit pas par sep on le rajoute
+   if rstrpos(current,sep) NE strlen(current)-1 then current = current+sep
+   if rstrpos(directory, sep) NE strlen(directory)-1 then directory = directory+sep
+   if keyword_set(nopath) then return, directory
+; does directory is define in the !path variable or is it the current directory?
+   possibledirectory = str_sep(!path, pathsep)
+   if rstrpos(possibledirectory[0],sep) NE strlen(possibledirectory[0])-1 then $
+    possibledirectory = possibledirectory+sep
+   possibledirectory = [current, possibledirectory]
+   while (where(possibledirectory EQ directory))[0] EQ -1 do begin
+      directory = dialog_pickfile(/directory, title = title)
+      if directory EQ '' then return, report('read_data canceled')
+      if rstrpos(directory, sep) NE strlen(directory)-1 then directory = directory+sep
+   endwhile
+
+   return, directory
+end
+
+
+
+
Index: tags/start/UTILITAIRE/isafile.pro
===================================================================
--- tags/start/UTILITAIRE/isafile.pro	(revision 5)
+++ tags/start/UTILITAIRE/isafile.pro	(revision 5)
@@ -0,0 +1,69 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:isafile
+;
+; PURPOSE:find a file and check if it is a real file!
+;
+; CATEGORY:for open
+;
+; CALLING SEQUENCE:filename = isafile()
+; 
+; INPUTS:none
+;
+; KEYWORD PARAMETERS:
+;       FILENAME: a proposed filename.
+;       IODIRECTORY: a directory where must be the file.
+;       /NEW:to specify that filename is a new file
+;
+; OUTPUTS:the filename
+;
+; COMMON BLOCKS:none
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      11/2/2000
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION isafile, FILENAME = filename, IODIRECTORY = iodirectory, FILTER = filter, NEW = new
+;------------------------------------------------------------
+; we find the filename.
+;------------------------------------------------------------
+; is filename given by the FILENAME keyword a good one?
+; si iodirectory n''est pas definit on l''initialise au repertoire courant
+   if NOT keyword_set(filename) then filename = 'nimportequoi'
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   CASE thisOS OF 
+      'MAC':sep = ':'
+      'WIN':sep = '\'
+      ELSE:sep = '/'
+   ENDCASE
+; we complete filename by iodirectory?
+   if strpos(filename, sep) EQ -1 then begin
+      if NOT keyword_set(iodirectory) then cd, current = iodirectory
+; si iodirectory ne finit pas par sep on le rajoute
+      if rstrpos(iodirectory, sep) NE strlen(iodirectory)-1 then $
+       iodirectory = iodirectory+sep
+      filename = iodirectory+filename
+   ENDIF
+   if keyword_set(new) then return, filename
+   test = findfile(filename)    ; le nom cherche correspond bien a un fichier?
+   while test[0] EQ '' OR n_elements(test) GT 1 do BEGIN ; on en cherche un tant qu''il ne correspond a rien!
+      test = test[0]
+      if keyword_set(filter) AND thisOS NE 'MAC' AND thisOS NE 'WIN' then $
+       filename = dialog_pickfile(path = iodirectory, filter = filter) $
+       ELSE filename = dialog_pickfile(path = iodirectory)
+      if filename EQ '' then return, report('read_data canceled')
+      test = findfile(filename)
+   endwhile
+
+   return, filename
+end
Index: tags/start/UTILITAIRE/linearequation.pro
===================================================================
--- tags/start/UTILITAIRE/linearequation.pro	(revision 5)
+++ tags/start/UTILITAIRE/linearequation.pro	(revision 5)
@@ -0,0 +1,85 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: linearequation
+;
+; PURPOSE:calcule une equation de droite du type ax+by+c=0 a partir
+; des coordonnees de 2 points. Rq: on peut avoir un tableau de couple
+; de points.
+;
+; CATEGORY:petit truc qui peut etre utile (sans boucles, ca va de soit!)
+;
+; CALLING SEQUENCE:abc=linearequation(point1, point2)
+; 
+; INPUTS: point1 et point2 dont deux point de(s) la droite(s) dont on
+; veut calculer l(es) equations(s).
+; deux possibilites sont possibles:
+;      1) point est un complexe ou un tableau de complexes, ou chaque
+;      element du complexe est les coordonnees du point
+;      2) points est un tableau de reels de dimensions 2
+;      ,nbre_de_droite. ou pour chaque ligne du tableau on a les
+;      coordonnees du point.
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:abc c''est un tableau de dimensions 3, nbre_de_droite, ou
+; pour chaque ligne du tableau on obtient les 3 parametres a, b, c de
+; l'equation de la droite ax+by+c=0
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;    IDL> abc=linearequation(complex(1,2),[3,4])
+;    IDL> print, abc[0]*1+abc[1]*2+abc[2]
+;          0.00000
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       10 juin 2000
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION linearequation, point1, point2
+
+   if size(point1, /type) EQ 6 OR size(point1, /type) EQ 9 then begin
+      x1 = float(point1)
+      y1 = imaginary(point1)
+   ENDIF ELSE BEGIN
+      x1 = float(reform(point1[0, *]))
+      y1 = float(reform(point1[1, *]))
+   ENDELSE
+
+   if size(point2, /type) EQ 6 OR size(point2, /type) EQ 9 then begin
+      x2 = float(point2)
+      y2 = imaginary(point2)
+   ENDIF ELSE BEGIN
+      x2 = float(reform(point2[0, *]))
+      y2 = float(reform(point2[1, *]))
+   ENDELSE
+
+   vertical = where(x1 EQ x2)
+   novertical = where(x1 NE x2)
+   abc = fltarr(3, n_elements(x1)) 
+
+   IF novertical[0] NE -1 then BEGIN
+; y=mx+p
+      nele = n_elements(novertical) 
+      m = (y2[novertical]-y1[novertical])/(x2[novertical]-x1[novertical])
+      p = (x2[novertical]*y1[novertical]-y2[novertical]*x1[novertical])/(x2[novertical]-x1[novertical])
+      abc[*, novertical] = [reform(-m, 1, nele), replicate(1, 1, nele), reform(-p, 1, nele)]
+   ENDIF
+   IF vertical[0] NE -1 then BEGIN
+; x=ny+p
+      nele = n_elements(vertical) 
+      n = (x2[vertical]-x1[vertical])/(y2[vertical]-y1[vertical])
+      p = (y2[vertical]*x1[vertical]-x2[vertical]*y1[vertical])/(y2[vertical]-y1[vertical])
+      abc[*, vertical] = [replicate(1, 1, nele), reform(-n, 1, nele), reform(-p, 1, nele)]
+   ENDIF
+
+   return, abc
+end
Index: tags/start/UTILITAIRE/lineintersection.pro
===================================================================
--- tags/start/UTILITAIRE/lineintersection.pro	(revision 5)
+++ tags/start/UTILITAIRE/lineintersection.pro	(revision 5)
@@ -0,0 +1,75 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: lineintersection
+;
+; PURPOSE: Calcule les coordonnees de l''intersection de 2 droites ou
+; d''une serie de 2 droites
+;
+; CATEGORY:petit truc qui peut etre utile (sans boucles, ca va de soit!)
+;
+; CALLING SEQUENCE: point=lineintersection(abc1, abc2)
+; 
+; INPUTS: abc est un tableau de dimensions 3,
+; nbre_de_couple_de_droites, dont chaque ligne contient les 3
+; parametres a, b, c de l''equation de droite du type ax+by+c=0
+;
+; KEYWORD PARAMETERS:
+;       /FLOAT: pour retourner l''output sous forme de tableau de
+;       reel plutot que de vecteur decomplexes (par defaut)
+;
+; OUTPUTS:2 possibilites:
+;      1) par defaut: c''est une vecteur de complexe dont chaque
+;      element est les coordonnees du point d''intersection d''un
+;      couple de droites.
+;      2) si /FLOAT est active, c'est un tableau de reels de
+;      dimensiones 2, nbre_de_couple_de_droites dont chaque
+;      ligne est les coordonnees du point d''intersection d''un
+;      couple de droites
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:si les deux droites dont paralleles, on retourne les
+; coordonnes (!values.f_nan,!values.f_nan)
+;
+; RESTRICTIONS:attention a la precision de la machine qui fait que
+; les coordonnees calcules de verifient peut-etre pas exactement les
+; equations du couple de droites.
+;
+; EXAMPLE:
+;     IDL> abc1=linearequation(complex(1,2),[3,4])
+;     IDL> abc2=linearequation(complex(1,2),[8,15])
+;     IDL> print, lineintersection(abc1, abc2)
+;     (      1.00000,      2.00000)
+;     IDL> print, lineintersection(abc1, abc2,/float)
+;           1.00000      2.00000
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      10 juin 2000
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION lineintersection, abc1, abc2, FLOAT = float
+;
+   a1 = float(reform(abc1[0, *]))
+   b1 = float(reform(abc1[1, *]))
+   c1 = float(reform(abc1[2, *]))
+   a2 = float(reform(abc2[0, *]))
+   b2 = float(reform(abc2[1, *]))
+   c2 = float(reform(abc2[2, *]))
+;
+   determinant = a1*b2-a2*b1
+   nan = where(determinant EQ 0)
+   if nan[0] NE -1 THEN determinant = !values.f_nan
+;
+   x = (b1*c2-c1*b2)/determinant
+   y = (c1*a2-a1*c2)/determinant
+;
+   if keyword_set(float) then begin
+      npts = n_elements(x) 
+      res = [reform(x, 1, npts, /over), reform(y, 1, npts, /over)]
+   ENDIF ELSE res = complex(x, y)
+   return, res
+end
Index: tags/start/UTILITAIRE/oups.pro
===================================================================
--- tags/start/UTILITAIRE/oups.pro	(revision 5)
+++ tags/start/UTILITAIRE/oups.pro	(revision 5)
@@ -0,0 +1,80 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:oups
+;
+; PURPOSE: Sorte de UNDO:
+; permet de refaire toute la serie de dessin depuis
+; l''ouverture de la derniere fenetre sans reexecuter la derniere
+; commande. cf. je fais un dessin avec 10 plt dessus au 10 eme je me
+; plante, un coup de @oups et je peux refaire mon plt rate!
+;
+; CATEGORY: pour faciliter les dessins
+;
+; CALLING SEQUENCE: @oups
+;
+; SIDE EFFECTS: compatible avec @ps @vzoom text_box...
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; il faut fermer le journal!
+;------------------------------------------------------------
+ journal
+; on recupere le journal sous la forme d''un vecteur de string:
+   vectjournal = getfile(homedir+'idlsave.pro')
+; on coupe la derniere ligne qui est oups
+   vectjournal = vectjournal[0:n_elements(vectjournal)-2 ]
+;------------------------------------------------------------
+; on le corrige si besoin est...
+;------------------------------------------------------------
+for i = 0, n_elements(vectjournal)-1 do $
+ if strpos(vectjournal[i],'text_box' ) EQ -1 then $
+ vectjournal[i] = strtrim(strcompress(vectjournal[i]), 2)
+;2 lignes sont identiques ??
+for i = 0, n_elements(vectjournal)-2 do $
+ if vectjournal[i] EQ vectjournal[i+1] then vectjournal[i] = ' '
+
+for i = 0, n_elements(vectjournal)-1 do BEGIN & $
+ if strpos(vectjournal[i],'oups' ) NE -1 $
+ OR strpos(vectjournal[i],'Syntax error' ) NE -1 $
+ OR strpos(vectjournal[i],'Illegal character' ) NE -1 $
+ then BEGIN vectjournal[i] = ' ' & vectjournal[i-1] = ' ' & endif & $
+ if strpos(strtrim(vectjournal[i], 1),'retall' ) EQ 0 $
+ OR strpos(vectjournal[i],'@oups' ) NE -1 $
+ OR strpos(vectjournal[i],'@ps' ) NE -1 $
+ OR strpos(vectjournal[i],'@vzoom' ) NE -1 $
+ OR strpos(vectjournal[i],'help' ) NE -1 $
+ OR strpos(vectjournal[i],'print' ) NE -1 $
+ then  vectjournal[i] = ' ' & $
+ if strpos(vectjournal[i],'text_box' ) NE -1 then $
+ vectjournal[i] = vectjournal[i]+strmid(vectjournal[i+1], 1) & endfor
+
+
+;
+; on vire la derniere ligne pour tout reexecuter sauf la derniere commande
+;
+ IF strpos(vectjournal[n_elements(vectjournal)-1],';,pos=[' ) NE -1 then $
+ vectjournal[n_elements(vectjournal)-2] = '' $
+ ELSE vectjournal[n_elements(vectjournal)-1] = '' 
+; on reecrit idlsave.pro
+putfile, homedir+'idlsave.pro', vectjournal
+; on compile puis applique idlsave
+cd, homedir
+@idlsave   
+; le journal vient d'etre reouvert, et on y met les elements de
+; vectjournal 
+for i = 0, n_elements(vectjournal)-1 DO $
+printf, !journal, vectjournal[i]
+      
+
+
Index: tags/start/UTILITAIRE/pwd.pro
===================================================================
--- tags/start/UTILITAIRE/pwd.pro	(revision 5)
+++ tags/start/UTILITAIRE/pwd.pro	(revision 5)
@@ -0,0 +1,23 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:pwd
+;
+; PURPOSE:print the current directory
+;
+; CATEGORY:like unix function
+;
+; CALLING SEQUENCE:pwd
+; 
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO pwd
+   cd, current = pwd
+   print, pwd
+   return
+end
Index: tags/start/UTILITAIRE/report.pro
===================================================================
--- tags/start/UTILITAIRE/report.pro	(revision 5)
+++ tags/start/UTILITAIRE/report.pro	(revision 5)
@@ -0,0 +1,98 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:report
+;
+; PURPOSE: comme dialog_message.pro si il y a deja des widgets actives
+; ou comme message.pro si il n''y a pas de widgets actives. pour poser
+; des question dont la reponse n''est pas oui/non utiliser xquestion
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:res = report(text)
+; 
+; INPUTS: text: un string on un vecteur de string. Si le string ne
+; comporte qu''un element, on cherche les eventuels characteres de
+; retour a la ligne: '!C'. If text is set to an array of strings, each
+; array element is displayed as a separate line of text.
+;
+; KEYWORD PARAMETERS: ceux dialog_message.pro et message.pro avec en +
+; PARENT qui fait la meme chose que DIALOG_PARENT de dialog_message.pro
+;
+; OUTPUTS: -1 si le mot cle QUESTION n''est pas activer
+;          si le mot cle est active la fonction retourne 1 pour yes et
+;          0 pour no.
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+; 
+; si aucun widget n''est active:
+;
+;     IDL> help, report('toto tata')
+;     % $MAIN$: toto tata
+;     <Expression>    INT       =       -1
+;     IDL> help, report('ca marche ?',/question)
+;     ca marche ? y/n (default answer is y)
+;     <Expression>    BYTE      =    1
+;     IDL> help, report('question1: !C ca marche ?',/question)
+;     question1:
+;     ca marche ? y/n (default answer is y)
+;     <Expression>    BYTE      =    1
+;
+; si des widgets sont deja actives, c''est la meme chose mais avec des
+; widgets!
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      21/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION report, text, DEFAULT_NO = default_no, PARENT = parent, QUESTION = question, _extra = ex
+   res = -1                     ;
+; on separe le text en differentes lignes (separees par !C) si ce
+; n''est pas deja fait...
+   if n_elements(text) EQ 1 then text = str_sep(text, '!C', /trim)
+; il y a des widgets actifs, c''est facile on appelle dialog_massage
+   if (widget_info(/managed))[0] NE 0 then BEGIN
+      res = dialog_message(text, dialog_parent = parent, QUESTION = question $
+                           , title = routine_name(1), DEFAULT_NO = default_no, _extra = ex)
+      if keyword_set(question) THEN res = res EQ 'Yes' ELSE res = -1
+   ENDIF ELSE BEGIN
+; aucun widget n''est actif
+; on pose une question ?
+      if keyword_set(question) then BEGIN
+; quelle est la reponse par defaut ?
+         if keyword_set(default_no) then answer = 'n' ELSE answer = 'y'
+         default_answer = answer
+         if n_elements(text) GT 1 THEN $
+          for i = 0, n_elements(text)-2 do print,text[i] 
+         read, text[n_elements(text)-1]+' y/n (default answer is '+default_answer+')' , answer
+         answer = strlowcase(answer) ;
+; si la reponse ne convient pas
+         while answer NE '' and answer NE 'y' and answer NE 'n' do begin
+            read, text[n_elements(text)-1]+' y/n (default answer is '+default_answer+')' , answer
+            answer = strlowcase(answer)
+         ENDWHILE               ;
+; on ajuste res en fonction de la reponse
+         case answer of
+            '':res = default_answer EQ 'y'
+            'y':res = 1
+            'n':res = 0
+         endcase
+      endif ELSE BEGIN
+; si on ne pose pas de question on fait juste un print
+         if n_elements(text) GT 1 THEN $
+          for i = 0, n_elements(text)-2 do print,'% '+routine_name(1)+': '+text[i] 
+         print, '% '+routine_name(1)+': '+text[n_elements(text)-1]
+      ENDELSE
+   ENDELSE
+
+   return,  res
+end
Index: tags/start/UTILITAIRE/routine_name.pro
===================================================================
--- tags/start/UTILITAIRE/routine_name.pro	(revision 5)
+++ tags/start/UTILITAIRE/routine_name.pro	(revision 5)
@@ -0,0 +1,81 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:routine_name,remonte
+;
+; PURPOSE:retourne le nom de la routine (procedure ou function) ds
+; lequel on se trouve
+;
+; CATEGORY:utilitaire
+;
+; CALLING SEQUENCE:res=routine_name([remonte])
+; 
+; INPUTS: remonte: un entier qui donne de combien de niveau on doit
+; remonter ds l''empillement des routines ewt sous-routines pour
+; retrouver le nom de la routine cherchee
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:un string donnant soit le nom de la routine en entier (avec
+; le path) soit '$MAIN$'
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;   cette fonction utilise le mot cle OUTPUT ds help.pro et il est
+;   specifie ds l''aide en ligne que la syntaxe du retour de ce mot cle
+;   peut changer suivant la version du code. Cette version marche avec
+;   IDL 5.2
+;
+; EXAMPLE:
+;
+;  IDL> print, routine_name()
+;  /usr1/com/smasson/IDL_RD/UTILITAIRE/report.pro
+;  IDL> print, routine_name(1)
+;  /usr1/com/smasson/IDL_RD/PLOTS/DIVERS/determineminmax.pro
+;  IDL> print, routine_name(2)
+;  /usr1/com/smasson/IDL_RD/PLOTS/DESSINE/plt.pro
+;  IDL> print, routine_name(3)
+;  $MAIN$
+;  IDL> print, routine_name(4)
+;  $MAIN$
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      21/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION routine_name,  remonte
+;
+   version=strmid(!version.release,0,3)
+   if version EQ '5.2' OR version EQ '5.3' OR version EQ '5.4' then begin
+      help,  /traceback, output = name
+      name = strtrim(name, 1)   ; on enleve les blancs en debut de ligne
+; on vat mettre les elements du vecteur bout a bout pour former un
+; unique sring
+      allnames = ''
+      for i = 0, n_elements(name)-1 do allnames = allnames+name[i]
+;
+      name = str_sep(allnames, '%') ; on le redecoupe 
+      name = strtrim(name, 2)   ; on eleve les blancs devant et derriere
+      name = strcompress(name)  ; on compresse les blancs
+; on ne retient pas les 2 premiers elements qui sont 1  un vide et la
+; ligne concernant routine_name 
+      name = name[2: n_elements(name)-1]
+; on choisit la ligne qui nous concerne
+      if NOT keyword_set(remonte) then remonte = 0
+      if remonte GE n_elements(name) then return,  '$MAIN$'
+      name = name[remonte]
+      if strpos(name, '$MAIN$') NE -1 then return,  '$MAIN$'
+      name = str_sep(name, ' ')
+      if n_elements(name) LT 3  then name = name[0] ELSE name = 'L.'+name[1]+' '+name[2]
+   ENDIF ELSE BEGIN
+      print, ('attention la fonction routine_name a ete ecrite pour les versions: !C IDL 5.2, IDL 5.2.1, 5.3 ou 5.4. ou 5.4.1 Verifier qu''elle marche bien avec la version '+!version.release)
+      return, 'Error'
+   ENDELSE 
+   return, name
+end
Index: tags/start/UTILITAIRE/testvar.pro
===================================================================
--- tags/start/UTILITAIRE/testvar.pro	(revision 5)
+++ tags/start/UTILITAIRE/testvar.pro	(revision 5)
@@ -0,0 +1,41 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:testvar
+;
+; PURPOSE:une sorte de keyword_set mais qd la valeur existe renvoie
+; celle-ci
+;
+; CATEGORY:comme keyword_set
+;
+; CALLING SEQUENCE:res=testvar(var=variable)
+; 
+; INPUTS:rien
+;
+; KEYWORD PARAMETERS:var : n''importe quoi
+;
+; OUTPUTS:0 si la variable n''existe pas 
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+;    IDL> print, testvar(var=toto)
+;           0
+;    IDL> print, testvar(var='toto')
+;    toto
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      14/12/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION testvar, var = var
+   if keyword_set(var) then return, var ELSE return,  0
+end
Index: tags/start/UTILITAIRE/text_box.pro
===================================================================
--- tags/start/UTILITAIRE/text_box.pro	(revision 5)
+++ tags/start/UTILITAIRE/text_box.pro	(revision 5)
@@ -0,0 +1,170 @@
+ PRO text_box,text,pos=pos,fg_color=fg_color,bg_color=bg_color,$
+               center=center,right=right,box=box,vert_space=vert_space, _EXTRA = ex
+;+
+; Name        : text_box
+;
+; Purpose     : Writes a text message within a box in a graphics window.
+;
+; Description:  This procedure writes a short text message within a box-shaped
+;               area in a graphics window.  The message may be split at word
+;               boundaries into several lines, and the character size and
+;               orientation may be adjusted for the text to fit within the box.
+;
+; Useage:       text_box,text,pos=pos,color=color,$
+;                    justify=justify,vert_space=vert_space
+;
+; Inputs      
+; TEXT          ASCII text string containing the message.
+;
+; keywords
+;  pos          4 element vector specifying the box position and size
+;               pos(0),pos(1) specify the lower left corner coordinate
+;               pos(2),pos(3) specify the upper right corner coordinate
+;               data window normalized coordinates are use
+;
+;   fg_color    color of box and legend titles (default=0)
+;
+;   bg_color    background color. Setting BG_COLOR erases the area 
+;               covered by the text box (filling it with color BG_COLOR)
+;               prior to writing the text.  If both BG_COLOR and !p.color
+;               are zero then the background color is reset to 255 to
+;               gaurantee a readability.
+;               
+;  right        if set, right justify text
+;  center       if set, center the text
+;
+;  vert_space   vertical spacing of lines in units of character height 
+;               (default = 1.5)
+;
+;
+;  author:  Paul Ricchiazzi                            7Jul93
+;           Institute for Computational Earth System Science
+;           University of California, Santa Barbara
+;-
+;
+        ON_ERROR, 2
+;
+;  Check the number of parameters.
+;
+justify=-1
+if keyword_set(right) ne 0 then justify=1
+if keyword_set(center) ne 0 then justify=0
+if keyword_set(vert_space) eq 0 then vert_space= 1.5
+IF n_elements(text) eq 0 then message, 'must specify text'
+nnx=!x.window*!d.x_vsize
+nny=!y.window*!d.y_vsize
+nnx=[0., 1.]*!d.x_vsize
+nny=[0., 1.]*!d.y_vsize
+
+
+if n_elements(pos) eq 0 then begin
+
+  box_cursor,xx1,yy1,nx,ny
+  xx2=xx1+nx
+  yy2=yy1+ny
+  pos=[(xx1-nnx(0))/(nnx(1)-nnx(0)),(yy1-nny(0))/(nny(1)-nny(0)),$
+       (xx2-nnx(0))/(nnx(1)-nnx(0)),(yy2-nny(0))/(nny(1)-nny(0))]
+  posstring=string(form='(a,4(f5.2,a))',$
+           ',pos=[',pos(0),',',pos(1),',',pos(2),',',pos(3),']')
+  print,strcompress(posstring,/remove_all)
+
+   
+endif else begin
+  
+  xx1 = nnx(0)+pos(0)*(nnx(1)-nnx(0))
+  xx2 = nnx(0)+pos(2)*(nnx(1)-nnx(0))
+  yy1 = nny(0)+pos(1)*(nny(1)-nnx(0))
+  yy2 = nny(0)+pos(3)*(nny(1)-nnx(0))
+
+endelse
+;
+;  calculate the height and width of the box in characters.
+;
+  width  = (xx2 - xx1) / !d.x_ch_size
+  height = (yy2 - yy1) / !d.y_ch_size
+;
+;  decompose the message into words.
+;
+  words = str_sep(text,' ')
+; print,f='(20a)',words
+  nwords=n_elements(words)
+  wordlen=lenstr(words)*!d.x_vsize
+  blanklen=lenstr(' ')*!d.x_vsize
+  maxcharsize=(xx2-xx1)/(4*blanklen+max(wordlen))
+  charsize=1  
+  lpnt=intarr(nwords)
+  nomore=0
+  ntries=0
+  repeat begin
+    ntries=ntries+1
+    if ntries gt 20 then message,'Can not fit message into box'
+    ychsiz=vert_space*!d.y_ch_size*charsize
+    wlen=wordlen*charsize
+    blen=blanklen*charsize
+    n_lines=fix((yy2-yy1)/ychsiz)-1
+    sum=0
+    ilines=0
+;   print,f='(8a8)','charsz','i','ilines','n_lines','lpnt','wlen','sum','xwdth'
+    for i=0,nwords-1 do begin
+      sum=sum+wlen(i)+blen
+      if sum+3*blen gt xx2-xx1 then begin
+        ilines=ilines+1
+        sum=wlen(i)+blen
+      endif
+      lpnt(i)=ilines        
+      
+;      print,f='(f8.2,4i8,3f8.2)',charsize,i,ilines,n_lines,lpnt(i),$
+;                 wlen(i)+blen,sum+3*blen,xx2-xx1
+    endfor        
+    case 1 of
+      ilines+1 lt n_lines: if charsize*1.1 gt maxcharsize then $
+          vert_space=(yy2-yy1)/((n_lines-1)*!d.y_ch_size*charsize) $
+          else charsize=charsize*1.1
+      ilines+1 eq n_lines: nomore=1
+      ilines+1 gt n_lines: charsize=charsize*.9
+    endcase
+endrep until nomore 
+
+lines=strarr(n_lines)
+maxlen=0
+
+for i=0,n_lines-1 do begin
+  ii=where(lpnt eq i,nc)
+  maxlen=(total(wlen(ii))+nc*blen)>maxlen
+  lines(i)=string(f='(200a)',words(ii)+' ')
+; print,i,words(ii)
+; print,i,lines(i)
+endfor
+
+;
+  align=.5*(1+justify)
+  
+  case justify of
+    -1:xx = xx1+.5*((xx2-xx1)-maxlen)
+     0:xx = 0.5*(xx1 + xx2)
+     1:xx = xx2-.5*((xx2-xx1)-maxlen)
+  endcase
+
+  dy=!d.y_ch_size*charsize*vert_space
+  yy=yy2-0.5*dy
+
+  xbox=[xx1,xx2,xx2,xx1,xx1]
+  ybox=[yy1,yy1,yy2,yy2,yy1]
+  if n_elements(bg_color) ne 0 then begin
+    if !p.color eq 0 and bg_color eq 0 then bgc=255 else bgc=bg_color
+    polyfill,xbox,ybox,color=bgc,/device
+  endif
+
+  if n_elements(fg_color) eq 0 then color = 0 else color=fg_color
+
+  for i_line = 0,n_lines-1 do begin
+    yy = yy-dy
+;   print,xx,yy,lines(i_line),charsize
+    xyouts, xx, yy, lines(i_line), /device, charsize=charsize, $
+      alignment=align, color=color, font=-1, _extra = ex
+  endfor
+  if keyword_set(box) then plots,xbox,ybox,color=color,/device
+;
+return
+end
+
Index: tags/start/UTILITAIRE/undefine.pro
===================================================================
--- tags/start/UTILITAIRE/undefine.pro	(revision 5)
+++ tags/start/UTILITAIRE/undefine.pro	(revision 5)
@@ -0,0 +1,41 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: undefine
+;
+; PURPOSE: effacer une variable
+;           meme chose que delvar mais utiulisable ds un programme et
+;           utilisable que pour une variable a la fois
+;
+; CATEGORY: 
+;
+; CALLING SEQUENCE: UNDEFINE, varname  
+; 
+; INPUTS: varname: la variable a detruire
+;
+; EXAMPLE:
+;
+;    IDL> a=1
+;    IDL> undefine,a
+;    % Compiled module: UNDEFINE.
+;    IDL> help, a
+;    A               UNDEFINED = <Undefined>
+;
+; MODIFICATION HISTORY: trouve sur la page web de D.Fanning 
+; http://www.dfanning.com :
+;QUESTION: How do I make an IDL variable have a type "undefined"? 
+;ANSWER: At the main IDL level you can use the IDL procedure DELVAR to
+;delete an IDL variable and make it undefined. Inside of procedures
+;and functions, I use this little program named UNDEFINE that I got
+;from Andrew Cool at the DSTO High Frequency Radar Division in
+;Adelaide, Australia.
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+   PRO UNDEFINE, varname  
+   tempvar = SIZE(TEMPORARY(varname))
+   END
+
Index: tags/start/UTILITAIRE/vzoom.pro
===================================================================
--- tags/start/UTILITAIRE/vzoom.pro	(revision 5)
+++ tags/start/UTILITAIRE/vzoom.pro	(revision 5)
@@ -0,0 +1,78 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:vraizoom
+;
+; PURPOSE:fait un vari zoom dans un plot, contrairement a la fonction
+; ZOOM  preecrite par IDL qui ne fait que grossir les pixels
+;
+; CATEGORY:petit outil
+;
+; CALLING SEQUENCE:@vzoom
+;
+; SIDE EFFECTS:utilise le journal. 
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       29/4/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+   cursor, x1, y1, /data, /dowm
+   cursor, x2, y2, /data, /down
+   x = [x1, x2]
+   x = x[sort(x)]
+   y = [y1, y2]
+   y = y[sort(y)]
+   domdef, [x, y, prof1, prof2]
+; il faut fermer le journal!
+   journal
+; on recupere le journal sous la forme d''un vecteur de string:
+   vectjournal = getfile(homedir+'idlsave.pro')
+; on coupe la derniere ligne qui est vraizoom
+   vectjournal = vectjournal[0:n_elements(vectjournal)-2 ]
+;------------------------------------------------------------
+; on le corrige si besoin est...
+;------------------------------------------------------------
+for i = 0, n_elements(vectjournal)-1 do $
+ if strpos(vectjournal[i],'text_box' ) EQ -1 then $
+ vectjournal[i] = strtrim(strcompress(vectjournal[i]), 2)
+;2 lignes sont identiques ??
+for i = 0, n_elements(vectjournal)-2 do $
+ if vectjournal[i] EQ vectjournal[i+1] then vectjournal[i] = ' '
+
+for i = 0, n_elements(vectjournal)-1 do BEGIN & $
+ if strpos(vectjournal[i],'oups' ) NE -1 $
+ OR strpos(vectjournal[i],'Syntax error' ) NE -1 $
+ OR strpos(vectjournal[i],'Illegal character' ) NE -1 $
+ then BEGIN vectjournal[i] = ' ' & vectjournal[i-1] = ' ' & endif & $
+ if strpos(strtrim(vectjournal[i], 1),'retall' ) EQ 0 $
+ OR strpos(vectjournal[i],'@ps' ) NE -1 $
+ OR strpos(vectjournal[i],'@oups' ) NE -1 $
+ OR strpos(vectjournal[i],'@vzoom' ) NE -1 $
+ OR strpos(vectjournal[i],'help' ) NE -1 $
+ OR strpos(vectjournal[i],'print' ) NE -1 $
+ then  vectjournal[i] = ' ' & $
+ if strpos(vectjournal[i],'text_box' ) NE -1 then $
+ IF strpos(vectjournal[i],',pos=' ) EQ -1 then $
+ vectjournal[i] = vectjournal[i]+strmid(vectjournal[i+1], 1) & endfor
+
+
+;
+; on reecrit idlsave.pro
+putfile, homedir+'idlsave.pro', vectjournal
+; applique idlsave
+   cd, homedir
+@idlsave   
+; le journal vient d'etre reouvert, et on y met les elements de
+; vectjournal 
+for i = 0, n_elements(vectjournal)-1 DO $
+printf,  !journal, vectjournal[i]
+
+
+
Index: tags/start/UTILITAIRE/xfile.pro
===================================================================
--- tags/start/UTILITAIRE/xfile.pro	(revision 5)
+++ tags/start/UTILITAIRE/xfile.pro	(revision 5)
@@ -0,0 +1,62 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: xfile
+;
+; PURPOSE: affiche ds un widget un fichier ASCII.
+;          c''est la meme chose que xdisplaydife mais ici on l''utilise pour
+;          visualiser le contenu d''une procedure ou d''une fonction
+;          meme si elle n''est pas ds le repertoire courant (grace a !path)
+;
+; CATEGORY: help
+;
+; CALLING SEQUENCE: xfile,'nom_fichier'
+;
+; INPUTS:
+;        nom_fichier:le nom d''une procedure ou d''une fonction a
+;        visualiser avec ou sans le .pro a la fin
+;
+; KEYWORD PARAMETERS:ceux de xdisplayfile
+;
+; EXAMPLE:xfile,'plt'
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       7/1/99
+;                       6/7/1999: compatibilite mac et windows
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO xfile, filename, _extra = ex
+pfile = strlowcase(filename)
+;
+; il faut trouver le nom complet 
+;
+   if strpos(pfile,".pro") lt 0 then pfile=pfile+".pro" 
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   CASE thisOS of
+      'MAC':BEGIN & sep = ':' & pathsep = ',' & end
+      'WIN':BEGIN & sep = '\' & pathsep = ';' & end
+      ELSE: BEGIN & sep = '/' & pathsep = ':' & end
+   ENDCASE
+   cd, current = current
+   if strpos(pfile,sep) lt 0 then BEGIN
+      if rstrpos(current,sep) NE strlen(current)-1 then current = current+sep
+      multipath = str_sep(!path,pathsep)
+      if rstrpos(multipath[0],sep) NE strlen(multipath[0])-1 then multipath = multipath +sep
+      pfile = [current, multipath]+ pfile
+   ENDIF
+   i = 0
+   repeat begin
+      res = findfile(pfile[i]) 
+      i = i+1
+   endrep until res[0] NE '' OR i EQ n_elements(pfile) 
+   if res[0] NE  '' then BEGIN
+; on ouvre le fichier ds un widget
+   xdisplayfile, pfile[i-1], _extra = ex
+   ENDIF ELSE ras = report('le fichier demande n''existe pas...')
+;
+;
+   return
+end
Index: tags/start/UTILITAIRE/xhelp.pro
===================================================================
--- tags/start/UTILITAIRE/xhelp.pro	(revision 5)
+++ tags/start/UTILITAIRE/xhelp.pro	(revision 5)
@@ -0,0 +1,111 @@
+;+
+; NAME: 
+;	xhelp
+;
+; PURPOSE:
+;	Display an IDL procedure header using widgets and the widget manager.
+;
+; CATEGORY:
+;	Widgets.
+;
+; CALLING SEQUENCE:
+;	xhelp, Filename,_extra=ex
+;
+; INPUTS:
+;     Filename:	A scalar string that contains the filename of the file
+;		to display.  If FILENAME does not include a complete path
+;               specification, xhelp will search for the file in
+;               the current working directory and then each of the
+;               directories listed in !PATH environment variable.  The
+;               ".pro" file suffix will be appended if it is not supplied.
+;
+; KEYWORD PARAMETERS:
+;       Ceux de xdisplayfile
+;
+; OUTPUTS:
+;	No explicit outputs.  A file viewing widget is created.
+;
+; SIDE EFFECTS:
+;	Triggers the XMANAGER if it is not already in use.
+;
+; RESTRICTIONS:
+;	None.
+;
+; PROCEDURE:
+;	Open a file and create a widget to display its contents.
+;
+; MODIFICATION HISTORY:
+;	Written By Steve Richards, December 1990
+;	Graceful error recovery, DMS, Feb, 1992.
+;       Modified to extract .pro documentation headers, PJR/ESRG mar94
+;
+;  author:  Paul Ricchiazzi                            jun93
+;           Institute for Computational Earth System Science
+;           University of California, Santa Barbara
+;
+;  7/1/99 : legeres mofification par Sebastien Masson : utilisation de
+;  xdisplayfile, de findfile et de _extra.
+;  6/7/1999: compatibilite mac et windows
+;-
+PRO xhelp, filename, _extra=ex
+
+; filename est bien un string?
+   cquoidonc = size(filename, /type)
+   if cquoidonc NE 7 then begin
+      ras = report('Input parameter must be a string and not a '+size(filename, /tname))
+      return
+   endif
+; il faut trouver le nom complet 
+   pfile=FILENAME
+   if strpos(pfile,".pro") lt 0 then pfile=pfile+".pro" 
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   CASE thisOS of
+      'MAC':BEGIN & sep = ':' & pathsep = ',' & end
+      'WIN':BEGIN & sep = '\' & pathsep = ';' & end
+      ELSE: BEGIN & sep = '/' & pathsep = ':' & end
+   ENDCASE
+   cd, current = current
+   if strpos(pfile,sep) lt 0 then BEGIN
+      if rstrpos(current,sep) NE strlen(current)-1 then current = current+sep
+      multipath = str_sep(!path,pathsep)
+      if rstrpos(multipath[0],sep) NE strlen(multipath[0])-1 then multipath = multipath +sep
+      pfile = [current, multipath]+ pfile
+   ENDIF
+; on test tous les noms possibles pour trouver ou est le fichier
+   nfile=n_elements(pfile)
+   n = 0
+   repeat begin
+      res = findfile(pfile[n]) 
+      n = n+1
+   endrep until res[0] NE '' OR n EQ n_elements(pfile) 
+   if res[0] NE '' then BEGIN
+      openr, unit,pfile[n-1], /get_lun ; ouverture du fichier
+; on selectionne le morceaux en-tete     
+      a = strarr(1000)          ;Maximum # of lines
+      xsize=0
+      i = 0
+      c = ''
+      readon=0
+      while not eof(unit) do begin
+         readf,unit,c
+         if strpos(c,';-') eq 0 then readon=0
+         if readon then begin
+            dum=where(byte(c) eq 9b,ntab) ; count tab characters
+            xsize=xsize > (strlen(c)+8*ntab)
+            a(i) = strmid(c,1,200)
+            i = i + 1
+         endif
+         if strpos(c,';+') eq 0 then readon=1
+      endwhile
+      if i EQ 0 then $
+         ras = report('le programme a etait mal ecrit, il n''y a pas d''en-tete... utiliser xfile.pro.') ELSE BEGIN 
+         a = a(0:i-1)
+; on ecrit le contenu de a ds un widget
+         xdisplayfile,'toto',text = a,title=pfile[n-1], _extra = ex
+      ENDELSE 
+      FREE_LUN, unit         ;free the file unit.
+   ENDIF ELSE ras = report('le fichier demande n''existe pas...')
+
+   return
+end
+
Index: tags/start/WIDGET/AUTOUR_de_XXX/buildcommand.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/buildcommand.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/buildcommand.pro	(revision 5)
@@ -0,0 +1,413 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:buildcommand
+;
+; PURPOSE:cette fonction reourne un string qui contient la commande de
+; lecture et les parametres du trace.
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:
+; 
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION buildcommand, base, FORPLTH = forplth, FORPLTZ = forpltz, FORPLTT = forpltt, BOITE = boite
+;------------------------------------------------------------
+; on recuper les ID des differents widgets 
+;------------------------------------------------------------
+   filelistid = widget_info(base, find_by_uname = 'filelist')
+   champid = widget_info(base, find_by_uname = 'champ')
+   nomexpid = widget_info(base, find_by_uname = 'nom_exp')
+   date1id = widget_info(base, find_by_uname = 'calendar1')
+   date2id = widget_info(base, find_by_uname = 'calendar2')
+   domainid = widget_info(base, find_by_uname = 'domain')
+   graphtypeid = widget_info(base, find_by_uname = 'action')
+;   optionid = widget_info(base, find_by_uname = 'option')
+;------------------------------------------------------------
+   widget_control,base, get_uvalue = top_uvalue
+   petitin = extractatt(top_uvalue, 'petitin')
+   numdessinin = petitin[2]-1
+   petitout = extractatt(top_uvalue, 'petitout')
+   numdessinout = petitout[2]-1
+;------------------------------------------------------------
+;---------------
+; on determine quelle procedure on va etre appele pour faire le dessin
+; et le type
+;---------------
+   widget_control,graphtypeid, get_uvalue = graphtype_uvalue
+   type = graphtype_uvalue.choix[widget_info(graphtypeid, /droplist_select)]
+;   type = top_uvalue.nameprocedures[numdessinin]
+   case type of
+      'plt':procedure = 'plt'
+      'pltz':procedure = 'pltz'
+      'pltt':procedure = 'pltt'
+      'xy':procedure = 'plt'
+      'xz':procedure = 'pltz'
+      'yz':procedure = 'pltz'
+      'xt':procedure = 'pltt'
+      'yt':procedure = 'pltt'
+      'zt':procedure = 'pltt'
+      'x':procedure = 'plt1d'
+      'y':procedure = 'plt1d'
+      'z':procedure = 'plt1d'
+      't':procedure = 'pltt'
+   endcase
+   if keyword_set(forplth) then BEGIN 
+      procedure = 'plt'
+      type = 'plt'
+   ENDIF 
+   if keyword_set(forpltz) then BEGIN 
+      procedure = 'pltz'
+      type = 'pltz'
+   ENDIF 
+   if keyword_set(forpltt) then BEGIN 
+      procedure = 'pltt'
+      type = 'pltt'
+   ENDIF
+;
+;  recherche des options
+;
+   options = extractatt(top_uvalue, 'options')   
+   optionsflag = extractatt(top_uvalue, 'optionsflag')
+   flags = optionsflag[*, numdessinin]
+   xindex = (flags[where(options EQ 'Longitude / x index')])[0]
+   yindex = (flags[where(options EQ 'Latitude / y index')])[0]
+   drawvecteur = (flags[where(options EQ 'Vecteur')])[0]*(procedure eq 'plt')
+   drawover = (flags[where(options EQ 'Overlay')])[0]
+;
+   alreadyread = extractatt(top_uvalue, 'alreadyread')
+   alreadyvector = extractatt(top_uvalue, 'alreadyvector')
+   alreadyover = extractatt(top_uvalue, 'alreadyoer')
+; que devons-nous lire ?
+   case 1 of
+      alreadyover NE -1:BEGIN
+         toread = alreadyover+1
+         whichread = 'over'
+      END
+      alreadyvector NE -1 AND alreadyvector NE !pi:BEGIN
+         toread = alreadyvector+1
+         whichread = 'vector'
+      END
+      alreadyread NE -1 AND alreadyread NE !pi AND alreadyread NE 2.*!pi:BEGIN
+         toread = alreadyread+1
+         whichread = 'classic'
+      END
+      else:BEGIN
+         case 1 of
+            alreadyvector eq !pi:BEGIN
+               toread = alreadyover+1
+               whichread = 'over'
+            END
+            alreadyread EQ !pi:BEGIN
+               toread = alreadyvector+1
+               whichread = 'vector'
+            END
+            alreadyread EQ 2.*!pi:BEGIN
+               toread = alreadyover+1
+               whichread = 'over'
+            END
+            ELSE:BEGIN
+               toread = alreadyread+1
+               whichread = 'classic'
+            END
+         endcase
+      END
+   ENDCASE
+;
+   widget_control, nomexpid, get_value = widcommand
+   widcommand = strcompress(widcommand[0], /remove_all)
+   cutcommand, widcommand, toread, coef, numberofread, operation, nameexp, separator, add
+;
+   readcommande = buildreadcommand(base, ''''+nameexp+'''', procedure, type, BOITE = boite, complete = whichread EQ 'classic' AND alreadyread EQ -1)
+; on choppe la ligne ou il y a litchamp pour appliquer coef et operateur
+   i = 0
+   while strpos(readcommande[i], 'litchamp') EQ -1 do i = i+1
+;-----------------------
+;-----------------------
+;-----------------------
+;-----------------------
+;-----------------------
+   case whichread of
+      'classic':BEGIN
+         if alreadyread+1 EQ 0 then BEGIN
+; on commence a ecrire la commande de lecture...
+            readcommande = ['; beginning of reading the field to draw' $
+                            , '; field number: '+strtrim(alreadyread+2, 1), readcommande]
+            readcommande[i+2] = 'field = '+coef+operation+readcommande[i+2]
+            *top_uvalue[1, findline(top_uvalue, 'currentreadcommand')] = readcommande
+         ENDIF ELSE BEGIN
+            readcommande = ['; field number: '+strtrim(alreadyread+2, 1), readcommande]
+            readcommande[i+1] = 'field = field'+separator+coef+operation+readcommande[i+1]
+            readcommande = [extractatt(top_uvalue, 'currentreadcommand'), readcommande]
+            *top_uvalue[1, findline(top_uvalue, 'currentreadcommand')] = readcommande
+         ENDELSE
+         if alreadyread+1 NE numberofread-1 THEN BEGIN 
+; si il faut lire d''autres champs on sort
+            *top_uvalue[1, findline(top_uvalue, 'alreadyread')] = alreadyread+1
+            *top_uvalue[1, findline(top_uvalue, 'noticebase')] = xnotice('Select the field number '+strtrim(alreadyread+3, 1))
+            return,  ''
+         ENDIF
+; on finalise la commande de lecture
+         readcommande = [readcommande, 'field = field'+add $
+                         , 'field = create_struct({tab:field, grille:vargrid, unite:varunit, experience:varexp, nom:varname})' $
+                         , '; end of reading the field to draw', ';']
+; on recupere le _EXTRA:
+         extra = extractatt(top_uvalue, 'extra')
+         if xindex NE 0 then extra = create_struct(extra, 'xindex', xindex)
+         if yindex NE 0 then extra = create_struct(extra, 'yindex', yindex)
+         exextra = cw_specifie_get_value(base)
+         extra =  mixstru(exextra,extra)
+         sextra = struct2string(extra)
+         readcommande = [readcommande, 'extra = '+sextra]
+;
+         *top_uvalue[1, findline(top_uvalue, 'currentreadcommand')] = readcommande
+         case 1 of
+            drawvecteur:BEGIN
+; quelle function de lecture utilisons nous? trace des vecteurs de
+; facon automatique ou non?
+               currentfile = extractatt(top_uvalue, 'currentfile')
+               funclec_name = *(extractatt(top_uvalue, 'readparameters'))[currentfile]
+               funclec_name = funclec_name.funclec_name
+               if funclec_name EQ 'read_ncdf' then begin
+; il faut lire des vecteurs maintenant?
+                  *top_uvalue[1, findline(top_uvalue, 'alreadyread')] = !pi
+                  *top_uvalue[1, findline(top_uvalue, 'noticebase')] = xnotice('Select the zonal component of vector')
+                  return,  ''
+               ENDIF ELSE BEGIN
+; on fait un trace automatique en appelant un et vn ...
+                  readuncommande = buildreadcommand(base, ''''+nameexp+'''', procedure, type, BOITE = boite, complete = 0, namefield = 'un')
+                  i = 0
+                  while strpos(readuncommande[i], 'litchamp') EQ -1 do i = i+1
+                  readuncommande = ['; reading the zonal component of vector', readuncommande]
+                  readuncommande[i+1] = 'fieldu = '+readuncommande[i+1]
+                  readuncommande = [readuncommande,'fieldu = create_struct({tab:fieldu, grille:vargrid, unite:varunit, experience:varexp, nom:varname})']
+;
+                  readvncommande = buildreadcommand(base, ''''+nameexp+'''', procedure, type, BOITE = boite, complete = 0, namefield = 'vn')
+                  i = 0
+                  while strpos(readvncommande[i], 'litchamp') EQ -1 do i = i+1
+                  readvncommande = ['; reading the zonal component of vector', readvncommande]
+                  readvncommande[i+1] = 'fieldv = '+readvncommande[i+1]
+                  readvncommande = [readvncommande,'fieldv = create_struct({tab:fieldv, grille:vargrid, unite:varunit, experience:varexp, nom:varname})']
+;
+                  readcommande = [readcommande,';', readuncommande, ';', readvncommande]
+                  *top_uvalue[1, findline(top_uvalue, 'currentreadcommand')] = readcommande
+; on enchaine sur un over plot???
+                  if drawover then begin
+                     *top_uvalue[1, findline(top_uvalue, 'alreadyread')] = 2.*!pi
+                     *top_uvalue[1, findline(top_uvalue, 'noticebase')] = xnotice('Select the field to overlay')
+                     return,  ''
+                  ENDIF ELSE *top_uvalue[1, findline(top_uvalue, 'alreadyread')] = -1
+               ENDELSE
+            END
+            drawover:BEGIN
+; il faut lire un autre champ a surcontourer?
+               *top_uvalue[1, findline(top_uvalue, 'alreadyread')] = 2.*!pi
+               *top_uvalue[1, findline(top_uvalue, 'noticebase')] = xnotice('Select the field to overlay')
+               return,  ''
+            END
+; c'est tout pour la lecture, on va tracer!
+            ELSE:*top_uvalue[1, findline(top_uvalue, 'alreadyread')] = -1
+         endcase
+      END
+      'vector':BEGIN
+; pour lesvecteurs, il y a 2 composantes! en u et en v donc il faut
+; doubler la lecture. pour alreadyvector entier, on lit u pour
+; alreadyvector entier+0.5, on lit v!
+         if floor(alreadyvector)+1 EQ 0 then begin
+            if floor(alreadyvector) EQ alreadyvector then begin
+               readcommande = ['; beginning of reading the zonal component of vector' $
+                               , '; fieldu number: '+strtrim(alreadyvector+2, 1), readcommande]
+               readcommande[i+2] = 'fieldu = '+coef+operation+readcommande[i+2]
+               readcommande = [extractatt(top_uvalue, 'currentreadcommand'), readcommande]
+            ENDIF ELSE BEGIN
+               readcommande = ['; beginning of reading the meridional component of vector' $
+                               , '; fieldv number: '+strtrim(floor(alreadyvector)+2, 1), readcommande]
+               readcommande[i+2] = 'fieldv = '+coef+operation+readcommande[i+2]
+               readcommande = [extractatt(top_uvalue, 'currentreadcommand'), readcommande]
+            ENDELSE
+         ENDIF ELSE BEGIN
+            if floor(alreadyvector) EQ alreadyvector then begin
+               readcommande = ['; fieldu number: '+strtrim(alreadyvector+2, 1), readcommande]
+               readcommande[i+1] = 'fieldu = fieldu'+separator+coef+operation+readcommande[i+1]
+               readcommande = [extractatt(top_uvalue, 'currentreadcommand'), readcommande]
+            ENDIF ELSE BEGIN
+               readcommande = ['; fieldv number: '+strtrim(floor(alreadyvector)+2, 1), readcommande]
+               readcommande[i+1] = 'fieldv = fieldv'+separator+coef+operation+readcommande[i+1]
+               readcommande = [extractatt(top_uvalue, 'currentreadcommand'), readcommande]
+            ENDELSE
+         ENDELSE
+         *top_uvalue[1, findline(top_uvalue, 'currentreadcommand')] = readcommande
+;
+         case alreadyvector+1 of
+            numberofread-1:BEGIN
+; on finalise la commande de lecture
+               readcommande = [readcommande, 'fieldu = fieldu'+add $
+                               , 'fieldu = create_struct({tab:fieldu, grille:vargrid, unite:varunit, experience:varexp, nom:varname})' $
+                               , '; end of reading the zonal component of vector', ';']
+               *top_uvalue[1, findline(top_uvalue, 'currentreadcommand')] = readcommande
+; on vient de finir le lecture des U
+               *top_uvalue[1, findline(top_uvalue, 'alreadyvector')] = -.5
+               *top_uvalue[1, findline(top_uvalue, 'noticebase')] = xnotice('Select the meridional component of vector')
+               return,  ''
+            END
+            numberofread-0.5:BEGIN
+; on finalise la commande de lecture
+               readcommande = [readcommande, 'fieldv = fieldv'+add $
+                               , 'fieldv = create_struct({tab:fieldv, grille:vargrid, unite:varunit, experience:varexp, nom:varname})' $
+                               , '; end of reading the meridional component of vector', ';']
+; on vient de finir le lecture des V
+;
+; on recupere le _EXTRA de vector et on complete eventuellement le extra
+; deja constitue:
+               extra = extractatt(top_uvalue, 'extra')
+               exextra = cw_specifie_get_value(base)
+               extra =  mixstru(exextra,extra)
+               sextra = struct2string(extra)
+               readcommande = [readcommande, 'vectorextra = '+sextra, 'extra=mixstru(extra,vectorextra)']
+;
+               *top_uvalue[1, findline(top_uvalue, 'currentreadcommand')] = readcommande
+;
+               if drawover then BEGIN
+; on enchaine sur un surcontour
+                  *top_uvalue[1, findline(top_uvalue, 'alreadyvector')] = !pi
+                  *top_uvalue[1, findline(top_uvalue, 'noticebase')] = xnotice('Select the field to overlay')
+                  return,  ''
+               ENDIF ELSE BEGIN
+                  *top_uvalue[1, findline(top_uvalue, 'alreadyread')] = -1
+                  *top_uvalue[1, findline(top_uvalue, 'alreadyvector')] = -1
+               ENDELSE
+            END
+            ELSE:BEGIN
+               *top_uvalue[1, findline(top_uvalue, 'alreadyvector')] = alreadyvector+1
+               if floor(alreadyvector) EQ alreadyvector then text = ' zonal ' $
+               ELSE text = ' meridional '
+               *top_uvalue[1, findline(top_uvalue, 'noticebase')] = xnotice('Select the '+strtrim(floor(alreadyread)+3, 1)+text+'component of vector')
+               return,  ''
+            END
+         endcase
+      END
+      'over':BEGIN
+         if alreadyover+1 EQ 0 then begin
+; on commence a ecrire la commande de lecture...
+            readcommande = ['; beginning of reading the field to overdraw' $
+                            , '; fieldover number: '+strtrim(alreadyread+2, 1), readcommande]
+            readcommande[i+2] = 'fieldover = '+coef+operation+readcommande[i+2]
+            readcommande = [extractatt(top_uvalue, 'currentreadcommand'), readcommande]
+         ENDIF ELSE BEGIN
+            readcommande = ['; fieldover number: '+strtrim(alreadyover+2, 1), readcommande]
+            readcommande[i+1] = 'fieldover = fieldover'+separator+coef+operation+readcommande[i+1]
+            readcommande = [extractatt(top_uvalue, 'currentreadcommand'), readcommande]
+         ENDELSE
+         *top_uvalue[1, findline(top_uvalue, 'currentreadcommand')] = readcommande
+;
+         if alreadyover+1 NE numberofread-1 THEN BEGIN 
+; si il faut lire d''autres champs on sort
+            *top_uvalue[1, findline(top_uvalue, 'alreadyover')] = alreadyover+1
+            *top_uvalue[1, findline(top_uvalue, 'noticebase')] = xnotice('Select the field number '+strtrim(alreadyover+3, 1)+' to overlay')
+            return,  ''
+         ENDIF
+; on finalise la commande de lecture
+         readcommande = [readcommande, 'fieldover = fieldover'+add $
+                         , 'fieldover = create_struct({tab:fieldover, grille:vargrid, unite:varunit, experience:varexp, nom:varname})' $
+                         , '; end of reading the field to overdraw', ';']
+; on recupere le _EXTRA de over et on complete eventuellement le extra
+; deja constitue:
+         extra = extractatt(top_uvalue, 'extra')
+         exextra = cw_specifie_get_value(base)
+         extra =  mixstru(exextra,extra)
+         sextra = struct2string(extra)
+         readcommande = [readcommande, 'overextra = '+sextra, 'extra=mixstru(extra,overextra)']
+;
+         *top_uvalue[1, findline(top_uvalue, 'currentreadcommand')] = readcommande
+; on remet les compteurs a 0
+         *top_uvalue[1, findline(top_uvalue, 'alreadyread')] = -1
+         *top_uvalue[1, findline(top_uvalue, 'alreadyvector')] = -1
+         *top_uvalue[1, findline(top_uvalue, 'alreadyover')] = -1
+      END
+   endcase
+;
+;-----------------------
+;-----------------------
+;-----------------------
+;-----------------------
+;-----------------------
+;-----------------------
+;---------------
+; determination du nom de la boite 
+;---------------
+   if NOT keyword_set(boite) then widget_control, domainid, get_value = boite
+; ecriture de celle-ci sous forme d''un string
+   box = '['+strtrim(boite[0], 1)
+   for i = 1, (n_elements(boite)-1) < (3+2*(strpos(type, 'z') EQ -1)) do $
+    box = box+', '+strtrim(boite[i], 1)
+; pour les [plots en z, box doit avoir par defaut 0,profmax
+   if strpos(type, 'z') NE -1 then BEGIN
+; si + de 1 niveau est selectionne:
+      widget_control, widget_info(base, find_by_uname = 'depthlev1'), get_value = niv1
+      niv1 = niv1.droplist_select
+      widget_control, widget_info(base, find_by_uname = 'depthlev2'), get_value = niv2
+      niv2 = niv2.droplist_select
+      if niv1 NE niv2 then begin
+         box = box+','+strtrim(boite[4], 1)+','+strtrim(boite[5], 1)
+      ENDIF ELSE BEGIN
+         if chkstru(exextra, 'profmax') then  pmax = exextra.profmax $
+         ELSE pmax = 200
+         box = box+',0,'+strtrim(pmax, 1)
+      ENDELSE
+   endif
+   box = box+']'
+;---------------
+; on determine typein
+;---------------
+   typein = ''''+type+''''
+;---------------
+;---------------
+; determination de petit
+;---------------
+   spetit = tostr(petitout)
+;------------------------------------------------------------
+; on va definir le string qui contiendra la commande a executer par widgetdessine.pro
+;------------------------------------------------------------
+   Commande = [readCommande, procedure+', field $', ', boite=' $
+               +box+', typein='+typein+', petit='+spetit+' $']
+   IF drawvecteur then Commande = [Commande, ', vecteur = {u: fieldu,v: fieldv} $']
+   IF drawover then Commande = [Commande, ', contour = fieldover $']
+   Commande = [Commande, ', _extra= mixstru(ex, extra), NOERASE=noerase']
+
+;    print, '---------------'
+;    for i = 0, n_elements(Commande)-1 do print, Commande[i]
+;    print, '---------------'
+;---------------
+; on complete et/ou actualise la structure top_uvalue...
+;---------------
+   (*top_uvalue[1, findline(top_uvalue, 'nameprocedures')])[numdessinout] = procedure
+   (*top_uvalue[1, findline(top_uvalue, 'types')])[numdessinout] = type
+   (*top_uvalue[1, findline(top_uvalue, 'domaines')])[*, numdessinout] = boite
+   (*top_uvalue[1, findline(top_uvalue, 'prefixes')])[numdessinout] = widcommand
+   (*top_uvalue[1, findline(top_uvalue, 'optionsflag')])[*, numdessinout] = flags
+   *((*top_uvalue[1, findline(top_uvalue, 'exextra')])[numdessinout]) = extra
+;------------------------------------------------------------
+   return, Commande
+end
+
+
Index: tags/start/WIDGET/AUTOUR_de_XXX/buildreadcommand.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/buildreadcommand.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/buildreadcommand.pro	(revision 5)
@@ -0,0 +1,161 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:buildreadcommand
+;
+; PURPOSE:
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:
+; 
+; INPUTS:
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION buildreadcommand, base, snameexp, procedure, type, BOITE = boite, COMPLETE = complete, NAMEFIELD = namefield
+;------------------------------------------------------------
+; on recuper les ID des differents widgets 
+;------------------------------------------------------------
+   filelistid = widget_info(base, find_by_uname = 'filelist')
+   champid = widget_info(base, find_by_uname = 'champ')
+   nomexpid = widget_info(base, find_by_uname = 'nom_exp')
+   date1id = widget_info(base, find_by_uname = 'calendar1')
+   date2id = widget_info(base, find_by_uname = 'calendar2')
+   domainid = widget_info(base, find_by_uname = 'domain')
+;   optionid = widget_info(base, find_by_uname = 'option')
+;------------------------------------------------------------
+   widget_control,base, get_uvalue = top_uvalue
+   numdessinin = (extractatt(top_uvalue, 'petitin'))[2]-1
+   numdessinout = (extractatt(top_uvalue, 'petitout'))[2]-1
+;---------------
+; determination du nom du fichier
+;---------------
+   currentfile = extractatt(top_uvalue, 'currentfile')
+   filelist = extractatt(top_uvalue, 'filelist')
+   filename = filelist[currentfile]
+   sfilename = ''''+filename+''''
+;---------------
+; on recupere le nom de la variable
+;---------------
+   if NOT keyword_set(namefield) then begin
+      listvar = (*(extractatt(top_uvalue, 'fileparameters'))[currentfile]).listvar
+      nomvariable = listvar[widget_info(champid, /droplist_select)]
+   ENDIF ELSE nomvariable = namefield
+   snomvariable = ''''+nomvariable+''''
+;
+;  recherche des options
+;
+   options = extractatt(top_uvalue, 'options')   
+   flags = extractatt(top_uvalue, 'optionsflag')
+   flags = flags[*, numdessinin]
+   xindex = (flags[where(options EQ 'Longitude / x index')])[0]
+   yindex = (flags[where(options EQ 'Latitude / y index')])[0]
+;
+   extra = extractatt(top_uvalue, 'extra')
+   if xindex NE 0 then extra = create_struct(extra, 'xindex', xindex)
+   if yindex NE 0 then extra = create_struct(extra, 'yindex', yindex)
+   exextra = cw_specifie_get_value(base)
+   exextra = extractstru(exextra, ['min', 'max', 'inter', 'lct'])
+   if size(exextra, /type) EQ 8 then extra = mixstru(exextra,extra)
+   sextra = struct2string(extra)
+
+;---------------
+; determination de date1 et date2
+;---------------
+   widget_control, date1id, get_value = date1
+;
+   widget_control, date2id, get_value = date2
+   date1 = long(date1) & date2 = long(date2)
+;
+   if procedure EQ 'pltt' AND date1 EQ date2 then begin
+      currentfile = extractatt(top_uvalue, 'currentfile')
+      calendar = (*(extractatt(top_uvalue, 'fileparameters'))[currentfile]).time_counter
+      caldat, calendar,monthcal,daycal,yearcal
+      if total(daycal eq 15) EQ n_elements(calendar) then monthly = 1
+      if total(monthcal EQ 6) EQ n_elements(calendar) then BEGIN 
+         monthly = 1 
+         yearly = 1
+      endif
+      date1 = vairdate(calendar[0], mensuel = monthly, annuel = yearly)
+      date2 = vairdate(calendar[n_elements(calendar)-1], mensuel = monthly, annuel = yearly)
+      widget_control, date1id, set_value = date1
+      widget_control, date2id, set_value = date2
+   endif
+;
+   sdate1 = strtrim(date1, 1) & sdate2 = strtrim(date2, 1)
+;---------------
+; determination du nom de la boite 
+;---------------
+   if NOT keyword_set(boite) then widget_control, domainid, get_value = boite
+; ecriture de celle-ci sous forme d''un string
+   box = '['+strtrim(boite[0], 1)
+   for i = 1, (n_elements(boite)-1) < (3+2*(strpos(type, 'z') EQ -1)) do $
+    box = box+', '+strtrim(boite[i], 1)
+   if strpos(type, 'z') NE -1 then BEGIN
+      @common
+      min = min([gdept, gdepw], max = max)
+      box = box+','+strtrim(floor(min), 1)+','+strtrim(ceil(max), 1)
+   endif
+   box = box+']'
+;---------------
+; determination de funclec_name, readparameters, meshparameters
+;---------------
+   readparameters = *(extractatt(top_uvalue, 'readparameters'))[currentfile]
+   funclec_name = readparameters.funclec_name
+   if keyword_set(complete) then begin
+      sreadparameters = struct2string(readparameters)
+      meshparameters = *(extractatt(top_uvalue, 'meshparameters'))[currentfile]
+      smeshparameters = struct2string(meshparameters)
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; on va definir le string qui contiendra la commande a executer pour
+; la lecture
+;------------------------------------------------------------
+      Commande = ['; declaration de la structure extra:', 'extra='+sextra $
+                  , '; declaration de la structure readparameters:', 'readparameters='+sreadparameters $
+                  , '; on change de lecture?:', 'nothing=changeread(readparameters)' $
+                  , '; declaration de la structure meshparameters:', 'meshparameters='+smeshparameters $
+                  , '; on change de grille?:', 'nothing=changegrid(meshparameters)' $
+                  , '; lecture du champ' $
+                  , 'if keyword_set(date1in) then date1 = date1in else date1 = '+sdate1 $
+                  , 'if keyword_set(date2in) then date2 = date2in else date2 = '+sdate2 $
+                  , 'litchamp('+funclec_name+'('+snomvariable+', date1, date2,'+snameexp $
+                  +',parent='+strtrim(base, 1)+',boite='+box+' $',', filename='+sfilename+' $' $
+                  , ', _extra=mixstru(ex, extra)))']
+      (*top_uvalue[1, findline(top_uvalue, 'champs')])[*, numdessinout] = [filename, nomvariable]
+      (*top_uvalue[1, findline(top_uvalue, 'dates')])[*, numdessinout] = [date1, date2]
+   ENDIF ELSE BEGIN
+      Commande = ['; lecture du champ' $
+                  , 'if keyword_set(date1in) then date1 = date1in else date1 = '+sdate1 $
+                  , 'if keyword_set(date2in) then date2 = date2in else date2 = '+sdate2 $
+                  , 'litchamp('+funclec_name+'('+snomvariable+', date1, date2,'+snameexp $
+                  +',parent='+strtrim(base, 1)+',boite='+box+' $',', filename='+sfilename+' $' $
+                  , ', _extra=mixstru(ex, extra)))']
+   ENDELSE
+;    print, '::::::::::::::::::::::'
+;    for i = 0, n_elements(Commande)-1 do print, Commande[i]
+;    print, '::::::::::::::::::::::'
+;------------------------------------------------------------
+
+;------------------------------------------------------------
+   return, commande
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/changefield.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/changefield.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/changefield.pro	(revision 5)
@@ -0,0 +1,27 @@
+PRO changefield, base, newfieldname, BOITE = boite
+;
+   widget_control, base, get_uvalue = top_uvalue
+;
+; changement de exextra :
+   exextra = definedefaultextra(newfieldname)
+   specifieid = widget_info(base,find_by_uname = 'specifie')
+   widget_control, specifieid, set_value = exextra
+; chamgement de variable -> devra-t-on changer de domaine verticale?
+   oldzgrid = extractatt(top_uvalue, 'zgrid')
+   currentfile = extractatt(top_uvalue, 'currentfile')
+   listgrid = (*(extractatt(top_uvalue, 'fileparameters'))[currentfile]).listgrid
+   listvar = (*(extractatt(top_uvalue, 'fileparameters'))[currentfile]).listvar
+;   for i = 0,  n_elements(listvar)-1 do print,  listvar[i], '/', listgrid[i]
+   indexvar = where(listvar EQ newfieldname) & indexvar = 0 > indexvar[0]
+   vargrid = strupcase(listgrid[indexvar])
+   IF vargrid EQ 'W' then zgrid = 'W' ELSE zgrid = 'T'
+   if zgrid NE oldzgrid then BEGIN
+      *top_uvalue[1, findline(top_uvalue, 'zgrid')] = zgrid
+      if NOT keyword_set(boite) THEN BEGIN
+         widget_control, widget_info(base, find_by_uname = 'domain'), get_value = boite
+         widget_control, widget_info(base, find_by_uname = 'domain'), set_value = boite
+      endif
+   endif
+;
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/changefile.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/changefile.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/changefile.pro	(revision 5)
@@ -0,0 +1,92 @@
+PRO changefile, base, newfilename, BOITE = boite, DATE1 = date1, DATE2 = date2, FIELDNAME = fieldname
+
+   widget_control, base, /hourglass
+   widget_control, base, get_uvalue = top_uvalue
+   filelist = extractatt(top_uvalue, 'filelist')
+   newfile = (where(filelist EQ newfilename))[0]
+   if newfile EQ -1 then begin
+      nothing, report('invalid filename')
+      return
+   endif
+   listid = widget_info(base, find_by_uname = 'filelist')
+   widget_control, listid, set_list_select = newfile
+   oldfile = extractatt(top_uvalue, 'currentfile')
+   oldfilename = filelist[oldfile]
+; a-t-on reelement change de fichier?
+   if oldfile EQ newfile AND NOT (keyword_set(BOITE) OR keyword_set(DATE1) OR keyword_set(DATE2) OR keyword_set(FIELDNAME)) then return
+;--------------
+   widget_control, base, update = 0
+;--------------
+;
+; on update l''element currentfile de la top_uvalue
+;
+   *top_uvalue[1, findline(top_uvalue, 'currentfile')] = newfile
+; on s''occupe du nom de la variable
+   oldlistvar = (*(extractatt(top_uvalue, 'fileparameters'))[oldfile]).listvar
+   newlistvar = (*(extractatt(top_uvalue, 'fileparameters'))[newfile]).listvar
+;
+   champid = widget_info(base, find_by_uname = 'champ') 
+   oldindexvar = widget_info(champid,/droplist_select)
+   oldfieldname = oldlistvar[oldindexvar]
+; a-t-on change de liste de variables ?
+   if n_elements(oldlistvar) NE n_elements(newlistvar) $
+    OR total(oldlistvar NE newlistvar) NE 0 THEN $
+    widget_control, champid, set_value = newlistvar
+;
+   if keyword_set(fieldname) then newfieldname = fieldname ELSE newfieldname = oldfieldname
+   indexvar = where(newlistvar EQ newfieldname) & indexvar = 0 > indexvar[0]
+   if oldindexvar NE indexvar then widget_control, champid, set_droplist_select = indexvar
+   newfieldname = newlistvar[indexvar]
+; on a modifiee le nom de la variable?
+   if newfieldname NE oldfieldname then BEGIN
+      changefield, base, newfieldname, BOITE = boite
+      widget_control, champid, set_droplist_select = indexvar
+   ENDIF
+;
+; on s''occupe du calendrier
+;
+   oldcalendar = (*(extractatt(top_uvalue, 'fileparameters'))[oldfile]).time_counter
+   newcalendar = (*(extractatt(top_uvalue, 'fileparameters'))[newfile]).time_counter
+; a-t-on change de calendrier ?
+   if n_elements(oldcalendar) NE n_elements(newcalendar) $
+    OR total(oldcalendar NE newcalendar) NE 0 then begin
+; quelles etaient les dates selectionnees ?    
+      date1id = widget_info(base, find_by_uname = 'calendar1')
+      if NOT keyword_set(date1) then widget_control, date1id, get_value = date1
+      if (where(newcalendar EQ juldate(date1,/vraidate)))[0] EQ -1 then date1 = newcalendar[0]
+      date2id = widget_info(base, find_by_uname = 'calendar2')
+      if NOT keyword_set(date2) then widget_control, date2id, get_value = date2
+      if (where(newcalendar EQ juldate(date2,/vraidate)))[0] EQ -1 then date2 = date1
+      if date2 LT date1 THEN date2 = date1
+      widget_control, date1id, /destroy
+      widget_control, date2id, /destroy
+      base12 = widget_info(base, find_by_uname = 'base12')
+      rien = cw_calendar(base12,newcalendar, juldate(date1,/vraidate), uname = 'calendar1' $
+                         , uvalue = {name:'calendar1'}, /frame)
+      rien = cw_calendar(base12,newcalendar, juldate(date2,/vraidate), uname = 'calendar2' $
+                         , uvalue = {name:'calendar2'}, /frame)
+   ENDIF ELSE BEGIN 
+      if keyword_set(date1) then begin
+         date1id = widget_info(base, find_by_uname = 'calendar1')
+         widget_control, date1id, set_value = date1
+      endif
+      if keyword_set(date2) then begin
+         date2id = widget_info(base, find_by_uname = 'calendar2')
+         widget_control, date2id, set_value = date2
+      endif
+   ENDELSE
+;
+; parametres de la grille
+;
+   newgrid = *(extractatt(top_uvalue, 'meshparameters'))[newfile]
+   change = changegrid(newgrid)
+   if change OR keyword_set(boite) then BEGIN
+      if NOT keyword_set(boite) then boite = -1
+      domainid = widget_info(base, find_by_uname = 'domain')
+      widget_control, domainid, set_value = boite
+   endif
+;--------------
+   widget_control, base, update = 1
+;--------------
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/createhistory.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/createhistory.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/createhistory.pro	(revision 5)
@@ -0,0 +1,41 @@
+PRO createhistory, base, petit
+;
+;-------------------------------------------------------------
+; we save globalcommand in globaloldcommand
+   widget_control,base, get_uvalue = top_uvalue
+   globalcommand = extractatt(top_uvalue, 'globalcommand')
+   *top_uvalue[1, findline(top_uvalue, 'globaloldcommand')] = globalcommand
+; composition du text contennu ds history.pro
+   texte = ['@common' $
+            , ' ' $
+            , 'if n_elements(portrait) ne 0 then key_portrait = portrait' $
+            , 'if n_elements(landscape) ne 0 then key_portrait = 1-landscape' $
+            , ' ' $
+            , 'if keyword_set(postscript) then begin'  $
+            , '    noerase = 1' $
+            , '    openps, infowidget = infowidget' $
+            , 'endif' $
+            , ' ' $
+            , '; beginning of 1' $
+            , ';' $
+            , '; end of 1']
+   if petit[0]*petit[1] GT 1 then begin
+      for draw = 1, petit[0]*petit[1]-1  do begin
+         texte = [texte $
+                  , '; beginning of '+strtrim(draw+1, 2) $
+                  , 'noerase=1' $
+                  , '; end of '+strtrim(draw+1, 2)]
+      endfor
+   ENDIF
+   texte = [texte $
+            , 'if keyword_set(postscript) then begin' $
+            , '    closeps, infowidget = infowidget' $
+            , '    imprime' $
+            , 'endif']
+; the new globalcommand
+   *top_uvalue[1, findline(top_uvalue, 'globalcommand')] = texte
+;-------------------------------------------------------------
+;   for i = 0, n_elements(texte)-1 do print, texte[i]
+;-------------------------------------------------------------
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/cutcommand.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/cutcommand.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/cutcommand.pro	(revision 5)
@@ -0,0 +1,86 @@
+PRO cutcommand, widcommand, toread, coef, numberofread, operation, nameexp, separator, add
+;
+; on separe widcommand en bloc separes par de + ou des -
+; par ex on peut avoir:
+; widcommand=2*champ1+champ2-8*champ9+678
+;
+; si on ne commence pas par un singne + ou -
+   case 1 of
+      strpos(widcommand, '+') EQ 0:BEGIN
+         widcommand = strmid(widcommand, 1)
+         firstsign = '+'
+      end
+      strpos(widcommand, '-') EQ 0:BEGIN
+         widcommand = strmid(widcommand, 1)
+         firstsign = '-'
+      END
+      ELSE:firstsign = '+'
+   endcase
+
+   sepplus = str_sep(widcommand, '+', /trim)
+   sepmoins = str_sep(sepplus[0], '-', /trim)
+   singleread = sepmoins
+   if n_elements(sepmoins) NE 1 then $
+    separator = [replicate('-', n_elements(sepmoins)-1), '+'] ELSE $
+    separator = ['+']
+   if n_elements(sepplus) GT 1 then $
+    for i = 1, n_elements(sepplus)-1 do begin
+      sepmoins = str_sep(sepplus[i], '-', /trim)
+      singleread = [singleread, sepmoins]
+      if n_elements(sepmoins) NE 1 then $
+       separator = [separator, replicate('-', n_elements(sepmoins)-1), '+'] ELSE $
+       separator = [separator, '+']
+   ENDFOR
+   separator = [firstsign, separator]
+;
+   numberofread = n_elements(singleread) 
+; cas simple ou il n''y a qu''un champ a lire...
+   if numberofread EQ 1 and isnumber(singleread[0]) GE 1 then begin
+      coef = ''
+      numberofread = 1
+      operation = ''
+      nameexp = '???'
+      separator = ''
+      add = separator[0]+singleread[0]
+      return
+   endif
+;
+; les dernier element de singleread est-il un ordre de lecture ou une
+; constant a ajouter ???
+;
+   if isnumber(singleread[numberofread-1]) GE 1 then begin
+      add = separator[numberofread-1]+singleread[numberofread-1]
+      singleread = singleread[0:numberofread-2]
+      numberofread = numberofread-1
+   ENDIF ELSE add = ''
+;
+   IF toread GE numberofread then begin
+      rien = report('toread ne peut etre + grand que numberofread')
+      return
+   ENDIF
+;
+;   for i = 0,  n_elements(singleread)-1 do print, separator[i], ' ',  singleread[i]
+;
+   pieceofread = singleread[toread]
+   separator = separator[toread]
+;
+   case 1 of
+      strpos(pieceofread, '*') NE -1:operation = '*'
+      strpos(pieceofread, '/') NE -1:operation = '/'
+      ELSE:operation = ''
+   ENDCASE
+   if operation NE '' then begin
+      finalread = str_sep(pieceofread, operation, /trim)
+      coef = finalread[0]
+      nameexp = finalread[1]
+   ENDIF ELSE BEGIN
+      if toread EQ 0 AND firstsign EQ '-' then begin
+      coef = '-1'
+      operation = '*'
+      ENDIF ELSE coef = ''
+      nameexp = pieceofread
+   ENDELSE
+;
+;
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/definedefaultextra.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/definedefaultextra.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/definedefaultextra.pro	(revision 5)
@@ -0,0 +1,19 @@
+FUNCTION definedefaultextra, nomvariable
+   case strlowcase(nomvariable) of
+;       'sn':BEGIN
+;          return, get_extra(min = 31., max = 37., inter = .2, lct = 33,/nocontout)
+;       END
+;       'tn':BEGIN
+;          return, get_extra(min = 20, max = 31, inter = .5, lct = 39)
+;       END
+;       'un':BEGIN
+;          return, get_extra(min = -1, max = 1, inter = .1, lct = 64)
+;       END
+;       'vn':BEGIN
+;          return, get_extra(min = -1, max = 1, inter = .1, lct = 64)
+;       END
+      ELSE:
+   ENDCASE
+
+   return, get_extra(min = '', max = '', inter = '', lct = 39)
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/doubleclickaction.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/doubleclickaction.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/doubleclickaction.pro	(revision 5)
@@ -0,0 +1,64 @@
+PRO doubleclickaction, event
+;------------------------------------------------------------
+   widget_control, event.id, get_uvalue = uval
+   widget_control,event.top, get_uvalue = top_uvalue
+; on active la bonne fenetre 
+   widget_control,event.id,get_value=win
+   wset, win
+; quel est le dessin selectionne??
+   petitin = extractatt(top_uvalue, 'petitin')
+   petitout = extractatt(top_uvalue, 'petitout')
+   x = (convert_coord(uval.x[0],uval.y[0], /device, /to_normal))[0]
+   y = (convert_coord(uval.x[0],uval.y[0], /device, /to_normal))[1]
+   numcolonne = n_elements(where(findgen(petitin[0])/petitin[0] lt x))-1
+   numligne = n_elements(where(findgen(petitin[1])/petitin[1] lt 1-y))-1
+   numdessin = numcolonne+numligne*petitin[0]+1
+; choix du type d''action
+   case uval.press of
+      1:BEGIN
+;         if top_uvalue.petitin[2] NE numdessin then begin
+         tracecadre, petitin, /erase
+         if total(petitin EQ petitout) EQ 3 then $
+          tracecadre, petitout, /out
+         petitin = [petitin[0:1], numdessin]
+         *top_uvalue[1, findline(top_uvalue, 'petitin')] = petitin
+         tracecadre, petitin
+         !p = (extractatt(top_uvalue, 'penvs'))[numdessin-1]
+         !x = (extractatt(top_uvalue, 'xenvs'))[numdessin-1]
+         !y = (extractatt(top_uvalue, 'yenvs'))[numdessin-1]
+;
+      END
+      2:BEGIN 
+;         if top_uvalue.petitout[2] NE numdessin then begin
+         tracecadre, petitout, /erase
+         if total(petitin EQ petitout) EQ 3 then $
+          tracecadre, petitin
+         petitout = [petitin[0:1], numdessin]
+         *top_uvalue[1, findline(top_uvalue, 'petitout')] = petitout
+         tracecadre, petitout, /out
+;         endif
+      END
+      4:BEGIN
+         tracecadre, [petitin[0:1], numdessin], /fill
+         inserthistory, event.top, ';', '; beginning of '+strtrim(numdessin, 2) $
+          , '; end of '+strtrim(numdessin, 2)
+; remise a 0 des attributs de la uvalue concernant ce dessin:
+
+         numdessin = numdessin-1
+         (*top_uvalue[1, findline(top_uvalue, 'champs')])[*, numdessin] = ['', '']
+         (*top_uvalue[1, findline(top_uvalue, 'dates')])[*, numdessin] = [0l, 0l]
+         (*top_uvalue[1, findline(top_uvalue, 'nameprocedures')])[numdessin] = ''
+         (*top_uvalue[1, findline(top_uvalue, 'types')])[numdessin] = ''
+         (*top_uvalue[1, findline(top_uvalue, 'domaines')])[*, numdessin] = fltarr(6)
+         (*top_uvalue[1, findline(top_uvalue, 'prefixes')])[numdessin] = ''
+
+         if numdessin EQ petitin[2] then $
+          tracecadre, petitin
+         if numdessin EQ petitout[2] then $
+          tracecadre, petitout, /out
+      END
+   endcase
+   updatewidget, event.top
+;------------------------------------------------------------
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/extractatt.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/extractatt.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/extractatt.pro	(revision 5)
@@ -0,0 +1,9 @@
+FUNCTION extractatt, top_uvalue, name
+   taille = size(top_uvalue)
+   j = -1
+   repeat BEGIN
+      j = j+1
+      if j EQ (size(top_uvalue))[2] then return, -1
+   endrep until *top_uvalue[0, j] EQ name
+   return, *top_uvalue[1, j]
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/findline.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/findline.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/findline.pro	(revision 5)
@@ -0,0 +1,9 @@
+FUNCTION findline, top_uvalue, name
+   taille = size(top_uvalue)
+   j = -1
+   repeat BEGIN
+      j = j+1
+      if j EQ (size(top_uvalue))[2] then return, -1
+   endrep until *top_uvalue[0, j] EQ name
+   return, j
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/identifyclick.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/identifyclick.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/identifyclick.pro	(revision 5)
@@ -0,0 +1,61 @@
+FUNCTION identifyclick, event
+   widget_control, event.id, get_uvalue=uval, /no_copy
+   thisEvent = TAG_NAMES(event, /Structure)
+   if thisEvent EQ 'WIDGET_TIMER' then press = 0 ELSE press = event.press
+;
+;  d/0/>1 -------->t/1/0--------->**d/2/0**       long click
+;         -------->d/1/0--------->**t/2/0**  click normal
+;                       --------->**d/2/>1**-------->d/3/0----->t/0/0  double click
+;                                           -------->t/3/0----->d/0/0  double click
+   type = 'inutile'
+   case 1 OF
+; d/0/0 1er remonte
+      thisEvent EQ 'WIDGET_DRAW' AND uval.click EQ 0 AND press EQ 0:
+; d/0/>1 1er appuie de la serie
+      thisEvent EQ 'WIDGET_DRAW' AND uval.click EQ 0 AND press ge 1:BEGIN
+         uval.x = [event.x, 0]
+         uval.y = [event.y, 0]
+         uval.press = press
+         uval.click = 1
+         widget_control, event.id, timer = .3
+      END
+; d/1/0 1er remonte
+      thisEvent EQ 'WIDGET_DRAW' AND uval.click EQ 1 AND press EQ 0:uval.click = 2
+; d/2/0 fin long click
+      thisEvent EQ 'WIDGET_DRAW' AND uval.click EQ 2 AND press EQ 0:BEGIN
+         type = 'long'
+         uval.x = [uval.x[0],event.x] & uval.x = uval.x[sort(uval.x)]
+         uval.y = [uval.y[0],event.y] & uval.y = uval.y[sort(uval.y)]
+         uval.click = 0
+         uval.press = event.release
+      END
+; d/2/>1
+      thisEvent EQ 'WIDGET_DRAW' AND uval.click EQ 2 AND press ge 1:BEGIN
+         type = 'double'
+         uval.press = press
+         uval.click = 3
+      END
+; d/3/0 remonte et fin de double click
+      thisEvent EQ 'WIDGET_DRAW' AND uval.click EQ 3 AND press EQ 0:uval.click = 0
+; t/0/0 fin de double click
+      thisEvent EQ 'WIDGET_TIMER' AND uval.click EQ 0 AND press EQ 0:
+; t/1/0 long click
+      thisEvent EQ 'WIDGET_TIMER' AND uval.click EQ 1 AND press EQ 0:uval.click = 2
+; t/2/0 click normal
+      thisEvent EQ 'WIDGET_TIMER' AND uval.click EQ 2 AND press EQ 0:BEGIN 
+         type = 'single'
+         press = uval.press
+         uval.click = 0
+      END
+; t/3/0 fin de double click
+      thisEvent EQ 'WIDGET_TIMER' AND uval.click EQ 3 AND press EQ 0:uval.click = 0
+; cas normalement impossible:
+      ELSE:BEGIN
+         print, thisEvent, uval.click, press
+         print, 'Probleme, cas normalement impossible!'
+      END
+   endcase
+
+   widget_control, event.id, set_uvalue=uval, /no_copy
+   return, {type:type}
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/inserthistory.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/inserthistory.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/inserthistory.pro	(revision 5)
@@ -0,0 +1,25 @@
+PRO inserthistory,  base, text, line1, line2
+;-------------------------------------------------------------
+   widget_control,base, get_uvalue = top_uvalue
+   globalcommand = extractatt(top_uvalue, 'globalcommand')
+   *top_uvalue[1, findline(top_uvalue, 'globaloldcommand')] = globalcommand
+;   for i = 0, n_elements(globalcommand)-1 do print, globalcommand[i]
+; we insert text between line1 and line2
+    index1 = where(globalcommand EQ line1) & index1 = index1[0]+1
+    if index1  EQ -1 then begin
+       rien = report(line1+' n''est pas trouve ds globalcommand')
+       return
+    endif
+    index2 = where(globalcommand EQ line2) & index2 = index2[0]
+    if index2  EQ -1 then begin
+       rien = report(line2+' n''est pas trouve ds globalcommand')
+       return
+    ENDIF
+; the new text:
+    globalcommand = [globalcommand[0:index1], text, globalcommand[index2:n_elements(globalcommand)-1]]
+; the new globalcommand
+   *top_uvalue[1, findline(top_uvalue, 'globalcommand')] = globalcommand
+
+;-------------------------------------------------------------
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/letsdraw.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/letsdraw.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/letsdraw.pro	(revision 5)
@@ -0,0 +1,102 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:widgetdessine
+;
+; PURPOSE: c'est la procedure qui lance le dessin. Si on ne le lui
+; donne pas de commande, elle appelle construitcommande pour savoir
+; quoi tracer.
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:widgetdessine, base
+; 
+; INPUTS:base: l''id du widget ou appliquer le dessin
+;
+; KEYWORD PARAMETERS:
+;       COMMANDE: un string du style: read_data('sst'...),....
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+
+PRO letsdraw, base, COMMANDE = commande, FORPLTH = forplth, FORPLTZ = forpltz, FORPLTT = forpltt, _extra = ex
+@common
+; on recupere la uvalue de base
+; widget_control,base, get_uvalue = top_uvalue
+; print, '*****************'
+; help,  top_uvalue, /struct
+; help,  top_uvalue.exextra, /struct
+   if NOT keyword_set(commande) then $
+    commande = buildcommand(base, FORPLTH=forplt, FORPLTZ=forpltz, FORPLTT=forpltt, _extra=ex)
+   if commande[0] EQ '' then return
+; on recupere la uvalue de base
+   widget_control, base, /hourglass
+   widget_control,base, get_uvalue = top_uvalue
+; print, '*****************'
+; help,  top_uvalue, /struct
+; print, '***..........****'
+;  help,  top_uvalue.exextra, /struct
+;  help,  top_uvalue.extra, /struct
+; print, '-*-*-*-*-*-*-*-*-*'
+; print, commande
+; help,mixstru(top_uvalue.exextra,top_uvalue.extra), /struct
+;
+;
+; on recuperel''id de la fenetre graphique associee au widget d''id base
+   graphid = extractatt(top_uvalue, 'graphid')
+   widget_control, graphid, get_value = win
+; on la selectionne (c''est a elle que sera passe toutes les commandes
+; concernant une fenetre)
+   wset, win
+;   erase, 255                       ; on netoie la fenetre
+; on s''assure que si on travaille avec un ecran codant les couleurs
+; sur 24 bits la couleur de fond specifiee!p.background est bien
+; appliquee
+;    if !d.n_colors gt 256 then begin
+;       device, decomposed=1
+;       !p.background='ffffff'x
+;       plot,[0],[0]
+;       device, decomposed=0
+;    ENDIF
+;
+   petitout = long(extractatt(top_uvalue, 'petitout'))
+   numdessinout = petitout[2]-1
+;
+   tracecadre, petitout, /fill
+;
+;
+   options = extractatt(top_uvalue, 'options')   
+   optionsflag = extractatt(top_uvalue, 'optionsflag')
+   portrait = (strtrim(optionsflag[where(options EQ 'Portrait/Landscape'), 0], 1))[0]
+   
+;
+   createpro, ['@common' $
+               , 'noerase = 1' $
+               , 'portrait = '+portrait $
+               , Commande] $
+    , filename = isafile(file = 'xxx_oneplot', io = homedir,/new)
+;
+   inserthistory, base, Commande,'; beginning of '+strtrim(petitout[2], 1) $
+    , '; end of '+strtrim(petitout[2], 1)
+;
+   (*top_uvalue[1, findline(top_uvalue, 'penvs')])[numdessinout] = !p
+   (*top_uvalue[1, findline(top_uvalue, 'xenvs')])[numdessinout] = !x
+   (*top_uvalue[1, findline(top_uvalue, 'yenvs')])[numdessinout] = !y
+
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/longclickaction.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/longclickaction.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/longclickaction.pro	(revision 5)
@@ -0,0 +1,77 @@
+PRO longclickaction, event
+   widget_control, event.id, get_uvalue=uval
+   widget_control,event.top, get_uvalue = top_uvalue
+; quel est le dessin selectionne??
+   petitout = extractatt(top_uvalue, 'petitout')
+   petitin = extractatt(top_uvalue, 'petitin')
+   petit = petitin
+   x = (convert_coord(uval.x[0],uval.y[0], /device, /to_normal))[0]
+   y = (convert_coord(uval.x[0],uval.y[0], /device, /to_normal))[1]
+   numcolonne = n_elements(where(findgen(petit[0])/petit[0] lt x))-1
+   numligne = n_elements(where(findgen(petit[1])/petit[1] lt 1-y))-1
+   numdessin = numcolonne+numligne*petit[0]
+; on met ce cadrant en leader
+   tracecadre, petitin, /erase
+   if total(petitin EQ petitout) EQ 3 then $
+    tracecadre, petitout, /out
+   petitin = [petitin[0:1], numdessin+1]
+   *top_uvalue[1, findline(top_uvalue, 'petitin')] = petitin
+   tracecadre, petitin
+   !p = (extractatt(top_uvalue, 'penvs'))[numdessin]
+   !x = (extractatt(top_uvalue, 'xenvs'))[numdessin]
+   !y = (extractatt(top_uvalue, 'yenvs'))[numdessin]
+;
+;------------------------------------------------------------
+; changement de domaine:
+;------------------------------------------------------------
+   coor = (convert_coord(uval.x,uval.y, /device, /to_data))
+   x = [coor[0, 0],coor[0, 1]]
+   y = [coor[1, 0],coor[1, 1]]
+   domainid = widget_info(event.top,find_by_uname = 'domain')
+   boite = [x, y]
+; faut-il passer la boite en indexes ???
+   currentplot = (extractatt(top_uvalue, 'petitin'))[2]-1
+   options = extractatt(top_uvalue, 'options')   
+   flags = extractatt(top_uvalue, 'optionsflag')
+   flags = flags[*, currentplot]
+   changex = (flags[where(options EQ 'Longitude / x index')])[0] EQ 1
+   changey = (flags[where(options EQ 'Latitude / y index')])[0] EQ 1
+   if changex OR changey then begin
+; on veut retrouver le type de grille qui est utilisee
+      currentfile = extractatt(top_uvalue, 'currentfile')
+      listgrid = (*(extractatt(top_uvalue, 'fileparameters'))[currentfile]).listgrid
+      indexvar = widget_info(widget_info(event.top, find_by_uname = 'champ'), /droplist_select)
+      vargrid = strupcase(listgrid[indexvar])
+      domdef, boite, grille = vargrid
+      grille, mask,glam,gphi,gdep,nx,ny,nz,premierx,premiery,premierz,dernierx,derniery,dernierz
+      if changex then boite[0:1] = [premierx, dernierx]
+      if changey then boite[2:3] = [premiery, derniery]
+   endif
+;
+   widget_control, domainid, set_value = boite
+;
+;------------------------------------------------------------
+   graphtypeid = widget_info(event.top, find_by_uname = 'action')
+   widget_control,graphtypeid, get_uvalue = graphtype_uvalue
+   type = graphtype_uvalue.choix[widget_info(graphtypeid, /droplist_select)]
+   case uval.press of
+      1:BEGIN
+         nodates = (type EQ 'xt' OR type EQ 'yt' OR type EQ 'zt' OR type EQ 't')
+         updatewidget, event.top, /noboite, nodates = nodates, notype = type NE 'plt'
+         forplth = type EQ 'plt'
+         letsdraw, event.top, forplth = forplth
+      END
+      2:BEGIN 
+         updatewidget, event.top, /noboite
+         forpltz = type EQ 'plt'
+         letsdraw, event.top, forpltz = forpltz
+      END
+      4:BEGIN
+         updatewidget, event.top, /noboite, /nodates
+         forpltt = type EQ 'plt'
+         letsdraw, event.top, forpltt = forpltt
+      END
+   endcase
+;------------------------------------------------------------
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/read_vermair.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/read_vermair.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/read_vermair.pro	(revision 5)
@@ -0,0 +1,11 @@
+FUNCTION read_vermair, name,debut,fin, nomexp, PARENT = parent, BOITE=boite, _EXTRA = ex
+@common
+;------------------------------------------------------------ 
+   if name EQ 'un' then name = 'vozocrtx'
+   if name EQ 'vn' then name = 'vomecrty'
+   if debut EQ fin then begin
+      res = lec(name,debut,nomexp, BOITE=boite, _EXTRA = ex)
+   ENDIF ELSE res = lec(name,debut,fin, nomexp, BOITE=boite, _EXTRA = ex)
+;------------------------------------------------------------ 
+   return, {tab:res, grille:vargrid, unite:'', experience:varexp, nom:varname}
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/scanfile.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/scanfile.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/scanfile.pro	(revision 5)
@@ -0,0 +1,141 @@
+;
+;  liste des presupposes:
+;       1) le fichier a lire est un fichier netcdf
+;       2) le nom de ce fichier finit
+;       par U.nc, V.nc, W.nc, T.nc ou F.nc, la lettre avant le
+;       nc designant la grille a laquelle se rapporte la champ.
+;       Si tel n''est pas la cas, le fichier est attribue a la grille
+;       T.
+;       3) ce fichier contient une dimension infinie qui doit etre
+;       celle qui se rapporte au temps et au mois 2 autres dimensions
+;       dont les noms sont 'x','lon','longitude' et 'y','lat' ou
+;       'latitude' ou bien en majuscule.
+;       4) il doit exiter ds ce fichier une unique variable n''ayant
+;       qu''une dimension et etant la dimension temporelle. cette
+;       variable sera prise comme axe des temps. Rq: si plusieurs
+;       variables verifient ces criteres on considere la premiere
+;       variable
+;       5) Cette variable axe des temps doit contenir l''attribut
+;       'units'qui doit etre ecrit suivant la syntaxe:
+;               "seconds since 0001-01-01 00:00:00" 
+;               "hours since 0001-01-01 00:00:00" 
+;               "days since 1979-01-01 00:59:59" 
+;               "months since 1979-01-01 00:59:59" 
+;               "years since 1979-01-01 00:59:59" 
+;
+; je crois que c''est tout!
+;
+;
+;------------------------------------------------------------
+FUNCTION scanfile, nomficher, IODIRECTORY = iodirectory
+@common
+;------------------------------------------------------------
+; bidouille pour utiliser les mots cles (on passe par des variables
+; declarees ds un common)
+;------------------------------------------------------------
+   res = -1
+;------------------------------------------------------------
+; choix du nom du fichier
+;------------------------------------------------------------
+   if NOT keyword_set(iodirectory) then iodirectory = iodir
+   nom = isafile(filename = nomficher, IODIRECTORY = iodirectory)
+;------------------------------------------------------------
+; ouverture du fichier nom
+;------------------------------------------------------------
+   cdfid=ncdf_open(nom)
+;------------------------------------------------------------
+; que contient le fichier??
+;------------------------------------------------------------
+   contient=ncdf_inquire(cdfid)
+   vargrid = strupcase(strmid(nom, strlen(nom)-9))
+   if vargrid EQ 'GRID.T.NC' OR vargrid EQ 'GRID.U.NC' $
+    OR vargrid EQ 'GRID.V.NC' OR vargrid EQ 'GRID.F.NC' $
+    OR vargrid eq 'GRID.W.NC' $
+    OR vargrid EQ 'GRID_T.NC' OR vargrid EQ 'GRID_U.NC' $
+    OR vargrid EQ 'GRID_V.NC' OR vargrid EQ 'GRID_F.NC' $
+    OR vargrid eq 'GRID_W.NC' then $
+    vargrid = strupcase(strmid(nom, strlen(nom)-4, 1)) ELSE vargrid='T'
+;------------------------------------------------------------
+; nom des differentes variables
+;------------------------------------------------------------
+; on ne garde les noms de variable uniquement si cette variable
+; contient au moins les dimensions qui doivent etre appelles x et y
+; et la dimension infinie
+   nomdim   =strarr(contient.ndims)
+   for dimiq=0,contient.ndims-1 do begin
+      ncdf_diminq,cdfid,dimiq,name,value ; nom et valeur de la dimension
+      nomdim[dimiq]=strlowcase(name)
+   ENDFOR
+   indexdimx = where(nomdim EQ 'x' OR nomdim EQ 'lon' OR nomdim EQ 'longitude')
+   indexdimx = indexdimx[0]
+   if indexdimx EQ -1 then begin
+      print, 'one of the dimensions must have the name: ''x'' or ''lon'' or ''longitude'''
+      stop
+   endif
+   indexdimy = where(nomdim EQ 'y' OR nomdim EQ 'lat' OR nomdim EQ 'latitude')
+   indexdimy = indexdimy[0]
+   if indexdimy EQ -1 then begin
+      print, 'one of the dimensions must have the name: ''y'' or ''lat'' or ''latitude'''
+      stop
+   endif
+;
+   namevar = strarr(contient.nvars)
+   for varid=0,contient.nvars-1 do begin
+      varcontient=ncdf_varinq(cdfid,varid) ; que contient la variable
+      if (where(varcontient.dim EQ indexdimx))[0] NE -1 AND $
+       (where(varcontient.dim EQ indexdimy))[0] NE -1 AND $
+       (where(varcontient.dim EQ contient.recdim))[0] NE -1 THEN namevar[varid]=varcontient.name 
+   ENDFOR
+   namevar = namevar[where(namevar NE '')]
+   listgrid = replicate(vargrid,  n_elements(namevar))
+;------------------------------------------------------------
+; on recupere l''axe des temps
+;------------------------------------------------------------
+; on recupere le nom de la variable contenant l''axe des temps
+   varid = 0
+   repeat BEGIN                 ; tant que l''on a pas trouve une variable qui n''a qu''
+                                ; une dimension: la dimension infinie
+      varcontient=ncdf_varinq(cdfid,varid) ; que contient la variable
+      varid = varid+1
+   endrep until n_elements(varcontient.dim) EQ 1 AND varcontient.dim[0] EQ contient.recdim
+; on lit l''axe des temps
+   varid = varid-1
+   ncdf_varget, cdfid, varid, time
+   time = long(time)
+   ncdf_attget,cdfid,varid,'units',value
+; time_counter:units = "seconds since 0001-01-01 00:00:00" ;
+; time_counter:units = "hours since 0001-01-01 00:00:00" ;
+; time_counter:units = "days since 1979-01-01 00:00:00" ;
+; time_counter:units = "months since 1979-01-01 00:00:00" ;
+; time_counter:units = "years since 1979-01-01 00:00:00" ;
+   value = strtrim(strcompress(string(value)), 2)
+   mots = str_sep(value, ' ')
+   unite = mots[0]
+   debut = str_sep(mots[2], '-')
+;
+;
+; ATTENTION il faut recuperer l''atribut calendar et ajuster time en
+; consequense...
+;
+;
+; on passe time en jour julien d''idl 
+; on suppose qu''on utilise le vrai calendrier.
+;
+   case strlowcase(unite) of
+      'seconds':time = julday(debut[1], debut[2], debut[0])+time/(long(24)*3600)
+      'hours':time = julday(debut[1], debut[2], debut[0])+time/(long(24))
+      'days':time = julday(debut[1], debut[2], debut[0])+time
+      'months':BEGIN 
+         for t = 0, n_elements(time)-1  do begin
+            time[t] = julday(debut[1]+time[t], debut[2], debut[0])
+         endfor
+      END
+      'years':BEGIN
+         for t = 0, n_elements(time)-1  do begin
+            time[t] = julday(debut[1], debut[2], debut[0]+time[t])
+         endfor
+      END
+   ENDCASE
+;------------------------------------------------------------
+   return, {filename:nom, time_counter:time, listvar:namevar, listgrid:strupcase(listgrid)}
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/selectfile.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/selectfile.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/selectfile.pro	(revision 5)
@@ -0,0 +1,97 @@
+;*********************************************************************
+PRO selectfile_event, event
+;
+@common
+;
+   widget_control, event.id,  get_uvalue = eventuvalue
+   IF chkstru(eventuvalue,'name') EQ 0 THEN return
+   case eventuvalue.name of
+      'Global Cancel':BEGIN 
+         widget_control, event.handler, get_uvalue = messenger
+         *messenger = -1
+         widget_control,event.handler,/destroy
+      END
+      'datafilename':BEGIN
+         widget_control, event.id, get_value = filename
+         filename = isafile(filename = filename[0])
+         if size(filename, /type) NE 7 then return
+         widget_control, event.id, set_value = filename
+      END
+      'browse datafilename':BEGIN
+         filename = isafile(iodir = iodir)
+         if size(filename, /type) NE 7 then return
+         widget_control, widget_info(event.handler, find_by_uname = 'datafilename') $
+          , set_value = filename
+      END
+      'meshfilename':BEGIN
+         widget_control, event.id, get_value = filename
+         filename = isafile(filename = filename[0])
+         if size(filename, /type) NE 7 then return
+         widget_control, event.id, set_value = filename
+      END
+      'browse meshfilename':BEGIN
+         filename = isafile(iodir = homedir)
+         if size(filename, /type) NE 7 then return
+         widget_control, widget_info(event.handler, find_by_uname = 'meshfilename') $
+          , set_value = filename
+      END
+      'Lets Go!':BEGIN
+         widget_control, widget_info(event.handler, find_by_uname = 'datafilename') $
+          , get_value = datafilename & datafilename = datafilename[0]
+         widget_control, widget_info(event.handler, find_by_uname = 'meshfilename') $
+          , get_value = meshfilename & meshfilename = meshfilename[0]
+         widget_control, event.handler, get_uvalue = messenger
+         *messenger = create_struct('datafilename', datafilename, 'meshfilename', meshfilename)
+         widget_control,event.handler,/destroy
+      END
+
+   endcase
+   return
+end
+;*********************************************************************
+FUNCTION selectfile
+;
+@common
+;------------------------------------------------------------
+;
+; pour recuperer les reponses possees lors de l''utilisation de ce
+; widget on cree un pointeur que l''on place dans la uvalue. Comme ca
+; une fois que le widget est detruit dans la procedure ...event.pro,
+; la variable surlaquelle pointait le pointeur (contenue ds la uvalue
+; du widget) n''est pas detruite est on peut recuperer le resultat!
+;
+   messenger = ptr_new(/allocate_heap)
+   base=widget_base(/COLUMN, title = 'selectfile', /align_center, uvalue = messenger, _EXTRA = ex)
+;
+   nothing = widget_button(base, value = 'Cancel', uvalue = {name:'Global Cancel'})
+;
+   basea=widget_base(base, /row, /align_center)
+   nothing = widget_label(basea, value = 'Data file name: ')
+   nothing = widget_text(basea, value = '', uvalue = {name:'datafilename'}, uname = 'datafilename', xsize = 45, /EDITABLE)
+   nothing = widget_button(basea, value = 'Browse', uvalue = {name:'browse datafilename'})
+;
+   baseb=widget_base(base, /row, /align_center)
+   nothing = widget_label(baseb, value = 'Mesh file or IDL batch file: ')
+   nothing = widget_text(baseb, value = '', uvalue = {name:'meshfilename'}, uname = 'meshfilename', xsize = 45, /EDITABLE)
+   nothing = widget_button(baseb, value = 'Browse', uvalue = {name:'browse meshfilename'})
+;
+   nothing = widget_button(base, value = 'Lets Go!', uvalue = {name:'Lets Go!'})
+
+;------------------------------------------------------------
+   widget_control,base,/realize
+   xmanager,'selectfile', base,event_handler = 'selectfile_event', no_block = 0
+;
+;
+   res = *messenger
+   ptr_free, messenger
+   if size(res, /type) NE 8 then return,  -1
+;
+   res1 = whichgrid(res.meshfilename, iodir = iodir)
+   if size(res1, /type) NE 8 then return,  -1
+   res2 = whichread()
+   if size(res2, /type) NE 8 then return,  -1
+   res3 = scanfile(res.datafilename, iodir = iodir)
+   if size(res3, /type) NE 8 then return,  -1
+
+   return, {fileparameters:res3, readparameters:res2, meshparameters:res1} 
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/singleclickaction.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/singleclickaction.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/singleclickaction.pro	(revision 5)
@@ -0,0 +1,4 @@
+PRO singleclickaction, event, quelclick
+
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/tracecadre.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/tracecadre.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/tracecadre.pro	(revision 5)
@@ -0,0 +1,28 @@
+PRO tracecadre, petit, out = out, erase = erase, fill = fill
+;------------------------------------------------------------
+; determination de la colonne et de la ligne correspondant au petit en
+; entree
+   numdessin = petit[2]-1
+   numligne = numdessin/petit[0]
+   numcolonne = numdessin-numligne*petit[0]
+; determination de poscadre
+   largeurcolonne = 1./petit[0]
+   largeurligne = 1./petit[1]
+   cadre = [numcolonne*largeurcolonne,1.-((numligne+1)*largeurligne) $
+            , (numcolonne+1)*largeurcolonne, 1.-(numligne*largeurligne)]
+   decale = 0.001
+   cadre = cadre+[decale,decale,-decale,-decale]
+   reinitplt
+   !p.position = [0., 0., 1., 1.]
+   IF keyword_set(fill) then begin
+      polyfill, [cadre[0], cadre[2], cadre[2], cadre[0], cadre[0]] $
+       , [cadre[1], cadre[1], cadre[3], cadre[3], cadre[1]], color = 255, /normal
+   ENDIF ELSE BEGIN
+      plot, [cadre[0], cadre[2], cadre[2], cadre[0], cadre[0]] $
+       , [cadre[1], cadre[1], cadre[3], cadre[3], cadre[1]] $
+       , xrange = [0, 1], yrange = [0, 1], linestyle = 2*keyword_set(out) $
+       , /noerase, /normal, thick = 2, color = 0+255*keyword_set(erase)
+   ENDELSE
+;------------------------------------------------------------
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/updatewidget.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/updatewidget.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/updatewidget.pro	(revision 5)
@@ -0,0 +1,79 @@
+PRO updatewidget, base, NOBOITE = noboite, NODATES = nodates, NOTYPE = notype
+;----------------------------------------------------------------------
+   widget_control,base, get_uvalue = top_uvalue
+   petitin = extractatt(top_uvalue, 'petitin')
+   numdessinin = petitin[2]-1
+;
+;----------------------------------------------------------------------
+   widget_control, base, update = 0
+;--------------
+; date1 et date2
+;--------------
+   if keyword_set(nodates) then begin
+      date1 = 0
+      date2 = 0 
+   ENDIF ELSE BEGIN 
+      dates = (extractatt(top_uvalue, 'dates'))[*, numdessinin]
+      date1 = dates[0] & date2 = dates[1]
+   ENDELSE
+;--------------
+; domaine
+;--------------
+   boite = (extractatt(top_uvalue, 'domaines'))[*, numdessinin]
+   if total(boite) EQ 0 then boite = -1
+   if keyword_set(noboite) then boite = 0
+;--------------
+; champ: filename & nomvar
+;--------------
+   champ = (extractatt(top_uvalue,  'champs'))[*, numdessinin]
+   filename = champ[0] & nomvar = champ[1]
+;
+   if filename NE '' OR nomvar NE '' THEN BEGIN
+      changefile, base, filename, fieldname = nomvar, BOITE = boite, DATE1 = date1, DATE2 = date2
+   ENDIF ELSE BEGIN
+      if date1 NE 0 then begin
+         date1id = widget_info(base, find_by_uname = 'calendar1')
+         widget_control, date1id, set_value = date1
+      endif
+      if date2 NE 0 then begin
+         date2id = widget_info(base, find_by_uname = 'calendar2')
+         widget_control, date2id, set_value = date2
+      endif
+      if keyword_set(boite) then BEGIN 
+         domainid = widget_info(base, find_by_uname = 'domain')
+         widget_control, domainid, set_value = boite
+      endif
+   ENDELSE
+;--------------
+; exextra
+;--------------
+   if n_elements(*((extractatt(top_uvalue, 'exextra'))[numdessinin])) NE 0 then begin
+      exextra = *((extractatt(top_uvalue, 'exextra'))[numdessinin])
+      specifieid = widget_info(base,find_by_uname = 'specifie')
+      widget_control, specifieid, set_value = exextra
+   endif
+;--------------
+; nomexp
+;--------------
+   nomexp = (extractatt(top_uvalue,  'prefixes'))[numdessinin]
+   if nomexp NE '' then begin
+      nomexpid = widget_info(base, find_by_uname = 'nom_exp')
+      widget_control, nomexpid, set_value = nomexp
+   endif
+;--------------
+; graphtype
+;--------------   
+   if NOT keyword_set(notype) then BEGIN
+      graphtype = (extractatt(top_uvalue, 'types'))[numdessinin]
+      if graphtype NE '' then begin
+         actionid = widget_info(base,find_by_uname = 'action')
+         widget_control, actionid, get_uvalue = action_uvalue
+         widget_control, actionid, set_droplist_select = (where(action_uvalue.choix EQ graphtype))[0]
+      endif
+   endif
+;--------------
+   widget_control, base, update = 1
+;--------------
+;----------------------------------------------------------------------
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/widgetdessine.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/widgetdessine.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/widgetdessine.pro	(revision 5)
@@ -0,0 +1,122 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:widgetdessine
+;
+; PURPOSE: c'est la procedure qui lance le dessin. Si on ne le lui
+; donne pas de commande, elle appelle construitcommande pour savoir
+; quoi tracer.
+;
+; CATEGORY:
+;
+; CALLING SEQUENCE:widgetdessine, base
+; 
+; INPUTS:base: l''id du widget ou appliquer le dessin
+;
+; KEYWORD PARAMETERS:
+;       COMMANDE: un string du style: read_data('sst'...),....
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+
+PRO widgetdessine, base, COMMANDE = commande, FORPLTH = forplth, FORPLTZ = forpltz, FORPLTT = forpltt, _extra = ex
+@common
+; on recupere la uvalue de base
+   widget_control,base, get_uvalue = top_uvalue
+; on determine quelle procedure on va etre appeler pour faire le dessin
+   procedure = top_uvalue.name
+   if keyword_set(forplth) then procedure = 'plt'
+   if keyword_set(forpltz) then procedure = 'pltz'
+   if keyword_set(forpltt) then procedure = 'pltt'
+; print, '*****************'
+; help,  top_uvalue, /struct
+; help,  top_uvalue.exextra, /struct
+   if NOT keyword_set(commande) then $
+    commande = construitcommande(base, FORPLTH = forplt, FORPLTZ = forpltz, FORPLTT = forpltt, _extra = ex)
+   widget_control,base, get_uvalue = top_uvalue
+; print, '*****************'
+; help,  top_uvalue, /struct
+; print, '***..........****'
+;  help,  top_uvalue.exextra, /struct
+;  help,  top_uvalue.extra, /struct
+; print, '-*-*-*-*-*-*-*-*-*'
+; print, commande
+; help,mixstru(top_uvalue.exextra,top_uvalue.extra), /struct
+;
+; on recuperel''id de la fenetre graphique associee au widget d''id base
+   widget_control,widget_info(base,find_by_uname = 'graph'),get_value=win
+; on la selectionne (c''est a elle que sera passe toutes les commandes
+; concernant une fenetre)
+   wset, win
+   erase, 255                       ; on netoie la fenetre
+; on s''assure que si on travaille avec un ecran codant les couleurs
+; sur 24 bits la couleur de fond specifiee!p.background est bien
+; appliquee
+   if !d.n_colors gt 256 then begin
+      device, decomposed=1
+      !p.background='ffffff'x
+      plot,[0],[0]
+      device, decomposed=0
+   ENDIF
+;
+; on execute la commande pour faire le dessin
+;
+   IF chkstru(top_uvalue, 'grille') THEN anciennegrille = top_uvalue.grille $
+   ELSE anciennegrille = 'T'
+   rien = execute(procedure+', '+Commande)
+;   if NOT rien then stop
+
+;
+; on va accualiser ;a stuture contenue ds la uvalue de base
+;
+; on doit determiner le type de dessin et eventuellement la nouvelle boite.
+   case procedure OF
+      'plt':type = 'xy'
+      'pltt':BEGIN
+         case 1 of
+            strpos(commande, '''xt''') NE -1:type = 'xt'
+            strpos(commande, '''yt''') NE -1:type = 'yt'
+            ELSE:type = 'unknow !'
+         endcase
+      END
+      'pltz':BEGIN 
+         lastboite = rstrpos(commande, 'boite=')
+         ouvrepos = strpos(commande, '[', lastboite+1)
+         boite = strmid(commande,ouvrepos+1,strpos(commande, ']', lastboite+1)-ouvrepos-1)
+         boite = str_sep(boite, ',') & boite = long(boite)
+         if boite[1]-boite[0] LE boite[3]-boite[2] then type = 'yz' ELSE type = 'xz' 
+      END
+   ENDCASE
+;
+; print, '&&&&&&&&&&&&&&&&&&&&&&&&'
+; help,  top_uvalue, /struct
+; help,   mixstru({name:procedure, commande:commande, penv:!p, xenv:!x, yenv:!y, type:type}, top_uvalue), /struct
+;
+;
+;
+   widget_control, base, set_uvalue = mixstru({name:procedure, commande:commande, penv:!p, xenv:!x, yenv:!y, type:type, grille:vargrid}, top_uvalue)
+; on change d''axe vertical ?
+   if vargrid NE anciennegrille then begin
+      widget_control, widget_info(base,  find_by_uname = 'domain'), get_value = value
+      widget_control, widget_info(base,  find_by_uname = 'domain'), set_value = value
+   endif
+
+; help,  top_uvalue.extra, /struct
+
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/xcreateanim.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/xcreateanim.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/xcreateanim.pro	(revision 5)
@@ -0,0 +1,201 @@
+pro xcreateanim_event, event 
+@common
+; on recupere les aguments contenus ds le widget
+   if tag_names(event, /structure_name) NE 'WIDGET_BUTTON' then return
+   widget_control, event.id, get_uvalue = uval
+   if n_elements(uval) EQ 0 then return
+   if uval EQ 'cancel' then begin
+      widget_control, event.top, /destroy
+      return
+   ENDIF
+; on va ecrire l''animation!
+;
+   widget_control, event.top, get_uvalue = local_uvalue
+   widget_control, local_uvalue.parent, get_uvalue = top_uvalue
+;
+   calendar = (*(extractatt(top_uvalue, 'fileparameters'))[local_uvalue.indexfile]).time_counter
+;
+   widget_control, widget_info(event.top, find_by_uname = 'Filename') $
+    , get_value = nomfic & nomfic = nomfic[0]
+;
+   widget_control, widget_info(event.top, find_by_uname = 'directorie') $
+    , get_value = animdir & animdir = animdir[0]
+;
+   widget_control, widget_info(event.top, find_by_uname = 'debut') $
+    , get_value = vdate1
+   index1 = where(calendar eq juldate(vdate1, /vraidate)) & index1 = index1[0] 
+   if index1 EQ -1 then return
+;
+   widget_control, widget_info(event.handler, find_by_uname = 'fin') $
+    , get_value = vdate2
+   index2 = where(calendar eq juldate(vdate2, /vraidate)) & index2 = index2[0] 
+   if index2 EQ -1 OR index2 LE index1 then return
+; on detruit le widget avant de creer le fichier .ps
+   widget_control, event.top, /destroy 
+; test pour savoir quel type des calendrier on a
+   caldat, calendar, m, d
+   if total(d EQ 15) EQ n_elements(d) then mensuel = 1 ELSE mensuel = 0
+   if total(d EQ 1) EQ n_elements(d) AND total(m EQ 6) EQ n_elements(m) $
+    then annuel = 1 ELSE annuel = 0
+;
+; creation de la routine qui nous serviera pour faire le dessin
+;
+; on recupere la liste des instructions
+   globalcommand = extractatt(top_uvalue, 'globalcommand')
+; on complete par le premiere et les dernieres lignes du programme
+   globalcommand = ['pro xxx2ps, NOERASE = noerase, POSTSCRIPT = postscript, DATE1IN = date1in, DATE2IN = date2in' $
+                    , globalcommand $
+                    , 'return',  'end']
+   putfile, isadirectory(io = homedir, title = 'Bad definition of homedir')+'xxx2ps.pro', globalcommand ; on l''ecrit
+   resolve_routine, 'xxx2ps' ; on le compile
+;
+;--------creation du fichier----------
+;
+;  recupere le nombre d'octets surlequel on code la palette
+   device, get_visual_depth = depth
+; taille de l''image (en nombre de pixel:
+   xsize = !d.x_size
+   ysize = !d.y_size
+;
+; on verifie que le nom du fichier termine bien par .gif
+   if strpos(nomfic, '.gif') EQ -1 then nomfic = nomfic+'.gif'
+
+   current_window = !d.window
+   window, /free, /pixmap, xsize=xsize, ysize=ysize
+
+
+; indication du numero de l''image que l''on est en train de creer
+   base = widget_base()
+   sliderid = widget_slider(base, minimum = 1, maximum = index2-index1+1, value = 1 $
+                            , title = 'image que l''on est en train de creer')
+   widget_control,base,/realize
+;
+; commencement du fichier gif. ecriture d''une image vide 
+   date = vairdate(calendar[index1], mensuel = mensuel, annuel= annuel)
+   xxx2ps, /noerase, date1in = date, date2in = date
+;
+;
+   image = tvrd(true = depth GT 8)
+;- If an 8-bit image was read, reduce the number of colors
+   if depth le 8 then begin
+      tvlct, red, green, blue, /get
+      reduce_colors, image, index
+      red = red[index]
+      green = green[index]
+      blue = blue[index]
+   endif            
+;
+   if depth gt 8 then $
+;- Convert 24-bit image to 8-bit
+   image = color_quan(image, 1, red, green, blue, colors=256, get_translation = translation, /map_all)
+;
+;
+   write_gif,animdir+nomfic, image, red, green, blue, /multiple
+   wdelete, !d.window
+;
+; boucle de creation et d''ecriture ds le fichier.
+;
+   for ind = index1+1, index2 do BEGIN
+;
+      widget_control, sliderid, set_value = ind-index1+1 ; on bouge le slider
+;
+      window, /free, /pixmap, xsize=xsize, ysize=ysize
+      date = vairdate(calendar[ind], mensuel = mensuel, annuel= annuel)
+      xxx2ps, /noerase, date1 = date, date2 = date
+;      
+      image = tvrd(true = depth GT 8)
+;
+      if depth gt 8 then $
+      image = color_quan(image, 1, aaa, bbb, ccc, colors=256, translation = translation) ;
+;
+      write_gif,animdir+nomfic,image,red, green, blue, /multiple
+      wdelete, !d.window
+   ENDFOR
+; on met une derniere image blanche
+      window, /free, /pixmap, xsize=xsize, ysize=ysize
+      reinitplt
+      plot,  [0],  [0], /nodata
+      image = tvrd(true = depth GT 8)
+;
+      if depth gt 8 then $
+      image = color_quan(image, 1, aaa, bbb, ccc, colors=256, translation = translation) ;
+;
+      write_gif,animdir+nomfic,image,red, green, blue, /multiple
+      wdelete, !d.window
+; fermeture du fichier
+   write_gif,animdir+nomfic,/close 
+   widget_control, base, /destroy 
+; rebascule en mode "normal"
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+;
+   wset, current_window
+
+; si on est sous x on essaie de lancer xanim...
+
+   if thisOS NE 'MAC' AND thisOS NE 'WIN' then begin
+      spawn, 'which xanim',result
+      if strpos(result[0],'xanim') EQ strlen(result[0])-5 then spawn, 'xanim '+animdir+nomfic+' &'
+   endif
+;
+   
+   return
+end
+;----------------------------------------------------------------
+PRO xcreateanim, parent
+@common
+;
+   widget_control, parent, get_uvalue = top_uvalue
+;
+; on va s''assurer que toutes les procedures de sont pas pltt
+;
+   procedures = extractatt(top_uvalue, 'nameprocedures')
+   if total(procedures EQ 'pltt') NE 0 then begin
+      nothing = report('Certains des plots ont un axe se rapportant au temps. !C Animation impossible!', /error)
+      return
+   ENDIF
+;
+; on va s''assurer que toutes les figures ont le meme calendrier 
+;
+   filelist = extractatt(top_uvalue,  'filelist')
+   filenames = (extractatt(top_uvalue,  'champs'))[0, *]
+   filenames = reform(filenames)
+   filenames = filenames[uniq(filenames, sort(filenames))]
+   if strtrim(filenames[0], 1) EQ '' then filenames = filenames[1:n_elements(filenames)-1]
+   indexfile = (where(filelist EQ filenames[0]))[0]
+   calendar = (*(extractatt(top_uvalue, 'fileparameters'))[indexfile]).time_counter  
+   if n_elements(filenames) GT 1 then begin
+      for i = 1, n_elements(filenames)-1 do begin
+         indexfilebis = (where(filelist EQ filenames[i]))[0]
+         calendarbis = (*(extractatt(top_uvalue, 'fileparameters'))[indexfilebis]).time_counter
+         if n_elements(calendarbis) NE n_elements(calendar)  then begin
+            nothing = report('Les diffrents plots n''utilisent pas le meme calendrier. !C Animation impossible!', /error)
+            return
+         ENDIF
+         if total(calendar NE calendarbis) NE 0 then begin
+            nothing = report('Les diffrents plots n''utilisent pas le meme calendrier. !C Animation impossible!', /error)
+            return
+         endif
+      endfor
+   endif
+;
+; c''est possible de faire une animation  
+;
+   base = widget_base(/column, title = 'creation d''une animation', uvalue = {parent:parent, indexfile:indexfile})   
+   rien = widget_label(base, value = 'Quel nom donner a l''animation')
+   rien = widget_text(base,value='anim_idl.gif', uname='Filename', /editable)
+   rien = widget_label(base, value = 'repertoire ou mettre le fichier')
+   if n_elements(animdir) EQ 0 then cd, current = animdir
+   rien = widget_text(base,value=animdir, uname='directorie', /editable)
+   rien = widget_label(base, value = 'Debut de l''animation')
+   rien = cw_calendar(base, calendar, uname = 'debut', uvalue = {name:'calendar'}, /frame)
+   rien = widget_label(base, value = 'Fin de l''animation')
+   rien = cw_calendar(base, calendar, calendar[n_elements(calendar)-1] $
+                      , uname = 'fin', uvalue = {name:'calendar'}, /frame)
+   rien = widget_button(base,value='OK', uvalue = 'ok')
+   rien = widget_button(base,value='Cancel', uvalue = 'cancel')
+;
+   widget_control,base,/realize
+   xmanager,'xcreateanim', base, /no_block
+   
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/xspecifiedessin.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/xspecifiedessin.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/xspecifiedessin.pro	(revision 5)
@@ -0,0 +1,140 @@
+PRO xspecifiedessin_event, event 
+   widget_control, event.top, get_uvalue = topid
+   widget_control, topid, get_uvalue = top_uvalue
+   widget_control, event.id, get_uvalue = uval
+   if n_elements(uval) EQ 0 then return
+   case uval of
+      'cancel':widget_control, event.top, /destroy
+      'default':BEGIN 
+         exextra = definedefaultextra(top_uvalue.nomvariable)
+         widget_control, widget_info(event.top,find_by_uname='min'), set_value = strtrim(exextra.min, 1)
+         widget_control, widget_info(event.top,find_by_uname='max'), set_value = strtrim(exextra.max, 1)
+         widget_control, widget_info(event.top,find_by_uname='int'), set_value = strtrim(exextra.inter, 1)
+         widget_control, widget_info(event.top,find_by_uname='palnum'), set_value = strtrim(exextra.lct, 1)
+         widget_control, widget_info(event.top,find_by_uname='autres'), set_value = '' 
+      END
+      'palcol':BEGIN 
+         ind = fix(strmid(event.value, 0, strpos(event.value, '-')))
+         widget_control, widget_info(event.top,find_by_uname='palnum'), set_value = strtrim(ind, 1)
+      END
+      'pzoom':BEGIN 
+         widget_control, widget_info(event.top,find_by_uname='pzoom'), get_value = pzoom
+         pzoom = long(pzoom[0])
+         pmaxid = widget_info(event.top,find_by_uname='pmax')
+         widget_control, pmaxid, get_value = pmax
+         pmax = long(pmax[0])
+         if pzoom GT pmax then widget_control, pmaxid, set_value = strtrim(pzoom, 1)
+      END
+      'ok':BEGIN 
+         widget_control, widget_info(event.top,find_by_uname='min'), get_value = min
+         min = float(min[0])
+         widget_control, widget_info(event.top,find_by_uname='max'), get_value = max
+         max = float(max[0])
+         widget_control, widget_info(event.top,find_by_uname='int'), get_value = int
+         int = float(int[0])
+         widget_control, widget_info(event.top,find_by_uname='palnum'), get_value = palnum
+         palnum = long(palnum[0])
+         widget_control, widget_info(event.top,find_by_uname='autres'), get_value = autres
+         autres = autres[0]
+;
+         exextra = {min:min, max:max, inter:int, lct:palnum}
+         if autres NE '' then rien = execute('exextra = get_extra('+autres+', _extra = exextra)')
+;
+; si on fait un pltz
+;
+         if top_uvalue.name EQ 'pltz' then begin
+            widget_control, widget_info(event.top,find_by_uname='pzoom'), get_value = pzoom
+            pzoom = long(pzoom[0])
+            pmaxid = widget_info(event.top,find_by_uname='pmax')
+            widget_control, pmaxid, get_value = pmax
+            pmax = long(pmax[0])
+            if pzoom GT pmax then pmax = pzoom
+; si pmax n''est pas la valeur par defaut alors il faut changer la
+; boite utiliseee ds le pltz
+            if pmax NE 200 then BEGIN
+               commande = top_uvalue.commande
+; on recupere la fin de la boite
+               pos2 = strpos(commande, ']', rstrpos(commande, 'boite'))
+; on change la derniere valeur de la boite
+               pos1 = rstrpos(commande, ',', pos2)
+               top_uvalue.commande = strmid(commande, 0, pos1+1)+strtrim(pmax, 1)+strmid(commande, pos2)
+;               ENDELSE 
+            ENDIF 
+            exextra = mixstru({profmax:pmax, zoom: pzoom}, exextra)
+         ENDIF 
+         widget_control, topid, set_uvalue = mixstru({exextra:exextra}, top_uvalue)
+         widget_control, event.top, /destroy
+         widgetdessine, topid, commande = top_uvalue.commande
+      END
+      ELSE:
+   endcase
+
+   return
+end
+;----------------------------------------------------------------
+PRO xspecifiedessin, parent, _extra = ex
+   widget_control, parent, get_uvalue = top_uvalue
+   base = widget_base(/column, title = 'Specification du Dessin', uvalue = parent)
+; base1 pour specifier le min, le max et l''intervalle
+   base1 = widget_base(base, /row, /frame)
+   rien = widget_label(base1, value = 'Min')
+   rien = widget_text(base1, value = strtrim(top_uvalue.exextra.min, 1), /editable, xsize = 5, uname = 'min', uvalue = 'min')
+   rien = widget_label(base1, value = 'Max')
+   rien = widget_text(base1, value = strtrim(top_uvalue.exextra.max, 1), /editable, xsize = 5, uname = 'max', uvalue = 'max')
+   rien = widget_label(base1, value = 'Int')
+   rien = widget_text(base1, value = strtrim(top_uvalue.exextra.inter, 1), /editable, xsize = 5, uname = 'int', uvalue = 'int')
+; base2 por specifier la palette de couleur (soit par numero soit ds
+; un menu deroulant)
+   base2 = widget_base(base, /row, /frame)
+   rien = widget_label(base2, value = 'Pal Number')
+   rien = widget_text(base2, value = strtrim(top_uvalue.exextra.lct, 1), /editable, xsize = 3, uname = 'palnum', uvalue = 'palnum')
+   lct,  get_name = nomcouleur
+   nbrligne = 30
+   nbrlist = n_elements(nomcouleur)/nbrligne
+   nomcouleur = strtrim(sindgen(n_elements(nomcouleur)), 1)+'- '+nomcouleur
+   nomcouleur = '0\'+nomcouleur
+   nomcouleur = ['1\palette de couleur', nomcouleur]
+   if nbrlist GT 1 then for i = 1,nbrlist do $
+    nomcouleur = [nomcouleur[0:nbrligne*i-1+i], '1\ ', nomcouleur[nbrligne*i+i:n_elements(nomcouleur)-1]]
+   rien = cw_pdmenu(base2,nomcouleur, /RETURN_NAME , uvalue = 'palcol', uname = 'palcol')
+; si on est en train de faire un graph pour pltz on raoute un widget
+; pour specifier la profmax et la profzoom
+   if top_uvalue.name EQ 'pltz' then BEGIN
+      base4pltz = widget_base(base, /row, /frame)
+      rien = widget_label(base4pltz, value = 'Prof max')
+; il faut retrouver la prof max de la boite utiliseee pour faire le pltz
+      posboite = strpos(top_uvalue.commande, '[', rstrpos(top_uvalue.commande, 'boite'))
+      boite = strmid(top_uvalue.commande, posboite $
+                     , strpos(top_uvalue.commande, ']', posboite )-posboite+1)
+      boite = str_sep(boite, ',')
+      if n_elements(boite) EQ 4 then pmax = 200 ELSE pmax = long(boite[n_elements(boite)-1])
+      pmax = strtrim(pmax, 1)
+; on declare le widget:
+      rien = widget_text(base4pltz, value = pmax, /editable, xsize = 4, uname = 'pmax', uvalue = 'pmax')
+      rien = widget_label(base4pltz, value = 'Prof Zoom')
+      if chkstru(top_uvalue.exextra, 'zoom') then pzoom = top_uvalue.exextra.zoom[0] $
+      ELSE pzoom = pmax
+      rien = widget_text(base4pltz, value = strtrim(pzoom, 1), /editable, xsize = 4, uname = 'pzoom', uvalue = 'pzoom')
+
+   endif
+   
+; baseavantfin pour passer tous les mots cles possibles...
+; widget text contennant les autres mots cles passe ds top_uvalue.exextra
+; en reste-t-il? si oui, il faut les mettres sous forme de string
+   restekeywd = extractstru(top_uvalue.exextra, ['min', 'max', 'inter', 'lct', 'zoom', 'profmax'])
+   if size(restekeywd, /type) EQ 8 then autres = strkeywd(restekeywd) ELSE autres = ''
+   baseavantfin = widget_base(base, /row, /frame)
+   rien = widget_label(baseavantfin, value = 'Autres mots cles')
+   rien = widget_text(baseavantfin, value = autres, /editable, uname = 'autres', uvalue = 'autres')
+; basefin pour en finir, trois boutons: Default/OK/Cancel
+   basefin = widget_base(base, /row, /frame, /align_center)
+   rien = widget_button(basefin,value='Default', uvalue = 'default')
+   rien = widget_button(basefin,value='OK', uvalue = 'ok')
+   rien = widget_button(basefin,value='Cancel', uvalue = 'cancel')
+
+;
+   widget_control,base,/realize
+   xmanager,'xspecifiedessin',base, /no_block
+;
+   return
+end
Index: tags/start/WIDGET/AUTOUR_de_XXX/xxxmenubar.pro
===================================================================
--- tags/start/WIDGET/AUTOUR_de_XXX/xxxmenubar.pro	(revision 5)
+++ tags/start/WIDGET/AUTOUR_de_XXX/xxxmenubar.pro	(revision 5)
@@ -0,0 +1,361 @@
+;------------------------------------------------
+PRO xxxmenubar_event, event
+@common
+
+
+   case event.value of
+      'Open' :begin 
+         newfile = selectfile()
+         if size(newfile, /type) NE 8 then return
+         widget_control, event.top, /hourglass
+         widget_control, event.top, update = 0
+         widget_control, event.top, get_uvalue = top_uvalue
+; on s''occupe de filelist
+         filelist = extractatt(top_uvalue, 'filelist')
+         filelist = [filelist, newfile.fileparameters.filename]
+         currentfile = n_elements(filelist)-1
+; on update le widget
+         filelistid = widget_info(event.top, find_by_uname = 'filelist')
+         widget_control, filelistid, set_value = filelist
+         widget_control, filelistid, set_list_select = currentfile
+; on update les elements filelist et currentfile de la top_uvalue
+         *top_uvalue[1, findline(top_uvalue, 'filelist')] = filelist
+         oldfile = *top_uvalue[1, findline(top_uvalue, 'currentfile')]
+         *top_uvalue[1, findline(top_uvalue, 'currentfile')] = currentfile
+; on s''occupe du nom de la variable
+         champid = widget_info(event.top, find_by_uname = 'champ')
+; quel etait le champ selectionne ? on le reselectionne ?
+         oldlistvar = (*(extractatt(top_uvalue, 'fileparameters'))[oldfile]).listvar
+         fieldname = oldlistvar[widget_info(champid,/droplist_select)]
+         index = where(newfile.fileparameters.listvar EQ fieldname) & index = 0>index[0]
+         widget_control, champid, set_value = newfile.fileparameters.listvar
+         widget_control, champid, set_droplist_select = index
+; on s''occupe du calendrier
+         date1id = widget_info(event.top, find_by_uname = 'calendar1')
+         widget_control, date1id, get_value = date1
+         widget_control, date1id, /destroy
+         if (where(newfile.fileparameters.time_counter EQ date1))[0] EQ -1 $
+          then date1 = newfile.fileparameters.time_counter[0]
+         date2id = widget_info(event.top, find_by_uname = 'calendar2')
+         widget_control, date2id, get_value = date2
+         widget_control, date2id, /destroy
+         if (where(newfile.fileparameters.time_counter EQ date2))[0] EQ -1 then date2 = date1
+         base12 = widget_info(event.top, find_by_uname = 'base12')
+         rien = cw_calendar(base12,newfile.fileparameters.time_counter,date1, uname = 'calendar1' $
+                            , uvalue = {name:'calendar1'}, /frame)
+         rien = cw_calendar(base12,newfile.fileparameters.time_counter,date2, uname = 'calendar2' $
+                            , uvalue = {name:'calendar2'}, /frame)
+; update la grille???
+         change = changegrid(newfile.meshparameters)
+         if change then BEGIN
+            domainid = widget_info(event.top, find_by_uname = 'domain')
+            widget_control, domainid, set_value = -1
+         endif
+; on update les elements fileparameters, readparameters et meshparameters de la top_uvalue
+         newfileparameters = ptrarr(currentfile+1, /allocate_heap)
+         FOR i = 0, currentfile-1 DO $
+          *newfileparameters[i] = *(extractatt(top_uvalue, 'fileparameters'))[i]
+         *newfileparameters[currentfile] = newfile.fileparameters
+         ptr_free, extractatt(top_uvalue, 'fileparameters')
+         *top_uvalue[1, findline(top_uvalue, 'fileparameters')] = newfileparameters
+;
+         newreadparameters = ptrarr(currentfile+1, /allocate_heap)
+         FOR i = 0, currentfile-1 DO $
+          *newreadparameters[i] = *(extractatt(top_uvalue, 'readparameters'))[i]
+         *newreadparameters[currentfile] = newfile.readparameters
+         ptr_free, extractatt(top_uvalue, 'readparameters')
+         *top_uvalue[1, findline(top_uvalue, 'readparameters')] = newreadparameters
+;
+         newmeshparameters = ptrarr(currentfile+1, /allocate_heap)
+         FOR i = 0, currentfile-1 DO $
+          *newmeshparameters[i] = *(extractatt(top_uvalue, 'meshparameters'))[i]
+         *newmeshparameters[currentfile] = newfile.meshparameters
+         ptr_free, extractatt(top_uvalue, 'meshparameters')
+         *top_uvalue[1, findline(top_uvalue, 'meshparameters')] = newmeshparameters
+; on actualise le widget!
+         widget_control, event.top, update = 1
+      end
+      'New xxx' :BEGIN
+         widget_control, event.top, get_uvalue = top_uvalue
+         extra = extractatt(top_uvalue, 'extra')
+         xxx, CALLERWIDID = event.top, _extra = extra
+      end
+      'Quit':begin 
+         widget_control, event.top, get_uvalue = top_uvalue
+         ptr_free, extractatt(top_uvalue, 'exextra')
+         ptr_free, extractatt(top_uvalue, 'fileparameters')
+         ptr_free, extractatt(top_uvalue, 'readparameters')
+         ptr_free, extractatt(top_uvalue, 'meshparameters')
+         ptr_free, top_uvalue
+         widget_control, event.top, /destroy ;on ferme le widget
+      end
+      'PS' :BEGIN
+; we find homedir
+         homedir = isadirectory(io = homedir, title = 'Bad definition of homedir')
+         widget_control,event.top, get_uvalue = top_uvalue
+; portrait ou landscape ???
+         options = extractatt(top_uvalue, 'options')   
+         optionsflag = extractatt(top_uvalue, 'optionsflag')
+         portrait = (optionsflag[where(options EQ 'Portrait/Landscape'), 0])[0]
+; on recupere la liste des instructions
+         globalcommand = extractatt(top_uvalue, 'globalcommand')
+; on complete par le premiere et les dernieres lignes du programme
+         globalcommand = ['pro xxx2ps, NOERASE = noerase, POSTSCRIPT = postscript, PORTRAIT = portrait, LANDSCAPE = landscape, DATE1IN = date1in, DATE2IN = date2in, _extra = ex' $
+                          , globalcommand $
+                          , 'return',  'end']
+         putfile, homedir+'xxx2ps.pro', globalcommand ; on l''ecrit
+         resolve_routine, 'xxx2ps' ; on le compile
+         xxx2ps, /post, portrait = portrait ; on l''applique
+      END
+      'Anim' :begin 
+         xcreateanim, event.top
+      end
+      'Gif' :BEGIN
+         widget_control,event.top, get_uvalue = top_uvalue
+         petitin = extractatt(top_uvalue, 'petitin')
+         numdessinin = petitin[2]-1
+         petitout = extractatt(top_uvalue, 'petitout')
+         numdessinout = petitout[2]-1
+         tracecadre, petitin, /erase
+         tracecadre, petitout, /erase
+         filename = xquestion('dans quelle fichier gif voulez vous sauver !C l''ecran de xxx?', 'xxx_image.gif')
+         if rstrpos(filename, '.gif') NE strlen(filename)-4 then filename = filename+'.gif'
+         filename = isafile(file = filename, io = imagedir, /new)
+         saveimage, filename, /quiet
+      end
+      'Script':BEGIN
+; on recupere le nom du fichier
+         filename = xquestion('dans quelle procedure IDL voulez vous sauver !C la realisation de ce graph?', 'xxx_figure.pro')
+; on le complete par un .pro
+         if rstrpos(filename, '.pro') NE strlen(filename)-4 then filename = filename+'.pro'
+         filename = isafile(file = filename, io = homedir, /new)
+         widget_control,event.top, get_uvalue = top_uvalue
+; portrait ou landscape ???
+         options = extractatt(top_uvalue, 'options')   
+         optionsflag = extractatt(top_uvalue, 'optionsflag')
+         portrait = (optionsflag[where(options EQ 'Portrait/Landscape'), 0])[0]
+; on lit les commandes pour faire un plot
+         globalcommand = extractatt(top_uvalue, 'globalcommand')
+; on complete par le premiere et les dernieres lignes du programme
+         thisOS = strupcase(strmid(!version.os_family, 0, 3))
+         CASE thisOS of
+            'MAC':sep = ':'
+            'WIN':sep = '\'
+            ELSE:sep = '/'
+         ENDCASE
+         poslastsep = rstrpos(filename, sep)
+         proname = strmid(filename, poslastsep+1, strlen(filename)-poslastsep-1-4)
+         globalcommand = ['pro '+proname+', NOERASE = noerase, POSTSCRIPT = postscript, PORTRAIT = portrait, LANDSCAPE = landscape, DATE1IN = date1in, DATE2IN = date2in, _extra = ex' $
+                          , '@common' $
+                          , ' ' $
+                          , '   portrait = '+strtrim(portrait, 1) $
+                          , '   '+globalcommand $
+                          , ' ' $
+                          , 'return' $
+                          , 'end']
+; on les ecrit dans un programme
+         putfile, filename, globalcommand
+      END
+      'Widget':BEGIN
+; on recupere le nom du fichier
+         filename = xquestion('dans quel fichier bianire voulez vous sauver le widget ?', 'xxx_widget.dat')
+; on le complete par un .dat
+         if rstrpos(filename, '.dat') NE strlen(filename)-4 then filename = filename+'.dat'
+         filename = isafile(file = filename, io = homedir, /new)
+;
+         widget_control, event.top, get_uvalue = uvalue
+         widget_control, extractatt(uvalue, 'graphid'),get_value=win
+         wshow, win
+         wset, win
+         image = tvrd(/true)
+         save, uvalue, image, filename = filename
+      END
+      'Prompt':BEGIN
+         commande = getfile(isadirectory(io = homedir)+'xxx_oneplot.pro')
+         for i = 0,  n_elements(commande)-1 do print, commande[i]
+      end
+      'Ok button' :begin 
+         widget_control, event.top, get_uvalue = top_uvalue
+         options = extractatt(top_uvalue, 'options')
+         index = where(options EQ 'Ok button') & index = index[0]
+         optionsflag = extractatt(top_uvalue, 'optionsflag')
+         flag = 1-optionsflag[index, 0]
+         (*top_uvalue[1, findline(top_uvalue, 'optionsflag')])[index, *] = flag
+         widget_control, widget_info(event.top, find_by_uname = 'base ok button'), map = flag
+      end
+      'Portrait/Landscape' :begin 
+         widget_control, event.top, get_uvalue = top_uvalue
+         options = extractatt(top_uvalue, 'options')
+         index = where(options EQ 'Portrait/Landscape') & index = index[0]
+         optionsflag = extractatt(top_uvalue, 'optionsflag')
+         key_portrait= 1-optionsflag[index, 0]
+         (*top_uvalue[1, findline(top_uvalue, 'optionsflag')])[index, *] = key_portrait
+; fenetre separee ou fenetre collee au widget ?
+         if widget_info(event.top, find_by_uname = 'graph') EQ 0 then BEGIN
+; on tue la fenetre
+            graphid = extractatt(top_uvalue, 'graphid')
+            widget_control, widget_info(graphid, /parent), /destroy
+; on la recree
+            basegraph = widget_base(title = 'xxx window',  group_leader = event.top, uvalue = event.top,  uname = 'basegraph')
+            windsize = givewindowsize()
+            graphid = widget_draw(basegraph, uname = 'graph' $
+                                  , uvalue = {name:'graph', press:0, click:0, x:[0., 0.], y:[0., 0.]} $
+                                  , /button_events, retain = 2 $
+                                  , xsize = windsize[0],ysize = windsize[1])
+            widget_control,basegraph,/realize
+            xmanager,'xxx',basegraph, /no_block
+; on redessine ce qu''il y avait dedans
+; we find homedir
+            homedir = isadirectory(io = homedir, title = 'Bad definition of homedir')
+; on recupere la liste des instructions
+            globalcommand = extractatt(top_uvalue, 'globalcommand')
+; on complete par le premiere et les dernieres lignes du programme
+            globalcommand = ['pro xxx2ps, NOERASE = noerase, POSTSCRIPT = postscript, PORTRAIT = portrait, LANDSCAPE = landscape' $
+                             , globalcommand $
+                             , 'return',  'end']
+            putfile, homedir+'xxx2ps.pro', globalcommand ; on l''ecrit
+            resolve_routine, 'xxx2ps' ; on le compile
+            xxx2ps, /noerase, portrait = key_portrait ; on l''applique
+; on reattribue l''element graphid de la top_uvalue
+            *top_uvalue[1, findline(top_uvalue, 'graphid')] = graphid
+         ENDIF ELSE BEGIN
+            extra = extractatt(top_uvalue, 'extra')
+            xxx, CALLERWIDID = event.top, /redraw, _extra = extra
+            widget_control, event.top, /destroy ;on ferme le widget
+         ENDELSE
+      end
+      'Overlay' :begin 
+         widget_control, event.top, get_uvalue = top_uvalue
+         numdessinin = (extractatt(top_uvalue, 'petitin'))[2]-1
+         options = extractatt(top_uvalue, 'options')   
+         flags = extractatt(top_uvalue, 'optionsflag')
+         index = where(options EQ 'Overlay')
+; on change le flag sur Longitude / x index
+         flag = 1-flags[index, numdessinin] & flag = flag[0]
+; on le reeatribue
+         (*top_uvalue[1, findline(top_uvalue, 'optionsflag')])[index, numdessinin] = flag
+      end
+      'Vecteur':BEGIN
+         widget_control, event.top, get_uvalue = top_uvalue
+         numdessinin = (extractatt(top_uvalue, 'petitin'))[2]-1
+         options = extractatt(top_uvalue, 'options')   
+         flags = extractatt(top_uvalue, 'optionsflag')
+         index = where(options EQ 'Vecteur')
+; on change le flag sur Longitude / x index
+         flag = 1-flags[index, numdessinin] & flag = flag[0]
+; on le reeatribue
+         (*top_uvalue[1, findline(top_uvalue, 'optionsflag')])[index, numdessinin] = flag
+      end
+      'Longitude / x index':BEGIN
+         widget_control, event.top, get_uvalue = top_uvalue
+         numdessinin = (extractatt(top_uvalue, 'petitin'))[2]-1
+         options = extractatt(top_uvalue, 'options')   
+         flags = extractatt(top_uvalue, 'optionsflag')
+         index = where(options EQ 'Longitude / x index')
+; on change le flag sur Longitude / x index
+         flag = 1-flags[index, numdessinin] & flag = flag[0]
+; on le reeatribue
+         (*top_uvalue[1, findline(top_uvalue, 'optionsflag')])[index, numdessinin] = flag
+; maintenant on va changer les sliders definissant la boite
+         domainid = widget_info(event.top, find_by_uname = 'domain')
+         boite = (extractatt(top_uvalue, 'domaines'))[*, numdessinin]
+; on veut retrouver le type de grille qui est utilisee
+         currentfile = extractatt(top_uvalue, 'currentfile')
+         listgrid = (*(extractatt(top_uvalue, 'fileparameters'))[currentfile]).listgrid
+         indexvar = widget_info(widget_info(event.top, find_by_uname = 'champ'), /droplist_select)
+         vargrid = strupcase(listgrid[indexvar])
+         if flag EQ 0 then BEGIN ; longitudes
+; on fait un domdef pour retrouver le lon1 lon2 correspondant a la
+; boite definie sur le widget... 
+            domdef, boite, grille = vargrid, /xindex $
+             , yindex = (flags[where(options EQ 'Latitude / y index'), numdessinin])[0]
+            widget_control, domainid, set_value = [lon1, lon2, boite[2:3]]
+         ENDIF ELSE BEGIN       ; xindex
+; maintenant ion veut retrouver premierx, dernierx correspondant a la
+; boite definie sur le widget...
+            domdef, boite, grille = vargrid $
+             , yindex = (flags[where(options EQ 'Latitude / y index'), numdessinin])[0]
+            grille, mask,glam,gphi,gdep,nx,ny,nz,premierx,premiery,premierz,dernierx,derniery,dernierz
+            widget_control, domainid, set_value = [premierx, dernierx, boite[2:3]]
+         ENDELSE
+; on met a jour la top_uvalue
+         widget_control, domainid, get_value = boite
+         (*top_uvalue[1, findline(top_uvalue, 'domaines')])[*, numdessinin] = boite
+      end
+      'Latitude / y index':begin 
+         widget_control, event.top, get_uvalue = top_uvalue
+         numdessinin = (extractatt(top_uvalue, 'petitin'))[2]-1
+         options = extractatt(top_uvalue, 'options')   
+         flags = extractatt(top_uvalue, 'optionsflag')
+         index = where(options EQ 'Latitude / y index')
+; on change le flag sur Latitude / y index
+         flag = 1-flags[index, numdessinin] & flag = flag[0]
+; on le reeatribue
+         (*top_uvalue[1, findline(top_uvalue, 'optionsflag')])[index, numdessinin] = flag
+; maintenant on va changer les sliders definissant la boite
+         domainid = widget_info(event.top, find_by_uname = 'domain')
+         boite = (extractatt(top_uvalue, 'domaines'))[*, numdessinin]
+; on veut retrouver le type de grille qui est utilisee
+         currentfile = extractatt(top_uvalue, 'currentfile')
+         listgrid = (*(extractatt(top_uvalue, 'fileparameters'))[currentfile]).listgrid
+         indexvar = widget_info(widget_info(event.top, find_by_uname = 'champ'), /droplist_select)
+         vargrid = strupcase(listgrid[indexvar])
+         if flag EQ 0 then BEGIN ; latitudes
+; on fait un domdef pour retrouver le lat1 lat2 correspondant a la
+; boite definie sur le widget... 
+            domdef, boite, grille = vargrid, /yindex $
+             , xindex = (flags[where(options EQ 'Longitude / x index'), numdessinin])[0]
+            widget_control, domainid, set_value = [boite[0:1], lat1, lat2]
+         ENDIF ELSE BEGIN       ; yindex
+; maintenant ion veut retrouver premiery, derniery correspondant a la
+; boite definie sur le widget...
+            domdef, boite, grille = vargrid $
+             , xindex = (flags[where(options EQ 'Longitude / x index'), numdessinin])[0]
+            grille, mask,glam,gphi,gdep,nx,ny,nz,premierx,premiery,premierz,dernierx,derniery,dernierz
+            widget_control, domainid, set_value = [boite[0:1], premiery, derniery]
+         ENDELSE
+; on met a jour la top_uvalue
+         widget_control, domainid, get_value = boite
+         (*top_uvalue[1, findline(top_uvalue, 'domaines')])[*, numdessinin] = boite
+      end
+   endcase
+   return
+end
+;------------------------------------------------
+PRO xxxmenubar, parent, OPTIONS =options, _EXTRA = ex
+;       desc = [ '1\Colors' , $
+;    '0\Red' , $
+;    '0\Green' , $
+;    '1\Blue' , $
+;    '0\Light' , $
+;    '0\Medium' , $
+;    '0\Dark' , $
+;    '0\Navy' , $
+;    '2\Royal' , $
+;    '0\Cyan' , $
+;    '2\Magenta' , $
+;    '2\Quit' ]
+   desc = [ '1\File' , $
+            '0\Open' , $
+            '0\New xxx' , $
+            '2\Quit', $
+            '1\Save as' , $
+            '0\PS' , $
+            '0\Anim' , $
+            '0\Gif' , $
+            '0\Script', $
+            '0\Widget', $
+            '2\Prompt', $
+            '1\Flag options']
+   descsuite = options
+   if n_elements(descsuite) GE 2 then $
+    descsuite[0:n_elements(descsuite)-2] = '0\'+descsuite[0:n_elements(descsuite)-2]
+   descsuite[n_elements(descsuite)-1] = '2\'+descsuite[n_elements(descsuite)-1]
+   desc = [desc, descsuite]
+            
+   menu = CW_PDMENU(parent, desc, /RETURN_NAME, /mbar, uname = 'menubar', uvalue = {name:'menubar'}, _EXTRA = ex)
+
+
+;------------------------------------------------
+   return
+end
Index: tags/start/WIDGET/COMPOUND_WIDGET/cw_bgroup.pro
===================================================================
--- tags/start/WIDGET/COMPOUND_WIDGET/cw_bgroup.pro	(revision 5)
+++ tags/start/WIDGET/COMPOUND_WIDGET/cw_bgroup.pro	(revision 5)
@@ -0,0 +1,349 @@
+; $Id$
+;
+; Copyright (c) 1992-1998, Research Systems, Inc.  All rights reserved.
+;	Unauthorized reproduction prohibited.
+;+
+; NAME:
+;	CW_BGROUP
+;
+; PURPOSE:
+;	CW_BGROUP is a compound widget that simplifies creating
+;	a base of buttons. It handles the details of creating the
+;	proper base (standard, exclusive, or non-exclusive) and filling
+;	in the desired buttons. Events for the individual buttons are
+;	handled transparently, and a CW_BGROUP event returned. This
+;	event can return any one of the following:
+;		- The Index of the button within the base.
+;		- The widget ID of the button.
+;		- The name of the button.
+;		- An arbitrary value taken from an array of User values.
+;
+; CATEGORY:
+;	Compound widgets.
+;
+; CALLING SEQUENCE:
+;		Widget = CW_BGROUP(Parent, Names)
+;
+;	To get or set the value of a CW_BGROUP, use the GET_VALUE and
+;	SET_VALUE keywords to WIDGET_CONTROL. The value of a CW_BGROUP
+;	is:
+;
+;		-----------------------------------------------
+;		Type		Value
+;		-----------------------------------------------
+;		normal		None
+;		exclusive   	Index of currently set button
+;		non-exclusive	Vector indicating the position
+;				of each button (1-set, 0-unset)
+;		-----------------------------------------------
+;
+;
+; INPUTS:
+;       Parent:		The ID of the parent widget.
+;	Names:		A string array, containing one string per button,
+;			giving the name of each button.
+;
+; KEYWORD PARAMETERS:
+;
+;	BUTTON_UVALUE:	An array of user values to be associated with
+;			each button and returned in the event structure.
+;	COLUMN:		Buttons will be arranged in the number of columns
+;			specified by this keyword.
+;	EVENT_FUNCT:	The name of an optional user-supplied event function 
+;			for buttons. This function is called with the return
+;			value structure whenever a button is pressed, and 
+;			follows the conventions for user-written event
+;			functions.
+;	EXCLUSIVE:	Buttons will be placed in an exclusive base, with
+;			only one button allowed to be selected at a time.
+;	FONT:		The name of the font to be used for the button
+;			titles. If this keyword is not specified, the default
+;			font is used.
+;	FRAME:		Specifies the width of the frame to be drawn around
+;			the base.
+;	IDS:		A named variable into which the button IDs will be
+;			stored, as a longword vector.
+;	LABEL_LEFT:	Creates a text label to the left of the buttons.
+;	LABEL_TOP:	Creates a text label above the buttons.
+;	MAP:		If set, the base will be mapped when the widget
+;			is realized (the default).
+;	NONEXCLUSIVE:	Buttons will be placed in an non-exclusive base.
+;			The buttons will be independent.
+;	NO_RELEASE:	If set, button release events will not be returned.
+;	RETURN_ID:	If set, the VALUE field of returned events will be
+;			the widget ID of the button.
+;	RETURN_INDEX:	If set, the VALUE field of returned events will be
+;			the zero-based index of the button within the base.
+;			THIS IS THE DEFAULT.
+;	RETURN_NAME:	If set, the VALUE field of returned events will be
+;			the name of the button within the base.
+;	ROW:		Buttons will be arranged in the number of rows
+;			specified by this keyword.
+;	SCROLL:		If set, the base will include scroll bars to allow
+;			viewing a large base through a smaller viewport.
+;	SET_VALUE:	The initial value of the buttons. This is equivalent
+;			to the later statement:
+;
+;			WIDGET_CONTROL, widget, set_value=value
+;
+;	SPACE:		The space, in pixels, to be left around the edges
+;			of a row or column major base. This keyword is
+;			ignored if EXCLUSIVE or NONEXCLUSIVE are specified.
+;	UVALUE:		The user value to be associated with the widget.
+;	XOFFSET:	The X offset of the widget relative to its parent.
+;	XPAD:		The horizontal space, in pixels, between children
+;			of a row or column major base. Ignored if EXCLUSIVE
+;			or NONEXCLUSIVE are specified.
+;	XSIZE:		The width of the base. 
+;	X_SCROLL_SIZE:	The width of the viewport if SCROLL is specified.
+;	YOFFSET:	The Y offset of the widget relative to its parent.
+;	YPAD:		The vertical space, in pixels, between children of
+;			a row or column major base. Ignored if EXCLUSIVE
+;			or NONEXCLUSIVE are specified.
+;	YSIZE:		The height of the base. 
+;	Y_SCROLL_SIZE:	The height of the viewport if SCROLL is specified.
+;
+; OUTPUTS:
+;       The ID of the created widget is returned.
+;
+; SIDE EFFECTS:
+;	This widget generates event structures with the following definition:
+;
+;		event = { ID:0L, TOP:0L, HANDLER:0L, SELECT:0, VALUE:0 }
+;
+;	The SELECT field is passed through from the button event. VALUE is
+;	either the INDEX, ID, NAME, or BUTTON_UVALUE of the button,
+;	depending on how the widget was created.
+;
+; RESTRICTIONS:
+;	Only buttons with textual names are handled by this widget.
+;	Bitmaps are not understood.
+;
+; MODIFICATION HISTORY:
+;	15 June 1992, AB
+;	7 April 1993, AB, Removed state caching.
+;	6 Oct. 1994, KDB, Font keyword is not applied to the label.
+;       10 FEB 1995, DJC  fixed bad bug in event procedure, getting
+;                         id of stash widget.
+;	11 April 1995, AB Removed Motif special cases.
+;-
+
+
+pro CW_BGROUP_SETV, id, value
+
+  ON_ERROR, 2						;return to caller
+
+  stash = WIDGET_INFO(id, /CHILD)
+  WIDGET_CONTROL, stash, GET_UVALUE=state, /NO_COPY
+
+  case state.type of
+    0: message,'unable to set plain button group value'
+    1: begin
+	  WIDGET_CONTROL, SET_BUTTON=0, state.ids[state.excl_pos]
+	  state.excl_pos = value
+	  WIDGET_CONTROL, /SET_BUTTON, state.ids[value]
+	end
+    2: begin
+	  n = n_elements(value)-1
+	  for i = 0, n do begin
+	    state.nonexcl_curpos[i] = value[i]
+	    WIDGET_CONTROL, state.ids[i], SET_BUTTON=value[i]
+	  endfor
+	end
+  endcase
+
+  WIDGET_CONTROL, stash, SET_UVALUE=state, /NO_COPY
+end
+
+
+
+function CW_BGROUP_GETV, id, value
+
+   ON_ERROR, 2                  ;return to caller
+
+   stash = WIDGET_INFO(id, /CHILD)
+   WIDGET_CONTROL, stash, GET_UVALUE=state, /NO_COPY
+
+   case state.type of
+      0: message,'unable to get plain button group value'
+;    1: ret = state.excl_pos
+      1: ret = state.ret_arr[state.excl_pos]
+;    2: ret = state.nonexcl_curpos
+      2: BEGIN 
+         index = where(state.nonexcl_curpos NE 0)
+         if index[0] EQ -1 then begin
+            if size(state.ret_arr, /type) EQ 7 then ret = '' ELSE ret = -1
+         ENDIF ELSE ret = state.ret_arr[index]
+      END
+   endcase
+
+   WIDGET_CONTROL, stash, SET_UVALUE=state, /NO_COPY
+
+   return, ret
+
+end
+
+
+
+function CW_BGROUP_EVENT, ev
+  WIDGET_CONTROL, ev.handler, GET_UVALUE=stash
+  WIDGET_CONTROL, stash, GET_UVALUE=state, /NO_COPY
+  WIDGET_CONTROL, ev.id, get_uvalue=uvalue
+
+  ret = 1			;Assume we return a struct
+  case state.type of
+    0:
+    1: if (ev.select eq 1) then begin
+	  state.excl_pos = uvalue
+	ENDIF else begin
+	  if (state.no_release ne 0) then ret = 0
+	ENDELSE
+    2: begin
+	  ; Keep track of the current state
+	  state.nonexcl_curpos[uvalue] = ev.select
+          if (state.no_release ne 0) and (ev.select eq 0) then ret = 0
+	end
+  endcase
+
+  if ret then begin		;Return a struct?
+      ret = { ID:state.base, TOP:ev.top, HANDLER:0L, SELECT:ev.select, $
+	       VALUE:state.ret_arr[uvalue] }
+      efun = state.efun
+      WIDGET_CONTROL, stash, SET_UVALUE=state, /NO_COPY
+      if efun ne '' then return, CALL_FUNCTION(efun, ret) $
+      else return, ret
+  endif else begin		;Trash the event
+      WIDGET_CONTROL, stash, SET_UVALUE=state, /NO_COPY
+      return, 0
+  endelse
+end
+
+
+
+
+
+
+
+function CW_BGROUP, parent, names, $
+	BUTTON_UVALUE = button_uvalue, COLUMN=column, EVENT_FUNCT = efun, $
+	EXCLUSIVE=excl, FONT=font, FRAME=frame, IDS=ids, LABEL_TOP=label_top, $
+	LABEL_LEFT=label_left, MAP=map, $
+	NONEXCLUSIVE=nonexcl, NO_RELEASE=no_release, RETURN_ID=return_id, $
+	RETURN_INDEX=return_index, RETURN_NAME=return_name, $
+	ROW=row, SCROLL=scroll, SET_VALUE=sval, SPACE=space, UVALUE=uvalue, UNAME = uname, $
+	XOFFSET=xoffset, XPAD=xpad, XSIZE=xsize, X_SCROLL_SIZE=x_scroll_size,$
+	YOFFSET=yoffset, YPAD=ypad, YSIZE=ysize, Y_SCROLL_SIZE=y_scroll_size, $
+           _EXTRA = ex
+
+
+  IF (N_PARAMS() ne 2) THEN MESSAGE, 'Incorrect number of arguments'
+
+  ON_ERROR, 2						;return to caller
+
+  ; Set default values for the keywords
+  version = WIDGET_INFO(/version)
+  if (version.toolkit eq 'OLIT') then def_space_pad = 4 else def_space_pad = 3
+  IF (N_ELEMENTS(column) eq 0) 		then column = 0
+  IF (N_ELEMENTS(excl) eq 0) 		then excl = 0
+  IF (N_ELEMENTS(frame) eq 0)		then frame = 0
+  IF (N_ELEMENTS(map) eq 0)		then map=1
+  IF (N_ELEMENTS(nonexcl) eq 0)		then nonexcl = 0
+  IF (N_ELEMENTS(no_release) eq 0)	then no_release = 0
+  IF (N_ELEMENTS(row) eq 0)		then row = 0
+  IF (N_ELEMENTS(scroll) eq 0)		then scroll = 0
+  IF (N_ELEMENTS(space) eq 0)		then space = def_space_pad
+  IF (N_ELEMENTS(uvalue) eq 0)		then uvalue = 0
+  IF (N_ELEMENTS(uname) eq 0)		then uname = ' '
+  IF (N_ELEMENTS(xoffset) eq 0)		then xoffset=0
+  IF (N_ELEMENTS(xpad) eq 0)		then xpad = def_space_pad
+  IF (N_ELEMENTS(xsize) eq 0)		then xsize = 0
+  IF (N_ELEMENTS(x_scroll_size) eq 0)	then x_scroll_size = 0
+  IF (N_ELEMENTS(yoffset) eq 0)		then yoffset=0
+  IF (N_ELEMENTS(ypad) eq 0)		then ypad = def_space_pad
+  IF (N_ELEMENTS(ysize) eq 0)		then ysize = 0
+  IF (N_ELEMENTS(y_scroll_size) eq 0)	then y_scroll_size = 0
+  
+
+
+
+  top_base = 0L
+  if (n_elements(label_top) ne 0) then begin
+    next_base = WIDGET_BASE(parent, XOFFSET=xoffset, YOFFSET=yoffset, /COLUMN, _EXTRA = ex)
+    if(keyword_set(font))then $
+       junk = WIDGET_LABEL(next_base, value=label_top,font=font) $
+    else    junk = WIDGET_LABEL(next_base, value=label_top)
+    top_base = next_base
+  endif else next_base = parent
+  if (n_elements(label_left) ne 0) then begin
+    next_base = WIDGET_BASE(next_base, XOFFSET=xoffset, YOFFSET=yoffset, /ROW, _EXTRA = ex)
+    if(keyword_set(font))then $
+       junk = WIDGET_LABEL(next_base, value=label_left, font=font) $
+    else junk = WIDGET_LABEL(next_base, value=label_left)
+    if (top_base eq 0L) then top_base = next_base
+  endif
+  ; We need some kind of outer base to hold the users UVALUE
+  if (top_base eq 0L) then begin
+    top_base = WIDGET_BASE(parent, XOFFSET=xoffset, YOFFSET=yoffset, _EXTRA = ex)
+    next_base = top_base
+  endif
+  If (top_base EQ next_base) THEN $
+     next_base = WIDGET_BASE(top_base, Xpad=1, Ypad=1, Space=1, _EXTRA = ex)
+
+  ; Set top level base attributes
+  WIDGET_CONTROL, top_base, MAP=map, $
+	FUNC_GET_VALUE='CW_BGROUP_GETV', PRO_SET_VALUE='CW_BGROUP_SETV', $
+	SET_UVALUE=uvalue, SET_UNAME = uname
+
+  ; The actual button holding base
+  base = WIDGET_BASE(next_base, COLUMN=column, EXCLUSIVE=excl, FRAME=frame, $
+	NONEXCLUSIVE=nonexcl, ROW=row, SCROLL=scroll, SPACE=space, $
+	XPAD=xpad, XSIZE=xsize, X_SCROLL_SIZE=x_scroll_size, $
+	YPAD=ypad, YSIZE=ysize, Y_SCROLL_SIZE=y_scroll_size, $
+	EVENT_FUNC='CW_BGROUP_EVENT', _EXTRA = ex, $
+	UVALUE=WIDGET_INFO(top_base, /child))
+
+
+  n = n_elements(names)
+  ids = lonarr(n)
+  for i = 0, n-1 do begin
+    if (n_elements(font) eq 0) then begin
+      ids[i] = WIDGET_BUTTON(base, value=names[i], UVALUE=i)
+    endif else begin
+      ids[i] = WIDGET_BUTTON(base, value=names[i], FONT=font, UVALUE=i)
+    endelse
+  endfor
+
+  ; Keep the state info in the real (inner) base UVALUE.
+  ; Pick an event value type:
+  ;	0 - Return ID
+  ;	1 - Return INDEX
+  ;	2 - Return NAME
+  ret_type = 1
+  if KEYWORD_SET(RETURN_ID) then ret_type = 0
+  if KEYWORD_SET(RETURN_NAME) then ret_type = 2
+  if KEYWORD_SET(BUTTON_UVALUE) then ret_type = 3
+    case ret_type of
+      0: ret_arr = ids
+      1: ret_arr = indgen(n)
+      2: ret_arr = names
+      3: ret_arr = button_uvalue
+    endcase
+  type = 0
+  if (excl ne 0) then type = 1
+
+  if (nonexcl ne 0) then type = 2
+  if n_elements(efun) le 0 then efun = ''
+  state = { type:type, $	; 0-Standard, 1-Exclusive, 2-Non-exclusive
+	    base: top_base, $	; cw_bgroup base...
+	    ret_arr:ret_arr, $	; Vector of event values
+	    efun : efun, $	; Name of event fcn
+	    nonexcl_curpos:intarr(n), $	; If non-exclus, tracks state
+	    excl_pos:0, $			; If exclusive, current button
+	    ids:ids, $			; Ids of buttons
+	    no_release:no_release }
+  WIDGET_CONTROL, WIDGET_INFO(top_base, /CHILD), SET_UVALUE=state, /NO_COPY
+
+  if (n_elements(sval) ne 0) then CW_BGROUP_SETV, top_base, sval
+
+  return, top_base
+END
Index: tags/start/WIDGET/COMPOUND_WIDGET/cw_calendar.pro
===================================================================
--- tags/start/WIDGET/COMPOUND_WIDGET/cw_calendar.pro	(revision 5)
+++ tags/start/WIDGET/COMPOUND_WIDGET/cw_calendar.pro	(revision 5)
@@ -0,0 +1,265 @@
+; IDL> testwid,julday(1,1,1980)+lindgen(100)*5
+;
+PRO testwid_event, event
+    DroplistId = widget_info(event.top,find_by_uname = 'c''est lui')
+   widget_control, event.id, get_uvalue=uval
+   if n_elements(uval) EQ 0 then return
+   case uval of
+      'done':widget_control, event.top, /destroy
+      'set':BEGIN 
+         widget_control, event.id, get_value = value
+         widget_control, DroplistId, set_value = value
+      END
+      'get':BEGIN 
+         widget_control, DroplistId, get_value = value
+         help,  value, /struct
+      END
+      ELSE:
+   endcase
+   return
+end
+PRO testwid, calendar, date0, _extra = ex
+   base=widget_base(/COLUMN)
+print, 'base=', base
+   nothing = widget_label(base, value = 'beginning of the test')
+;
+   nothing = cw_calendar(base,calendar, date0, _extra = ex, uname = 'c''est lui', uvalue = 'c''est lui' )
+print, 'cw_calendar ID =', nothing
+;
+   nothing = widget_label(base, value = 'end of the test')
+    nothing = widget_text(base, value = string(calendar[0]), uvalue = 'set', /editable)
+    nothing = widget_button(base, value = 'get', uvalue = 'get')
+    nothing = widget_button(base, value = 'done', uvalue = 'done')
+   widget_control, base, /REALIZE
+   xmanager,'testwid', base
+   return
+END
+;
+;
+;
+PRO cw_calendar_set_value, id, value
+   possiblecase = ['day', 'month', 'year', 'century']
+   name = 0
+   repeat begin
+      wid_id = widget_info(id,find_by_uname = possiblecase[name])
+      name = name+1
+   endrep until wid_id NE 0
+   widget_control,wid_id, get_uvalue=wid_uvalue
+   value = long(value[0])
+   year = value/10000l & month = (value-year*10000l)/100L & day = value-year*10000l-month*100L
+   if year EQ 0 then year = -1 & if month EQ 0 then month = 6 & if day EQ 0 then day = 15
+   julianvalue = julday(month, day, year)
+   if (where(wid_uvalue.calendar EQ julianvalue))[0] EQ - 1 then return
+   for name = 3, 0, -1 do BEGIN
+      if widget_info(id,find_by_uname = possiblecase[name]) NE 0  then $
+         set_droplist, {handler:id, out:2}, possiblecase[name], value
+   endfor
+   return
+end
+;----------------------------------------------------------------------
+FUNCTION cw_calendar_get_value, id
+   possiblecase = ['day', 'month', 'year', 'century']
+   name = 0
+   repeat begin
+      wid_id = widget_info(id,find_by_uname = possiblecase[name])
+      name = name+1
+   endrep until wid_id NE 0
+   widget_control,wid_id, get_uvalue=wid_uvalue
+   caldat, wid_uvalue.calendar,monthcal,daycal,yearcal
+   centurycal = yearcal/100L
+   if n_elements(centurycal[uniq(centurycal, sort(centurycal))]) NE 1 then $ 
+    yearcal = yearcal-centurycal*100
+   droplistname = ['day','month','year','century']
+   for name = 0, n_elements(droplistname)-1  do begin
+      nothing = execute('wid_id = widget_info(id,find_by_uname = '''+droplistname[name]+''')')
+      if wid_id NE 0 then begin
+         widget_control,wid_id, get_value=wid_value
+         widget_control,wid_id, get_uvalue=wid_uvalue
+         nothing = execute('array = '+droplistname[name]+'cal[wid_uvalue.index]')
+         nothing = execute(droplistname[name]+' = array[wid_value.droplist_select]')
+      ENDIF ELSE nothing = execute(droplistname[name]+'= 0')
+   ENDFOR
+   return, 10000L*(year+100L*century)+100L*month+day
+end
+;----------------------------------------------------------------------
+PRO set_droplist, event, casename, date0
+; casename: quel est le widget que l''on veut bouger: 'day', 'month',
+; 'year', 'century' ???
+   wid_id = widget_info(event.handler,find_by_uname = casename)
+   possiblecase = ['day', 'month', 'year', 'century']
+   whichcase = (where(possiblecase EQ casename))[0]
+; on recupere la uvalue attache au widget et qui nous donne ques sont
+; les 'day', 'month', 'year', 'century' en train d''etre traites et le
+; calendrier
+; on recuper ici le calendrier
+   widget_control,wid_id, get_uvalue=wid_uvalue
+   caldat, wid_uvalue.calendar,monthcal,daycal,yearcal
+   centurycal = yearcal/100
+; et la date courrante
+   if n_elements(date0) EQ 0 then date0 = cw_calendar_get_value(event.handler)
+   year0 = date0/10000l
+   century0 = year0/100
+   month0 = (date0-year0*10000l)/100L
+   day0 = date0-year0*10000l-month0*100L
+   if n_elements(centurycal[uniq(centurycal, sort(centurycal))]) NE 1 then BEGIN 
+      yearcal = yearcal-centurycal*100
+      year0   = year0  -centurycal*100
+   ENDIF
+; index: 'day', 'month', 'year', 'century' possibles pour la date donnee
+   case casename of
+      'day':index = where(monthcal EQ month0 AND yearcal EQ year0 AND centurycal EQ century0)
+      'month':index = where(yearcal EQ year0 AND centurycal EQ century0)
+      'year':index = where(centurycal EQ century0)
+      'century':index = uniq(centurycal, sort(long(centurycal)))
+   ENDCASE
+; current: liste des mois possibles par ex
+   nothing = execute('current = '+possiblecase[whichcase]+'cal[index]')
+; supprime les boublons
+   indexbis = uniq(current, sort(current))
+   index = index[indexbis];
+; nouvelle liste des possibilites offertes par la droplist (par ex
+; liste des mois possibles)
+   current = current[indexbis]
+; on accualise la uvalue du widget (par ex on met la nouvelle liste de
+; mois possibles)
+   widget_control, wid_id, set_uvalue = {name:wid_uvalue.name, calendar:wid_uvalue.calendar, index:index}
+;on met en place la nouvelle liste possible
+   widget_control, wid_id, get_value = oldselect
+   if casename EQ 'month' then begin
+      widget_control, wid_id, set_value = string(format='(C(CMoA))',31*(current-1))
+   ENDIF ELSE BEGIN 
+      widget_control, wid_id, set_value = strtrim(current, 1)
+  ENDELSE
+; quel est l''index qu'il faut selectionner parmis la nouvelle liste!
+   widget_control, wid_id, get_value = droplist
+   if event.out EQ 2 then BEGIN 
+    nothing = execute('widget_control, wid_id, set_value = {droplist_select:(where(current EQ '+casename+'0))[0]}') 
+   ENDIF ELSE widget_control, wid_id, set_value $
+    = {droplist_select:((droplist.droplist_number-1)*(event.out EQ -1)+oldselect.droplist_select*(event.out EQ 0)) < (droplist.droplist_number-1)}
+   return
+end
+;----------------------------------------------------------------------
+PRO move, event, casename
+   possiblecase = ['day', 'month', 'year', 'century', 'impossiblecase']
+   whichcase = (where(possiblecase EQ casename))[0]
+   id = widget_info(event.handler,find_by_uname = casename)
+   widget_control, id, get_value=wvalue
+   if wvalue.droplist_select EQ (wvalue.droplist_number-1)*(event.out EQ 1) THEN BEGIN
+      if casename EQ 'century' $
+       OR widget_info(event.handler,find_by_uname = possiblecase[whichcase+1]) EQ 0 then begin
+         widget_control, id, get_value=widvalue
+         widget_control, id, set_value={droplist_select:(widvalue.droplist_number-1)*(event.out EQ -1)}
+      ENDIF ELSE nothing = execute('move, event,'''+possiblecase[whichcase+1]+'''') 
+   ENDIF ELSE widget_control, id, set_value={droplist_select:wvalue.droplist_select+event.out}
+   nothing = execute('set_droplist, event,'''+possiblecase[whichcase-1]+'''')
+   return
+end
+;----------------------------------------------------------------------
+FUNCTION cw_calendar_event, event
+;help,  /struct, event
+   widget_control, event.id, get_uvalue=uval
+   possiblecase = ['day', 'month', 'year', 'century', 'impossiblecase']
+   whichcase = (where(possiblecase EQ uval.name))[0]
+   if event.out NE 0 then BEGIN ; we use the +/- button and we want to go out of the droplist:
+; to index -1 (event.out=-1) or to index droplist_number (event.out=1)
+; we try to move the droplist just right named possiblecase[whichcase+1]
+      if widget_info(event.handler,find_by_uname = possiblecase[whichcase+1]) EQ 0 then BEGIN
+; this widget do not exist we set cyclicly the current widget to the
+; value 0 if event.out=1 or droplist_number-1 if event.out=-1
+         widget_control, event.id, get_value=widvalue
+         widget_control, event.id, set_value={droplist_select:(widvalue.droplist_number-1)*(event.out EQ -1)}
+      ENDIF ELSE move, event, possiblecase[whichcase+1]
+   ENDIF
+   if uval.name NE 'day' then begin
+      event.out = 0
+      for name = whichcase-1, 0, -1 do begin
+         if widget_info(event.handler,find_by_uname = possiblecase[name]) NE 0 then $
+          set_droplist, event, possiblecase[name]
+      endfor
+   endif
+   return, {CW_CALENDAR, ID:event.handler, TOP:event.top, HANDLER:0L $
+            , VALUE:cw_calendar_get_value(event.handler)}
+end
+;----------------------------------------------------------------------
+FUNCTION cw_calendar, parent, calendar, date0, UVALUE = uvalue, UNAME = uname, ROW = row, COLUMN = column, _extra = ex
+; cheking for row and column keywords
+   column = keyword_set(column)*(1-keyword_set(row))
+   row = keyword_set(row)*(1-keyword_set(column)) +(keyword_set(row) EQ column) 
+; liste des mois, jours annee disponibles ds le calendrier
+   caldat, calendar,monthcal,daycal,yearcal
+   centurycal = yearcal/100
+; date de depart
+   if n_elements(date0) EQ 0 then date0 = calendar[0]
+   if (where(calendar EQ date0))[0] EQ -1 then date0 = calendar[0]
+   caldat, date0,month0,day0,year0
+   century0 = year0/100
+; test du type de calendrier
+   if n_elements(calendar) GT 1 then begin
+      if total(daycal eq 15) EQ n_elements(calendar) then monthly = 1
+   if total(monthcal EQ 6) EQ n_elements(calendar) then BEGIN  & monthly = 1 & yearly = 1 & endif
+   if total(yearcal EQ 50) EQ n_elements(calendar) then BEGIN  & monthly = 1 & yearly = 1 & centuryly = 1 & ENDIF
+   endif
+;---------------------------------------------------------------------------------------
+   if NOT keyword_set(uvalue) then uvalue = ''
+   if NOT keyword_set(uname) then uname = ''
+   base = widget_base(parent, ROW = row, COLUMN = column  $
+                      , EVENT_FUNC = 'cw_calendar_event' $
+                      , FUNC_GET_VALUE='cw_calendar_get_value' $
+                      , PRO_SET_VALUE='cw_calendar_set_value' $
+                      , UVALUE = uvalue, UNAME = uname, _extra = ex)   
+;-------------day----------------
+   if NOT keyword_set(monthly)  then begin
+      dayindex = where(monthcal EQ month0 AND yearcal EQ year0 AND centurycal EQ century0)
+      currentday = daycal[dayindex]
+      currentday = string(currentday)
+      for i = 0, n_elements(currentday)-1 do currentday[i] = strtrim(currentday[i], 1)
+      rien = cw_droplist_pm(base,UVALUE = {name:'day', calendar:calendar, index:dayindex}, UNAME = 'day', value = currentday)
+      widget_control, rien, set_value = {droplist_select:(where(long(currentday) EQ day0))[0]}
+   endif
+;-------------month----------------
+   if NOT keyword_set(yearly)  then BEGIN
+; les mois du siecle en cours et de l''anne en cours
+      monthindex = where(yearcal EQ year0 AND centurycal EQ century0)
+      currentmonth = long(monthcal[monthindex])
+; on supprime les elements repetes
+      monthindexbis = uniq(currentmonth, sort(currentmonth))
+      monthindex = monthindex[monthindexbis]
+      currentmonth = currentmonth[monthindexbis]
+; on cree une droplist avec comme valeur tous les mois possibles de
+; l''annee courrante (year0)
+;       rien = cw_droplist_pm(base,UVALUE = {name:'month', calendar:calendar, index:monthindex}, UNAME = 'month', value = string(format='(C(CMoA))',31*indgen(12)))
+      rien = cw_droplist_pm(base,UVALUE = {name:'month', calendar:calendar, index:monthindex}, UNAME = 'month', value = string(format='(C(CMoA))',31*(currentmonth-1)))
+; on possitionne le mois courrant sur le bon mois parmis les mois
+; possibles de l''annee courrante
+      widget_control, rien, set_value = {droplist_select:(where(long(currentmonth) EQ month0))[0]}
+   endif
+;-------------year----------------
+   if NOT keyword_set(centuryly)  then begin
+      if n_elements(centurycal[uniq(centurycal, sort(centurycal))]) NE 1 then BEGIN 
+         yearcal = yearcal-centurycal*100
+         year0   = year0-centurycal*100
+      endif
+      yearindex = where(centurycal EQ century0)
+      currentyear = yearcal[yearindex]
+      yearindexbis = uniq(currentyear, sort(long(currentyear)))
+      yearindex = yearindex[yearindexbis]
+      currentyear = currentyear[yearindexbis]
+      currentyear = string(currentyear)
+      for i = 0, n_elements(currentyear)-1 do currentyear[i] = strtrim(currentyear[i], 1)
+      rien = cw_droplist_pm(base,UVALUE = {name:'year', calendar:calendar, index:yearindex}, UNAME = 'year', value = currentyear)
+      widget_control, rien, set_value = {droplist_select:(where(long(currentyear) EQ year0))[0]}
+   endif
+;-------------century----------------
+   centuryindex = uniq(centurycal, sort(long(centurycal)))
+   currentcentury = centurycal[centuryindex]
+   currentcentury = string(currentcentury)
+   for i = 0, n_elements(currentcentury)-1 do currentcentury[i] = strtrim(currentcentury[i], 1)
+   if n_elements(uniq(centurycal, sort(centurycal))) NE 1 then BEGIN
+      rien = cw_droplist_pm(base,UVALUE = {name:'century', calendar:calendar, index:centuryindex}, UNAME = 'century', value = currentcentury)
+      widget_control, rien, set_value = {droplist_select:(where(long(currentcentury) EQ century0))[0]}
+   endif
+;-----------------------------
+;
+;
+   return, base
+end
Index: tags/start/WIDGET/COMPOUND_WIDGET/cw_domain.pro
===================================================================
--- tags/start/WIDGET/COMPOUND_WIDGET/cw_domain.pro	(revision 5)
+++ tags/start/WIDGET/COMPOUND_WIDGET/cw_domain.pro	(revision 5)
@@ -0,0 +1,525 @@
+; IDL> testwid
+; PRO testwid_event, event
+; ; help,  event, /struct
+;    Id = widget_info(event.top,find_by_uname = 'c''est lui')
+;    widget_control, event.id, get_uvalue=uval
+;    if n_elements(uval) EQ 0 then return
+;    case uval of
+;       'done':widget_control, event.top, /destroy
+;       'set':BEGIN
+;          widget_control, event.id, get_value = value & value = value[0]
+;          nothing = execute('boite ='+value)
+;          widget_control, Id, set_value = boite
+;       END
+;       'get':BEGIN 
+;          widget_control, Id, get_value = value
+;          print,  value
+;       END
+;       ELSE:
+;    endcase
+;    return
+; end
+; PRO testwid, _extra = ex
+;    base=widget_base(/COLUMN)
+;    print, 'base=', base
+;    nothing = widget_label(base, value = 'beginning of the test')
+; ;
+;    nothing = cw_domain(base,_extra = ex, uname = 'c''est lui', uvalue = 'c''est lui')
+;    print, 'cw_domain ID =', nothing
+; ;
+;    nothing = widget_label(base, value = 'end of the test')
+;    nothing = widget_text(base, value = '[40, 100, -10, 10]', uvalue = 'set', /editable)
+;    nothing = widget_button(base, value = 'get', uvalue = 'get')
+;    nothing = widget_button(base, value = 'done', uvalue = 'done')
+;    widget_control, base, /REALIZE
+;    xmanager,'testwid', base
+;    return
+; end
+;
+;
+;*********************************************************************
+pro cw_domain_set_value, id, value
+@common
+;------------------------------------------------
+; quel est le type de boite?
+   topid = findtopid(id)
+   widget_control, topid, get_uvalue=top_uvalue
+   currentplot = (extractatt(top_uvalue, 'petitin'))[2]-1
+   options = extractatt(top_uvalue, 'options')   
+   flags = extractatt(top_uvalue, 'optionsflag')
+   flags = flags[*, currentplot]
+   IF (flags[where(options EQ 'Longitude / x index')])[0] EQ 0 THEN $
+    xtype = 'geographic' ELSE xtype = 'index'
+   IF (flags[where(options EQ 'Latitude / y index')])[0] EQ 0 THEN $
+    ytype = 'geographic' ELSE ytype = 'index'
+;------------------------------------------------
+; comment completer la boite?
+   IF xtype EQ  'geographic' then begin
+      lonn1 = lon1
+      lonn2 = lon2
+      xtitle = 'lon'
+   ENDIF ELSE BEGIN
+      lonn1 = premierxt
+      lonn2 = dernierxt
+      xtitle = 'x index'
+   ENDELSE
+   IF ytype EQ  'geographic' then begin
+      latt1 = lat1
+      latt2 = lat2
+      ytitle = 'lat'
+   ENDIF ELSE BEGIN
+      latt1 = premieryt
+      latt2 = dernieryt
+      ytitle = 'y index'
+   ENDELSE
+;------------------------------------------------
+   proff1 = floor(min([gdepw[0], gdept[0]]))
+   proff2 = ceil(max([gdepw[0], gdept[0]]))
+;------------------------------------------------
+   Case N_Elements(Value) OF
+      0:boite = [lonn1, lonn2, latt1, latt2, proff1, proff2]
+      1:BEGIN 
+         if value EQ -1 then boite = [lonn1, lonn2, latt1, latt2, proff1, proff2] $
+         ELSE boite=[lonn1, lonn2, latt1, latt2, 0.,value[0]]
+      END
+      2:boite=[lonn1, lonn2, latt1, latt2, value[0],value[1]]
+      4:boite=[Value]
+      5:boite=[Value[0:3], 0, Value[4]]
+      6:boite = Value
+      Else:BEGIN 
+         rien = report('Mauvaise Definition de Boite')
+      END
+   ENDCASE
+;------------------------------------------------
+   boite[0] = floor(boite[0])
+   boite[1] = ceil(boite[1])
+   boite[2] = floor(boite[2])
+   boite[3] = ceil(boite[3])
+   if n_elements(boite GE 5) then begin
+      boite[4] = floor(boite[4])
+      boite[5] = ceil(boite[5])
+   endif
+;------------------------------------------------
+;------------------------------------------------
+   widget_control,widget_info(id,find_by_uname = 'lon1'), get_uvalue = uvalue
+   strict = uvalue.strict
+;
+; les longitudes
+;
+; min et max possible
+   if xtype EQ 'geographic' then begin
+      min = floor(min([glamt,glamu,glamv], max = max))
+      max = ceil(max)
+   ENDIF ELSE BEGIN 
+      min = 0
+      max = jpi-1
+   ENDELSE
+; les id des widgets
+   lon1id = widget_info(id,find_by_uname = 'lon1')
+   lon2id = widget_info(id,find_by_uname = 'lon2')
+; doit-on changer de type d''axe x: longitude/index
+   lonbase = widget_info(id,find_by_uname = 'lonbase')
+   widget_control, lonbase,  get_uvalue = lonbase_uvalue
+   if lonbase_uvalue.name NE xtype then BEGIN
+      widget_control, lonbase, update = 0
+; on casse tout
+      widget_control, lon1id, /destroy
+      widget_control, lon2id, /destroy
+; on reconstruit
+      lon1id = cw_slider_pm(lonbase,value=min > boite[0] < ((boite[1] < max)-keyword_set(strict)) $
+                            , uvalue={name:'lon1', strict:keyword_set(strict)},uname ='lon1' $
+                            , title = xtitle+'1', minimum = min $
+                            , maximum = (boite[1] < max)-keyword_set(strict))
+      lon2id = cw_slider_pm(lonbase,value=((min > boite[0])+keyword_set(strict)) > boite[1] < max $
+                            , uvalue={name:'lon2', strict:keyword_set(strict)} $
+                            , uname='lon2', title = xtitle+'2', maximum = max $
+                            , minimum = (min > boite[0])+keyword_set(strict))
+      widget_control, lonbase, set_uvalue = {name:xtype}
+      widget_control, lonbase, update = 1
+   ENDIF ELSE BEGIN
+; la nouvelle valeur qu''ils vont avoir
+      cursorvalue1 = min > boite[0] < ((boite[1] < max)-strict)
+      cursorvalue2 = ((min > boite[0])+strict) > boite[1] < max
+; on change les bornes des slider
+      widget_control, lon1id, set_value = {slider_min:min, slider_max:cursorvalue2-strict}
+      widget_control, lon2id, set_value = {slider_min:cursorvalue1+strict, slider_max:max}
+; on attribut la nouvelle valeur
+      widget_control, lon1id , set_value = cursorvalue1
+      widget_control, lon2id, set_value = cursorvalue2
+   ENDELSE
+;
+; les latitudes
+;
+; min et max possible
+   if ytype EQ 'geographic' then begin
+      min = floor(min([gphit,gphiu,gphiv], max = max))
+      max = ceil(max)
+   ENDIF ELSE BEGIN 
+      min = 0
+      max = jpj-1
+   ENDELSE
+; doit-on changer de type d''axe y: latitude/index
+   latbase = widget_info(id,find_by_uname = 'latbase')
+   widget_control, latbase,  get_uvalue = latbase_uvalue
+   lat1id = widget_info(id,find_by_uname = 'lat1')
+   lat2id = widget_info(id,find_by_uname = 'lat2')
+   if latbase_uvalue.name NE ytype then BEGIN
+      widget_control, latbase, update = 0
+      widget_control, lat1id, /destroy
+      widget_control, lat2id, /destroy
+      lat1id = cw_slider_pm(latbase,value=min > boite[2] < ((boite[3] < max)-keyword_set(strict)) $
+                            , uvalue={name:'lat1', strict:keyword_set(strict)},uname ='lat1' $
+                            , title = ytitle+'1', minimum =min $
+                            , maximum = ((boite[3] < max)-keyword_set(strict)))
+      lat2id = cw_slider_pm(latbase,value=((min > boite[2])+keyword_set(strict)) > boite[3] < max $
+                            , uvalue={name:'lat2', strict:keyword_set(strict)} $
+                            , uname ='lat2', title = ytitle+'2' ,maximum =  max $
+                            , minimum =(min > boite[2])+keyword_set(strict))
+      widget_control, latbase, set_uvalue = {name:ytype}
+      widget_control, latbase, update = 1
+   ENDIF ELSE BEGIN
+      cursorvalue1 = min > boite[2] < ((boite[3] < max)-strict)
+      cursorvalue2 = ((min > boite[2])+strict) > boite[3] < max
+      widget_control, lat1id, set_value = {slider_min:min, slider_max:cursorvalue2-strict}
+      widget_control, lat2id, set_value = {slider_min:cursorvalue1+strict, slider_max:max}
+      widget_control, lat1id, set_value = cursorvalue1
+      widget_control, lat2id, set_value = cursorvalue2
+   ENDELSE
+;
+;
+   if n_elements(boite) EQ 4 then return
+;
+; la profondeur
+;
+   depthlev1id = widget_info(id,find_by_uname = 'depthlev1')
+   depthlev2id = widget_info(id,find_by_uname = 'depthlev2')
+   depth1id = widget_info(id,find_by_uname = 'depth1')
+   depth2id = widget_info(id,find_by_uname = 'depth2')
+   widget_control, depthlev1id, get_uvalue = depthlev1_uval
+; a-t-on change de type de grille ?, faut=il changerl''axe verticale?
+   widget_control, findtopid(id),  get_uvalue = top_uvalue
+   zgrid = extractatt(top_uvalue, 'zgrid')
+   grid_t = zgrid EQ 'T'
+   if grid_t NE depthlev1_uval.grid_t then BEGIN
+      widget_control, depthlev2id, get_uvalue = depthlev2_uval
+      depthlev1_uval.grid_t = grid_t
+      depthlev2_uval.grid_t = grid_t
+;
+      if grid_t then gdep = gdept ELSE gdep = gdepw
+      gdep1 = floor(gdep)
+      gdep2 = ceil(gdep)
+      identique = where(gdep2-gdep1 EQ 0)
+      if identique[0] NE -1 then gdep2[identique] = gdep2[identique] +1
+      depthlev1_uval.value = gdep1
+      depthlev2_uval.value = gdep2
+;
+      widget_control, depthlev1id, set_value = {value:strtrim(gdep1, 1)}
+      widget_control, depthlev2id, set_value = {value:strtrim(gdep2, 1)}
+;
+      widget_control, depthlev1id, set_uvalue = depthlev1_uval
+      widget_control, depthlev2id, set_uvalue = depthlev2_uval
+   ENDIF ELSE BEGIN 
+      gdep1 = depthlev1_uval.value
+      gdep2 = gdep1+1
+   ENDELSE
+; on s''assure que les profs donnees contiennent bien au moins un
+; niveau.
+   if boite[4] GT boite[5] then begin
+      rien = boite[4]
+      boite[4] = boite[5]
+      boite[5] = rien
+   endif
+; 
+   rien = where(gdep1 LT boite[4], indice1)
+   indice1 = indice1 < (jpk-1)
+   rien = where(gdep2 LE boite[5], indice2)
+   indice2 = indice1 > (indice2-1)
+;
+   if indice1 EQ indice2 then BEGIN
+      if (where(gdep1 GE boite[4] AND gdep2 LE boite[5]))[0]  EQ -1 then begin
+         indice1 = 0 > (indice1-(grid_t EQ 1))
+         indice2 = indice1
+      endif
+      boite[4] = gdep1[indice1]
+      boite[5] = boite[4]+1
+   endif
+; maintenant que les values et les indexes sont definis proprement,
+; on peut les appliquer
+   widget_control, depthlev1id, set_value = {droplist_select:indice1}
+   widget_control, depthlev2id, set_value = {droplist_select:indice2}
+; controler les min et les max des sliders...
+   if indice1 EQ 0 then min1 = 0 ELSE min1 = gdep2[indice1-1]
+   max1 = (min1+1) > gdep1[indice2]
+   widget_control, depth1id, set_value = {slider_min:min1, slider_max:max1, value:boite[4]}
+   min2 = gdep2[indice1]
+   if indice2 EQ jpk-1 then BEGIN 
+      max2 = max([gdept, gdepw])
+      max2 = strtrim(string(max2,format='(e8.0)'), 1)
+      max2 = float('1'+strmid(max2, 1))+float(max2)
+   ENDIF ELSE max2 = gdep1[indice2+1]
+   widget_control, depth2id, set_value = {slider_min:min2, slider_max:max2, value:boite[5]}
+;
+   return
+end
+;*********************************************************************
+FUNCTION cw_domain_get_value, id
+   box = lonarr(6)
+   possiblecase = ['lon1', 'lon2','lat1', 'lat2','depth1','depth2']
+   for i = 0, 5 do begin
+      widget_control,widget_info(id,find_by_uname = possiblecase[i]) $
+       , get_value = value
+      box[i] = value.value
+   endfor
+   return, box
+end
+;*********************************************************************
+FUNCTION cw_domain_event, event
+@common
+; help,  /struct, event
+   if (where(tag_names(event) EQ 'OUT'))[0] NE -1 then if event.out NE 0 then return,  -1
+   widget_control, event.id, get_uvalue=uval
+   case uval.name of
+      'lon1':widget_control,widget_info(event.handler,find_by_uname = 'lon2') $
+       , set_value = {slider_min:event.value+uval.strict}
+      'lon2':widget_control,widget_info(event.handler,find_by_uname = 'lon1') $
+       , set_value = {slider_max:event.value-uval.strict}
+      'lat1':widget_control,widget_info(event.handler,find_by_uname = 'lat2') $
+       , set_value = {slider_min:event.value+uval.strict}
+      'lat2':widget_control,widget_info(event.handler,find_by_uname = 'lat1') $
+       , set_value = {slider_max:event.value-uval.strict}
+      'unzoom':BEGIN
+         id = widget_info(event.handler,find_by_uname = 'lon1')
+         widget_control, id, get_value = value
+         widget_control, id, set_value = {slider_min:value.slider_min_max[0]}
+         widget_control, id, set_value = value.slider_min_max[0]
+         id = widget_info(event.handler,find_by_uname = 'lat1')
+         widget_control, id, get_value = value
+         widget_control, id, set_value = {slider_min:value.slider_min_max[0]}
+         widget_control, id, set_value = value.slider_min_max[0]
+         id = widget_info(event.handler,find_by_uname = 'lon2')
+         widget_control, id, get_value = value
+         widget_control, id, set_value = {slider_max:value.slider_min_max[1]}
+         widget_control, id, set_value = value.slider_min_max[1]
+         id = widget_info(event.handler,find_by_uname = 'lat2')
+         widget_control, id, get_value = value
+         widget_control, id, set_value = {slider_max:value.slider_min_max[1]}
+         widget_control, id, set_value = value.slider_min_max[1]
+      END
+      'depthlev1':BEGIN
+; ids...
+         depth1id = widget_info(event.handler,find_by_uname = 'depth1')
+         depth2id = widget_info(event.handler,find_by_uname = 'depth2')
+         depthlev2id = widget_info(event.handler,find_by_uname = 'depthlev2')
+; faut-il changer depthlev2 ?
+         widget_control, depthlev2id, get_value = depthlev2_value
+         if depthlev2_value.droplist_select LT event.index then BEGIN
+; on redefinie la valeur de depthlev2id
+            widget_control, depthlev2id, set_value = {droplist_select:event.index}
+; donc on redefinit la valeur et le max du slider 2
+            widget_control, depthlev2id, get_uvalue = depthlev2_uval
+            if event.index EQ jpk-1 then BEGIN 
+               max = max([gdept, gdepw])
+               max = strtrim(string(max,format='(e8.0)'), 1)
+               max = float('1'+strmid(max, 1))+float(max)
+            ENDIF ELSE max = depthlev2_uval.value[event.index+1]-1
+            widget_control, depth2id $
+             , set_value = {slider_max:max, value:depthlev2_uval.value[event.index]}
+; du coup on redefinie donc le max du slider 1 
+            widget_control, depth1id, set_value = {slider_max:uval.value[event.index]}
+         END 
+; on redefinie la valeur et le min du slider depth 1
+         if event.index EQ 0 then min = 0 ELSE min = uval.value[event.index-1]+1
+         widget_control, depth1id, set_value = {slider_min:min, value:uval.value[event.index]}
+; du coup on change aussi la valeur du min du slider depth 2
+         widget_control, depth2id, set_value = {slider_min:uval.value[event.index]+1}
+      END
+      'depthlev2':BEGIN
+; ids...
+         depth1id = widget_info(event.handler,find_by_uname = 'depth1')
+         depth2id = widget_info(event.handler,find_by_uname = 'depth2')
+         depthlev1id = widget_info(event.handler,find_by_uname = 'depthlev1')
+; faut-il changer depthlev1 ?
+         widget_control, depthlev1id, get_value = depthlev1_value
+         if depthlev1_value.droplist_select GT event.index then BEGIN
+; on redefinie la valeur de depthlev1id
+            widget_control, depthlev1id, set_value = {droplist_select:event.index}
+; donc on redefinit la valeur et le min du slider 1
+            widget_control, depthlev1id, get_uvalue = depthlev1_uval
+            if event.index EQ 0 then min = 0 ELSE min = uval.value[event.index-1]
+            widget_control, depth1id $
+             , set_value = {slider_min:min, value:depthlev1_uval.value[event.index]}
+; du coup on redefinie donc le min du slider 2
+            widget_control, depth2id, set_value = {slider_min:uval.value[event.index]}
+         END 
+; on redefinie la valeur et le max du slider depth 2
+         if event.index EQ jpk-1 then BEGIN 
+            max = max([gdept, gdepw])
+            max = strtrim(string(max,format='(e8.0)'), 1)
+            max = float('1'+strmid(max, 1))+float(max)
+         ENDIF ELSE max = uval.value[event.index+1]-1
+         widget_control, depth2id, set_value = {slider_max:max, value:uval.value[event.index]}
+; du coup on change aussi la valeur du max du slider depth 1
+         widget_control, depth1id, set_value = {slider_max:uval.value[event.index]-1}
+      END
+      'depth1':BEGIN
+; ids...
+         depth2id = widget_info(event.handler,find_by_uname = 'depth2')
+         depthlev1id = widget_info(event.handler,find_by_uname = 'depthlev1')
+; doit-on changer depthlev1 ?
+         widget_control, depthlev1id, get_value = depthlev1_value
+         widget_control, depthlev1id, get_uvalue = depthlev1_uval
+         rien = where(depthlev1_uval.value LT event.value, indice)
+         indice = indice < (jpk-1)
+         if indice NE depthlev1_value.droplist_select then begin
+; on change le min de depth2
+            widget_control, depth2id, set_value = {slider_min:depthlev1_uval.value[indice]+1}
+; on redefinie la valeur de depthlev1id
+            widget_control, depthlev1id, set_value = {droplist_select:indice}
+; donc on redefinit le min du slider 1
+            if indice EQ 0 then min = 0 ELSE min = depthlev1_uval.value[indice-1]+1
+            widget_control, event.id, set_value = {slider_min:min}
+         endif
+      END
+      'depth2':BEGIN
+; ids...
+         depth1id = widget_info(event.handler,find_by_uname = 'depth1')
+         depthlev2id = widget_info(event.handler,find_by_uname = 'depthlev2')
+; doit-on changer depthlev2 ?
+         widget_control, depthlev2id, get_value = depthlev2_value
+         widget_control, depthlev2id, get_uvalue = depthlev2_uval
+         rien = where(depthlev2_uval.value LE event.value, indice)
+         indice = 0 > (indice-1)
+         if indice NE depthlev2_value.droplist_select then begin
+; on change le max de depth1
+            widget_control, depth1id, set_value = {slider_max:depthlev2_uval.value[indice]-1}
+; on redefinie la valeur de depthlev2id
+            widget_control, depthlev2id, set_value = {droplist_select:indice}
+; donc on redefinit le max du slider 2
+            if indice EQ jpk-1 then BEGIN 
+               max = max([gdept, gdepw])
+               max = strtrim(string(max,format='(e8.0)'), 1)
+               max = float('1'+strmid(max, 1))+float(max)
+            ENDIF ELSE max = depthlev2_uval.value[indice+1]-1
+            widget_control, event.id, set_value = {slider_max:max}
+         endif
+      END
+      ELSE:
+   ENDCASE
+;    slidesliceid = widget_info(event.top, find_by_uname = 'slide_slice')
+;    if slidesliceid NE 0 then widget_control, slidesliceid, set_value = 1
+   return,{ID:event.handler, TOP:event.top, HANDLER:0L $
+           , BOX:cw_domain_get_value(event.handler)}
+end
+;*********************************************************************
+FUNCTION cw_domain, parent, BOITE = boite, STRICT = strict, UVALUE = uvalue, UNAME = uname, ROW = row, COLUMN = column, UNZOOM = unzoom, _extra = ex
+;
+@common
+; cheking exclusive keywords
+   column = keyword_set(column)*(1-keyword_set(row))
+   row = keyword_set(row)*(1-keyword_set(column)) +(keyword_set(row) EQ column) 
+; def de la boite
+   if NOT keyword_set(boite) then boite = [lon1, lon2, lat1, lat2 $
+                                           , min([gdepw[0], gdept[0]]), max([gdepw[0], gdept[0]]) ]
+   Case N_Elements(Boite) OF
+      0:boite = [lon1, lon2, lat1, lat2, prof1, prof2]
+      1:boite=[lon1, lon2, lat1, lat2, 0.,boite[0]]
+      2:boite=[lon1, lon2, lat1, lat2, boite[0],boite[1]]
+      4:boite=[Boite, prof1, prof2]
+      5:boite=[Boite[0:3], 0, Boite[4]]
+      6:
+      Else: return, report('Mauvaise Definition de Boite')
+   ENDCASE
+;
+   boite[0] = floor(boite[0])
+   boite[1] = ceil(boite[1])
+   boite[2] = floor(boite[2])
+   boite[3] = ceil(boite[3])
+   boite[4] = floor(boite[4])
+   boite[5] = ceil(boite[5])
+;------------------------------------------------
+   if NOT keyword_set(uvalue) then uvalue = ''
+   if NOT keyword_set(uname) then uname = ''
+   base = widget_base(parent, /row  $
+                      , space = 1,  xpad = 1,  ypad = 1 $
+                      , EVENT_FUNC = 'cw_domain_event' $
+                      , FUNC_GET_VALUE='cw_domain_get_value' $
+                      , PRO_SET_VALUE='cw_domain_set_value' $
+                      , UVALUE = uvalue, UNAME = uname, _extra = ex)   
+;-------------longitude---------------------------
+   basehori = widget_base(base, ROW = row, COLUMN = column)
+;-------------longitude---------------------------
+   min = floor(min([glamt,glamu,glamv], max = max))
+   max = ceil(max)
+   lonbase = widget_base(basehori, /ROW, space = 1, xpad = 1, ypad = 1, uname = 'lonbase')
+   lon1id = cw_slider_pm(lonbase,value=min > boite[0] < ((boite[1] < max)-keyword_set(strict)) $
+                       , uvalue={name:'lon1', strict:keyword_set(strict)},uname ='lon1' $
+                       , title = 'lon1', minimum = min $
+                       , maximum = (boite[1] < max)-keyword_set(strict))
+   lon2id = cw_slider_pm(lonbase,value=((min > boite[0])+keyword_set(strict)) > boite[1] < max $
+                       , uvalue={name:'lon2', strict:keyword_set(strict)} $
+                       , uname='lon2', title = 'lon2', maximum = max $
+                       , minimum = (min > boite[0])+keyword_set(strict))
+   widget_control, lonbase, set_uvalue = {name:'geographic'}
+;---------------latitude-------------------------
+   min = floor(min([gphit,gphiu,gphiv], max = max))
+   max = ceil(max)
+   latbase = widget_base(basehori, /ROW, space = 1, xpad = 1, ypad = 1, uname = 'latbase')
+   lat1id = cw_slider_pm(latbase,value=min > boite[2] < ((boite[3] < max)-keyword_set(strict)) $
+                       , uvalue={name:'lat1', strict:keyword_set(strict)},uname ='lat1' $
+                       , title = 'lat1', minimum =min $
+                       , maximum = ((boite[3] < max)-keyword_set(strict)))
+   lat2id = cw_slider_pm(latbase,value=((min > boite[2])+keyword_set(strict)) > boite[3] < max $
+                       , uvalue={name:'lat2', strict:keyword_set(strict)} $
+                       , uname ='lat2', title = 'lat2' ,maximum =  max $
+                       , minimum =(min > boite[2])+keyword_set(strict))
+   widget_control, latbase, set_uvalue = {name:'geographic'}
+;----------------unzoom------------------------
+   if keyword_set(unzoom) then rien = widget_button(basehori,value='unzoom', uvalue={name:'unzoom'})
+;----------------depth------------------------
+   basevert = widget_base(base, ROW = row, COLUMN = column)
+   basedepth = widget_base(basevert, /row)
+;
+   if strupcase(vargrid) EQ 'W' then gdep = gdepw ELSE gdep = gdept
+   gdep1 = floor(gdep)
+   gdep2 = ceil(gdep)
+   identique = where(gdep2-gdep1 EQ 0)
+   if identique[0] NE -1 then gdep2[identique] = gdep2[identique] +1
+   sgdep1 = strtrim(gdep1, 1)
+   sgdep2 = strtrim(gdep2, 1)
+;
+   basedepthdrop = widget_base(basedepth, column = column,  row = row)
+;
+   dephtid=cw_droplist_pm(basedepthdrop,value=''+sgdep1, uvalue={name:'depthlev1', value:gdep1, grid_t:strupcase(vargrid) NE 'W'}, uname='depthlev1')
+   rien = where(gdep1 LT boite[4], indice1)
+   indice1 = indice1 < (jpk-1)
+   widget_control, dephtid, set_value = {droplist_select:indice1}
+;
+   dephtid=cw_droplist_pm(basedepthdrop,value=''+sgdep2, uvalue={name:'depthlev2', value:gdep2, grid_t:strupcase(vargrid) NE 'W'}, uname='depthlev2')
+   rien = where(gdep2 LE boite[5], indice2)
+   indice2 = indice1 > (indice2-1)
+   widget_control, dephtid, set_value = {droplist_select:indice2}
+;
+   basedepthslid = widget_base(basedepth, column = column,  row = row)
+;
+   if indice1 EQ 0 then min1 = 0 ELSE min1 = gdep2[indice1-1]
+   max1 = (min1+1) > gdep1[indice2]
+   rien = cw_slider_pm(basedepthslid, value= min1 > boite[4] < (boite[5] < max1) $
+                       , uvalue = {name:'depth1'}, uname = 'depth1' $
+                       , title = 'depth1', minimum = min1, maximum = max1)
+;
+   min2 = gdep2[indice1]
+   if indice2 EQ jpk-1 then BEGIN 
+      max2 = max([gdept, gdepw])
+      max2 = strtrim(string(max2,format='(e8.0)'), 1)
+      max2 = float('1'+strmid(max2, 1))+float(max2)
+   ENDIF ELSE max2 = gdep1[indice2+1]
+   if max2 EQ min2 then max2 = min2+1
+   rien = cw_slider_pm(basedepthslid, value= (min2 > boite[4]) > boite[5] < max2 $
+                       , uvalue={name:'depth2'}, minimum = min2 $
+                       , uname = 'depth2', title = 'depth2' ,maximum =  max2)
+;--------------------------------------------
+;
+;
+;
+   return, base
+end
Index: tags/start/WIDGET/COMPOUND_WIDGET/cw_droplist_pm.pro
===================================================================
--- tags/start/WIDGET/COMPOUND_WIDGET/cw_droplist_pm.pro	(revision 5)
+++ tags/start/WIDGET/COMPOUND_WIDGET/cw_droplist_pm.pro	(revision 5)
@@ -0,0 +1,219 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: cw_droplist_pm
+;
+; PURPOSE: widget equivalent a WIDGET_DROPLIST sauf qu'en plus on
+; dispose de 2 bouttons + et - pour deplacer le widget de +/- 1.
+;
+; CATEGORY: compound widget (aide a l''ecriture des widgets)
+;
+; CALLING SEQUENCE: id=cw_droplist_pm(parent)
+; 
+; INPUTS:
+;         Parent: The widget ID of the parent widget.
+;
+; KEYWORD PARAMETERS:tous ceux de WIDGET_DROPLIST
+;
+; OUTPUTS:
+;         The returned value of this function is the widget ID of the
+;         newly-created animation widget.
+;
+; COMMON BLOCKS: none
+;
+; SIDE EFFECTS:
+;
+;     Widget Events Returned by Droplist Widgets
+;
+;   Pressing the mouse button while the mouse cursor is over an
+;   element of a droplist widget causes the widget to change the label
+;   on the droplist button and to generate an event. The appearance of
+;   any previously selected element is restored to normal at the same
+;   time. The event structure returned by the WIDGET_EVENT function is
+;   defined by the following statement:
+;
+;   { CW_DROPLIST_PM, ID:0L, TOP:0L, HANDLER:0L, INDEX:0L, OUT:0 }
+;
+;   The first three fields are the standard fields found in every
+;   widget event.
+;   INDEX returns the index of the selected item. This can be used to
+;   index the array of names originally used to set the widget''s
+;   value
+;   OUT:c''est un entier qui peut prendre 3 valeurs:
+;       1 : si on appuie sur + alors que l''index est deja aux max. rq:
+;       ds ce cas l''index reste au max
+;       -1: si on appuie sur - alors que l''index est deja aux min. rq:
+;       ds ce cas l''index reste au min
+;       0 : ds les autres cas!
+;
+;   Keywords to WIDGET_CONTROL
+;
+;   A number of keywords to the WIDGET_CONTROL procedure affect the
+;   behavior of cw_slider_pm widget: GET_VALUE and SET_VALUE.
+;       1) GET_VALUE
+;   widget_control,wid_id,get_value=resultat
+;   retourne ds la variable resultat une structure de 3 elements dont
+;   les noms sont inspires des mots cles que l''on peut passer a
+;   widget_control qd on utilise WIDGET_DROPLIST:
+;            DROPLIST_NUMBER: the number of elements currently
+;            contained in the specified droplist widget.
+;            DROPLIST_SELECT: the zero-based number of the
+;            currently-selected element (i.e., the currently-displayed
+;            element) in the specified droplist widget.
+;            DYNAMIC_RESIZE: a True value (1) if the widget specified
+;            by Widget_ID is a button, droplist, or label widget that
+;            has had its DYNAMIC_RESIZE attribute set. Otherwise,
+;            False (0) is returned.
+;       2) SET_VALUE
+;   widget_control,wid_id,set_value=impose
+;   permet de modifier l''etat de la droplist comme on peut le faire
+;   pour WIDGET_DROPLIST Impose peut etre:
+;       a) The contents of the list widget (string or string array)
+;       b) une structure qui peut avoir comme elements (de 1 a 3):
+;            DYNAMIC_RESIZE:Set this keyword to activate (if set to 1)
+;            or deactivate (if set to 0) dynamic resizing of the
+;            specified CW_DROPLIST_PM widget (see the documentation
+;            for the DYNAMIC_RESIZE keyword to WIDGET_DROPLIST
+;            procedure for more information about dynamic widget
+;            resizing).
+;            DROPLIST_SELECT:Set this keyword to return the zero-based
+;            number of the currently-selected element (i.e., the
+;            currently-displayed element) in the specified droplist
+;            widget.
+;            VALUE: The contents of the list widget (string or string
+;            array)
+;
+; RESTRICTIONS:
+;
+; EXAMPLE: cf utiliser le programme founit i-dessous: testwid et la
+; procedure associee, testwid_event.
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      6/9/1999
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; PRO testwid_event, event
+; ;   help, event, /STRUCT
+;    DroplistId = widget_info(event.top,find_by_uname = 'c''est lui')
+;    widget_control, event.id, get_uvalue=uval
+;    if n_elements(uval) EQ 0 then return
+;    case uval of
+;       'done':widget_control, event.top, /destroy
+;       'dynamic_resize':BEGIN 
+;          widget_control, event.id, get_value = value
+;          widget_control, DroplistId, set_value = {dynamic_resize:value}
+;       END
+;       'droplist_select':BEGIN 
+;          widget_control, event.id, get_value = value
+;          widget_control, DroplistId, set_value = {droplist_select:value}
+;       END
+;       'value':BEGIN 
+;          widget_control, event.id, get_value = value
+;          widget_control, DroplistId, set_value = value
+;       END
+;       'get':BEGIN 
+;          widget_control, DroplistId, get_value = value
+;          help,  value, /struct
+;       END
+;       ELSE:
+;    endcase
+;    return
+; end
+; PRO testwid, _extra = ex
+;    base=widget_base(/COLUMN)
+; print, 'base=', base
+;    nothing = widget_label(base, value = 'beginning of the test')
+; ;
+;    nothing = cw_droplist_pm(base, _extra = ex, uname = 'c''est lui', uvalue = 'c''est lui')
+; print, 'cw_droplist_pm ID =', nothing
+; ;
+;    nothing = widget_label(base, value = 'end of the test')
+;    nothing = widget_text(base, value = '0', uvalue = 'dynamic_resize', /editable)
+;    nothing = widget_text(base, value = '10', uvalue = 'droplist_select', /editable)
+;    nothing = widget_text(base, value = '5', uvalue = 'value', /editable)
+;    nothing = widget_button(base, value = 'get', uvalue = 'get')
+;    nothing = widget_button(base, value = 'done', uvalue = 'done')
+;    widget_control, base, /REALIZE
+;    xmanager,'testwid', base
+;    return
+; end
+;----------------------------------------------------------------------
+PRO cw_droplist_pm_set_value, id, value
+   DroplistId = widget_info(id,find_by_uname = 'Droplist')
+   if size(value, /type) eq 8 then BEGIN ; this is a structure
+      tagnames = tag_names(value)
+      for tag = 0, n_tags(value)-1 do begin
+         case strtrim(strlowcase(tagnames[tag]), 2) of
+            'dynamic_resize':widget_control, DroplistId, dynamic_resize = value.dynamic_resize
+            'droplist_select':widget_control, DroplistId, set_droplist_select = value.droplist_select
+            'value':widget_control, DroplistId, set_value = value.value
+            ELSE:ras = report('mauvais nom de l''argument de la structure ds cw_droplist_pm_set_value')
+         endcase
+      endfor
+   ENDIF ELSE widget_control, DroplistId, set_value = value
+   return
+end
+;----------------------------------------------------------------------
+FUNCTION cw_droplist_pm_get_value, id
+   DroplistId = widget_info(id,find_by_uname = 'Droplist')
+   return, {droplist_number:widget_info(DroplistId, /droplist_number) $
+            , droplist_select:widget_info(DroplistId, /droplist_select) $
+            , dynamic_resize:widget_info(DroplistId, /dynamic_resize)}
+end
+;----------------------------------------------------------------------
+FUNCTION cw_droplist_pm_event, event
+   widget_control, event.id, get_uvalue=uval
+;
+   if uval EQ 'Droplist' then $
+    return, {CW_DROPLIST_PM, ID:event.handler, TOP:event.top, HANDLER:0L $
+             , INDEX:event.index, OUT:0}
+;
+   DroplistId = widget_info(event.handler,find_by_uname = 'Droplist')
+   index = widget_info(DroplistId, /droplist_select)
+   case uval OF
+      'plus':BEGIN
+         indexmax = widget_info(DroplistId, /droplist_number)-1
+         if index NE indexmax then widget_control, DroplistId,set_droplist_select = index+1
+         return, {CW_DROPLIST_PM, ID:event.handler, TOP:event.top, HANDLER:0L $
+                  , INDEX:(index+1) < indexmax, OUT:long(index EQ indexmax)}
+      END
+      'minus':BEGIN
+         if index NE 0 then widget_control, DroplistId,set_droplist_select = index-1
+         return, {CW_DROPLIST_PM, ID:event.handler, TOP:event.top, HANDLER:0L $
+                  , INDEX:0 > (index-1), OUT:-long(index EQ 0)}
+      END
+   endcase
+end
+;----------------------------------------------------------------------
+FUNCTION cw_droplist_pm, parent,UVALUE = uvalue, UNAME = uname, ROW = row, COLUMN = column, _extra = ex
+
+   IF (N_PARAMS() NE 1) THEN MESSAGE, 'Incorrect number of arguments'
+   ON_ERROR, 2                  ;return to caller
+; cheking for row and column keywords
+   row = keyword_set(row)*(1-keyword_set(column)) 
+   column = keyword_set(column)*(1-keyword_set(row))+(keyword_set(column) EQ row) 
+   if NOT keyword_set(uvalue) then uvalue = ''
+   if NOT keyword_set(uname) then uname = ''
+;
+   base = widget_base(parent, space = 1, xpad = 1, ypad = 1, ROW = row, COLUMN = column  $
+                      , EVENT_FUNC = 'cw_droplist_pm_event' $
+                      , FUNC_GET_VALUE='cw_droplist_pm_get_value' $
+                      , PRO_SET_VALUE='cw_droplist_pm_set_value' $
+                      , UVALUE = uvalue, UNAME = uname, _extra = ex)   
+;
+   if keyword_set(row) THEN nothing = widget_button(base,value= '-', uvalue= 'minus')
+   nothing = widget_droplist(base, UVALUE = 'Droplist', UNAME = 'Droplist', _extra = ex)
+   if keyword_set(column) then begin
+      base1 = widget_base(base, /row, /align_center, space = 1, xpad = 1, ypad = 1)
+      nothing = widget_button(base1,value= '-', uvalue= 'minus', xsize = 20, ysize = 20)
+      nothing = widget_button(base1,value= '+', uvalue= 'plus', xsize = 20, ysize = 20)
+   ENDIF ELSE nothing = widget_button(base,value= '+', uvalue= 'plus')
+;
+;   widget_control,base,/realize
+;
+   return, base
+end
Index: tags/start/WIDGET/COMPOUND_WIDGET/cw_fourparameter.pro
===================================================================
--- tags/start/WIDGET/COMPOUND_WIDGET/cw_fourparameter.pro	(revision 5)
+++ tags/start/WIDGET/COMPOUND_WIDGET/cw_fourparameter.pro	(revision 5)
@@ -0,0 +1,105 @@
+;*********************************************************************************
+FUNCTION cw_fourparameter_get_value, id
+      widget_control, widget_info(id, find_by_uname = 'glo'), get_value = glo
+      widget_control, widget_info(id, find_by_uname = 'used'), get_value = used
+      widget_control, widget_info(id, find_by_uname = 'min'), get_value = min
+      widget_control, widget_info(id, find_by_uname = 'max'), get_value = max
+   return, fix([glo[0], used[0], min[0], max[0]])
+end
+;*********************************************************************************
+FUNCTION cw_fourparameter_event, event
+   widget_control, event.id, get_uvalue=uval
+   value = cw_fourparameter_get_value(event.handler)
+   case uval of
+      'glo':
+      'used':BEGIN
+         widget_control, event.id, get_value = used 
+         value[1] = fix(used[0])
+         if value[1] GT value[0] then begin
+            value[1] = value[0]
+            widget_control, event.id, set_value = strtrim(value[1], 1)
+            value[2] = 0
+            widget_control, widget_info(event.handler, find_by_uname = 'min'), set_value = strtrim(value[2], 1)
+            value[3] = value[0]-1
+            widget_control, widget_info(event.handler, find_by_uname = 'max'),set_value=strtrim(value[3], 1)
+         ENDIF
+         if value[1] GT value[3]-value[2] then begin
+            value[2] = 0
+            widget_control, widget_info(event.handler, find_by_uname = 'min'), set_value = strtrim(value[2], 1)
+            value[3] = value[1]-1
+            widget_control, widget_info(event.handler, find_by_uname = 'max'),set_value=strtrim(value[3], 1)
+         ENDIF
+      END
+      'min':BEGIN 
+         widget_control, event.id, get_value = minv 
+         value[2] = 0 > fix(minv[0]) < (value[3]-1)
+         widget_control, event.id, set_value = strtrim(value[2], 1)
+         value[1] = fix(value[3]-value[2]+1)
+         widget_control, widget_info(event.handler, find_by_uname = 'used'), set_value = strtrim(value[1], 1)
+      END
+      'max':BEGIN
+         widget_control, event.id, get_value = maxv 
+         value[3] = (value[2]+1) > fix(maxv[0]) < (value[0]-1)
+         widget_control, event.id, set_value = strtrim(value[3], 1)
+         value[1] = fix(value[3]-value[2]+1)
+         widget_control, widget_info(event.handler, find_by_uname = 'used'), set_value = strtrim(value[1], 1)
+      END
+   endcase
+   return, {ID:event.handler, TOP:event.top, HANDLER:0L $
+            , VALUE:value}
+end
+;*********************************************************************************
+FUNCTION cw_fourparameter,  parent, xgloin, xin, xminin, xmaxin, direction, type, CLEAR = clear, EDITABLE = editable, UVALUE = uvalue, UNAME = uname
+;
+@common
+;
+   xglo = xgloin
+   x = xin
+   xmin = xminin
+   xmax = xmaxin
+;
+   if keyword_set(clear)  then begin
+      x = 0
+      xmin = 0
+      xmax = 0
+   ENDIF
+;   
+   if NOT keyword_set(uvalue) then uvalue = ''
+   if NOT keyword_set(uname) then uname = ''
+    base = widget_base(parent, /column, UVALUE = uvalue, UNAME = uname $
+                      , EVENT_FUNC = 'cw_fourparameter_event' $
+                      , FUNC_GET_VALUE='cw_fourparameter_get_value' $
+                      , PRO_SET_VALUE='cw_fourparameter_set_value' )
+;
+;     case type of
+;        'mesh':nothing = widget_label(base, value = 'parametres de position de la grille par rapport')
+;        'dta':nothing = widget_label(base, value = 'parametres de position des donnees par rapport')
+;     endcase
+;     nothing = widget_label(base, value = 'au domaine de calcul suivant '+direction)
+    baserow = widget_base(base, /row)
+    case direction of
+       'x':letter = 'i'
+       'y':letter = 'j'
+       'z':letter = 'k'
+    ENDCASE
+    case type of
+       'mesh':used = ''
+       'dta':used = 'dta'
+    endcase
+;
+    nothing = widget_label(baserow, value = 'jp'+letter+'glo')
+    nothing = widget_text(baserow, value = strtrim(xglo, 1), uname = 'glo', uvalue = 'glo', xsize = 4, EDITABLE = editable)
+
+    nothing = widget_label(baserow, value = 'jp'+letter+used)
+    nothing = widget_text(baserow, value = strtrim(x, 1), uname = 'used', uvalue = 'used', xsize = 4, EDITABLE = editable)
+
+    nothing = widget_label(baserow, value = 'i'+direction+'min'+type)
+    rien = execute('value = strtrim(i'+direction+'min'+type+'*(1-keyword_set(editable)), 1)')
+    nothing = widget_text(baserow, value = strtrim(xmin, 1), uname = 'min', uvalue = 'min', xsize = 4, EDITABLE = editable)
+
+    nothing = widget_label(baserow, value = 'i'+direction+'max'+type)
+    nothing = widget_text(baserow, value = strtrim(xmax, 1), uname = 'max', uvalue = 'max', xsize = 4, EDITABLE = editable)
+
+
+   return, base
+end
Index: tags/start/WIDGET/COMPOUND_WIDGET/cw_miseenpage.pro
===================================================================
--- tags/start/WIDGET/COMPOUND_WIDGET/cw_miseenpage.pro	(revision 5)
+++ tags/start/WIDGET/COMPOUND_WIDGET/cw_miseenpage.pro	(revision 5)
@@ -0,0 +1,138 @@
+;*********************************************************************
+;*********************************************************************
+FUNCTION cw_miseenpage_event, event
+
+   widget_control, event.id, get_uvalue=uval
+   widget_control, event.top, get_uvalue=top_uvalue
+;
+   petitin = extractatt(top_uvalue, 'petitin')
+   numdessinin = petitin[2]-1
+   petitout = extractatt(top_uvalue, 'petitout')
+;
+   if uval.name EQ 'undo' then begin
+      return,{ID:event.handler, TOP:event.top, HANDLER:0L}
+   ENDIF ELSE BEGIN 
+;
+@common
+; si on ne change pas le nombre de colonnes, on sort
+      if uval.name EQ 'column' then $
+       if event.index+1 EQ petitin[0] THEN $
+       return,{ID:event.handler, TOP:event.top, HANDLER:0L}
+; si on ne change pas le nombre de lignes, on sort
+      if uval.name EQ 'row' then $
+       if event.index+1 EQ petitin[1] THEN $
+       return,{ID:event.handler, TOP:event.top, HANDLER:0L}
+;
+; on efface la page
+;      graphid = widget_info(event.top,find_by_uname = 'graph')
+      graphid = extractatt(top_uvalue, 'graphid')
+      widget_control,graphid,get_value=win
+      wset, win
+      erase, 255
+      case uval.name of
+         'clear':
+         'column':BEGIN 
+            petitin = [event.index+1, petitin[1], 1]
+            petitout = [event.index+1, petitout[1], 1]
+         END
+         'row':BEGIN
+            petitin = [petitin[0], event.index+1, 1]
+            petitout = [petitout[0], event.index+1, 1]
+         END
+      endcase
+      nbredessin = petitin[0]*petitin[1]
+;         
+; on remet tout a 0 en ce qui concerne les postscripts
+      createhistory, event.top, petitin
+;         
+         options = extractatt(top_uvalue, 'options')   
+         flags = extractatt(top_uvalue, 'optionsflag')
+         xlonindex = where(options EQ 'Longitude / x index')
+         xlonflag = flags[xlonindex, numdessinin] & xlonflag = xlonflag[0]
+         ylatindex = where(options EQ 'Latitude / y index')
+         ylatflag = flags[ylatindex, numdessinin] & ylatflag = ylatflag[0]
+;         
+      flag = [1, key_portrait, 0, 0, 0, 0]
+      flag[xlonindex] = xlonflag
+      flag[ylatindex] = ylatflag
+;         
+; actualisation de la top_uvalue...
+;
+      *top_uvalue[1, findline(top_uvalue, 'petitin')] = petitin
+      *top_uvalue[1, findline(top_uvalue, 'petitout')] = petitout
+;
+      *top_uvalue[1, findline(top_uvalue, 'penvs')] = replicate(!p, nbredessin)
+      *top_uvalue[1, findline(top_uvalue, 'xenvs')] = replicate(!x, nbredessin)
+      *top_uvalue[1, findline(top_uvalue, 'yenvs')] = replicate(!y, nbredessin)
+;
+      old = (extractatt(top_uvalue, 'nameprocedures'))[numdessinin]
+      new = strarr(nbredessin)
+      new[0] = old
+      *top_uvalue[1, findline(top_uvalue, 'nameprocedures')] = new
+;
+      old = (extractatt(top_uvalue, 'types'))[numdessinin]
+      new = strarr(nbredessin)
+      new[0] = old
+      *top_uvalue[1, findline(top_uvalue, 'types')] = new
+;
+      old = (extractatt(top_uvalue,  'champs'))[*, numdessinin]
+      new = strarr(2, nbredessin)
+      new[*, 0] = old
+      *top_uvalue[1, findline(top_uvalue, 'champs')] = new
+;
+      old = (extractatt(top_uvalue, 'domaines'))[*, numdessinin]
+      new = fltarr(6, nbredessin)
+      new[*, 0] = old
+      *top_uvalue[1, findline(top_uvalue, 'domaines')] = new
+;
+      old = (extractatt(top_uvalue, 'dates'))[*, numdessinin]
+      new = lonarr(2, nbredessin)
+      new[*, 0] = old
+      *top_uvalue[1, findline(top_uvalue, 'dates')] = new
+;
+      old = (extractatt(top_uvalue,  'prefixes'))[numdessinin]
+      new = strarr(nbredessin)
+      new[0] = old
+      *top_uvalue[1, findline(top_uvalue, 'prefixes')] = new
+;
+      new = flag#replicate(1, nbredessin)
+      *top_uvalue[1, findline(top_uvalue, 'optionsflag')] = new
+;
+      ptr_free, extractatt(top_uvalue, 'exextra')
+      *top_uvalue[1, findline(top_uvalue, 'exextra')] = ptrarr(nbredessin, /allocate_heap)
+;      *top_uvalue[1, findline(top_uvalue, '')] = 
+;
+   ENDELSE 
+
+   return,{ID:event.handler, TOP:event.top, HANDLER:0L}
+end
+;*********************************************************************
+FUNCTION cw_miseenpage, parent, petit, UVALUE = uvalue, UNAME = uname, ROW = row, COLUMN = column, UNZOOM = unzoom, _extra = ex
+; cheking exclusive keywords
+   column = keyword_set(column)*(1-keyword_set(row))
+   row = keyword_set(row)*(1-keyword_set(column)) +(keyword_set(row) EQ column)
+;------------------------------------------------
+   if NOT keyword_set(uvalue) then uvalue = ''
+   if NOT keyword_set(uname) then uname = ''
+   base = widget_base(parent, ROW = row, COLUMN = column  $
+                      , EVENT_FUNC = 'cw_miseenpage_event' $
+                      , FUNC_GET_VALUE='cw_miseenpage_get_value' $
+                      , PRO_SET_VALUE='cw_miseenpage_set_value' $
+                      , UVALUE = uvalue, UNAME = uname, _extra = ex)   
+;------------------------------------------------
+   IF n_elements(petit) eq 0 then petit = [1, 1, 1]
+   basedroplist = widget_base(base, /column, /align_center)
+   id=widget_droplist(basedroplist, value=strtrim(indgen(10)+1, 1), title ='column' $
+                        , uvalue ={name:'column'}, uname='column')
+   widget_control, id, set_droplist_select = petit[0]-1
+   id=widget_droplist(basedroplist, value=strtrim(indgen(10)+1, 1), title =' row ' $
+                        , uvalue ={name:'row'}, uname='row')
+   widget_control, id, set_droplist_select = petit[1]-1
+   basebutton = widget_base(base, /column, /align_center)
+   rien = widget_button(basebutton, value = 'Clear', uvalue ={name:'clear'}, uname='clear')
+   rien = widget_button(basebutton, value = 'Undo', uvalue ={name:'undo'}, uname='undo')
+;------------------------------------------------
+;------------------------------------------------
+   return, base
+end
+;*********************************************************************
Index: tags/start/WIDGET/COMPOUND_WIDGET/cw_pdmenu.pro
===================================================================
--- tags/start/WIDGET/COMPOUND_WIDGET/cw_pdmenu.pro	(revision 5)
+++ tags/start/WIDGET/COMPOUND_WIDGET/cw_pdmenu.pro	(revision 5)
@@ -0,0 +1,362 @@
+; $Id$
+;
+; Copyright (c) 1992-1998, Research Systems, Inc.  All rights reserved.
+;	Unauthorized reproduction prohibited.
+;+
+; NAME:
+;	CW_PDMENU
+;
+; PURPOSE:
+;	CW_PDMENU is a compound widget that simplifies creating
+;	pulldown menus. It has a simpler interface than the XPDMENU
+;	procedure, which it is intended to replace. Events for the
+;	individual buttons are handled transparently, and a CW_PDMENU
+;	event returned. This event can return any one of the following:
+;               - The Index of the button within the base.
+;               - The widget ID of the button.
+;               - The name of the button.
+;		- The fully qualified name of the button. This allows
+;		  different sub-menus to contain buttons with the same
+;		  name in an unambiguous way.
+;
+;
+; CATEGORY:
+;	Compound widgets.
+;
+; CALLING SEQUENCE:
+;	widget = CW_PDMENU(Parent, Desc)
+;
+; INPUTS:
+;       Parent:	The ID of the parent widget.
+;	Desc:	An array of strings or structures.  Each element contains
+;		a menu description with two fields, a flag field, and
+;		the name of the item.  If a structure, each element
+;		is defined as follows:
+;			{ CW_PDMENU_S, flags:0, name:'' }
+;
+;		The name tag gives the name of button. The flags
+;		field is a two-bit bitmask that controls how the button is
+;		interpreted:
+;
+;		    Value	   Meaning
+;		    -------------------------------------------
+;		     0     This button is neither the beginning
+;			   nor the end of a pulldown level.
+;		     1     This button is the root of a
+;                          sub-pulldown menu. The sub-buttons
+;			   start with the next button.
+;		     2     This button is the last button at the
+;			   current pulldown level. The next button
+;			   belongs to the same level as the current
+;			   parent button.
+;			   If none or empty string is specified as a
+;			   the name, the button is not created, but
+;			   the next button belongs to the upward level.
+;		     3     This button is the root of a sub-pulldown
+;			   menu, but it is also the last entry of
+;			   the current level.
+;		     4     Same as 0, above, except that this button will
+;			   be preceeded by a separator as with the SEPARATOR
+;			   keyword to WIDGET_BUTTON.
+;		     5     Same as 1, above, except that this button will
+;			   be preceeded by a separator.
+;		     6     Same as 2, above, except that this button will
+;			   be preceeded by a separator.
+;		     7     Same as 3, above, except that this button will
+;			   be preceeded by a separator.
+;
+;	If Desc is a string, each element contains the flag field
+;	followed by a backslash character, followed by the menu item's
+;	contents.  See the example below.
+;
+;	EVENT PROCEDURES:  An event procedure may be specified for an
+;	element and all its children, by including a third field
+;	in Desc, if Desc is a string array.  Events for buttons without
+;	an event procedure, are dispatched normally.
+;	See the example below.
+;
+; KEYWORD PARAMETERS:
+;	DELIMITER:        The character used to separate the parts of a
+;			  fully qualified name in returned events. The
+;			  default is to use the '.' character.
+;	FONT:		  The name of the font to be used for the button
+;			  titles. If this keyword is not specified, the
+;			  default font is used.
+;	HELP:		  If MBAR is specified and one of the buttons on the
+;			  menubar has the label "help" (case insensitive) then
+;			  that button is created with the /HELP keyword to
+;			  give it any special appearance it is supposed to
+;			  have on a menubar. For example, Motif expects
+;			  help buttons to be on the right.
+;	IDS:		  A named variable into which the button IDs will
+;			  be stored as a longword vector.
+;	MBAR:		  if constructing a menu-bar pulldown, set this
+;			  keyword.  In this case, the parent must be the 
+;			  widget id of the menu bar of a top-level base,
+;			  returned by WIDGET_BASE(..., MBAR=mbar).
+;	RETURN_ID:	  If present and non-zero, the VALUE field of returned
+;			  events will be the widget ID of the button.
+;	RETURN_INDEX:	  If present and non-zero, the VALUE field of returned
+;			  events will be the zero-based index of the button
+;			  within the base. THIS IS THE DEFAULT.
+;	RETURN_NAME:	  If present and non-zero, the VALUE field of returned
+;			  events will be the name of the selected button.
+;	RETURN_FULL_NAME: If present and non-zero, the VALUE field of returned
+;               	  events will be the fully qualified name of the
+;			  selected button. This means that the names of all
+;			  the buttons from the topmost button of the pulldown
+;			  menu to the selected one are concatenated with the
+;			  delimiter specified by the DELIMITER keyword. For
+;			  example, if the top button was named COLORS, the
+;			  second level button was named BLUE, and the selected
+;			  button was named LIGHT, the returned value would be
+;
+;			  COLORS.BLUE.LIGHT
+;
+;			  This allows different submenus to have buttons with
+;			  the same name (e.g. COLORS.RED.LIGHT).
+;	UVALUE:		  The user value to be associated with the widget.
+;
+;       UNAME:            Set this keyword to a string that can be
+;       used to identify the widget in your code. You can associate a
+;       name with each widget in a specific hierarchy, and then use
+;       that name to query the widget hierarchy and get the correct
+;       widget ID.
+;
+;	XOFFSET:	  The X offset of the widget relative to its parent.
+;	YOFFSET:	  The Y offset of the widget relative to its parent.
+;
+;       _EXTRA:
+;
+; OUTPUTS:
+;       The ID of the top level button is returned.
+;
+; SIDE EFFECTS:
+;	This widget generates event structures with the following definition:
+;
+;		event = { ID:0L, TOP:0L, HANDLER:0L, VALUE:0 }
+;
+;	VALUE is either the INDEX, ID, NAME, or FULL_NAME of the button,
+;	depending on how the widget was created.
+;
+; RESTRICTIONS:
+;	Only buttons with textual names are handled by this widget.
+;	Bitmaps are not understood.
+;
+; EXAMPLE:
+;	The following is the description of a menu bar with two buttons,
+;	"Colors" and "Quit". Colors is a pulldown containing the colors
+;	"Red", "Green", Blue", "Cyan", and "Magenta". Blue is a sub-pulldown
+;	containing "Light", "Medium", "Dark", "Navy", and "Royal":
+;
+;		; Make sure CW_PDMENU_S is defined
+;		junk = { CW_PDMENU_S, flags:0, name:'' }
+;
+;		; The description
+;		desc = [ { CW_PDMENU_S, 1, 'Colors' }, $
+;			     { CW_PDMENU_S, 0, 'Red' }, $
+;			     { CW_PDMENU_S, 0, 'Green' }, $
+;			     { CW_PDMENU_S, 5, 'Blue\BLUE_EVENT_PROC' }, $
+;			         { CW_PDMENU_S, 0, 'Light' }, $
+;			         { CW_PDMENU_S, 0, 'Medium' }, $
+;			         { CW_PDMENU_S, 0, 'Dark' }, $
+;			         { CW_PDMENU_S, 0, 'Navy' }, $
+;			         { CW_PDMENU_S, 2, 'Royal' }, $
+;			       { CW_PDMENU_S, 4, 'Cyan' }, $
+;			       { CW_PDMENU_S, 2, 'Magenta\MAGENTA_EVENT_PROC' }, $
+;			 { CW_PDMENU_S, 2, 'Quit' } ]
+;
+;	The same menu may be defined as a string by equating the Desc parameter
+;	to the following string array:
+;	
+;	desc =[ '1\Colors' , $
+;		'0\Red' , $
+;		'0\Green' , $
+;		'5\Blue\BLUE_EVENT_PROC' , $
+;		'0\Light' , $
+;		'0\Medium' , $
+;		'0\Dark' , $
+;		'0\Navy' , $
+;		'2\Royal' , $
+;		'4\Cyan' , $
+;		'2\Magenta\MAGENTA_EVENT_PROC' , $
+;		'2\Quit'  ]
+;
+;
+;	The following small program can be used with the above description
+;	to create the specified menu:
+;
+;
+;		base = widget_base()
+;		menu = cw_pdmenu(base, desc, /RETURN_FULL_NAME)
+;		WIDGET_CONTROL, /REALIZE, base
+;		repeat begin
+;		  ev = WIDGET_EVENT(base)
+;		  print, ev.value
+;		end until ev.value eq 'Quit'
+;		WIDGET_CONTROL, /DESTROY, base
+;		end
+;
+;	Note that independent event procedures were specified for
+;	the multiple Blue buttons (blue_event_proc), and the Magenta button 
+;	(magenta_event_proc).
+
+; MODIFICATION HISTORY:
+;	18 June 1992, AB
+;	16 Jan 1995, DMS, Added MBAR keyword, event procedures,
+;			and menu descriptor strings.
+;	2 July 1995, AB, Added HELP keyword.
+;	3 September 1996, LP, Added button-less end of current level
+;-
+
+
+function CW_PDMENU_EVENT, ev
+
+  WIDGET_CONTROL, ev.id, get_uvalue=uvalue
+
+  return, { ID:ev.handler, TOP:ev.top, HANDLER:0L, value:uvalue }
+
+end
+
+
+
+
+
+
+
+pro CW_PDMENU_BUILD, parent, desc, cur, n, ev_type, full_qual_str, $
+	delim, ids, mbars, HELP_KW, FONT=font
+; Recursive routine that builds the pulldown hierarchy described in DESC.
+; Returns the ID of each button in ids.
+
+  is_string = size(desc)
+  is_string = is_string[is_string[0]+1] eq 7
+  while (cur lt n) do begin
+    separator=0
+    if is_string then begin
+        ; String version of DESC structure
+	a = str_sep(desc[cur], '\')
+	dflags = fix(strtrim(a[0],2))
+        if dflags GT 3 then begin
+          separator = 1
+          dflags = dflags - 4
+        endif
+        ; End of the level, and no button
+        if dflags EQ 2 AND N_ELEMENTS(a) LT 2 then begin
+            ids[cur] = 0
+            cur = cur + 1
+            return
+        endif
+        dname = a[1]
+    endif else begin
+        ; Structure version of DESC structure
+        dflags = desc[cur].flags
+        if dflags GT 3 then begin
+          separator = 1
+          dflags = dflags - 4
+        endif
+        dname = desc[cur].name
+        ; End of the level, and no button
+        if dflags EQ 2 AND dname EQ '' then begin
+            ids[cur] = 0
+            cur = cur + 1
+            return
+        endif
+        a = ['', str_sep(dname, '\')]
+        dname = a[1]
+    endelse
+
+    if (strlen(full_qual_str) ne 0) then $
+      new_qstr = full_qual_str + delim + dname $
+    else new_qstr = dname
+    ;If parented to a menu bar, don't draw a frame.
+    if (dflags and 1) then menu=2-mbars else menu = 0
+    ;
+    ; Build string with approriate keywords and execute it
+    ;
+    strExecute = 'new = WIDGET_BUTTON(parent, value=dname, MENU=menu'
+    if ((mbars ne 0) and (HELP_KW ne 0) $
+        and (strupcase(dname) eq 'HELP')) then $
+      strExecute = strExecute + ', /HELP'
+    if (keyword_set(font)) then strExecute = strExecute + ',  FONT=font'
+    strExecute = strExecute + ', SEPARATOR=separator'
+    strExecute = strExecute + ')'
+
+    status = EXECUTE(strExecute)
+
+    ; Set requested Return value
+    case ev_type of
+      0: uvalue = cur
+      1: uvalue = new
+      2: uvalue = dname
+      3: uvalue = new_qstr
+    endcase
+    WIDGET_CONTROL, new, SET_UVALUE=uvalue
+
+    ; Register event procedure
+    if n_elements(a) ge 3 then WIDGET_CONTROL, new, EVENT_PRO=strtrim(a[2],2)
+    ids[cur] = new
+    cur = cur + 1
+
+    ; Pullright menu button, start new level
+    if (dflags and 1) then $
+      CW_PDMENU_BUILD,new,desc,cur,n,ev_type,$
+      new_qstr,delim,ids,mbars, 0,FONT=font
+
+    ; End of the current level
+    if ((dflags and 2) ne 0) then return
+  endwhile
+
+end
+
+
+
+
+
+
+function CW_PDMENU, parent, desc, COLUMN=column, DELIMITER=delim, FONT=font, $
+	IDS=ids, MBAR=mbar, HELP=HELP_KW, $
+	RETURN_ID=r_id, RETURN_INDEX=ignore, RETURN_NAME=r_name, $
+	RETURN_FULL_NAME=r_full_name, $
+	UVALUE=uvalue, UNAME = uname, XOFFSET=xoffset, YOFFSET=yoffset, $
+           _EXTRA = ex
+
+
+  IF (N_PARAMS() ne 2) THEN MESSAGE, 'Incorrect number of arguments'
+
+  ON_ERROR, 2						;return to caller
+
+  ; Set default values for the keywords
+  If KEYWORD_SET(column) then row = 0 else begin row = 1 & column = 0 & end
+  IF (N_ELEMENTS(delim) eq 0)	then delim = '.'
+  IF (N_ELEMENTS(uvalue) eq 0)	then uvalue = 0
+  IF (N_ELEMENTS(xoffset) eq 0)	then xoffset=0
+  IF (N_ELEMENTS(yoffset) eq 0)	then yoffset=0
+
+  ; How to interpret ev_type:
+  ;	0 - Return index
+  ;	1 - Return ID
+  ;	2 - Return name
+  ;	3 - Return fully qualified name.
+  ev_type = 0
+  if (keyword_set(r_id)) 	then ev_type = 1
+  if (keyword_set(r_name)) 	then ev_type = 2
+  if (keyword_set(r_full_name))	then ev_type = 3
+
+
+  n = n_elements(desc)
+  ids = lonarr(n)
+  mbars = KEYWORD_SET(mbar)
+  help_kw = KEYWORD_SET(HELP_KW)
+  if mbars then BEGIN
+    base = parent
+    if (keyword_set(uvalue)) then WIDGET_CONTROL, base, SET_UVALUE=uvalue, SET_UNAME=uname
+  ENDIF else BEGIN
+    base = widget_base(parent, COLUMN=column, UNAME = uname, $
+		     ROW=row, UVALUE=uvalue, XOFFSET=xoffset, YOFFSET=yoffset, _EXTRA = ex)
+  ENDELSE
+  WIDGET_CONTROL, base, EVENT_FUNC='CW_PDMENU_EVENT' 
+ CW_PDMENU_BUILD, base, desc, 0, n, ev_type, '', delim, ids, mbars, help_kw, $
+	FONT=font
+  return, base
+END
Index: tags/start/WIDGET/COMPOUND_WIDGET/cw_slide_slice.pro
===================================================================
--- tags/start/WIDGET/COMPOUND_WIDGET/cw_slide_slice.pro	(revision 5)
+++ tags/start/WIDGET/COMPOUND_WIDGET/cw_slide_slice.pro	(revision 5)
@@ -0,0 +1,163 @@
+pro cw_slide_slice_set_value, id, value
+@common
+   topid = findtopid(id)
+   domainid = widget_info(topid, find_by_uname = 'domain')
+   widget_control, domainid, get_value = boite
+   if boite[1]-boite[0] LT boite[3]-boite[2] then type = 'y' ELSE type = 'x'
+   thickid  = widget_info(topid, find_by_uname = 'thickness')
+   widget_control, thickid, get_uvalue = thicknessuval
+   widget_control, thickid, get_value = thickness
+   thickness = thicknessuval.choix[thickness.droplist_select]
+   sliderid = widget_info(topid, find_by_uname = 'slider')
+   if type EQ 'y' then BEGIN
+      mini = floor(min([glamt, glamu], max = maxi))
+      maxi = ceil(maxi)-thickness
+      widget_control, sliderid, set_value = {slider_min:mini, slider_max:maxi, value:boite[0]<maxi}
+      thickness = boite[1]-boite[0]
+   ENDIF ELSE BEGIN 
+      mini = floor(min([gphit, gphiv], max = maxi))
+      maxi = ceil(maxi)-thickness
+      widget_control, sliderid, set_value = {slider_min:mini, slider_max:maxi, value:boite[2]<maxi}
+      thickness = boite[3]-boite[2]
+   ENDELSE
+   thicknessval = thicknessuval.choix
+   index = where(thicknessval EQ thickness) & index = index[0]
+   if index EQ -1 then BEGIN 
+      index = 20
+      thicknessval[20] = strtrim(thickness, 1)
+      widget_control, thickid, set_value = thicknessval
+      widget_control, thickid, set_uvalue ={name:'thickness', choix:thicknessval}
+   endif
+   widget_control, thickid, set_value = {droplist_select:index}
+   return
+end
+;----------------------------------------------------------------------
+FUNCTION cw_slide_slice_event,  event
+@common
+   widget_control, event.id, get_uvalue=uval
+   domainid = widget_info(event.top, find_by_uname = 'domain')
+   thickid  = widget_info(event.handler, find_by_uname = 'thickness')
+   sliderid = widget_info(event.handler, find_by_uname = 'slider')
+;   uniteid  = widget_info(event.handler, find_by_uname = 'unite')
+   widget_control, domainid, get_value = boite
+   if boite[1]-boite[0] LT boite[3]-boite[2] then type = 'y' ELSE type = 'x'
+   widget_control, thickid, get_uvalue = thicknessuval
+   widget_control, thickid, get_value = thickness
+   thickness = thicknessuval.choix[thickness.droplist_select]
+   widget_control, sliderid, get_value = slider & slider = slider.value
+
+   if uval.name EQ 'thickness' then begin
+      if boite[1]-boite[0] LT boite[3]-boite[2] then type = 'y' ELSE type = 'x'
+      if type EQ 'y' then BEGIN
+         mini = floor(min([glamt, glamu], max = maxi))
+         maxi = ceil(maxi)-thickness
+      ENDIF ELSE BEGIN 
+         mini = floor(min([gphit, gphiv], max = maxi))
+         maxi = ceil(maxi)-thickness
+      ENDELSE
+      slider = slider<maxi
+      widget_control, sliderid, set_value = {slider_min:mini, slider_max:maxi, value:slider}
+   endif
+
+;   widget_control, uniteid, get_value = unite
+;
+;
+;    if uval.name EQ 'unite' then begin
+;       domdef, boite, grille = 'T'
+;       if unite EQ 'degre' then BEGIN
+;          if strpos(type,'y') NE -1 then begin
+;             mini = floor(min([glamt, glamu], max = maxi))
+;             maxi = ceil(maxi)
+; print, lon1, mini, maxi
+;             widget_control, sliderid, set_value = {value:lon1, slider_min_max:[mini, maxi]}
+;          ENDIF ELSE BEGIN 
+;             mini = floor(min([gphit, glamv], max = maxi))
+;             maxi = ceil(maxi)
+;             widget_control, sliderid, set_value = {value:lat1, slider_min_max:[mini, maxi]}
+;          ENDELSE
+;       ENDIF ELSE BEGIN
+;          if strpos(type,'y') NE -1 then BEGIN
+; print, 'ds if',premierxt, 0, jpi-1
+;             widget_control, sliderid, set_value = {value:premierxt, slider_min_max:[0, jpi-1]}
+;          ENDIF ELSE BEGIN 
+;             widget_control, sliderid, set_value = {value:premieryt, slider_min_max:[0, jpj-1]}
+;          ENDELSE
+;       ENDELSE
+;    endif
+;
+;   if unite EQ 'degre' then BEGIN
+   if type EQ 'y' then begin
+      boite[0] = slider &  boite[1] = slider+thickness
+   ENDIF ELSE BEGIN 
+      boite[2] = slider &  boite[3] = slider+thickness
+   ENDELSE 
+;    ENDIF ELSE BEGIN
+;       if strpos(type,'y') NE -1 then begin
+;          boite[0] = glamt[slider, 0] &  boite[1] = glamu[slider+thickness, 0]
+;       ENDIF ELSE BEGIN 
+;          boite[2] = gphit[0, slider] &  boite[3] = gphiv[0, slider+thickness]
+;       ENDELSE 
+;    ENDELSE
+   widget_control, domainid, set_value = boite
+   return, {CW_SLIDE_SLICE, ID:event.handler, TOP:event.top, HANDLER:0L}
+end
+;--------------------------------------------------------------------------------
+FUNCTION cw_slide_slice, parent, boite = boite, UVALUE = uvalue, UNAME = uname, FRAME = frame, ROW = row, COLUMN = column, _extra = ex
+@common
+;------------------------------------------------
+; cheking exclusive keywords
+   column = keyword_set(column)*(1-keyword_set(row))
+   row = keyword_set(row)*(1-keyword_set(column)) +(keyword_set(row) EQ column) 
+   if NOT keyword_set(uvalue) then uvalue = ''
+   if NOT keyword_set(uname) then uname = ''
+;
+   base = widget_base(parent, ROW = row, COLUMN = column  $
+                      , EVENT_FUNC = 'cw_slide_slice_event' $
+                      , FUNC_GET_VALUE='cw_slide_slice_get_value' $
+                      , PRO_SET_VALUE='cw_slide_slice_set_value' $
+                      , ROW = row, COLUMN = column, UVALUE = uvalue, UNAME = uname $
+                      , FRAME = frame, _extra = ex)   
+;------------------------------------------------
+   if NOT keyword_set(boite) then boite = [lon1, lon2, lat1, lat2]
+;    rien = cw_bgroup(base, ['degre', 'points'],/exclusive, /column, uname = 'unite', uvalue = {name:'unite'}, /return_name, set_value = 0, /no_release)
+   thicknessval = indgen(21)+1
+   thicknessval = string(thicknessval)
+   for i = 0, n_elements(thicknessval)-1 do thicknessval[i] = strtrim(thicknessval[i], 1)
+   droplistid = cw_droplist_pm(base, value = thicknessval, uname = 'thickness', uvalue = {name:'thickness', choix:thicknessval})
+;
+   if boite[1]-boite[0] LT boite[3]-boite[2] then type = 'y' ELSE type = 'x'
+   if type EQ 'y' then BEGIN
+      mini = floor(min([glamt, glamu], max = maxi))
+      thickness = boite[1]-boite[0]
+      maxi = ceil(maxi)-thickness
+      rien = cw_slider_pm(base, minimum = mini, maximum = (mini+1) > maxi $
+                          , value = mini > boite[0] < maxi, /column, uname = 'slider' $
+                          , uvalue = {name:'slider'})
+   ENDIF ELSE BEGIN 
+      mini = floor(min([gphit, gphiv], max = maxi))
+      thickness = boite[3]-boite[2]
+      maxi = ceil(maxi)-thickness
+      rien = cw_slider_pm(base, minimum = mini, maximum =  (mini+1) > maxi $
+                          , value = mini > boite[2] < maxi, /column, uname = 'slider' $
+                          , uvalue = {name:'slider'})
+   ENDELSE
+   index = where(thicknessval EQ thickness) & index = index[0]
+   if index EQ -1 then BEGIN 
+      index = 20
+      thicknessval[20] = strtrim(thickness, 1)
+      widget_control, droplistid, set_value = thicknessval
+      widget_control, droplistid, set_uvalue ={name:'thickness', choix:thicknessval}
+   endif
+   widget_control, droplistid, set_value = {droplist_select:index}
+   
+;   if type EQ 'xt' then begin
+;       mini = floor(min([glamt,glamu,glamv], max = maxi))
+;       maxi = ceil(maxi)
+;    ENDIF ELSE BEGIN 
+;       mini = floor(min([gphit,gphiu,gphiv], max = maxi))
+;       maxi = ceil(maxi)
+;    ENDELSE
+   
+;------------------------------------------------
+   return, base
+end
Index: tags/start/WIDGET/COMPOUND_WIDGET/cw_slider_pm.pro
===================================================================
--- tags/start/WIDGET/COMPOUND_WIDGET/cw_slider_pm.pro	(revision 5)
+++ tags/start/WIDGET/COMPOUND_WIDGET/cw_slider_pm.pro	(revision 5)
@@ -0,0 +1,227 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: cw_slider_pm
+;
+; PURPOSE: widget equivalent a WIDGET_SLIDER sauf qu'en plus on
+; dispose de 2 bouttons + et - pour deplacer le widget de +/- 1.
+;
+; CATEGORY: compound widget (aide a l''ecriture des widgets)
+;
+; CALLING SEQUENCE: id=cw_slider_pm(parent)
+; 
+; INPUTS:
+;         Parent: The widget ID of the parent widget.
+;
+; KEYWORD PARAMETERS:tous ceux de WIDGET_SLIDER
+;
+; OUTPUTS:
+;         The returned value of this function is the widget ID of the
+;         newly-created animation widget.
+;
+; COMMON BLOCKS: none
+;
+; SIDE EFFECTS: 
+;
+;  Widget Events Returned by the CW_SLIDER_PM Widget
+;
+;  Slider widgets generate events when the mouse is used to change
+;  their value. The event structure returned by the WIDGET_EVENT
+;  function is defined by the following statement:
+;
+;  {CW_SLIDER_PM, ID:0L, TOP:0L, HANDLER:0L, VALUE:0L, DRAG:0, OUT:0}
+;
+;  ID is the widget ID of the button generating the event. TOP is the
+;  widget ID of the top level widget containing ID.
+;  HANDLER contains the widget ID of the widget associated with the
+;  handler routine.
+;  VALUE returns the new value of the slider.
+;  DRAG returns integer 1 if the slider event was generated as part of
+;  a drag operation, or zero if the event was generated when the user
+;  had finished positioning the slider. Note that the slider widget
+;  only generates events during the drag operation if the DRAG keyword
+;  is set, and if the application is running under Motif. When the
+;  DRAG keyword is set, the DRAG field can be used to avoid
+;  computationally expensive operations until the user releases the
+;  slider.
+;  OUT:c''est un entier qui peut prendre 3 valeurs:
+;      1 : si on appuie sur + alors que le slider est deja aux max. rq:
+;      ds ce cas le slider reste au max
+;      -1: si on appuie sur - alors que le slider est deja aux min. rq:
+;      ds ce cas le slider reste au min
+;      0 : ds les autres cas!
+;
+;   Keywords to WIDGET_CONTROL
+;
+;   A number of keywords to the WIDGET_CONTROL procedure affect the
+;   behavior of cw_slider_pm widget: GET_VALUE and SET_VALUE.
+;       1) GET_VALUE
+;   widget_control,wid_id,get_value=resultat
+;   retourne ds la variable resultat une structure de 2 elements dont
+;   les noms sont inspires des mots cles que l''on peut passer a
+;   widget_control qd on utilise WIDGET_SLIDER:
+;            VALUE:the value setting of the widget
+;            SLIDER_MIN_MAX: a 2 elements array: The minimum and the
+;            maximum value of the range encompassed by the slider
+;       2) SET_VALUE
+;   widget_control,wid_id,set_value=impose
+;   permet de modifier l''etat de la slider bar comme on peut le faire
+;   pour WIDGET_SLIDER. Impose peut etre:
+;       a) un entier: donne la nouvelle  position of the slider.
+;       b) une structure qui peut avoir comme elements (de 1 a 3):
+;            VALUE:un entier qui donne la nouvelle  position of the slider.
+;            SLIDER_MIN:Set to a new minimum value for the specified
+;            slider widget.
+;            SLIDER_MAX:Set to a new minimum value for the specified
+;            slider widget.
+;
+; RESTRICTIONS:
+;
+; EXAMPLE: cf utiliser le programme founit i-dessous: testwid et la
+; procedure associee, testwid_event.
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      5/9/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+; PRO testwid_event, event
+; ;   help, event, /STRUCT
+;    SliderBarId = widget_info(event.top,find_by_uname = 'c''est lui')
+;    widget_control, event.id, get_uvalue=uval
+;    if n_elements(uval) EQ 0 then return
+;    case uval of
+;       'done':widget_control, event.top, /destroy
+;       'slider_min':BEGIN 
+;          widget_control, event.id, get_value = value
+;          widget_control, SliderBarId, set_value = {slider_min:value}
+;       END
+;       'slider_max':BEGIN 
+;          widget_control, event.id, get_value = value
+;          widget_control, SliderBarId, set_value = {slider_max:value}
+;       END
+;       'slider_value':BEGIN 
+;          widget_control, event.id, get_value = value
+;          widget_control, SliderBarId, set_value = value
+;       END
+;       'get':BEGIN 
+;          widget_control, SliderBarId, get_value = value
+;          help,  value, /struct
+;          print, value.slider_min_max
+;       END
+;       ELSE:
+;    endcase
+;    return
+; end
+; PRO testwid, _extra = ex
+;    base=widget_base(/COLUMN)
+; print, 'base=', base
+;    nothing = widget_label(base, value = 'beginning of the test')
+; ;
+;    nothing = cw_slider_pm(base, _extra = ex, uname = 'c''est lui', uvalue = 'c''est lui')
+; print, 'cw_slider_pm ID =', nothing
+; ;
+;    nothing = widget_label(base, value = 'end of the test')
+;    nothing = widget_text(base, value = '0', uvalue = 'slider_min', /editable)
+;    nothing = widget_text(base, value = '10', uvalue = 'slider_max', /editable)
+;    nothing = widget_text(base, value = '5', uvalue = 'slider_value', /editable)
+;    nothing = widget_button(base, value = 'get', uvalue = 'get')
+;    nothing = widget_button(base, value = 'done', uvalue = 'done')
+;    widget_control, base, /REALIZE
+;    xmanager,'testwid', base
+;    return
+; end
+;----------------------------------------------------------------------
+PRO cw_slider_pm_set_value, id, value
+   SliderBarId = widget_info(id,find_by_uname = 'SliderBar')
+   if size(value, /type) eq 8 then BEGIN ; this is a structure
+      tagnames = tag_names(value)
+      for tag = 0, n_tags(value)-1 do begin
+         case strtrim(strlowcase(tagnames[tag]), 2) of
+            'slider_min':widget_control, SliderBarId, set_slider_min = value.slider_min
+            'slider_max':widget_control, SliderBarId, set_slider_max = value.slider_max
+            'value':widget_control, SliderBarId, set_value = value.value
+            ELSE:ras = report('mauvais nom de l''argument de la structure ds cw_slider_pm_set_value')
+         endcase
+      endfor
+   ENDIF ELSE widget_control, SliderBarId, set_value = value[0]
+   return
+end
+;----------------------------------------------------------------------
+FUNCTION cw_slider_pm_get_value, id
+   SliderBarId = widget_info(id,find_by_uname = 'SliderBar')
+   widget_control, SliderBarId, get_value = value
+   return, {value:value, slider_min_max:widget_info(SliderBarId, /slider_min_max)}
+end
+;----------------------------------------------------------------------
+FUNCTION cw_slider_pm_event, event
+   widget_control, event.id, get_uvalue=uval
+;
+   if uval EQ 'SliderBar' then $
+    return, {CW_SLIDER_PM, ID:event.handler, TOP:event.top, HANDLER:0L $
+             , VALUE:event.value, OUT:0}
+;
+   SliderBarId = widget_info(event.handler,find_by_uname = 'SliderBar')
+   minmax = widget_info(SliderBarId, /SLIDER_MIN_MAX)
+   widget_control, SliderBarId, get_value = value
+   case uval OF
+      'plus':BEGIN
+         if value NE minmax[1] then widget_control, SliderBarId,set_value = value+1
+         return, {CW_SLIDER_PM, ID:event.handler, TOP:event.top, HANDLER:0L $
+                  , VALUE:(value+1) < minmax[1], OUT:long(value eq minmax[1])}
+      END
+      'minus':BEGIN
+         if value NE minmax[0] then widget_control, SliderBarId,set_value = value-1
+         return, {CW_SLIDER_PM, ID:event.handler, TOP:event.top, HANDLER:0L $
+                  , VALUE:0 > (value-1), OUT:-long(value EQ minmax[0])}
+      END
+   endcase
+end
+;----------------------------------------------------------------------
+FUNCTION cw_slider_pm, parent, ROW = row, COLUMN = column, VERTICAL = vertical, UVALUE = uvalue, UNAME = uname, _extra = ex
+
+   IF (N_PARAMS() NE 1) THEN MESSAGE, 'Incorrect number of arguments'
+   ON_ERROR, 2                  ;return to caller
+;
+; cheking exclusive keywords
+   column = (keyword_set(column)*(1-keyword_set(row))+keyword_set(vertical)) < 1
+   row = keyword_set(row)*(1-keyword_set(column)) +(keyword_set(row) EQ column) 
+   if NOT keyword_set(uvalue) then uvalue = ''
+   if NOT keyword_set(uname) then uname = ''
+   base = widget_base(parent, space = 1, xpad = 1, ypad = 1 $
+                      , EVENT_FUNC = 'cw_slider_pm_event' $
+                      , FUNC_GET_VALUE='cw_slider_pm_get_value' $
+                      , PRO_SET_VALUE='cw_slider_pm_set_value' $
+                      , ROW = row, COLUMN = column, UVALUE = uvalue, UNAME = uname, _extra = ex)   
+;
+   if keyword_set(vertical) then BEGIN
+      if keyword_set(row) then begin
+         nothing = widget_slider(base, /VERTICAL, UVALUE = 'SliderBar', UNAME = 'SliderBar', _extra = ex)
+         base1 = widget_base(base, space = 1, xpad = 1, ypad = 1 $
+                             , /column, /align_center)
+         nothing = widget_button(base1,value= '+', uvalue='plus', xsize = 15, ysize = 15)
+         nothing = widget_button(base1,value= '-', uvalue='minus', xsize = 15, ysize = 15)
+      ENDIF ELSE BEGIN 
+         nothing = widget_button(base,value= '+', uvalue='plus', xsize = 15, ysize = 15)
+         nothing = widget_slider(base, /VERTICAL, UVALUE = 'SliderBar', UNAME = 'SliderBar', _extra = ex)
+         nothing = widget_button(base,value= '-', uvalue='minus', xsize = 15, ysize = 15)
+      ENDELSE
+   ENDIF ELSE BEGIN
+      if keyword_set(row) then begin
+         nothing = widget_button(base,value= '-', uvalue='minus', xsize = 15, ysize = 15)
+         nothing = widget_slider(base, UVALUE = 'SliderBar', UNAME = 'SliderBar', _extra = ex)
+         nothing = widget_button(base,value= '+', uvalue='plus', xsize = 15, ysize = 15)
+      ENDIF ELSE BEGIN 
+         nothing = widget_slider(base, UVALUE = 'SliderBar', UNAME = 'SliderBar', _extra = ex)
+         base1 = widget_base(base, space = 1, xpad = 1, ypad = 1 $
+                             , /row, /align_center)
+         nothing = widget_button(base1,value= '-', uvalue='minus', xsize = 15, ysize = 15)
+         nothing = widget_button(base1,value= '+', uvalue='plus', xsize = 15, ysize = 15)
+      ENDELSE
+   ENDELSE
+;
+;
+   return, base
+end
Index: tags/start/WIDGET/COMPOUND_WIDGET/cw_specifie.pro
===================================================================
--- tags/start/WIDGET/COMPOUND_WIDGET/cw_specifie.pro	(revision 5)
+++ tags/start/WIDGET/COMPOUND_WIDGET/cw_specifie.pro	(revision 5)
@@ -0,0 +1,139 @@
+;*****************************************************
+;*****************************************************
+PRO cw_specifie_set_value, id, value
+   if size(value, /type) NE 8 then return
+   widget_control, widget_info(id,find_by_uname='min'), set_value = strtrim(value.min, 2)
+   widget_control, widget_info(id,find_by_uname='max'), set_value = strtrim(value.max, 2)
+   widget_control, widget_info(id,find_by_uname='int'), set_value = strtrim(value.inter, 2)
+   widget_control, widget_info(id,find_by_uname='palnum'), set_value = strtrim(value.lct, 2)
+   autres = extractstru(value, ['min', 'max', 'inter', 'lct', 'nothing', 'xindex', 'yindex'])
+   if size(autres, /type) EQ 8 then BEGIN 
+      autresid = widget_info(id,find_by_uname='autres')
+      widget_control, widget_info(id,find_by_uname='autres'), get_value = autresautres
+      autresautres = autresautres[0]
+      if strtrim(autresautres, 2) NE '' then begin
+         nothing = execute('autresautres = get_extra('+autresautres+')')
+         autres = mixstru(autres, autresautres)
+      endif
+      autres = strkeywd(autres)
+      widget_control, widget_info(id,find_by_uname='autres'), set_value = autres
+   endif
+   return
+end
+;*****************************************************
+;*****************************************************
+FUNCTION cw_specifie_get_value, id
+   widget_control, widget_info(id,find_by_uname='min'), get_value = min
+   min = float(min[0])
+   widget_control, widget_info(id,find_by_uname='max'), get_value = max
+   max = float(max[0])
+   widget_control, widget_info(id,find_by_uname='int'), get_value = int
+   int = float(int[0])
+   widget_control, widget_info(id,find_by_uname='palnum'), get_value = palnum
+   palnum = long(palnum[0])
+   widget_control, widget_info(id,find_by_uname='autres'), get_value = autres
+   autres = autres[0]
+;
+   exextra = {min:min, max:max, inter:int, lct:palnum}
+   if strtrim(autres, 2) NE '' then $
+    rien = execute('exextra = get_extra('+autres+', _extra = exextra)')
+   return, exextra
+end
+;*****************************************************
+;*****************************************************
+FUNCTION cw_specifie_event, event
+;------------------------------------------------------------
+; on recuper les ID des differents widgets 
+;------------------------------------------------------------
+;------------------------------------------------------------
+   widget_control, event.id, get_uvalue = uval
+   widget_control, event.top, get_uvalue = top_uvalue
+   petitin = extractatt(top_uvalue, 'petitin')
+   numdessinin = petitin[2]-1
+   petitout = extractatt(top_uvalue, 'petitout')
+   numdessinout = petitout[2]-1
+;------------------------------------------------------------
+   case uval of
+      'default':BEGIN 
+;---------------
+; on trouve le nom de la variable:
+;---------------
+         champid = widget_info(event.top, find_by_uname = 'champ')
+         currentfile = extractatt(top_uvalue, 'currentfile')
+         listvar = (*(extractatt(top_uvalue, 'fileparameters'))[currentfile]).listvar
+         varname = listvar[widget_info(champid, /droplist_select)]
+;---------------
+         exextra = definedefaultextra(varname)
+         widget_control, widget_info(event.handler,find_by_uname='min'), set_value = strtrim(exextra.min, 1)
+         widget_control, widget_info(event.handler,find_by_uname='max'), set_value = strtrim(exextra.max, 1)
+         widget_control, widget_info(event.handler,find_by_uname='int'), set_value = strtrim(exextra.inter, 1)
+         widget_control, widget_info(event.handler,find_by_uname='palnum'), set_value = strtrim(exextra.lct, 1)
+         widget_control, widget_info(event.handler,find_by_uname='autres'), set_value = ''
+      END
+      'palcol':BEGIN 
+         ind = fix(strmid(event.value, 0, strpos(event.value, '-')))
+         widget_control, widget_info(event.handler,find_by_uname='palnum'), set_value = strtrim(ind, 1)
+      END
+      'ok':
+      ELSE:
+   endcase
+   return,{ID:event.handler, TOP:event.top, HANDLER:0L, OK:uval EQ 'ok'}
+end
+;*****************************************************
+;*****************************************************
+FUNCTION cw_specifie, parent, ROW = row, COLUMN = column, UVALUE = uvalue, UNAME = uname, FRAME = frame, FORXXX = forxxx, _extra = ex
+; cheking exclusive keywords
+   column = keyword_set(column)*(1-keyword_set(row))
+   row = keyword_set(row)*(1-keyword_set(column)) +(keyword_set(row) EQ column) 
+;------------------------------------------------
+   if NOT keyword_set(uvalue) then uvalue = ''
+   if NOT keyword_set(uname) then uname = ''
+   base = widget_base(parent, ROW = row, COLUMN = column  $
+                      , EVENT_FUNC = 'cw_specifie_event' $
+                      , FUNC_GET_VALUE='cw_specifie_get_value' $
+                      , PRO_SET_VALUE='cw_specifie_set_value' $
+                      , UVALUE = uvalue, UNAME = uname, _extra = ex)   
+; base1 pour specifier le min, le max et l''intervalle
+   base1 = widget_base(base, /row, /frame)
+   rien = widget_label(base1, value = 'Min')
+   rien = widget_text(base1, value = '', /editable, xsize = 5, uname = 'min', uvalue = 'min')
+   rien = widget_label(base1, value = 'Max')
+   rien = widget_text(base1, value = '', /editable, xsize = 5, uname = 'max', uvalue = 'max')
+   rien = widget_label(base1, value = 'Int')
+   rien = widget_text(base1, value = '', /editable, xsize = 5, uname = 'int', uvalue = 'int')
+; base2 por specifier la palette de couleur (soit par numero soit ds
+; un menu deroulant)
+   if keyword_set(FORXXX) then base2 = widget_base(base, /row, /frame) ELSE base2 = base1
+   rien = widget_label(base2, value = 'Pal Numb')
+   if keyword_set(forxxx) then colvalue = '' ELSE colvalue = '39'
+   rien = widget_text(base2, value = colvalue, /editable, xsize = 3, uname = 'palnum', uvalue = 'palnum')
+   lct,  get_name = nomcouleur
+   nbrligne = 30
+   nbrlist = n_elements(nomcouleur)/nbrligne
+   nomcouleur = strtrim(sindgen(n_elements(nomcouleur)), 1)+'- '+nomcouleur
+   nomcouleur = '0\'+nomcouleur
+   nomcouleur = ['1\color palette', nomcouleur]
+   if nbrlist GT 1 then for i = 1,nbrlist do $
+    nomcouleur = [nomcouleur[0:nbrligne*i-1+i], '1\ ', nomcouleur[nbrligne*i+i:n_elements(nomcouleur)-1]]
+   rien = cw_pdmenu(base2,nomcouleur, /RETURN_NAME , uvalue = 'palcol', uname = 'palcol')
+
+; baseavantfin pour passer tous les mots cles possibles...
+; widget text contennant les autres mots cles passe ds top_uvalue.exextra
+; en reste-t-il? si oui, il faut les mettres sous forme de string
+
+   baseavantfin = widget_base(base, /row, /frame)
+   rien = widget_label(baseavantfin, value = 'Keywords')
+   rien = widget_text(baseavantfin, value = '  ', /editable, uname = 'autres', uvalue = 'autres', scr_xsize = 400)
+   if keyword_set(forxxx)  then begin
+; basefin pour en finir, 2 boutons: Default/OK
+      basefin = widget_base(base, /row, /frame, /align_center)
+      rien = widget_button(basefin,value='Default', uvalue = 'default')
+      rien = widget_button(basefin,value='OK', uvalue = 'ok')
+; on intialise les widget_text:
+      cw_specifie_set_value, base, definedefaultextra('rien_du_tout')
+   endif
+
+;------------------------------------------------
+   return, base
+end
+
Index: tags/start/WIDGET/COMPOUND_WIDGET/testwid.pro
===================================================================
--- tags/start/WIDGET/COMPOUND_WIDGET/testwid.pro	(revision 5)
+++ tags/start/WIDGET/COMPOUND_WIDGET/testwid.pro	(revision 5)
@@ -0,0 +1,34 @@
+PRO testwid_event, event
+    DroplistId = widget_info(event.top,find_by_uname = 'c''est lui')
+   widget_control, event.id, get_uvalue=uval
+   if n_elements(uval) EQ 0 then return
+   case uval of
+      'done':widget_control, event.top, /destroy
+      'set':BEGIN 
+         widget_control, event.id, get_value = value
+         widget_control, DroplistId, set_value = value
+      END
+      'get':BEGIN 
+         widget_control, DroplistId, get_value = value
+         help,  value, /struct
+      END
+      ELSE:
+   endcase
+   return
+end
+PRO testwid, calendar, date0, _extra = ex
+   base=widget_base(/COLUMN)
+print, 'base=', base
+   nothing = widget_label(base, value = 'beginning of the test')
+;
+   nothing = cw_calendar(base,calendar, date0, _extra = ex, uname = 'c''est lui', uvalue = 'c''est lui' )
+print, 'cw_calendar ID =', nothing
+;
+   nothing = widget_label(base, value = 'end of the test')
+    nothing = widget_text(base, value = string(calendar[0]), uvalue = 'set', /editable)
+    nothing = widget_button(base, value = 'get', uvalue = 'get')
+    nothing = widget_button(base, value = 'done', uvalue = 'done')
+   widget_control, base, /REALIZE
+   xmanager,'testwid', base
+   return
+end
Index: tags/start/WIDGET/findtopid.pro
===================================================================
--- tags/start/WIDGET/findtopid.pro	(revision 5)
+++ tags/start/WIDGET/findtopid.pro	(revision 5)
@@ -0,0 +1,46 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME: findtopid
+;
+; PURPOSE: retrouve a partir d''un Id de widget l'Id du widget qui est
+; "the top-level base" (i.e., it has no parent)
+;
+; CATEGORY: aide pour les widgets
+;
+; CALLING SEQUENCE: res=findtopid(Widget_ID)
+; 
+; INPUTS: Widget_ID: this argument should be the widget ID of the
+; widget for which information is desired.
+;
+; KEYWORD PARAMETERS:
+;
+; OUTPUTS: l'Id du widget qui est "the top-level base"
+;
+; COMMON BLOCKS:
+;
+; SIDE EFFECTS: 
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      22/9/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION findtopid,  identite
+   id = long(identite)
+;    exist = widget_info(id, /managed)
+;    if exist EQ 0 then return,  -1
+   topid = id
+   topid2 = id
+   while topid2 NE 0 do begin
+      topid = topid2
+      topid2 = widget_info(topid2, /parent)
+   endwhile
+   return,  long(topid)
+end
Index: tags/start/WIDGET/slec.pro
===================================================================
--- tags/start/WIDGET/slec.pro	(revision 5)
+++ tags/start/WIDGET/slec.pro	(revision 5)
@@ -0,0 +1,12 @@
+FUNCTION slec,name,debut,fin, nomexp, PARENT = parent, BOITE=boite, _EXTRA = ex
+@common
+;------------------------------------------------------------ 
+   case n_params() of
+      1:tab = nlec(name, PARENT = parent, BOITE=boite, _EXTRA = ex)
+      2:tab = nlec(name,debut, PARENT = parent, BOITE=boite, _EXTRA = ex)
+      3:tab = nlec(name,debut,fin, PARENT = parent, BOITE=boite, _EXTRA = ex)
+      4:tab = nlec(name,debut,fin, nomexp, PARENT = parent, BOITE=boite, _EXTRA = ex)
+   endcase
+;
+   return, {tab:tab, grille:vargrid, unite:varunit, experience:varexp, nom:varname}
+end
Index: tags/start/WIDGET/xnotice.pro
===================================================================
--- tags/start/WIDGET/xnotice.pro	(revision 5)
+++ tags/start/WIDGET/xnotice.pro	(revision 5)
@@ -0,0 +1,62 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:xnotice
+;
+; PURPOSE:cree un widget avec du texte au milieu de la fenetre.
+;
+; CATEGORY:information
+;
+; CALLING SEQUENCE:widgetid=xnotice(text)
+; 
+; INPUTS:text: un string ou un vecteur de string. Si c''est un
+; scalaire on cherche le separateur de ligne !C pour creer un texte a
+; plusieurs lignes.
+;
+; KEYWORD PARAMETERS:chkwidget: oblige a verifier qu''il y a des
+; widgets actif pour creer un widget, sinon imprime au prompt
+;
+; OUTPUTS:lidentite du widget cree
+;
+; COMMON BLOCKS
+;
+; SIDE EFFECTS:ne fait pas appelle a xmanager -> ne cree aucun event!
+; il faut detruire ce widget a la main:
+; widget_control, widgetid, /destroy
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;    IDL> id=xnotice('ca marche !C ou pas?')
+;    IDL> widget_control, id, /destroy
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      2000 3 17
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+FUNCTION xnotice, text, CHKWIDGET = chkwidget
+;
+; on separe le text en differentes lignes (separees par !C) si ce
+; n''est pas deja fait...
+   if n_elements(text) EQ 1 then text = str_sep(text, '!C', /trim)
+;
+   if keyword_set(chkwidget) then makewid = (widget_info(/managed))[0]ELSE makewid = 1
+;
+   if makewid EQ 0 then BEGIN
+      for i = 0,  n_elements(text)-1 do print, text[i]
+      noticebase = 0
+   endif
+;
+   noticebase = widget_base(/column, title = 'information', /align_center)
+   screensize = get_screen_size()
+   widget_control, noticebase, tlb_set_xoffset = screensize[0]/2.2, tlb_set_yoffset = screensize[1]/2.2
+   nothing = widget_label(noticebase, value = ' ')
+   for i = 0,  n_elements(text)-1 do nothing = widget_label(noticebase, value = text[i])
+   nothing = widget_label(noticebase, value = ' ')
+   widget_control,noticebase,/realize
+;
+   return, noticebase
+end
Index: tags/start/WIDGET/xquestion.pro
===================================================================
--- tags/start/WIDGET/xquestion.pro	(revision 5)
+++ tags/start/WIDGET/xquestion.pro	(revision 5)
@@ -0,0 +1,107 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:xquestion
+;
+; PURPOSE: a small widget who ask a question and give an answer.
+;          WARNING: For a binary question with yes/no answer use
+;                   DIALOG_MESSAGE.
+;
+; CATEGORY: widget
+;
+; CALLING SEQUENCE: answer = xquestion(question[,proposedanswer])
+; 
+; INPUTS:
+;        question: a scalar string or a array of string. If this
+;        argument is set to :
+;          + an array of strings: each array element is
+;            displayed as a separate line of text.
+;          + a scalar string: we are looking for the "separate line
+;          character" '!C'
+;
+;        proposedanswer: a string proposing a answer
+;
+; KEYWORD PARAMETERS: those from WIDGET_BASE and WIDGET_TEXT
+;
+;        /CHKWIDGET: active this keyword if you whant that xquestion
+;        check if managed widget are present. If not, xquestion do not
+;        open a widget but print the question in the IDL window. 
+;
+; OUTPUTS:
+;        answer: a string
+;
+; COMMON BLOCKS:
+;        none (we use a "false widget")
+;
+; SIDE EFFECTS:
+;        The function does not return to its caller until the user
+;        press "Enter" key in the widget.
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+;        IDL> help, xquestion('Postscript name')
+;        <Expression>    STRING    = 'toto.ps'
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                      13/10/1999
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;-------------------------------------------------------------------------
+pro xquestion_event, event
+; we get the answer
+   widget_control, widget_info(event.top, find_by_uname = 'text') $
+    , get_value = answer & answer = answer[0]
+; now we give the answer to xquestion.pro by using the pointer uvalue
+   widget_control, event.top, get_uvalue = ptranswer
+   *ptranswer = answer
+; we destroy the widget
+   widget_control, event.top, /destroy
+   return
+end
+;-------------------------------------------------------------------------
+FUNCTION xquestion, question, proposedanswer, CHKWIDGET = chkwidget, _extra = ex ;
+; is separate line a scalar? we must cut it into pieces? 
+   if n_elements(question) EQ 1 then question = str_sep(question, '!C', /trim)
+; is a widget necessary?
+   if keyword_set(chkwidget) then BEGIN
+      if (widget_info(/managed))[0] EQ 0 then BEGIN
+         if n_elements(proposedanswer) EQ 0 then BEGIN 
+            proposedanswer = ''
+            answer = ''
+            complete = ''
+         ENDIF ELSE BEGIN 
+            answer = proposedanswer
+            complete = '(default answer is '+proposedanswer+') '
+         ENDELSE
+         if n_elements(question) GT 1 THEN $
+          for i = 0, n_elements(question)-2 do print,question[i] 
+         read, question[n_elements(question)-1]+' '+complete , answer
+         if keyword_set(answer) EQ 0 then answer = proposedanswer
+         return, answer
+      endif
+   endif
+; definition of the widget
+   BaseId = widget_base(/column, title = 'Question', _extra = ex)
+   screensize = get_screen_size()
+   widget_control, BaseId, tlb_set_xoffset = screensize[0]/2.2, tlb_set_yoffset = screensize[1]/2.2
+   for i = 0,  n_elements(question)-1 DO trash = widget_label(BaseId, value = question[i], /align_left)
+   if n_elements(proposedanswer) EQ 0 then answer = '' ELSE answer = proposedanswer
+   trash = widget_text(BaseId, value = answer, /editable, _extra = ex, uname = 'text')
+   trash = widget_button(BaseId, value = 'ok')
+   ptranswer = ptr_new(/allocate_heap)
+   widget_control, BaseId, set_uvalue = ptranswer
+; we realize the widget and wait for an answer
+   widget_control,BaseId,/realize
+   xmanager,'xquestion',BaseId
+; we get the answer
+   answer = *ptranswer
+; we freeing the pointer
+   ptr_free, ptranswer
+;
+   return, answer
+end
Index: tags/start/WIDGET/xx.pro
===================================================================
--- tags/start/WIDGET/xx.pro	(revision 5)
+++ tags/start/WIDGET/xx.pro	(revision 5)
@@ -0,0 +1,53 @@
+
+PRO xx,  JOUR = jour, MESHFILENAME = meshfilename,  LISTVAR = listvar, LISTGRID = listgrid, FUNCLEC_NAME = funclec_name, CALENDAR = calendar, _extra = ex
+;
+@common
+;----------------------------------------------------------------------
+;----------------------------------------------------------------------
+;  partie a changer
+;----------------------------------------------------------------------
+;----------------------------------------------------------------------
+; nom de la fonction de lecture:
+   if NOT keyword_set(funclec_name) then funclec_name = 'slec'
+   prefix = 'INF'
+; liste des variables
+   if NOT keyword_set(listvar) then listvar = ['tn','sn','un','vn', 'taux', 'tauy','hdep20','hdep28','hdep15','hturb','hpycn','htoth','emp','qn','qs', 'smltot11', 'smltot12', 'smltot13', 'smltot14', 'smltot15', 'smltot16', 'tmltot11', 'tmltot12', 'tmltot13', 'tmltot14', 'tmltot15', 'tmltot16']
+; liste des grilles auxquelles elles se rapportent les variables
+   if NOT keyword_set(listgrid) then BEGIN 
+      listgrid = replicate('T', n_elements(listvar))
+      listgrid[[2, 4]] = 'U'
+      listgrid[[3, 5]] = 'V'
+   ENDIF
+; calendrier a utiliser (en jours juliens d''IDL   
+   if NOT keyword_set(calendar) then BEGIN 
+      if keyword_set(jour) then calendar = calendriertotem(/julian_day) ELSE calendar = calendriertotem(/julian_day, /mensuel)
+   ENDIF
+; nom du fichier se rapportant au masque
+   if NOT keyword_set(meshfilename) then meshfilename = '/usr1/com/smasson/IDL/INIT/inittotem.pro'
+   meshparameters = whichgrid(meshfilename)
+; parameteres specifiant comment doit etre lu le champ
+   readparameters= {funclec_name: funclec_name $
+                    , jpidta: jpidta, jpjdta: jpjdta, jpkdta: jpkdta $
+                    , ixmindta: ixmindta, ixmaxdta: ixmaxdta $
+                    , iymindta: iymindta, iymaxdta: iymaxdta $
+                    , izmindta: izmindta, izmaxdta: izmaxdta }
+;----------------------------------------------------------------------
+;----------------------------------------------------------------------
+;   fin de la partie a changer
+;----------------------------------------------------------------------
+;----------------------------------------------------------------------
+;
+;
+   fileparameters = {filename: 'many !' $
+                     , time_counter: calendar $
+                     , listvar: listvar $
+                     , listgrid: strupcase(listgrid)}
+;
+   multistructure = {fileparameters: temporary(fileparameters) $
+              , readparameters: temporary(readparameters) $
+              , meshparameters: temporary(meshparameters)}
+;
+   xxx, multistructure = temporary(multistructure), _extra = ex
+
+   return
+end
Index: tags/start/WIDGET/xxx.pro
===================================================================
--- tags/start/WIDGET/xxx.pro	(revision 5)
+++ tags/start/WIDGET/xxx.pro	(revision 5)
@@ -0,0 +1,436 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:xxx
+;
+; PURPOSE:un maximum de possibilites avec un minimum de clics
+;
+; CATEGORY:super widget
+;
+; CALLING SEQUENCE:xxx
+; 
+; INPUTS:none
+;
+; KEYWORD PARAMETERS:
+;
+;      /SEPARATE: pour separer la partie boutons de la partie dessin
+;      en 2 fenetres. Utile pour les petits ecrans, mais attention
+;      peut saturer la memoire video de certains Tx un peu vetustes.
+;
+;      RESTORE='toto.dat' ou toto.dat est un fichier cree lors d''une
+;      precedente utilisation de xxx grace a la commande "Widget" du
+;      menu "save as".
+;
+; OUTPUTS:
+;
+; COMMON BLOCKS:common.pro
+;
+; SIDE EFFECTS:
+;
+; RESTRICTIONS:
+;
+; EXAMPLE:
+;
+; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
+;
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+
+PRO xxx_event, event
+;------------------------------------------------------------
+@common
+;------------------------------------------------------------
+;    = widget_info(event.top,find_by_uname = '')
+; quel est le type d''evenement?
+;   if event.id EQ 622 then help,  event,  /struct
+   widget_control, event.id, get_uvalue=uval
+   if (tag_names(event, /structure_name))[0] EQ 'WIDGET_TRACKING' then uval = {name:'ActiverFenetre'}
+   if keyword_set(uval) EQ 0 then return
+;help,  event, /struct
+;help, uval , /struct
+; case sur le type d''evenement
+   widget_control, event.top, get_uvalue = top_uvalue
+; si on a active le mot cles separate a l''appelle de xxx
+   if size(top_uvalue, /type) EQ 3 then begin
+      event.top = top_uvalue
+      widget_control, event.top, get_uvalue = top_uvalue
+   endif
+; on tue le petit widget cree par notice.pro si il existe
+   noticebase = extractatt(top_uvalue, 'noticebase')
+   if noticebase NE 0 then BEGIN
+      widget_control, noticebase, /destroy
+      *top_uvalue[1, findline(top_uvalue, 'noticebase')] = 0l
+   endif
+;
+;
+   options = extractatt(top_uvalue, 'options')
+   index = where(options EQ 'Ok button') & index = index[0]
+   currentplot = (extractatt(top_uvalue, 'petitout'))[2]-1
+   okbutton = extractatt(top_uvalue, 'optionsflag')
+   okbutton = okbutton[index, currentplot]
+   case uval.name OF
+      'menubar':xxxmenubar_event, event
+      'ok':nouveaudessin = 1
+      'specifie':nouveaudessin = event.ok*(1-okbutton)
+      'action':nouveaudessin = 1-okbutton
+      'calendar1':BEGIN
+         date2id = widget_info(event.top, find_by_uname = 'calendar2')
+         widget_control, date2id, get_value = date2
+         if event.value GT date2 then widget_control, date2id, set_value = event.value
+
+         nouveaudessin = 1-okbutton
+      END
+      'calendar2':BEGIN
+         date1id = widget_info(event.top, find_by_uname = 'calendar1')
+         widget_control, date1id, get_value = date1
+         if event.value LT date1 then widget_control, date1id, set_value = event.value
+
+         nouveaudessin = 1-okbutton
+      END
+      'domain':nouveaudessin = 1-okbutton
+      'champ':BEGIN
+         currentfile  = extractatt(top_uvalue, 'currentfile')
+         listvar = (*(extractatt(top_uvalue, 'fileparameters'))[currentfile]).listvar
+         name = listvar[event.index]
+         changefield, event.top, name
+         nouveaudessin = 1-okbutton
+      END
+      'nom_exp':nouveaudessin = 1-okbutton
+      'filelist':BEGIN
+         filelist = extractatt(top_uvalue, 'filelist')
+         newfilename = filelist[event.index]
+         changefile, event.top, newfilename
+      END
+      'ActiverFenetre':BEGIN
+         if event.enter EQ 1 AND !d.name NE 'PS' then BEGIN
+;            graphid = widget_info(event.top,find_by_uname = 'graph')
+            graphid = extractatt(top_uvalue, 'graphid')
+            widget_control,graphid,get_value=win
+            wset, win
+            widget_control,event.top,get_uvalue=top_uvalue
+            numdessinin = (extractatt(top_uvalue, 'petitin'))[2]-1
+            !p = (extractatt(top_uvalue, 'penvs'))[numdessinin]
+            !x = (extractatt(top_uvalue, 'xenvs'))[numdessinin]
+            !y = (extractatt(top_uvalue, 'yenvs'))[numdessinin]
+         endif
+      END
+      'graph':BEGIN
+         quelclick = identifyclick(event)
+         case quelclick.type of
+            'inutile':return
+            'long':longclickaction, event
+            'single':BEGIN 
+               print, quelclick.type
+            END
+            'double':doubleclickaction, event
+         endcase
+      END
+   endcase
+   if keyword_set(nouveaudessin) then letsdraw, event.top
+   return
+end
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO xxx, BOITE = boite, CALLERWIDID = CallerWidId, DATE1 = date1, DATE2 = date2, PETIT = petit, MULTISTRUCTURE = multistructure, REDRAW = redraw, SEPARATE = separate, UVALUE = uvalue, RESTORE = restore, _EXTRA = ex
+;------------------------------------------------------------
+@common
+;------------------------------------------------------------
+; initialisation de l''environnement
+;------------------------------------------------------------
+   reinitplt
+;------------------------------------------------------------
+; on va recupere la uvalue attache au widget qui a
+; appele le nouveau widget que l''on est en train de mettre en place
+   if keyword_set(restore) then BEGIN
+      restore = isafile(filename = restore, iodir = homedir)
+      if size(restore, /type) NE 7 then restore = 0 ELSE BEGIN 
+         restore, isafile(file = restore, io = homedir)
+         newgrid = *(extractatt(uvalue, 'meshparameters'))[0]
+         change = changegrid(newgrid)
+      ENDELSE 
+   endif
+   if n_elements(CallerWidId) NE 0 THEN $
+    widget_control, CallerWidId, get_uvalue = uvalue ELSE CallerWidId = 0
+;------------------------------------------------------------
+; on commmence la definition du widget...
+;------------------------------------------------------------
+; sa base
+   base = widget_base(column = 1-(key_portrait OR keyword_set(SEPARATE)) $
+                      , row = key_portrait OR keyword_set(SEPARATE), title='xxx' $
+                      , GROUP_LEADER = group, /tracking_events, uname = 'base', mbar = mbarid)
+; la barre de menu
+   if keyword_set(uvalue) then begin
+      options = extractatt(uvalue, 'options')
+   ENDIF ELSE options = ['Ok button', 'Portrait/Landscape', 'Overlay', 'Vecteur', 'Longitude / x index', 'Latitude / y index']
+   xxxmenubar, mbarid, options = options
+;------------------------------------------------------------
+; on passe a la definition de tout ce qui est au dessus du dessin
+;------------------------------------------------------------
+; base contenant les boutons au dessus, a gauche du dessin
+   base1 = widget_base(base, /column)
+   base1bis = widget_base(base1, column = key_portrait OR keyword_set(SEPARATE) $
+                          , row = 1-(key_portrait OR keyword_set(SEPARATE)))
+;------------------------------------------------------------
+; sous base separant les boutons du widget_domain
+   base11=widget_base(base1bis, /row) 
+;
+   base111=widget_base(base11,  /column) 
+; boutton 'OK'
+   baseok = widget_base(base111, /row, /align_right $
+                        , map = 0, uname = 'base ok button')
+   rien = widget_button(baseok, /align_right, value = ' OK ', uvalue = {name:'ok'}, /frame)
+; droplist des types de plots possibles
+   graphtype = ['plt','pltz', 'pltt', 'xy', 'xz', 'yz', 'xt', 'yt', 'zt', 'x', 'y', 'z', 't']
+   graphtypeid = widget_droplist(base111, value = graphtype, uname = 'action', uvalue = {name:'action', choix:graphtype})
+; configuration de la page
+   if n_elements(petit) eq 0 then BEGIN 
+      petitin = [1, 1, 1]
+      petitout = [1, 1, 1]
+   endif
+   if keyword_set(uvalue) then begin
+      petitin = extractatt(uvalue, 'petitin')
+      petitout = extractatt(uvalue, 'petitout')
+   endif
+   nbredessin = petitin[0]*petitin[1]
+   numdessinin = petitin[2]-1
+;
+   rien = cw_miseenpage(base11, petitin, /row, /frame)
+; mapping du boutton 'OK'
+   if keyword_set(uvalue) then flag = extractatt(uvalue,'optionsflag') $
+;   ELSE flag = [0, key_portrait, 0, 1, 0, 0, 0]#replicate(1, petitin[2]-1)
+   ELSE flag = [1, key_portrait, 0, 0, 0, 0]#replicate(1, nbredessin)
+   currentflag = flag[*, petitin[2]-1]
+   widget_control, baseok, map = currentflag[0]
+;
+; liste des fichiers que l''on veut regarder
+;
+   if keyword_set(uvalue) then BEGIN 
+      currentfile = extractatt(uvalue,'currentfile')
+      filelist = extractatt(uvalue,'filelist')
+      fileparameters = extractatt(uvalue,'fileparameters')
+      readparameters = extractatt(uvalue,'readparameters')
+      meshparameters = extractatt(uvalue,'meshparameters')
+   ENDIF ELSE BEGIN
+      if keyword_set(multistructure) then newfile = multistructure ELSE newfile = selectfile()
+      if size(newfile, /type) NE 8 then return
+      fileparameters = ptrarr(1, /allocate_heap)
+      *fileparameters[0] = newfile.fileparameters
+      readparameters = ptrarr(1, /allocate_heap)
+      *readparameters[0] = newfile.readparameters
+      meshparameters = ptrarr(1, /allocate_heap)
+      *meshparameters[0] = newfile.meshparameters
+      currentfile = 0
+      filelist = newfile.fileparameters.filename
+   ENDELSE
+; liste des fichiers
+   rien = widget_list(base11, value = filelist, uname = 'filelist', uvalue = {name:'filelist'}, scr_xsize = 100)
+; specification de l''operation que l''on veut faire sur les fichiers
+   if keyword_set(CallerWidId) then begin
+      widget_control, widget_info(CallerWidId, find_by_uname = 'nom_exp'), get_value = value
+      value = value[0]
+   ENDIF ELSE value = prefix
+   rien=widget_text(base11, value = value, uvalue={name:'nom_exp'}, uname='nom_exp', /editable)
+; liste des variables
+   currentlistvar = (*fileparameters[currentfile]).listvar
+;
+   if keyword_set(separate) then basechamp = widget_base(base1bis, /row) 
+   base12=widget_base(base1bis, /row , uname = 'base12') 
+   if NOT keyword_set(separate) then basechamp = base12
+;
+   rien=widget_droplist(basechamp, value=currentlistvar, title ='champ' $
+                        , uvalue ={name:'champ'}, uname='champ')
+   if keyword_set(CallerWidId) then begin
+      selectvar = widget_info(widget_info(CallerWidId, find_by_uname = 'champ'), /droplist_select)
+   ENDIF ELSE selectvar = 0
+   widget_control, rien, set_droplist_select = selectvar
+; calendrier
+   currentcalendar = (*fileparameters[currentfile]).time_counter
+   if keyword_set(CallerWidId) then begin
+      widget_control, widget_info(CallerWidId, find_by_uname = 'calendar1'), get_value = date1
+      widget_control, widget_info(CallerWidId, find_by_uname = 'calendar2'), get_value = date2
+      date1 = juldate(date1)
+      date2 = juldate(date2)
+   ENDIF
+   rien = cw_calendar(base12,currentcalendar, date1, uname = 'calendar1', uvalue = {name:'calendar1'}, /frame)
+   rien = cw_calendar(base12,currentcalendar, date2, uname = 'calendar2', uvalue = {name:'calendar2'}, /frame)
+;------------------------------------------------------------
+; 2eme ligne
+;------------------------------------------------------------
+   vargrid = strupcase((*fileparameters[currentfile]).listgrid[selectvar])
+   IF vargrid EQ 'W' then zgrid = 'W' ELSE zgrid = 'T'
+   rien = cw_domain(base1, uname = 'domain', uvalue = {name:'domain'}, /unzoom, /frame, boite = boite, row = 1-(key_portrait OR keyword_set(SEPARATE)), column = key_portrait OR keyword_set(SEPARATE))
+;------------------------------------------------------------
+; 3eme ligne
+;------------------------------------------------------------
+   rien = cw_specifie(base1, uname = 'specifie', uvalue = {name:'specifie'}, /frame, column = key_portrait OR keyword_set(SEPARATE), /forxxx)
+   if keyword_set(CallerWidId) then BEGIN
+      widget_control, widget_info(CallerWidId, find_by_uname = 'specifie'), get_value = specifie_value
+      widget_control, widget_info(base, find_by_uname = 'specifie'), set_value = specifie_value
+   ENDIF
+;------------------------------------------------------------
+; partie graph
+;------------------------------------------------------------
+   if keyword_set(separate) then $
+    basegraph = widget_base(title = 'xxx window',  group_leader = base, uvalue = base) $
+   ELSE basegraph = widget_base(base, /row)
+   
+   windsize = givewindowsize()
+   graphid = widget_draw(basegraph, uname = 'graph' $
+                         , uvalue = {name:'graph', press:0, click:0, x:[0., 0.], y:[0., 0.]} $
+                         , /button_events, retain = 2 $
+                         , xsize=windsize[0], ysize=windsize[1])
+   if keyword_set(separate) then begin
+      widget_control,basegraph,/realize
+      xmanager,'xxx',basegraph, /no_block
+   endif
+;------------------------------------------------------------
+;------------------------------------------------------------
+;    base3 = widget_base(base, row = 1-key_portrait, column = key_portrait, /align_right)
+; ;------------------------------------------------------------
+;    base31 = widget_base(base3, row = 1-key_portrait, column = key_portrait, /align_right, map = 0, uname = 'base ok button')
+;    rien = widget_button(base31, /align_right, value = ' OK ', uvalue = {name:'ok'}, /frame)
+;   rien = cw_to(base3, /frame, row = 1-key_portrait, column = key_portrait)
+;   rien = cw_conclu(base3, /align_right, row = 1-key_portrait, column = key_portrait, /frame)
+;------------------------------------------------------------
+;execution de la fentre de base et des sous-fenetres
+   widget_control,base,/realize
+;------------------------------------------------------------
+   if keyword_set(uvalue) then BEGIN ;
+; on recopie le pointeur uvalue dans top_uvalue.
+; Attention, il faut completement redefinir top_uvalue a partir des
+; variables pointees par uvalue. Sinon si on fait simplement
+; top_uvalue = uvalue, qd on detruit par uvalue et les variables
+; surlesquelles il pointe on detruit aussi les variables sur
+; lesquelles pointent top_uvalue.
+      case 1 of
+         keyword_set(redraw):BEGIN
+            top_uvalue = uvalue
+            widget_control, base, set_uvalue = top_uvalue
+; we find homedir
+            homedir = isadirectory(io = homedir, title = 'Bad definition of homedir')
+; portrait ou landscape ???
+            options = extractatt(top_uvalue, 'options')   
+            optionsflag = extractatt(top_uvalue, 'optionsflag')
+            portrait = (optionsflag[where(options EQ 'Portrait/Landscape'), 0])[0]
+; on recupere la liste des instructions
+            globalcommand = extractatt(top_uvalue, 'globalcommand')
+; on complete par le premiere et les dernieres lignes du programme
+            globalcommand = ['pro xxx2ps, NOERASE = noerase, POSTSCRIPT = postscript, PORTRAIT = portrait, LANDSCAPE = landscape' $
+                             , globalcommand $
+                             , 'return',  'end']
+            putfile, homedir+'xxx2ps.pro', globalcommand ; on l''ecrit
+            resolve_routine, 'xxx2ps' ; on le compile
+            xxx2ps, /noerase, portrait = portrait ; on l''applique
+         END
+         keyword_set(restore):begin
+            top_uvalue = uvalue
+            widget_control, base, set_uvalue = top_uvalue
+            widget_control, graphid,get_value=win
+            wshow, win
+            wset, win
+            tv, image, /true
+; etat des widgets
+            updatewidget, base
+; menage
+         END
+         ELSE:BEGIN
+            top_uvalue = ptrarr(2, 29, /allocate_heap)
+            FOR i =  0, 28 do *top_uvalue[0, i] = *uvalue[0, i]
+            FOR i =  0, 14 do *top_uvalue[1, i] = *uvalue[1, i]
+            FOR i = 18, 27 do *top_uvalue[1, i] = *uvalue[1, i]
+            numfile = n_elements(extractatt(uvalue, 'filelist')) 
+            *top_uvalue[1, 15] = ptrarr(numfile, /allocate_heap)
+            *top_uvalue[1, 16] = ptrarr(numfile, /allocate_heap)
+            *top_uvalue[1, 17] = ptrarr(numfile, /allocate_heap)
+            for i = 0, numfile-1 do begin
+               *(*top_uvalue[1, 15])[i] = *(*uvalue[1, 15])[i] 
+               *(*top_uvalue[1, 16])[i] = *(*uvalue[1, 16])[i] 
+               *(*top_uvalue[1, 17])[i] = *(*uvalue[1, 17])[i] 
+            endfor
+            *top_uvalue[1, 28] = ptrarr(nbredessin, /allocate_heap)
+            for i = 0, nbredessin-1 do *(*top_uvalue[1, 28])[i] = *(*uvalue[1, 28])[i] 
+            widget_control, base, set_uvalue = top_uvalue
+; copie l''ecran du widget de uvalue dans celui de top_uvalue
+            if keyword_set(CallerWidId)  then begin
+               widget_control, extractatt(uvalue, 'graphid'),get_value=win
+               wshow, win
+               wset, win
+               image = tvrd(/true)
+               widget_control, graphid,get_value=win
+               wshow, win
+               wset, win
+               tv, image, /true
+            ENDIF
+         END
+      endcase
+      *top_uvalue[1, findline(top_uvalue, 'graphid')] = graphid
+;
+   ENDIF ELSE BEGIN
+; sinon on va definit tous les elements que l''on acroche au widget
+; grace a la top_uvalue qui est un tableau de pointeurs a 2 colonnes:
+; les noms et des variables
+; on initialie tous ces elements.
+; variables concernant le widget ds sa generalite
+      if NOT keyword_set(ex)  then ex = {nothing:0}
+; variables se rapportant aux differents fichiers que l''on peut lire
+; variables specifiques a chaque dessin
+;
+      types = strarr(nbredessin)
+      champs = strarr(2, nbredessin)      
+      domaines = fltarr(6, nbredessin)
+      nameprocedures = strarr(nbredessin)
+      dates = lonarr(2, nbredessin)
+      prefixes = strarr(nbredessin)
+      exextra = ptrarr(nbredessin, /allocate_heap)
+; creation du pointeur que l''on va attache au widget.
+      top_uvalue = ptrarr(2, 29, /allocate_heap)
+; variables se rapportant au widget en general
+      *top_uvalue[0, 0] = 'options' & *top_uvalue[1, 0] = options
+      *top_uvalue[0, 1] = 'petitin' & *top_uvalue[1, 1] = petitin
+      *top_uvalue[0, 2] = 'petitout' & *top_uvalue[1, 2] = petitout
+      *top_uvalue[0, 3] = 'graphid' & *top_uvalue[1, 3] = graphid
+      *top_uvalue[0, 4] = 'alreadyvector' & *top_uvalue[1, 4] = -1
+      *top_uvalue[0, 5] = 'alreadyover' & *top_uvalue[1, 5] = -1
+      *top_uvalue[0, 6] = 'alreadyread' & *top_uvalue[1, 6] = -1
+      *top_uvalue[0, 7] = 'currentreadcommand' & *top_uvalue[1, 7] = ''
+      *top_uvalue[0, 8] = 'globalcommand' & *top_uvalue[1, 8] = ''
+      *top_uvalue[0, 9] = 'globaloldcommand' & *top_uvalue[1, 9] = ''
+      *top_uvalue[0, 10] = 'zgrid' & *top_uvalue[1, 10] = zgrid
+      *top_uvalue[0, 11] = 'noticebase' & *top_uvalue[1, 11] = 0l
+      *top_uvalue[0, 12] = 'extra' & *top_uvalue[1, 12] = ex
+; variables se rapportant aux differents fichiers que l''on peut lire
+      *top_uvalue[0, 13] = 'currentfile' & *top_uvalue[1, 13] = currentfile
+      *top_uvalue[0, 14] = 'filelist' & *top_uvalue[1, 14] = filelist
+      *top_uvalue[0, 15] = 'fileparameters' & *top_uvalue[1, 15] = fileparameters
+      *top_uvalue[0, 16] = 'readparameters' & *top_uvalue[1, 16] = readparameters
+      *top_uvalue[0, 17] = 'meshparameters' & *top_uvalue[1, 17] = meshparameters
+; variables se rapportant aux differents dessins que l''on peut faire
+      *top_uvalue[0, 18] = 'penvs' & *top_uvalue[1, 18] = replicate(!p, nbredessin)
+      *top_uvalue[0, 19] = 'xenvs' & *top_uvalue[1, 19] = replicate(!x, nbredessin)
+      *top_uvalue[0, 20] = 'yenvs' & *top_uvalue[1, 20] = replicate(!y, nbredessin)
+      *top_uvalue[0, 21] = 'nameprocedures' & *top_uvalue[1, 21] = nameprocedures
+      *top_uvalue[0, 22] = 'types' & *top_uvalue[1, 22] = types
+      *top_uvalue[0, 23] = 'champs' & *top_uvalue[1, 23] = champs
+      *top_uvalue[0, 24] = 'domaines' & *top_uvalue[1, 24] = domaines
+      *top_uvalue[0, 25] = 'dates' & *top_uvalue[1, 25] = dates
+      *top_uvalue[0, 26] = 'prefixes' & *top_uvalue[1, 26] = prefixes
+      *top_uvalue[0, 27] = 'optionsflag' & *top_uvalue[1, 27] = flag
+      *top_uvalue[0, 28] = 'exextra' & *top_uvalue[1, 28] = exextra
+;
+      widget_control, base, set_uvalue = top_uvalue
+      createhistory, base, petitin
+;
+   ENDELSE 
+;------------------------------------------------------------
+   xmanager,'xxx',base, /no_block
+;------------------------------------------------------------
+;------------------------------------------------------------
+   return
+end
