Changeset 11


Ignore:
Timestamp:
04/27/06 11:05:35 (18 years ago)
Author:
pinsard
Message:

upgrade of UTILITAIRE/Utilities according to cerbere.lodyc.jussieu.fr: /usr/home/smasson/SAXO_RD/ : files

Location:
trunk
Files:
3 added
19 moved

Legend:

Unmodified
Added
Removed

  • trunk/Obsolete/cp.pro

    r9 r11  
    66; 
    77; PURPOSE: copy files 
     8;       obsolete, file_copy should be used instead... 
    89; 
    9 ; CATEGORY: commande unix 
    10 ; 
    11 ; CALLING SEQUENCE: cp, filenamein, filenameout 
    12 ;  
    13 ; INPUTS:filenamein, filenameout: 2 strings. 
    14 ; 
    15 ; KEYWORD PARAMETERS: 
    16 ; 
    17 ; OUTPUTS: 
    18 ; 
    19 ; COMMON BLOCKS: 
    20 ; 
    21 ; SIDE EFFECTS: 
    22 ; 
    23 ; RESTRICTIONS: 
    24 ; 
    25 ; EXAMPLE: 
    26 ; 
    27 ; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr) 
     10; MODIFICATION HISTORY: 
     11; June 2005: Sebastien Masson => obsolete routine  
    2812; 
    2913;- 
    … …  
    3115;------------------------------------------------------------ 
    3216;------------------------------------------------------------ 
    33 PRO cp, filenamein, filenameout 
    34 ; 
    35    if size(filenamein, /type) NE 7 then begin 
    36       rien = report('filenamein must be a string') 
    37       return 
    38    endif 
    39    if size(filenameout, /type) NE 7 then begin 
    40       rien = report('filenameout must be a string') 
    41       return 
    42    endif 
    43 ; 
    44    thisOS = strupcase(strmid(!version.os_family, 0, 3)) 
    45    if thisOS eq 'MAC' or thisOS eq 'WIN' then begin 
    46       text = getfile(filenamein) 
    47       putfile, filenameout, text 
    48    ENDIF ELSE spawn, 'cp '+filenamein+' '+filenameout 
    49  
    50    return 
    51 end 
     17PRO cp, filenamein, filenameout, _extra = ex 
     18  file_copy, filenamein, filenameout, _extra = ex 
     19  RETURN 
     20END 

  • trunk/ToBeReviewed/UTILITAIRE/fitintobox.pro

    r9 r11  
    55; NAME:fitintobox 
    66; 
    7 ; PURPOSE:verifie qu''un tableau correspond bien au domaine 4d 
    8 ; specifie lors du dernier domdef et pat jpt. 
     7; PURPOSE: check that the input array has size and dimensions 
     8; compatible with the domain that was defined with the previous call 
     9; of domdef. 
    910; 
    10 ; CATEGORY:pour les debuts de noumbreux programme (blindage) 
     11; CATEGORY: domain compatibility 
    1112; 
    12 ; CALLING SEQUENCE:res=fitintobox(field) 
     13; CALLING SEQUENCE:  
     14;     res = fitintobox(field[, nx, ny, nz, firstx, firsty, firstz  
     15;                                        ,  lastx,  lasty,  lastz]) 
    1316;  
    14 ; INPUTS:field un tableau ou une structure verifiant les 
    15 ; caracteristiques speficfies ds litchamp.pro 
     17; INPUTS: 
     18;     field: an array or a structure that can be read by the function 
     19;     litchamp.pro 
     20;  
     21;     nx, ny, nz, firstx, firsty, firstz,  lastx,  lasty,  lastz: 
     22;     optional parameters. If not given they will be define with a 
     23;     call to the procedure grille.pro 
     24;      
     25; KEYWORD PARAMETERS: none 
    1626; 
    17 ; KEYWORD PARAMETERS: 
     27; OUTPUTS: an array with dimensions matching the domain 
     28;          or -1 if there is an error... 
    1829; 
    19 ; OUTPUTS:un tableau a la taille du domaine 4d. 
    20 ; 
    21 ; COMMON BLOCKS:common.pro 
     30; COMMON BLOCKS: cm_4mesh and cm_4cal 
    2231; 
    2332; SIDE EFFECTS: 
    2433; 
    25 ; RESTRICTIONS:utilise pour se reperer dans l''espace les variables 
    26 ; globales jpi,jpj,jpk,premier...,dernier...,nx...,ny...,nz,... 
    27 ; pour differencier un tableau 3d xyz d''un tableau 3d xyt, on utilise 
    28 ; jpt qui doit etre egale a 1 ds le cas xyz et different de 1 dans 
    29 ; l''autre cas. 
     34; RESTRICTIONS: 
    3035; 
    3136; EXAMPLE: 
    3237; 
     38;   IDL> help, fitintobox(findgen(jpi,jpj)) 
     39;   <Expression>    FLOAT     = Array[41, 3] 
     40;   IDL> help, fitintobox(findgen(jpi,jpj,78)) 
     41;   Error:  
     42;   the array dimensions [180,148,78] are incompatible 
     43;   with the the domain dimensions  
     44;   [jpi/nx, jpj/ny, jpk/nz, jpt] = [180/41, 148/3, 31/31, 1] 
     45;   <Expression>    INT       =       -1 
     46; 
    3347; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr) 
    3448;                     10 juin 2000. 
     49; June 2005: S. Masson rewrite all. 
    3550;- 
    3651;------------------------------------------------------------ 
    3752;------------------------------------------------------------ 
    3853;------------------------------------------------------------ 
    39 FUNCTION fitintobox, field 
    40 @common 
     54FUNCTION err_mess, sz, jpi, nx, jpj, ny, jpk, nz, jpt 
     55  IF n_elements(sz EQ 1) THEN $ 
     56    RETURN, report(['Error: ' $ 
     57                  , 'the vector size (' + tostr(sz) + ') is incompatible' $ 
     58                  , 'with the the domain dimensions ' $ 
     59                  , '[jpi/nx, jpj/ny, jpk/nz, jpt] = [' $ 
     60                  + strtrim(jpi, 1) + '/' + strtrim(nx, 1) $ 
     61                  + ', ' + strtrim(jpj, 1) + '/' + strtrim(ny, 1) $ 
     62                  + ', ' + strtrim(jpk, 1) + '/' + strtrim(nz, 1) $ 
     63                  + ', ' + strtrim(jpt, 1) + ']'], /simple) 
     64  RETURN, report(['Error: ' $ 
     65                  , 'the array dimensions ' + tostr(sz) + ' are incompatible' $ 
     66                  , 'with the the domain dimensions ' $ 
     67                  , '[jpi/nx, jpj/ny, jpk/nz, jpt] = [' $ 
     68                  + strtrim(jpi, 1) + '/' + strtrim(nx, 1) $ 
     69                  + ', ' + strtrim(jpj, 1) + '/' + strtrim(ny, 1) $ 
     70                  + ', ' + strtrim(jpk, 1) + '/' + strtrim(nz, 1) $ 
     71                  + ', ' + strtrim(jpt, 1) + ']'], /simple) 
     72END 
     73;------------------------------------------------------------ 
     74FUNCTION fitintobox, field, nx, ny, nz, firstx, firsty $ 
     75                     , firstz, lastx, lasty, lastz, WDEPTH = wdepth 
     76;------------------------------------------------------------ 
     77; include commons 
     78@cm_4mesh 
     79@cm_4cal 
     80  IF NOT keyword_set(key_forgetold) THEN BEGIN 
     81@updatenew 
     82  ENDIF 
    4183;--------------------- 
    42    array = litchamp(field) 
    43    grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery, dernierz 
     84  arr = litchamp(field) 
     85  IF n_params() EQ 1 THEN grille, -1, -1, -1, -1, nx, ny, nz $ 
     86    , firstx, firsty, firstz, lastx, lasty, lastz, WDEPTH = wdepth 
     87;-------------------------------------------------------------- 
     88;-------------------------------------------------------------- 
     89; case according the number of dimensions of the array 
     90;-------------------------------------------------------------- 
     91;-------------------------------------------------------------- 
     92  sz = size(arr) 
     93  case sz[0] of 
     94;-------------------------------------------------------------- 
     95    0:BEGIN                     ; scalar 
     96;-------------------------------------------------------------- 
     97      return, report('Error: scalar value = ' + strtrim(arr, 1), /simple) 
     98    END 
     99;-------------------------------------------------------------- 
     100    1:BEGIN                     ; 1D arrays 
     101;-------------------------------------------------------------- 
     102      CASE 1 OF 
     103; x arrays 
     104        sz[1] EQ jpi                                                   :arr = (temporary(arr))[firstx:lastx                               ]  
     105        sz[1] EQ  nx                                                   :                                                       
     106; y arrays 
     107        sz[1] EQ jpj                                                   :arr = (temporary(arr))[              firsty:lasty                 ]  
     108        sz[1] EQ  ny                                                   :                                                       
     109; z arrays 
     110        sz[1] EQ jpk                                                   :arr = (temporary(arr))[                            firstz:lastz   ]  
     111        sz[1] EQ  nz                                                   :                                                       
     112; t arrays 
     113        sz[1] EQ jpt                                                   : 
     114        ELSE:return, err_mess(sz[1], jpi, nx, jpj, ny, jpk, nz, jpt)  
     115      ENDCASE 
     116    END 
     117;-------------------------------------------------------------- 
     118    2:BEGIN                     ; 2D arrays 
     119;-------------------------------------------------------------- 
     120      CASE 1 OF 
     121; xy arrays 
     122        sz[1] EQ jpi AND sz[2] EQ jpj                                  :arr = (temporary(arr))[firstx:lastx, firsty:lasty                 ]  
     123        sz[1] EQ jpi AND sz[2] EQ  ny                                  :arr = (temporary(arr))[firstx:lastx,            *                 ] 
     124        sz[1] EQ  nx AND sz[2] EQ jpj                                  :arr = (temporary(arr))[           *, firsty:lasty                 ] 
     125        sz[1] EQ  nx AND sz[2] EQ  ny                                  :arr = (temporary(arr))[           *,            *                 ] 
     126; x(y)z arrays 
     127        sz[1] EQ jpi AND ny EQ 1      AND sz[2] EQ jpk                 :arr = (temporary(arr))[firstx:lastx, firstz:lastz   ]  
     128        sz[1] EQ jpi AND ny EQ 1      AND sz[2] EQ  nz                 :arr = (temporary(arr))[firstx:lastx,            *   ] 
     129        sz[1] EQ  nx AND ny EQ 1      AND sz[2] EQ jpk                 :arr = (temporary(arr))[           *, firstz:lastz   ] 
     130        sz[1] EQ  nx AND ny EQ 1      AND sz[2] EQ  nz                 : 
     131; (x)yz arrays 
     132        nx EQ 1      AND sz[1] EQ jpj AND sz[2] EQ jpk                 :arr = (temporary(arr))[              firsty:lasty, firstz:lastz   ]  
     133        nx EQ 1      AND sz[1] EQ jpj AND sz[2] EQ  nz                 :arr = (temporary(arr))[              firsty:lasty,            *   ] 
     134        nx EQ 1      AND sz[1] EQ  ny AND sz[2] EQ jpk                 :arr = (temporary(arr))[                         *, firstz:lastz   ] 
     135        nx EQ 1      AND sz[1] EQ  ny AND sz[2] EQ  nz                 : 
     136; xt arrays 
     137        sz[1] EQ jpi                                   AND sz[2] EQ jpt:arr = (temporary(arr))[firstx:lastx                            , *]  
     138        sz[1] EQ  nx                                   AND sz[2] EQ jpt: 
     139; yt arrays 
     140                         sz[1] EQ jpj                  AND sz[2] EQ jpt:arr = (temporary(arr))[              firsty:lasty              , *] 
     141                         sz[1] EQ  ny                  AND sz[2] EQ jpt: 
     142; zt arrays 
     143                                          sz[1] EQ jpk AND sz[2] EQ jpt:arr = (temporary(arr))[                            firstz:lastz, *]  
     144                                          sz[1] EQ  nz AND sz[2] EQ jpt: 
     145        ELSE:return, err_mess(sz[1:2], jpi, nx, jpj, ny, jpk, nz, jpt) 
     146      ENDCASE 
     147    END 
     148;-------------------------------------------------------------- 
     149    3:BEGIN                     ; 3D arrays 
     150;-------------------------------------------------------------- 
     151      CASE 1 OF 
     152; xyz arrays 
     153        sz[1] EQ jpi AND sz[2] EQ jpj AND sz[3] EQ jpk                 :arr = (temporary(arr))[firstx:lastx, firsty:lasty, firstz:lastz   ]  
     154        sz[1] EQ jpi AND sz[2] EQ  ny AND sz[3] EQ jpk                 :arr = (temporary(arr))[firstx:lastx,            *, firstz:lastz   ] 
     155        sz[1] EQ  nx AND sz[2] EQ jpj AND sz[3] EQ jpk                 :arr = (temporary(arr))[           *, firsty:lasty, firstz:lastz   ] 
     156        sz[1] EQ  nx AND sz[2] EQ  ny AND sz[3] EQ jpk                 :arr = (temporary(arr))[           *,            *, firstz:lastz   ] 
     157        sz[1] EQ jpi AND sz[2] EQ jpj AND sz[3] EQ  nz                 :arr = (temporary(arr))[firstx:lastx, firsty:lasty,            *   ]  
     158        sz[1] EQ jpi AND sz[2] EQ  ny AND sz[3] EQ  nz                 :arr = (temporary(arr))[firstx:lastx,            *,            *   ] 
     159        sz[1] EQ  nx AND sz[2] EQ jpj AND sz[3] EQ  nz                 :arr = (temporary(arr))[           *, firsty:lasty,            *   ] 
     160        sz[1] EQ  nx AND sz[2] EQ  ny AND sz[3] EQ  nz                 : 
     161; xyt arrays 
     162        sz[1] EQ jpi AND sz[2] EQ jpj                  AND sz[3] EQ jpt:arr = (temporary(arr))[firstx:lastx, firsty:lasty,               *]  
     163        sz[1] EQ jpi AND sz[2] EQ  ny                  AND sz[3] EQ jpt:arr = (temporary(arr))[firstx:lastx,            *,               *] 
     164        sz[1] EQ  nx AND sz[2] EQ jpj                  AND sz[3] EQ jpt:arr = (temporary(arr))[           *, firsty:lasty,               *] 
     165        sz[1] EQ  nx AND sz[2] EQ  ny                  AND sz[3] EQ jpt: 
     166; (x)yzt arrays 
     167        nx EQ 1      AND sz[1] EQ jpj AND sz[2] EQ jpk AND sz[3] EQ jpt:arr = (temporary(arr))[              firsty:lasty, firstz:lastz, *]  
     168        nx EQ 1      AND sz[1] EQ jpj AND sz[2] EQ  nz AND sz[3] EQ jpt:arr = (temporary(arr))[              firsty:lasty,            *, *] 
     169        nx EQ 1      AND sz[1] EQ  ny AND sz[2] EQ jpk AND sz[3] EQ jpt:arr = (temporary(arr))[                         *, firstz:lastz, *] 
     170        nx EQ 1      AND sz[1] EQ  ny AND sz[2] EQ  nz AND sz[3] EQ jpt: 
     171; x(y)zt arrays 
     172        sz[1] EQ jpi AND ny EQ 1      AND sz[2] EQ jpk AND sz[3] EQ jpt:arr = (temporary(arr))[firstx:lastx,               firstz:lastz, *]  
     173        sz[1] EQ jpi AND ny EQ 1      AND sz[2] EQ  nz AND sz[3] EQ jpt:arr = (temporary(arr))[firstx:lastx,                          *, *] 
     174        sz[1] EQ  nx AND ny EQ 1      AND sz[2] EQ jpk AND sz[3] EQ jpt:arr = (temporary(arr))[           *,               firstz:lastz, *] 
     175        sz[1] EQ  nx AND ny EQ 1      AND sz[2] EQ  nz AND sz[3] EQ jpt: 
     176        ELSE:return, err_mess(sz[1:3], jpi, nx, jpj, ny, jpk, nz, jpt) 
     177      ENDCASE 
     178    END 
     179;-------------------------------------------------------------- 
     180    4:BEGIN                     ; 4D arrays 
     181;-------------------------------------------------------------- 
     182      CASE 1 OF 
     183; xyzt arrays 
     184        sz[1] EQ jpi AND sz[2] EQ jpj AND sz[3] EQ jpk AND sz[4] EQ jpt:arr = (temporary(arr))[firstx:lastx, firsty:lasty, firstz:lastz, *]  
     185        sz[1] EQ jpi AND sz[2] EQ  ny AND sz[3] EQ jpk AND sz[4] EQ jpt:arr = (temporary(arr))[firstx:lastx,            *, firstz:lastz, *] 
     186        sz[1] EQ  nx AND sz[2] EQ jpj AND sz[3] EQ jpk AND sz[4] EQ jpt:arr = (temporary(arr))[           *, firsty:lasty, firstz:lastz, *] 
     187        sz[1] EQ  nx AND sz[2] EQ  ny AND sz[3] EQ jpk AND sz[4] EQ jpt:arr = (temporary(arr))[           *,            *, firstz:lastz, *] 
     188        sz[1] EQ jpi AND sz[2] EQ jpj AND sz[3] EQ  nz AND sz[4] EQ jpt:arr = (temporary(arr))[firstx:lastx, firsty:lasty,            *, *]  
     189        sz[1] EQ jpi AND sz[2] EQ  ny AND sz[3] EQ  nz AND sz[4] EQ jpt:arr = (temporary(arr))[firstx:lastx,            *,            *, *] 
     190        sz[1] EQ  nx AND sz[2] EQ jpj AND sz[3] EQ  nz AND sz[4] EQ jpt:arr = (temporary(arr))[           *, firsty:lasty,            *, *] 
     191        sz[1] EQ  nx AND sz[2] EQ  ny AND sz[3] EQ  nz AND sz[4] EQ jpt: 
     192        ELSE:return, err_mess(sz[1:4], jpi, nx, jpj, ny, jpk, nz, jpt) 
     193      ENDCASE 
     194    END 
     195    ELSE:return, report('Error: fitintobox is managing arrays with a maximum of 4 dimensions', /simple) 
     196  ENDCASE 
    44197 
    45 ;--------------------- 
    46    taille=size(array) 
    47    case 1 of 
    48 ;---------------------------------------------------------------------------- 
    49 ;xy 
    50 ;---------------------------------------------------------------------------- 
    51       taille[0] EQ 2:BEGIN 
    52          case 1 of 
    53             taille[1] eq  nx and taille[2] eq  ny: 
    54             taille[1] eq jpi and taille[2] eq jpj:array=array[premierx:dernierx, premiery:derniery] 
    55             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)) 
    56          endcase 
    57       END 
    58 ;---------------------------------------------------------------------------- 
    59 ;xyz 
    60 ;---------------------------------------------------------------------------- 
    61       taille[0] EQ 3 AND jpt EQ 1:BEGIN 
    62          case 1 of 
    63             taille[1] eq  nx and taille[2] eq  ny and taille[3] eq  nz: 
    64             taille[1] eq  nx and taille[2] eq  ny and taille[3] eq  jpk: $ 
    65              array=array[*, *, premierz:dernierz] 
    66             taille[1] eq jpi and taille[2] eq jpj and taille[3] eq  jpk: $ 
    67              array=array[premierx:dernierx, premiery:derniery, premierz:dernierz] 
    68             taille[1] eq nx and taille[2] eq ny and taille[3] eq  jpk: $ 
    69              array=array[premierx:dernierx, premiery:derniery, *] 
    70             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)) 
    71          endcase 
    72       END 
    73 ;---------------------------------------------------------------------------- 
    74 ;xyt 
    75 ;---------------------------------------------------------------------------- 
    76       taille[0] EQ 3 AND jpt NE 1:BEGIN 
    77          case 1 of 
    78             taille[1] eq  nx and taille[2] eq  ny AND taille[3] eq jpt: 
    79             taille[1] eq jpi and taille[2] eq jpj AND taille[3] eq jpt:array=array[premierx:dernierx, premiery:derniery, *] 
    80             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)) 
    81          endcase 
    82       END 
    83 ;---------------------------------------------------------------------------- 
    84 ;xyzt 
    85 ;---------------------------------------------------------------------------- 
    86       taille[0] EQ 4:BEGIN 
    87          case 1 of 
    88             taille[1] eq  nx and taille[2] eq  ny and taille[3] eq  nz AND taille[4] eq jpt: 
    89             taille[1] eq  nx and taille[2] eq  ny and taille[3] eq  jpk AND taille[4] eq jpt: $ 
    90              array=array[*, *, premierz:dernierz, *] 
    91             taille[1] eq jpi and taille[2] eq jpj and taille[3] eq  jpk AND taille[4] eq jpt: $ 
    92              array=array[premierx:dernierx, premiery:derniery, premierz:dernierz, *] 
    93             taille[1] eq nx and taille[2] eq ny and taille[3] eq  jpk AND taille[4] eq jpt: $ 
    94              array=array[premierx:dernierx, premiery:derniery, *, *] 
    95             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)) 
    96          endcase 
    97       END 
    98    endcase 
    99 ;---------------------------------------------------------------------------- 
    100  
    101  
    102    return, array 
     198  return, arr 
    103199end 

  • trunk/ToBeReviewed/UTILITAIRE/oups.pro

    r9 r11  
    3232 journal 
    3333; on recupere le journal sous la forme d''un vecteur de string: 
    34    vectjournal = getfile(homedir+'idlsave.pro') 
     34   vectjournal = getfile(myuniquetmpdir+'idlsave.pro') 
    3535; on coupe la derniere ligne qui est oups 
    3636   vectjournal = vectjournal[0:n_elements(vectjournal)-2 ] 
    … …  
    6868 ELSE vectjournal[n_elements(vectjournal)-1] = ''  
    6969; on reecrit idlsave.pro 
    70 putfile, homedir+'idlsave.pro', vectjournal 
     70putfile, myuniquetmpdir+'idlsave.pro', vectjournal 
    7171; on compile puis applique idlsave 
    72 cd, homedir 
     72cd,  current = curdir 
     73cd, myuniquetmpdir 
    7374@idlsave    
     75cd, curdir 
    7476; le journal vient d'etre reouvert, et on y met les elements de 
    7577; vectjournal  
    7678for i = 0, n_elements(vectjournal)-1 DO $ 
    77 printf, !journal, vectjournal[i] 
     79journal, vectjournal[i] 
    7880       
    7981 

  • trunk/ToBeReviewed/UTILITAIRE/report.pro

    r9 r11  
    1818; array element is displayed as a separate line of text. 
    1919; 
    20 ; KEYWORD PARAMETERS: ceux dialog_message.pro et message.pro avec en + 
     20; KEYWORD PARAMETERS:  
     21;         SIMPLE: activate to print only the message without the name 
     22;             and the line of the routine (defined by calling routine_name) 
     23; 
     24; ceux dialog_message.pro et message.pro avec en + 
    2125; PARENT qui fait la meme chose que DIALOG_PARENT de dialog_message.pro 
    2226; 
    … …  
    5559;------------------------------------------------------------ 
    5660;------------------------------------------------------------ 
    57 FUNCTION report, text, DEFAULT_NO = default_no, PARENT = parent, QUESTION = question, _extra = ex 
     61FUNCTION report, text, DEFAULT_NO = default_no, PARENT = parent, QUESTION = question, SIMPLE = simple, _extra = ex 
    5862   res = -1                     ; 
    59 ; on separe le text en differentes lignes (separees par !C) si ce 
     63; on separe le texte en differentes lignes (separees par !C) si ce 
    6064; n''est pas deja fait... 
    6165   if n_elements(text) EQ 1 then text = str_sep(text, '!C', /trim) 
    … …  
    8993      endif ELSE BEGIN 
    9094; si on ne pose pas de question on fait juste un print 
     95        IF keyword_set(simple) THEN prefix = '' ELSE prefix = '% '+routine_name(1)+': ' 
    9196         if n_elements(text) GT 1 THEN $ 
    92           for i = 0, n_elements(text)-2 do print,'% '+routine_name(1)+': '+text[i]  
    93          print, '% '+routine_name(1)+': '+text[n_elements(text)-1] 
     97          for i = 0, n_elements(text)-2 do print, prefix+text[i]  
     98         print, prefix+text[n_elements(text)-1] 
    9499      ENDELSE 
    95100   ENDELSE 

  • trunk/ToBeReviewed/UTILITAIRE/routine_name.pro

    r9 r11  
    5252FUNCTION routine_name,  remonte 
    5353; 
    54    version=strmid(!version.release,0,3) 
    55    if version EQ '5.2' OR version EQ '5.3' OR version EQ '5.4' OR version EQ '5.5' OR version EQ '5.6' then begin 
    56       help,  /traceback, output = name 
    57       name = strtrim(name, 1)   ; on enleve les blancs en debut de ligne 
    58 ; on vat mettre les elements du vecteur bout a bout pour former un 
     54  help,  /traceback, output = name 
     55  name = strtrim(name, 1)     ; on enleve les blancs en debut de ligne 
     56; on va mettre les elements du vecteur bout a bout pour former un 
    5957; unique sring 
    60       allnames = '' 
    61       for i = 0, n_elements(name)-1 do allnames = allnames+name[i] 
     58  allnames = '' 
     59  for i = 0, n_elements(name)-1 do allnames = allnames+name[i] 
    6260; 
    63       name = str_sep(allnames, '%') ; on le redecoupe  
    64       name = strtrim(name, 2)   ; on eleve les blancs devant et derriere 
    65       name = strcompress(name)  ; on compresse les blancs 
     61  name = str_sep(allnames, '%') ; on le redecoupe  
     62  name = strtrim(name, 2)     ; on eleve les blancs devant et derriere 
     63  name = strcompress(name)      ; on compresse les blancs 
    6664; on ne retient pas les 2 premiers elements qui sont 1  un vide et la 
    6765; ligne concernant routine_name  
    68       name = name[2: n_elements(name)-1] 
     66  name = name[2: n_elements(name)-1] 
    6967; on choisit la ligne qui nous concerne 
    70       if NOT keyword_set(remonte) then remonte = 0 
    71       if remonte GE n_elements(name) then return,  '$MAIN$' 
    72       name = name[remonte] 
    73       if strpos(name, '$MAIN$') NE -1 then return,  '$MAIN$' 
    74       name = str_sep(name, ' ') 
    75       if n_elements(name) LT 3  then name = name[0] ELSE name = 'L.'+name[1]+' '+name[2] 
    76    ENDIF ELSE BEGIN 
    77       print, 'attention la fonction routine_name a ete ecrite pour les versions: IDL 5.2, IDL 5.2.1, 5.3 ou 5.4. ou 5.4.1 ou 5.5  ou 5.6 Verifier qu''elle marche bien avec la version '+!version.release 
    78       return, 'Error' 
    79    ENDELSE  
    80    return, name 
     68  if NOT keyword_set(remonte) then remonte = 0 
     69  if remonte GE n_elements(name) then return,  '$MAIN$' 
     70  name = name[remonte] 
     71  if strpos(name, '$MAIN$') NE -1 then return,  '$MAIN$' 
     72  name = str_sep(name, ' ') 
     73  if n_elements(name) LT 3  then name = name[0] ELSE name = 'L.'+name[1]+' '+name[2] 
     74; 
     75  return, name 
    8176end 

  • trunk/ToBeReviewed/UTILITAIRE/vzoom.pro

    r9 r11  
    3030   y = [y1, y2] 
    3131   y = y[sort(y)] 
    32    domdef, [x, y, prof1, prof2] 
     32   domdef, [x, y, vert1, vert2] 
    3333; il faut fermer le journal! 
    3434   journal 
    3535; on recupere le journal sous la forme d''un vecteur de string: 
    36    vectjournal = getfile(homedir+'idlsave.pro') 
     36   vectjournal = getfile(myuniquetmpdir+'idlsave.pro') 
    3737; on coupe la derniere ligne qui est vraizoom 
    3838   vectjournal = vectjournal[0:n_elements(vectjournal)-2 ] 
    … …  
    6666; 
    6767; on reecrit idlsave.pro 
    68 putfile, homedir+'idlsave.pro', vectjournal 
     68putfile, myuniquetmpdir+'idlsave.pro', vectjournal 
    6969; applique idlsave 
    70    cd, homedir 
     70   cd,  current = curdir 
     71   cd, myuniquetmpdir 
    7172@idlsave    
     73   cd, curdir 
    7274; le journal vient d'etre reouvert, et on y met les elements de 
    7375; vectjournal  
    7476for i = 0, n_elements(vectjournal)-1 DO $ 
    75 printf,  !journal, vectjournal[i] 
     77journal, vectjournal[i] 
    7678 
    7779 

  • trunk/Utilities/createpro.pro

    r9 r11  
    55; NAME:createpro 
    66; 
    7 ; PURPOSE:ecrit un .pro le compile et l''execute 
     7; PURPOSE: write an idl procedure, compile it and execute it. 
    88; 
    99; CATEGORY: 
    … …  
    1212;  
    1313; INPUTS: 
    14 ;       command:un vecteur de string contenant les intructions a 
    15 ;       passer pour construire la procedure 
     14;      command: a string array defining the procedure to be created. 
     15;      each element will be a line of the created procedure.  
    1616; 
    1717; KEYWORD PARAMETERS: 
    18 ;       filenamein: un string donnant le nom de la procedure a ecrire 
    1918; 
    20 ; OUTPUTS: 
     19;      FILENAMEIN: name of the procedure to be created. 
     20;      'for_createpro.pro' by default 
    2121; 
    22 ; COMMON BLOCKS: 
     22;      KWDLIST: a vector string. to specify a list of keywords that 
     23;      must be included in the procedure definition. Warning: the string 
     24;      must start with a ',' for example: KWDLIST = ', TOTO = toto' 
    2325; 
    24 ; SIDE EFFECTS:complete filename par '.pro' si besion 
     26;      KWDUSED: a vector string. to specify a list of keywords that 
     27;      must be used when executing the created procedure. Warning: the string 
     28;      must start with a ',' for example: KWDLIST = ', TOTO = toto' 
     29; 
     30; OUTPUTS: none  
     31; 
     32; COMMON BLOCKS: none 
     33; 
     34; SIDE EFFECTS: ends teh procedure name with '.pro' if needed 
    2535; 
    2636; RESTRICTIONS:de marche pas pour les fonctions 
    2737; 
    2838; EXAMPLE: 
    29 ;      IDL> createpro, ['print,''OK'''],filename='test' 
     39;      IDL> createpro, ['print,''OK'''], filename='test' 
     40;      IDL> createpro, ['if keyword_set(ok) then print,''OK'' else print, ''No'''] $ 
     41;      IDL>   , filename = 'test', kwdlist =', ok = ok'  
     42;      IDL> createpro, ['if keyword_set(ok) then print,''OK'' else print, ''No'''] $ 
     43;      IDL>   , filename = 'test', kwdlist = ', ok = ok', kwdused = ', /ok'  
     44; 
    3045; 
    3146; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr) 
    32 ; 
     47; cleaning + new keywords: October 2005 
    3348;- 
    3449;------------------------------------------------------------ 
    3550;------------------------------------------------------------ 
    3651;------------------------------------------------------------ 
    37 PRO createpro, command, filenamein = filenamein 
     52PRO createpro, command, FILENAMEIN = filenamein $ 
     53               , KWDLIST = kwdlist, KWDUSED = kwdused 
    3854 
    39    if NOT keyword_set(filenamein) then filename = 'for_createpro.pro' $ 
    40    ELSE BEGIN 
    41       filename = filenamein 
    42       if rstrpos(filename, '.pro') NE strlen(filename)-4 then $ 
    43        filename = filename+'.pro' 
    44    ENDELSE 
    45    shortfilename = strmid(filename,  0, strlen(filename)-4) 
    46    thisOS = strupcase(strmid(!version.os_family, 0, 3)) 
    47    CASE thisOS of 
    48       'MAC':sep = ':' 
    49       'WIN':sep = '\' 
    50       ELSE:sep = '/' 
    51    ENDCASE 
    52    shortfilename = strmid(shortfilename, rstrpos(shortfilename, sep)+1) 
    53    if rstrpos(shortfilename, sep) GE 1 then begin 
    54       directory = strmid(filename,  0,  rstrpos(shortfilename, sep)) 
    55       directory = isadirectory(io = directory, $ 
    56                                title = 'Bad definition of Directory: '+directory) 
    57    endif 
    58    putfile, filename, ['pro '+shortfilename, command, 'return', 'end'] 
     55; define filename if needed 
     56  if NOT keyword_set(filenamein) then filename = 'for_createpro.pro' $ 
     57  ELSE filename = filenamein  
     58; get the name of the procedure (not the name of the file containing the procedure) 
     59   shortfilename =  file_basename(filename, '.pro') 
     60; check if the directory exists 
     61   dirname = isadirectory(file_dirname(filename) $ 
     62                          , title = 'Redefine '+shortfilename+'.pro directory') 
     63   IF size(dirname, /type) NE 7 THEN return 
     64; 
     65   filename = dirname + shortfilename + '.pro' 
     66; create the file 
     67   if NOT keyword_set(kwdlist) then kwdlist = '' 
     68   putfile, filename, ['pro ' + shortfilename + kwdlist $ 
     69                       , command, 'return', 'end'] 
     70; go in dirname directory 
     71   cd, dirname, current = old_dir 
     72; compile it 
    5973   resolve_routine, shortfilename 
    60    rien = execute(shortfilename) 
     74   cd, old_dir 
     75; execute it 
     76   if NOT keyword_set(kwdused) then kwdused = '' 
     77   dummy = execute(shortfilename + kwdused) 
     78; 
    6179   return 
    6280end 

  • trunk/Utilities/find.pro

    r9 r11  
    55; NAME:find 
    66; 
    7 ; PURPOSE:similaire a la commance unix find. On donne un nom de 
    8 ; fichier et en retour la fonction renvoie le nom du fichier entier 
    9 ; (avec tous les repertoires) si le fichier existe dans un des 
    10 ; repertoires definit par !path. Dans le cas contraire la function 
    11 ; renvoie 'NOT FOUND' 
     7; PURPOSE: based on file_search, but it is possible to speficy 
     8;          a set of possibles names and a different set of 
     9;          possibles directories names. 
     10;          By defaut look for files included in !path 
    1211; 
    13 ; CATEGORY:trouver un fichier 
     12; CATEGORY:find a file 
    1413; 
    15 ; CALLING SEQUENCE: nom_entier=find('nom_fichier') 
     14; CALLING SEQUENCE: found = find(filename) 
    1615; 
    17 ; INPUTS: 
    18 ;     nom_fichier: un string contenant le nom du fichier. Si ce 
    19 ; fichier ne contient pas une extension (.bidule) on essaie de 
    20 ; chercher un fichier nom_fichier.pro. Ce string peut contenir le 
    21 ; caractere * qui, comme sous unix, remplace n''importe quelle chaine 
    22 ; de charactere.  
     16; INPUTS: A scalar or array variable of string type, containing 
     17;     file names to match. Input names specifications may contain 
     18;     wildcard characters, enabling them to match multiple files 
     19;     (see file_search for more informations). By defaut and if 
     20;     necessary, find is looking for filename and also for filename 
     21;     completed with '.pro' 
    2322; 
    2423; KEYWORD PARAMETERS: 
    25 ;     REPERTOIRE: activer ce mot cle si on veut que find donne 
    26 ;     uniquement les differents repertoires ou on peut trouver le 
    27 ;     fichier  
    2824; 
    29 ;     NOPRO: activer si on ne veut pas que nom_fichier soit complete 
    30 ;     automatiquement par .pro si il ne contient pas d''extension 
     25;     IODIRECTORY: A scalar or array variable of string type, containing 
     26;        directories names where we are looking for the file. by defaut 
     27;        we use !path. Different directories can be separated by 
     28;        path_sep(/search_path) (':' on unix type machine) as it is done 
     29;        to define !path. 
     30;        Note that if filename's dirname is different from '.', this 
     31;        keyword is not taken into account. 
    3132; 
    32 ; OUTPUTS: 
    33 ;     nom_entier: un string ou un vecteur de string. il contient le 
    34 ;     nom entier du fichier avec tout le chemin depuis le debut de 
    35 ;     l''arborescence. Si plusieurs fichiers sont trouves (dans 
    36 ;     differents repertoires ou lors de l''utilisation de *) 
    37 ;     nom_entier est un vecteur dont chacun de ses elements est une 
    38 ;     solution possible. Si Le fichier n''est pas trouve nom_entier 
    39 ;     est egale a 'NOT FOUND'.  
     33;     FIRSTFOUND: activate this keyword to stop looking for the file as 
     34;        soon as we found one. 
     35; 
     36;     RECURSIVE: performs recursive searching of directory hierarchies. 
     37;        In a recursive search, find looks recursively for any and all  
     38;        subdirectories in the file hierarchy rooted at the IODIRECTORY 
     39;        argument.  
     40; 
     41;     REPERTOIRE: obsolete. keep for compatibility, use directory keyword 
     42; 
     43;     NOPRO: activate to avoid the automatic search of filename 
     44;        completed with '.pro' 
     45; 
     46;     UNIQUE: activate to make sure that each element of the output 
     47;        vector is unique. 
     48; 
     49;     all file_search keywords 
     50; 
     51; OUTPUTS: A scalar or array variable of string type, containing the 
     52;       name (with the full path of the matching files. If no files 
     53;       exist with names matching the input arguments, find returns 
     54;       the scalar string : 'NOT FOUND' 
    4055; 
    4156; COMMON BLOCKS: none 
    … …  
    4762; EXAMPLE: 
    4863; 
    49 ;     IDL> print, find('*loadct')    
    50 ;     /local/idl/lib/loadct.pro /local/idl/lib/xloadct.pro 
    51 ;     IDL> print, find('toto')    
    52 ;     NOT FOUND 
    53 ;     IDL> print, find('find')    
    54 ;     /home/1997001/smasso01/IDL_RD/find.pro 
    55 ;     IDL> print, find('l*',/rep)    
    56 ;     /home/1997001/smasso01/IDL_RD/ /local/idl/lib/ /local/idl/lib/obsolete/ 
     64;   IDL> print, find('*loadct')   
     65;   /usr/local/rsi/idl_6.0/lib/utilities/xloadct.pro 
     66;   /usr/local/rsi/idl_6.0/lib/loadct.pro 
     67;   IDL> print, find('*loadct', iodir=!dir,/recursive) 
     68;   /usr/local/rsi/idl_6.0/lib/loadct.pro 
     69;   /usr/local/rsi/idl_6.0/lib/utilities/xloadct.pro 
     70;   IDL> print, find('*loadct.pro')   
     71;   /usr/local/rsi/idl_6.0/lib/utilities/xloadct.pro 
     72;   /usr/local/rsi/idl_6.0/lib/loadct.pro 
     73;   IDL> print, find('*loadct',/nopro)   
     74;   NOT FOUND 
     75;   IDL> print, find('*loadct', iodir = '/usr/local/rsi/idl_6.0/lib')   
     76;   /usr/local/rsi/idl_6.0/lib/loadct.pro 
     77;   IDL> print, find('*loadct', iodir = '/usr/local/rsi/idl_6.0/lib', /test_write)   
     78;   NOT FOUND 
     79;   IDL> print, find('*loadct', iodir = '/usr/local/rsi/idl_6.0/lib', /recursive)   
     80;   /usr/local/rsi/idl_6.0/lib/loadct.pro 
     81;   /usr/local/rsi/idl_6.0/lib/utilities/xloadct.pro 
     82;   IDL> print, find('mesh*', iodirectory = [iodir, !path]) 
     83;   /Users/sebastie/DATA/ORCA2/meshmaskORCA2closea.nc 
     84;   /Users/sebastie/IDL/meshmaskclosesea.pro 
     85;   /Users/sebastie/IDL/meshmaskclosesea.pro~ 
     86;   /Users/sebastie/SAXO_RD/Obsolete/meshlec.pro 
     87;   /usr/local/rsi/idl_6.0/lib/mesh_obj.pro 
    5788; 
    5889; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr) 
    5990;                       28/4/1999 
    6091;                       6/7/1999: compatibilite mac et windows 
     92; June 2005: Sebastien Masson: cleaning, use for file_* functions 
    6193;- 
    6294;------------------------------------------------------------ 
     95; print,  
    6396;------------------------------------------------------------ 
    6497;------------------------------------------------------------ 
    65 FUNCTION find,  nomfichier, REPERTOIRE = repertoire, NOPRO = nopro 
    66    nomfich = nomfichier 
    67 ; il faut completer le nom par .pro??? 
    68    if NOT keyword_set(nopro) THEN $ 
    69     if strpos(nomfich,'.') EQ -1 then nomfich=nomfich+".pro"  
    70 ; on cree tous les noms entiers possibles avec les repertoires 
    71 ; contenus dans !path 
    72    thisOS = strupcase(strmid(!version.os_family, 0, 3)) 
    73    CASE thisOS of 
    74       'MAC':BEGIN & sep = ':' & pathsep = ',' & end 
    75       'WIN':BEGIN & sep = '\' & pathsep = ';' & end 
    76       ELSE: BEGIN & sep = '/' & pathsep = ':' & end 
    77    ENDCASE 
    78    cd, current = current 
    79    if strpos(nomfich,sep) lt 0 then BEGIN 
    80       if rstrpos(current,sep) NE strlen(current)-1 then current = current+sep 
    81       multipath = str_sep(!path,pathsep) 
    82       if rstrpos(multipath[0],sep) NE strlen(multipath[0])-1 then multipath = multipath +sep 
    83       nomfich = [current, multipath]+ nomfich 
    84    ENDIF 
    85 ; on test tous les noms possibles pour trouver ou est le fichier 
    86    res = [' '] 
    87    for n = 0, n_elements(nomfich)-1 do BEGIN  
    88       tmp = findfile(nomfich[n]) 
    89       if tmp[0] NE '' then res = [res, tmp]  
    90    ENDFOR 
    91    if n_elements(res) EQ 1 then return, 'NOT FOUND' ELSE BEGIN  
    92       res = res[1:n_elements(res)-1] 
    93       IF keyword_set(repertoire) then BEGIN 
    94 ; on extrait le nom des repertoires 
    95          for i = 0,n_elements(res)-1 do res[i] = strmid(res[i], 0, rstrpos(res[i],sep)+1) 
    96 ; on supprime les repertoires en double 
    97          res = res[uniq(res, sort(res))] 
     98FUNCTION find, filein, IODIRECTORY = iodirectory, RECURSIVE = recursive $ 
     99               , REPERTOIRE = repertoire, NOPRO = nopro, UNIQUE = unique $ 
     100               , FIRSTFOUND = firstfound, _extra = ex 
     101; 
     102; define where we look for the file 
     103  CASE 1 OF 
     104    keyword_set(iodirectory): dirnames = iodirectory 
     105    keyword_set(repertoire): dirnames = repertoire 
     106    ELSE: dirnames = !path 
     107  ENDCASE 
     108  tmp = dirnames 
     109  dirnames = 'dummy' 
     110  FOR i = 0, n_elements(tmp)-1 DO $ 
     111    dirnames = [dirnames, strsplit(tmp[i], path_sep(/search_path), /extract)] 
     112  dirnames = dirnames[1:*] 
     113; 
     114  fileout = 'dummy' 
     115  FOR i = 0, n_elements(filein)-1 DO BEGIN 
     116    dir = file_dirname(filein[i]) 
     117    base = file_basename(filein[i]) 
     118; try to complete the file name with .pro 
     119    if strmid(base, 0, 1, /reverse_offset) NE '*' $ 
     120      AND NOT keyword_set(nopro)THEN base = base + '{.pro,}' 
     121; use dirnames only if dir eq '.' 
     122    IF dir EQ  '.' THEN BEGIN  
     123      if keyword_set(recursive) THEN $ 
     124        found = file_search(dirnames, base, _extra = ex) $ 
     125      ELSE found = file_search(dirnames + '/' + base, _extra = ex) 
     126    ENDIF ELSE found = file_search(dir + '/' + base, _extra = ex) 
     127    IF found[0] NE '' THEN BEGIN  
     128      IF keyword_set(firstfound) THEN BEGIN  
     129        IF keyword_set(unique) THEN return, found[uniq(found, sort(found))] $ 
     130        ELSE return, found 
    98131      ENDIF 
    99       return, res 
    100    ENDELSE  
    101 end 
     132      fileout = [fileout, found] 
     133    ENDIF 
     134  ENDFOR 
     135  IF n_elements(fileout) EQ 1 THEN fileout = 'NOT FOUND' $ 
     136  ELSE fileout = fileout[1:*] 
     137; 
     138  IF n_elements(fileout) GT 1 THEN BEGIN  
     139    IF keyword_set(unique) THEN fileout = fileout[uniq(fileout, sort(fileout))] 
     140  ENDIF ELSE fileout = fileout[0] 
     141; 
     142  RETURN, fileout 
     143END 

  • trunk/Utilities/isadirectory.pro

    r9 r11  
    55; NAME:isadirectory 
    66; 
    7 ; PURPOSE:check if a directory is in the !path variable or is the 
    8 ; common. end it by '/' under Unix/Linux, ':' under Mac and '\' under 
    9 ; Windows. 
     7; PURPOSE:check if a directory exists and make sure that it ends  
     8;         with the directory separator mark. 
    109; 
    1110; CATEGORY: io 
    1211; 
    13 ; CALLING SEQUENCE: directory=isadirectory() 
     12; CALLING SEQUENCE: directory=isadirectory([dirname]) 
    1413;  
    15 ; INPUTS:none 
     14; INPUTS:optional:a proposed directory. If neither dirname  
     15;        input parameter of IODIRECTORY keyword are defined, 
     16;        the ask the user to choose a directory. 
    1617; 
    1718; KEYWORD PARAMETERS: 
    18 ;       IODIRECTORY:a proposed directory 
    19 ;       TITLE: the title of the widget open if we need to choose a 
    20 ;       directory. 
    21 ;       /NOPATH:do not check if the directory is in the !path 
    22 ;       variable. 
    2319; 
    24 ; OUTPUTS: de directory name 
     20;     IODIRECTORY:a proposed directory 
    2521; 
    26 ; COMMON BLOCKS: 
     22;     TITLE = the title of the window 
    2723; 
    28 ; SIDE EFFECTS:while statement until we found a good directory... 
     24;     all dialog_pickfile keywords (like filter) 
     25; 
     26; OUTPUTS: the directory name 
     27; 
     28; COMMON BLOCKS:none 
     29; 
     30; SIDE EFFECTS: 
    2931; 
    3032; RESTRICTIONS: 
    … …  
    3234; EXAMPLE: 
    3335; 
     36;    IDL> print, !dir 
     37;    /usr/local/rsi/idl_6.0 
     38;    IDL> print, isadirectory(!dir) 
     39;    /usr/local/rsi/idl_6.0/ 
     40;    IDL> print, isadirectory(!dir+'notgood') 
     41; 
    3442; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr) 
    3543;                      June 28, 2000 
     44; June 2005: Sebastien Masson: cleaning, use for file_* functions 
    3645;- 
    3746;------------------------------------------------------------ 
    3847;------------------------------------------------------------ 
    3948;------------------------------------------------------------ 
    40 FUNCTION isadirectory, IODIRECTORY = iodirectory, NOPATH = nopath, TITLE = title 
    41  
    42    cd, current = current 
    43 ; if directory is undefine, we get the current directory. 
    44    if  keyword_set(iodirectory) THEN directory = iodirectory ELSE directory = current  
     49FUNCTION isadirectory, directoryin, TITLE = title, IODIRECTORY = iodirectory, _extra = ex 
    4550; 
    46    thisOS = strupcase(strmid(!version.os_family, 0, 3)) 
    47    CASE thisOS of 
    48    'MAC':BEGIN & sep = ':' & pathsep = ',' & end 
    49    'WIN':BEGIN & sep = '\' & pathsep = ';' & end 
    50    ELSE: BEGIN & sep = '/' & pathsep = ':' & end 
    51    ENDCASE 
    52 ; si directory ou current ne finit pas par sep on le rajoute 
    53    if rstrpos(current,sep) NE strlen(current)-1 then current = current+sep 
    54    if rstrpos(directory, sep) NE strlen(directory)-1 then directory = directory+sep 
    55    if keyword_set(nopath) then return, directory 
    56 ; does directory is define in the !path variable or is it the current directory? 
    57    possibledirectory = str_sep(!path, pathsep) 
    58    if rstrpos(possibledirectory[0],sep) NE strlen(possibledirectory[0])-1 then $ 
    59     possibledirectory = possibledirectory+sep 
    60    possibledirectory = [current, possibledirectory] 
    61    while (where(possibledirectory EQ directory))[0] EQ -1 do begin 
    62       directory = dialog_pickfile(/directory, title = title) 
    63       if directory EQ '' then return, report('read_data canceled') 
    64       if rstrpos(directory, sep) NE strlen(directory)-1 then directory = directory+sep 
    65    endwhile 
    66  
    67    return, directory 
    68 end 
     51  CASE 1 OF 
     52    (size(directoryin, /type))[0] EQ 7:directory = directoryin 
     53    keyword_set(iodirectory):directory = iodirectory 
     54    ELSE:directory = 'directory that is not existing' 
     55  ENDCASE 
     56  testfile = file_test(directory, /directory) 
     57; if directory doesn't exist, we ask the user to provide a directory name 
     58  IF total(testfile) NE n_elements(directory) THEN BEGIN 
     59    IF NOT keyword_set(title) THEN title = 'choose a directory' 
     60    FOR i = 0, n_elements(directory)-1 DO BEGIN 
     61      IF testfile[i] EQ 0 THEN BEGIN 
     62        directory[i] = dialog_pickfile(/directory, title = title $ 
     63                                       , /must_exist, _extra = ex) 
     64        if directory[i] EQ '' THEN RETURN, report('check/find directory canceled') 
     65      ENDIF 
     66    ENDFOR 
     67  ENDIF 
     68; 
     69  directory = file_search(directory, /mark_directory) 
     70  IF n_elements(directory) EQ 1 THEN RETURN, directory[0] $ 
     71  ELSE RETURN, directory 
     72; 
     73END 
    6974 
    7075 

  • trunk/Utilities/isafile.pro

    r9 r11  
    33;------------------------------------------------------------ 
    44;+ 
    5 ; NAME:isafile 
     5; NAME: isafile 
    66; 
    7 ; PURPOSE:find a file and check if it is a real file! 
     7; PURPOSE: same as find.pro except that as long as the file is 'NOT FOUND', 
     8;          isafile calls dialog_pickfile, to ask the user to select a file. 
    89; 
    9 ; CATEGORY:for open 
     10; CATEGORY: io 
    1011; 
    11 ; CALLING SEQUENCE:filename = isafile() 
     12; CALLING SEQUENCE:filename = isafile([filein]) 
    1213;  
    13 ; INPUTS:none 
     14; INPUTS:optional:a proposed name. If neither filein 
     15;        input parameter of filename keyword are defined, 
     16;        the ask the user to choose a file. 
    1417; 
    1518; KEYWORD PARAMETERS: 
    16 ;       FILENAME: a proposed filename. 
    17 ;       IODIRECTORY: a directory where must be the file. 
    18 ;       /NEW:to specify that filename is a new file 
    1919; 
    20 ; OUTPUTS:the filename 
     20;     FILENAME: a proposed filename. 
     21; 
     22;     IODIRECTORY: a directory where we look for the file. this 
     23;           keyword is taken into account only if the dirmame 
     24;           of filein or filename is '.' 
     25; 
     26;     /NEW:to specify that filename is a new file and that 
     27;        we should check only its path 
     28; 
     29;     RECURSIVE: performs recursive searching of directory hierarchies. 
     30;        In a recursive search, find looks recursively for any and all  
     31;        subdirectories in the file hierarchy rooted at the IODIRECTORY 
     32;        argument.  
     33; 
     34;     all find, file_search and dialog_pickfile keywords (like title) 
     35; 
     36; OUTPUTS:the filename with its path 
    2137; 
    2238; COMMON BLOCKS:none 
    … …  
    2844; EXAMPLE: 
    2945; 
     46;  IDL> print, isafile('/Users/sebastie/SAXO_RD/Commons/cm_4mesh.pro') 
     47;  /Users/sebastie/SAXO_RD/Commons/cm_4mesh.pro 
     48;  IDL> print, isafile('cm_4mesh.pro', iodir = '/Users/sebastie/SAXO_RD/Commons') 
     49;  /Users/sebastie/SAXO_RD/Commons/cm_4mesh.pro 
     50;  IDL> print, isafile('cm_4mesh.pro', iodir = !path) 
     51;  /Users/sebastie/SAXO_RD/Commons/cm_4mesh.pro 
     52;  IDL> print, isafile('cm_4mesh.pro', iodir = '/Users/sebastie/SAXO_RD', /recursive) 
     53;  /Users/sebastie/SAXO_RD/Commons/cm_4mesh.pro 
     54;  IDL> print, isafile('cm_4mesh.pro', iodir = getenv('HOME'), /recursive) 
     55;  /Users/sebastie/SAXO_RD/Commons/cm_4mesh.pro 
     56;  IDL> print, isafile('fake_file.pro') 
     57; 
    3058; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr) 
    3159;                      11/2/2000 
     60; June 2005: Sebastien Masson: cleaning, use for file_* functions 
    3261;- 
    3362;------------------------------------------------------------ 
    3463;------------------------------------------------------------ 
    3564;------------------------------------------------------------ 
    36 FUNCTION isafile, FILENAME = filename, IODIRECTORY = iodirectory, FILTER = filter, NEW = new 
     65FUNCTION isafile, filein, FILENAME = filename, IODIRECTORY = iodirectory $ 
     66                  , NEW = new, RECURSIVE = RECURSIVE, _extra = ex 
    3767;------------------------------------------------------------ 
    38 ; we find the filename. 
    39 ;------------------------------------------------------------ 
    40 ; is filename given by the FILENAME keyword a good one? 
    41 ; si iodirectory n''est pas definit on l''initialise au repertoire courant 
    42    if NOT keyword_set(filename) then filename = 'nimportequoi' 
    43    thisOS = strupcase(strmid(!version.os_family, 0, 3)) 
    44    CASE thisOS OF  
    45       'MAC':sep = ':' 
    46       'WIN':sep = '\' 
    47       ELSE:sep = '/' 
    48    ENDCASE 
    49 ; we complete filename by iodirectory? 
    50    if strpos(filename, sep) EQ -1 then begin 
    51       if NOT keyword_set(iodirectory) then cd, current = iodirectory 
    52 ; si iodirectory ne finit pas par sep on le rajoute 
    53       if rstrpos(iodirectory, sep) NE strlen(iodirectory)-1 then $ 
    54        iodirectory = iodirectory+sep 
    55       filename = iodirectory+filename 
    56    ENDIF 
    57    if keyword_set(new) then return, filename 
    58    test = findfile(filename)    ; le nom cherche correspond bien a un fichier? 
    59    while test[0] EQ '' OR n_elements(test) GT 1 do BEGIN ; on en cherche un tant qu''il ne correspond a rien! 
    60       test = test[0] 
    61       if keyword_set(filter) AND thisOS NE 'MAC' AND thisOS NE 'WIN' then $ 
    62        filename = dialog_pickfile(path = iodirectory, filter = filter) $ 
    63        ELSE filename = dialog_pickfile(path = iodirectory) 
    64       if filename EQ '' then return, report('read_data canceled') 
    65       test = findfile(filename) 
    66    endwhile 
    67  
    68    return, filename 
    69 end 
     68  CASE 1 OF 
     69    (size(filein, /type))[0] EQ 7:fileout = filein 
     70    keyword_set(filename):fileout = filename 
     71    ELSE:fileout = 'file that is not existing' 
     72  ENDCASE 
     73  if size(fileout, /type) NE 7 THEN return, -1 
     74; 
     75  basename = file_basename(fileout) 
     76  dirname = file_dirname(fileout) 
     77; should we redefine dirname? 
     78  if keyword_set(iodirectory) AND dirname EQ '.' then dirname = iodirectory 
     79; 
     80  if keyword_set(new) then return, dirname + path_sep() + basename 
     81; 
     82  fileout = find(basename, iodirectory = dirname $ 
     83                 , recursive = recursive, /unique, /firstfound, _extra = ex) 
     84  WHILE fileout[0] EQ 'NOT FOUND' DO BEGIN 
     85    fileout = dialog_pickfile(path = dirname[0], _extra = ex) 
     86    if fileout EQ '' THEN RETURN, report('check/find file canceled') 
     87; check again everything... 
     88    basename = file_basename(fileout) 
     89    dirname = file_dirname(fileout) 
     90; check if the name of the dirname is ok 
     91    dirname = isadirectory(dirname, title = 'choose a directory for the file ' $ 
     92                           + basename) 
     93; if we cancel the check 
     94    IF size(dirname, /type) NE 7 THEN return, report('check/find file canceled') 
     95    fileout = find(basename, iodirectory = dirname $ 
     96                   , recursive = recursive, /unique, /firstfound, _extra = ex) 
     97  ENDWHILE 
     98; 
     99  RETURN, fileout 
     100END 
Note: See TracChangeset for help on using the changeset viewer.