- Timestamp:
- 04/27/06 11:05:35 (18 years ago)
- Location:
- trunk
- Files:
-
- 3 added
- 19 moved
Legend:
- Unmodified
- Added
- Removed
-
trunk/Obsolete/cp.pro
r9 r11 6 6 ; 7 7 ; PURPOSE: copy files 8 ; obsolete, file_copy should be used instead... 8 9 ; 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 28 12 ; 29 13 ;- … … 31 15 ;------------------------------------------------------------ 32 16 ;------------------------------------------------------------ 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 17 PRO cp, filenamein, filenameout, _extra = ex 18 file_copy, filenamein, filenameout, _extra = ex 19 RETURN 20 END -
trunk/ToBeReviewed/UTILITAIRE/fitintobox.pro
r9 r11 5 5 ; NAME:fitintobox 6 6 ; 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. 9 10 ; 10 ; CATEGORY: pour les debuts de noumbreux programme (blindage)11 ; CATEGORY: domain compatibility 11 12 ; 12 ; CALLING SEQUENCE:res=fitintobox(field) 13 ; CALLING SEQUENCE: 14 ; res = fitintobox(field[, nx, ny, nz, firstx, firsty, firstz 15 ; , lastx, lasty, lastz]) 13 16 ; 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 16 26 ; 17 ; KEYWORD PARAMETERS: 27 ; OUTPUTS: an array with dimensions matching the domain 28 ; or -1 if there is an error... 18 29 ; 19 ; OUTPUTS:un tableau a la taille du domaine 4d. 20 ; 21 ; COMMON BLOCKS:common.pro 30 ; COMMON BLOCKS: cm_4mesh and cm_4cal 22 31 ; 23 32 ; SIDE EFFECTS: 24 33 ; 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: 30 35 ; 31 36 ; EXAMPLE: 32 37 ; 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 ; 33 47 ; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr) 34 48 ; 10 juin 2000. 49 ; June 2005: S. Masson rewrite all. 35 50 ;- 36 51 ;------------------------------------------------------------ 37 52 ;------------------------------------------------------------ 38 53 ;------------------------------------------------------------ 39 FUNCTION fitintobox, field 40 @common 54 FUNCTION 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) 72 END 73 ;------------------------------------------------------------ 74 FUNCTION 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 41 83 ;--------------------- 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 44 197 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 103 199 end -
trunk/ToBeReviewed/UTILITAIRE/oups.pro
r9 r11 32 32 journal 33 33 ; on recupere le journal sous la forme d''un vecteur de string: 34 vectjournal = getfile( homedir+'idlsave.pro')34 vectjournal = getfile(myuniquetmpdir+'idlsave.pro') 35 35 ; on coupe la derniere ligne qui est oups 36 36 vectjournal = vectjournal[0:n_elements(vectjournal)-2 ] … … 68 68 ELSE vectjournal[n_elements(vectjournal)-1] = '' 69 69 ; on reecrit idlsave.pro 70 putfile, homedir+'idlsave.pro', vectjournal70 putfile, myuniquetmpdir+'idlsave.pro', vectjournal 71 71 ; on compile puis applique idlsave 72 cd, homedir 72 cd, current = curdir 73 cd, myuniquetmpdir 73 74 @idlsave 75 cd, curdir 74 76 ; le journal vient d'etre reouvert, et on y met les elements de 75 77 ; vectjournal 76 78 for i = 0, n_elements(vectjournal)-1 DO $ 77 printf, !journal, vectjournal[i]79 journal, vectjournal[i] 78 80 79 81 -
trunk/ToBeReviewed/UTILITAIRE/report.pro
r9 r11 18 18 ; array element is displayed as a separate line of text. 19 19 ; 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 + 21 25 ; PARENT qui fait la meme chose que DIALOG_PARENT de dialog_message.pro 22 26 ; … … 55 59 ;------------------------------------------------------------ 56 60 ;------------------------------------------------------------ 57 FUNCTION report, text, DEFAULT_NO = default_no, PARENT = parent, QUESTION = question, _extra = ex61 FUNCTION report, text, DEFAULT_NO = default_no, PARENT = parent, QUESTION = question, SIMPLE = simple, _extra = ex 58 62 res = -1 ; 59 ; on separe le text en differentes lignes (separees par !C) si ce63 ; on separe le texte en differentes lignes (separees par !C) si ce 60 64 ; n''est pas deja fait... 61 65 if n_elements(text) EQ 1 then text = str_sep(text, '!C', /trim) … … 89 93 endif ELSE BEGIN 90 94 ; si on ne pose pas de question on fait juste un print 95 IF keyword_set(simple) THEN prefix = '' ELSE prefix = '% '+routine_name(1)+': ' 91 96 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] 94 99 ENDELSE 95 100 ENDELSE -
trunk/ToBeReviewed/UTILITAIRE/routine_name.pro
r9 r11 52 52 FUNCTION routine_name, remonte 53 53 ; 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 59 57 ; unique sring 60 61 58 allnames = '' 59 for i = 0, n_elements(name)-1 do allnames = allnames+name[i] 62 60 ; 63 64 name = strtrim(name, 2); on eleve les blancs devant et derriere65 name = strcompress(name); on compresse les blancs61 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 66 64 ; on ne retient pas les 2 premiers elements qui sont 1 un vide et la 67 65 ; ligne concernant routine_name 68 66 name = name[2: n_elements(name)-1] 69 67 ; 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 81 76 end -
trunk/ToBeReviewed/UTILITAIRE/vzoom.pro
r9 r11 30 30 y = [y1, y2] 31 31 y = y[sort(y)] 32 domdef, [x, y, prof1, prof2]32 domdef, [x, y, vert1, vert2] 33 33 ; il faut fermer le journal! 34 34 journal 35 35 ; on recupere le journal sous la forme d''un vecteur de string: 36 vectjournal = getfile( homedir+'idlsave.pro')36 vectjournal = getfile(myuniquetmpdir+'idlsave.pro') 37 37 ; on coupe la derniere ligne qui est vraizoom 38 38 vectjournal = vectjournal[0:n_elements(vectjournal)-2 ] … … 66 66 ; 67 67 ; on reecrit idlsave.pro 68 putfile, homedir+'idlsave.pro', vectjournal68 putfile, myuniquetmpdir+'idlsave.pro', vectjournal 69 69 ; applique idlsave 70 cd, homedir 70 cd, current = curdir 71 cd, myuniquetmpdir 71 72 @idlsave 73 cd, curdir 72 74 ; le journal vient d'etre reouvert, et on y met les elements de 73 75 ; vectjournal 74 76 for i = 0, n_elements(vectjournal)-1 DO $ 75 printf, !journal, vectjournal[i]77 journal, vectjournal[i] 76 78 77 79 -
trunk/Utilities/createpro.pro
r9 r11 5 5 ; NAME:createpro 6 6 ; 7 ; PURPOSE: ecrit un .pro le compile et l''execute7 ; PURPOSE: write an idl procedure, compile it and execute it. 8 8 ; 9 9 ; CATEGORY: … … 12 12 ; 13 13 ; INPUTS: 14 ; command:un vecteur de string contenant les intructions a15 ; passer pour construire la procedure14 ; command: a string array defining the procedure to be created. 15 ; each element will be a line of the created procedure. 16 16 ; 17 17 ; KEYWORD PARAMETERS: 18 ; filenamein: un string donnant le nom de la procedure a ecrire19 18 ; 20 ; OUTPUTS: 19 ; FILENAMEIN: name of the procedure to be created. 20 ; 'for_createpro.pro' by default 21 21 ; 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' 23 25 ; 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 25 35 ; 26 36 ; RESTRICTIONS:de marche pas pour les fonctions 27 37 ; 28 38 ; 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 ; 30 45 ; 31 46 ; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr) 32 ; 47 ; cleaning + new keywords: October 2005 33 48 ;- 34 49 ;------------------------------------------------------------ 35 50 ;------------------------------------------------------------ 36 51 ;------------------------------------------------------------ 37 PRO createpro, command, filenamein = filenamein 52 PRO createpro, command, FILENAMEIN = filenamein $ 53 , KWDLIST = kwdlist, KWDUSED = kwdused 38 54 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 59 73 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 ; 61 79 return 62 80 end -
trunk/Utilities/find.pro
r9 r11 5 5 ; NAME:find 6 6 ; 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 12 11 ; 13 ; CATEGORY: trouver un fichier12 ; CATEGORY:find a file 14 13 ; 15 ; CALLING SEQUENCE: nom_entier=find('nom_fichier')14 ; CALLING SEQUENCE: found = find(filename) 16 15 ; 17 ; INPUTS: 18 ; nom_fichier: un string contenant le nom du fichier. Si ce19 ; fichier ne contient pas une extension (.bidule) on essaie de20 ; chercher un fichier nom_fichier.pro. Ce string peut contenir le21 ; caractere * qui, comme sous unix, remplace n''importe quelle chaine22 ; 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' 23 22 ; 24 23 ; KEYWORD PARAMETERS: 25 ; REPERTOIRE: activer ce mot cle si on veut que find donne26 ; uniquement les differents repertoires ou on peut trouver le27 ; fichier28 24 ; 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. 31 32 ; 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' 40 55 ; 41 56 ; COMMON BLOCKS: none … … 47 62 ; EXAMPLE: 48 63 ; 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 57 88 ; 58 89 ; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr) 59 90 ; 28/4/1999 60 91 ; 6/7/1999: compatibilite mac et windows 92 ; June 2005: Sebastien Masson: cleaning, use for file_* functions 61 93 ;- 62 94 ;------------------------------------------------------------ 95 ; print, 63 96 ;------------------------------------------------------------ 64 97 ;------------------------------------------------------------ 65 FUNCTION find, nomfichier, REPERTOIRE = repertoire, NOPRO = nopro66 nomfich = nomfichier67 ; 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 of74 'MAC':BEGIN & sep = ':' & pathsep = ',' & end75 'WIN':BEGIN & sep = '\' & pathsep = ';' & end76 ELSE: BEGIN & sep = '/' & pathsep = ':' & end77 ENDCASE78 cd, current = current79 if strpos(nomfich,sep) lt 0 then BEGIN80 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 +sep83 nomfich = [current, multipath]+ nomfich84 ENDIF85 ; on test tous les noms possibles pour trouver ou est le fichier86 res = [' ']87 for n = 0, n_elements(nomfich)-1 do BEGIN88 tmp = findfile(nomfich[n]) 89 if tmp[0] NE '' then res = [res, tmp]90 ENDFOR91 if n_elements(res) EQ 1 then return, 'NOT FOUND' ELSE BEGIN92 res = res[1:n_elements(res)-1]93 IF keyword_set(repertoire) then BEGIN94 ; 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))]98 FUNCTION 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 98 131 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 143 END -
trunk/Utilities/isadirectory.pro
r9 r11 5 5 ; NAME:isadirectory 6 6 ; 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. 10 9 ; 11 10 ; CATEGORY: io 12 11 ; 13 ; CALLING SEQUENCE: directory=isadirectory( )12 ; CALLING SEQUENCE: directory=isadirectory([dirname]) 14 13 ; 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. 16 17 ; 17 18 ; KEYWORD PARAMETERS: 18 ; IODIRECTORY:a proposed directory19 ; TITLE: the title of the widget open if we need to choose a20 ; directory.21 ; /NOPATH:do not check if the directory is in the !path22 ; variable.23 19 ; 24 ; OUTPUTS: de directory name20 ; IODIRECTORY:a proposed directory 25 21 ; 26 ; COMMON BLOCKS:22 ; TITLE = the title of the window 27 23 ; 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: 29 31 ; 30 32 ; RESTRICTIONS: … … 32 34 ; EXAMPLE: 33 35 ; 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 ; 34 42 ; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr) 35 43 ; June 28, 2000 44 ; June 2005: Sebastien Masson: cleaning, use for file_* functions 36 45 ;- 37 46 ;------------------------------------------------------------ 38 47 ;------------------------------------------------------------ 39 48 ;------------------------------------------------------------ 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 49 FUNCTION isadirectory, directoryin, TITLE = title, IODIRECTORY = iodirectory, _extra = ex 45 50 ; 46 thisOS = strupcase(strmid(!version.os_family, 0, 3))47 CASE thisOS of48 'MAC':BEGIN & sep = ':' & pathsep = ',' & end49 'WIN':BEGIN & sep = '\' & pathsep = ';' & end50 ELSE: BEGIN & sep = '/' & pathsep = ':' & end51 ENDCASE52 ; si directory ou current ne finit pas par sep on le rajoute53 if rstrpos(current,sep) NE strlen(current)-1 then current = current+sep54 if rstrpos(directory, sep) NE strlen(directory)-1 then directory = directory+sep55 if keyword_set(nopath) then return, directory56 ; 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+sep60 possibledirectory = [current, possibledirectory]61 while (where(possibledirectory EQ directory))[0] EQ -1 do begin62 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+sep65 endwhile66 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 ; 73 END 69 74 70 75 -
trunk/Utilities/isafile.pro
r9 r11 3 3 ;------------------------------------------------------------ 4 4 ;+ 5 ; NAME: isafile5 ; NAME: isafile 6 6 ; 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. 8 9 ; 9 ; CATEGORY: for open10 ; CATEGORY: io 10 11 ; 11 ; CALLING SEQUENCE:filename = isafile( )12 ; CALLING SEQUENCE:filename = isafile([filein]) 12 13 ; 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. 14 17 ; 15 18 ; 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 file19 19 ; 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 21 37 ; 22 38 ; COMMON BLOCKS:none … … 28 44 ; EXAMPLE: 29 45 ; 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 ; 30 58 ; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr) 31 59 ; 11/2/2000 60 ; June 2005: Sebastien Masson: cleaning, use for file_* functions 32 61 ;- 33 62 ;------------------------------------------------------------ 34 63 ;------------------------------------------------------------ 35 64 ;------------------------------------------------------------ 36 FUNCTION isafile, FILENAME = filename, IODIRECTORY = iodirectory, FILTER = filter, NEW = new 65 FUNCTION isafile, filein, FILENAME = filename, IODIRECTORY = iodirectory $ 66 , NEW = new, RECURSIVE = RECURSIVE, _extra = ex 37 67 ;------------------------------------------------------------ 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 100 END
Note: See TracChangeset
for help on using the changeset viewer.